timeliner/process-locations.lisp

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

(defun doc->point (doc)
  (geo:point-deg
   (/ (get-element "latitudeE7" doc) 1d7)
   (/ (get-element "longitudeE7" doc) 1d7)))

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

(defun day-kv (date)
  (ts->kv (local-time:parse-timestring date)))

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

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

(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)))

(defun make-place-doc (ts point)
  (let ((lat (geo:latitude-deg point))
        (lon (geo:longitude-deg point)))
    (multiple-value-bind (text address) (reverse-geocode lat lon)
      (kv
       (kv :ts (ts->ms ts))
       (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 extract-places (docs)
  (loop
     for doc in docs
     for point = (doc->point doc)     
     with last-place and moved and need-add
     when last-place do (setf moved
                              (geo:distance>=
                               (geo:distance-between
                                point
                                (doc->point last-place))
                               (geo:distance-meters 200)))
     when moved do (setf last-place doc
                         need-add t)
     when (and need-add
               (> (local-time:timestamp-difference
                   (doc->ts doc)
                   (doc->ts last-place))
                  400))
     collect (cons (doc->ts last-place) (doc->point last-place))
     and do (setf need-add nil)
     when (not last-place) do (setf last-place doc)))

(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 (db.sort "locations" (ts->kv ts) :field "timestampMs" :limit 1440))
       for places = (extract-places locs)
       when places do
         (format t "Inserting ~A places for ~A~%" (length places) ts)
         (loop
            for place in places
            do (db.insert "events" (make-place-doc (car place) (cdr place))))
       until (local-time:timestamp> ts now)
       finally (return ts))))