timeliner/process-locations.lisp

(defun ts->ms (ts)
  (+ (* 1000 (local-time:timestamp-to-unix ts))
     (floor (local-time:nsec-of ts) 1000000)))
(defun ms->ts (ms)
  (multiple-value-bind (unix msec) (floor ms 1000)
    (local-time:unix-to-timestamp unix :nsec (* msec 1000000))))

(defun $between (a from to)
  (kv ($>= a from) ($< a to)))

(defun reverse-geocode (lat lon)
  (let* ((data (yason:parse
                (flexi-streams:octets-to-string
                 (drakma:http-request
                  (format nil
                          "http://open.mapquestapi.com/nominatim/v1/reverse.php?format=json&lat=~A&lon=~A"
                          lat lon)))))
         (address (gethash "address" data)))
    (values (gethash "display_name" data)
            address)))

(defmethod cl-mongo::bson-encode((key string) (value local-time:timestamp) &key (array nil))
  (cl-mongo::bson-encode key (cl-mongo::make-bson-time (ts->ms value)) :array array))

(defun make-place-doc (loc)
  (let* ((point (cdr loc))
         (lat (geo:latitude-deg point))
         (lon (geo:longitude-deg point)))
    (multiple-value-bind (text address) (reverse-geocode lat lon)
      (kv
       (kv :ts (car loc))
       (kv :type "place")
       (kv :title text)
       (kv :language (gethash "country_code" address))
       (kv :loc (kv (kv :type "Point") ; GeoJSON Point
                    (kv :coordinates (list lon lat))))))))

(defun save-places (places)
  (loop for place in places
     do (db.insert "events" (make-place-doc place))))

(defun extract-places (locs)
  (loop
     for loc in locs
     for point = (cdr loc)
     with last-place and last-loc and moved and need-add
     when last-loc do (setf moved
                            (geo:distance>=
                             (geo:distance-between
                              point
                              (cdr last-loc))
                             (geo:distance-meters 100)))
     when moved do (setf last-loc loc ; Store loc as possible place
                         need-add t)
     when (and need-add last-place last-loc
               (geo:distance<
                (geo:distance-between
                 (cdr last-place)
                 (cdr last-loc))
                (geo:distance-meters 200))) do (setf need-add nil) ; Do not add same place after glitch
     when (and need-add
               (> (local-time:timestamp-difference
                   (car loc)
                   (car last-loc))
                  400)) ; When stayed in 100m for 6.6mins
     collect last-loc
     and do (setf need-add nil) (setf last-place last-loc)
     when (not last-loc) do (setf last-loc loc)))

(defun doc->point (doc)
  (let ((coord (get-element "coordinates"
                            (get-element "loc" doc))))
    (geo:point-deg (second coord) (first coord))))

(defun doc->ts (doc)
  (local-time:unix-to-timestamp
   (floor (get-element "timestampMs" doc) 1000)))

(defun docs->locs (docs)
  (loop for doc in docs
     collect (cons (doc->ts doc) (doc->point doc))))

(defun ts->kv (field ts)
  (let ((nd (local-time:timestamp+ ts 1 :day)))
    ($between field
              (* 1000 (local-time:timestamp-to-unix ts))
              (* 1000 (local-time:timestamp-to-unix nd)))))

(defun takedown-import (from-date)
  (let ((now (local-time:now)))
    (loop
       for ts = (local-time:parse-timestring from-date) then (local-time:timestamp+ ts 1 :day)
       for locs = (docs->locs (docs (db.sort "locations" (ts->kv "timestampMs" ts) :field "timestampMs" :limit 1440)))
       for places = (extract-places locs)
       when places do
         (format t "Inserting ~A places for ~A~%" (length places) ts)
         (save-places places)
       until (local-time:timestamp> ts now)
       finally (return ts))))

