|
@@ -14,6 +14,10 @@
|
|
|
(local-time:unix-to-timestamp
|
|
(local-time:unix-to-timestamp
|
|
|
(floor (get-element "timestampMs" doc) 1000)))
|
|
(floor (get-element "timestampMs" doc) 1000)))
|
|
|
|
|
|
|
|
|
|
+(defun docs->locs (docs)
|
|
|
|
|
+ (loop for doc in docs
|
|
|
|
|
+ collect (cons (doc->ts doc) (doc->point (doc)))))
|
|
|
|
|
+
|
|
|
(defun day-kv (date)
|
|
(defun day-kv (date)
|
|
|
(ts->kv (local-time:parse-timestring date)))
|
|
(ts->kv (local-time:parse-timestring date)))
|
|
|
|
|
|
|
@@ -49,33 +53,33 @@
|
|
|
(kv :loc (kv (kv :type "Point") ; GeoJSON Point
|
|
(kv :loc (kv (kv :type "Point") ; GeoJSON Point
|
|
|
(kv :coordinates (list lon lat))))))))
|
|
(kv :coordinates (list lon lat))))))))
|
|
|
|
|
|
|
|
-(defun extract-places (docs)
|
|
|
|
|
|
|
+(defun extract-places (locs)
|
|
|
(loop
|
|
(loop
|
|
|
- for doc in docs
|
|
|
|
|
- for point = (doc->point doc)
|
|
|
|
|
|
|
+ for loc in locs
|
|
|
|
|
+ for point = (cdr loc)
|
|
|
with last-place and moved and need-add
|
|
with last-place and moved and need-add
|
|
|
when last-place do (setf moved
|
|
when last-place do (setf moved
|
|
|
(geo:distance>=
|
|
(geo:distance>=
|
|
|
(geo:distance-between
|
|
(geo:distance-between
|
|
|
point
|
|
point
|
|
|
- (doc->point last-place))
|
|
|
|
|
- (geo:distance-meters 200)))
|
|
|
|
|
- when moved do (setf last-place doc
|
|
|
|
|
|
|
+ (cdr last-place))
|
|
|
|
|
+ (geo:distance-meters 100)))
|
|
|
|
|
+ when moved do (setf last-place loc
|
|
|
need-add t)
|
|
need-add t)
|
|
|
when (and need-add
|
|
when (and need-add
|
|
|
(> (local-time:timestamp-difference
|
|
(> (local-time:timestamp-difference
|
|
|
- (doc->ts doc)
|
|
|
|
|
- (doc->ts last-place))
|
|
|
|
|
- 400))
|
|
|
|
|
- collect (cons (doc->ts last-place) (doc->point last-place))
|
|
|
|
|
|
|
+ (car loc)
|
|
|
|
|
+ (car last-place))
|
|
|
|
|
+ 400)) ; When stayed in 100m for 6.6mins
|
|
|
|
|
+ collect last-place
|
|
|
and do (setf need-add nil)
|
|
and do (setf need-add nil)
|
|
|
- when (not last-place) do (setf last-place doc)))
|
|
|
|
|
|
|
+ when (not last-place) do (setf last-place loc)))
|
|
|
|
|
|
|
|
(defun takedown-import (from-date)
|
|
(defun takedown-import (from-date)
|
|
|
(let ((now (local-time:now)))
|
|
(let ((now (local-time:now)))
|
|
|
(loop
|
|
(loop
|
|
|
for ts = (local-time:parse-timestring from-date) then (local-time:timestamp+ ts 1 :day)
|
|
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 locs = (docs->locs (docs (db.sort "locations" (ts->kv ts) :field "timestampMs" :limit 1440)))
|
|
|
for places = (extract-places locs)
|
|
for places = (extract-places locs)
|
|
|
when places do
|
|
when places do
|
|
|
(format t "Inserting ~A places for ~A~%" (length places) ts)
|
|
(format t "Inserting ~A places for ~A~%" (length places) ts)
|
|
@@ -100,6 +104,5 @@
|
|
|
(if trim "true" "false"))
|
|
(if trim "true" "false"))
|
|
|
:additional-headers (list (cons "x-manualheader" *google-manual-header*)
|
|
:additional-headers (list (cons "x-manualheader" *google-manual-header*)
|
|
|
(cons "cookie" *google-cookie*))))))
|
|
(cons "cookie" *google-cookie*))))))
|
|
|
- collect (list (ms->ts (parse-integer (cadr loc)))
|
|
|
|
|
- (cons (caddr loc)
|
|
|
|
|
- (cadddr loc)))))
|
|
|
|
|
|
|
+ collect (cons (ms->ts (parse-integer (cadr loc)))
|
|
|
|
|
+ (geo:point-deg (caddr loc) (cadddr loc)))))
|