(defvar *google-cookie* "__utma=237271068.717680786.1400099247.1400832512.1401060155.8; __utmb=237271068.1.10.1401060155; __utmc=237271068; __utmz=237271068.1400099247.1.1.utmcsr=google|utmccn=(organic)|utmcmd=organic|utmctr=(not%20provided); PREF=ID=1286af472975083f:U=66bfdd2c2bd546ec:FF=0:LD=en:TM=1387331606:LM=1387331648:GM=1:S=HyJJz5GiPYDO3enC; S_awfe=Flyca3yNcq7bRAELW3sHjA; S=adwords-kwoptimization=b5C-NozKx2e3M_Ey4fAz8Q:adwords-usermgmt=aI9og5GCca-P2__xQn18JA:adwords-common-ui=8D_eUxAYAsq3Vb2nq2sHEA:awfe=9MHnmAxQpPW7cx1DI0UVyg:awfe-efe=9MHnmAxQpPW7cx1DI0UVyg:adwords-campaignmgmt=RLKckyB0orOMG3ZDyKgvvg:adwords-navi=mLrH6o9Yts0R11WpddXxLA:adwords-conversiontracking=W211LBaz36B5ZeTzW4DNAA:static_files=_yP-7t9tqQM:payments=_ni1ZumEGMN4fOzdKRqH7w; NID=67=rrSfF1FmREywf26qNS2Y9H8wqUm9Ld3EtkVd9wZl7anEjYJKijA_4xCWKiNNiT4Coqdg-yA-Rswh3LTzCj5Mj-oQbc_MFQc5LqYTMBtdxpYPmaJHKom8Zk60dI9vxnYm4nP3qHSc0m84blpORHhzDdCMF4I-_-x9X-53Y_Iw4DwkOmSdBz5QPih3YTzzsbJZURmWqjLmtqj6JEa-4ylUwWNWM4puhCJEG69zjF4BjAfUuK_y1A3SEg3ptmGrttEZOvOVBZDGFMIJ0l85aa7Chud687F5DyAgi1qGOs946JD22CSU39PKyg; HSID=A7iaFUZxprrjrPKeS; SSID=AvKqEId4AsgbqLtOj; APISID=JFjZBUABTu9DaM0C/AYUyz9k8ypD0yblUO; SAPISID=QDr6_QSyPK0KKySp/AYUaTYz2U06LZYAcM; OGPC=4061130-2:; SID=DQAAAPoCAAAR29_N5Y6ftVeVr8w7iuna8fqkpEgI6D-9SLe26d835wthWtZsL5sL-aUWi6J4-6GEybslhCf4aJCxnBV4xIkKKiRDEhtqQAztV-kr1lbYQ6-FewxvQB63_eqlIqobVo_k-bQAirTpDBPsMwrY27PuM4qPJDQI8i9TYnU7F5bEph0DF-h7bJ9cbEQewoZRlyjopHClpZk3Z9Bh8i8vBbFZfDkTRXXD59vRO6BQrqcGvXdrzRqV8fzCDEB3EM7xd75y2y2l3hNXhQSZiAGQaZhrdxQ461BQ1i7Kug2vfKv1VSW5pCOratacplqSjsEXhj9hIsrT_gkiW2xWwLLrEBTF3vcM1tzWK7vinjm78ZPJwq9j3ZzDJ07svQ68ssTOpxQ027e-frCevBHvXFBtY8MubNtb-IpzOjEeM7DmCRP91z0ia5zQU5V7CHb78_cYbL_6gj0_OVc-kXoq-CLGS6NiQMTFHxf6uaE4Qu4aXNndqU45s83zw028y0SSHwv7l5OeiGYUoCPUfd8fazfPnV8-zia4BYuuZF4vn9s0MzsdkNmf45RSSXzFlAE97fzgtzzfcPtSqi-eTFkF9R_UEER8ZDqXL6B-9AD2rosoEZebeFD-YzCgP31GfzbvuTYjkPHKsRxD9Lbd3Kt7UxaS-bLwPNycqABwxemkIANKsbDDwwmLw4FxmC5uPXxrbx6bfG9ZzK-qxZIS3I3c_S1yRtsPuFCiCwKLcSGnIiK50IBL8Rd8iuKrWEYkRadwFgUn8JcgsnGKVfmQ8PdYcj6AIm5RZUr54fjbwgar964otDgQlKUl75GxZYzQwHf22zfZqHeNrbvz6J4IPS2iMh1BNrBxpAEA6uouJsQPa-77ETRJpHuF0GpBS14PSE-oI8jUS0i787JCnZBS7PsBHGQi2NMCDY_NRQybVeazdrEkPVYecZOfwGB7WDb6asHB-wRUhWHUNivX9DGEe9tuKV0JYY5PS93PdboxJYY7O7j9XlLLOU97YOI2Rm4hxGm0M8kUKIw")
(defvar *google-manual-header* "fqHTCQQE3WGc62jBT3NPR9y3BmI:1401060149338")

(defun load-history (from &optional (to (local-time:timestamp+ from 1 :day)) (trim nil))
  (loop for loc in (cadadr (yason:parse
                            (flexi-streams:octets-to-string
                             (drakma:http-request
                              "https://maps.google.com/locationhistory/b/0/apps/pvjson?t=0"
                              :method :post
                              :user-agent "Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/35.0.1916.114 Safari/537.36"
                              :content (format nil "[null,~A,~A,~A]"
                                               (ts->ms from)
                                               (ts->ms to)
                                               (if trim "true" "false"))
                              :additional-headers (list (cons "x-manualheader" *google-manual-header*)
                                                        (cons "cookie" *google-cookie*)
                                                        '("referer" . "https://maps.google.com/locationhistory/b/0"))))))
     collect (cons (ms->ts (parse-integer (cadr loc)))
                   (geo:point-deg (caddr loc) (cadddr loc)))))

(defun point->doc (point)
  (when point
    (kv (kv :type "Point") ; GeoJSON Point
        (kv :coordinates (list (geo:longitude-deg point)
                               (geo:latitude-deg point))))))

(defun make-location-doc (loc)
  (kv
   (kv "timestampMs" (ts->ms (car loc)))
   (kv "loc" (point->doc (cdr loc)))))

(defun save-locations (locations)
  (loop for loc in locations
     do (db.insert "locations" (make-location-doc loc))))

(defun json-import (from &optional (to (local-time:timestamp+ from 1 :day)))
  (let* ((locs (load-history from to nil))
         (places (extract-places locs)))
    (format t "Saving ~A locations for ~A~%" (length locs) from)
    (save-locations locs)
    (format t "Saving ~A place events for ~A~%" (length places) from)
    (save-places places)))

(defun find-location-at (ms)
  (let* ((ts (ms->ts ms))
         (docs (docs (db.sort "locations"
                              ($between
                               "timestampMs"
                               (ts->ms (local-time:timestamp- ts 5 :minute))
                               (ts->ms (local-time:timestamp+ ts 5 :minute)))
                              :field "timestampMs" :limit 15)))
         less
         greater)
    (loop
       for doc in docs
       for docMs = (get-element "timestampMs" doc)
       when (<= docMs ms) do (setf less doc)
       when (and (not greater) (>= docMs ms)) do (setf greater doc))
    (when (and less greater)
      (geo:interpolate-between-points
       (doc->point less)
       (doc->point greater)
       (/ (- ms (get-element "timestampMs" less))
          (- (get-element "timestampMs" greater)
             (get-element "timestampMs" less)))))))