process-locations.lisp 5.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105
  1. (defun ts->ms (ts)
  2. (+ (* 1000 (local-time:timestamp-to-unix ts))
  3. (floor (local-time:nsec-of ts) 1000000)))
  4. (defun ms->ts (ms)
  5. (multiple-value-bind (unix msec) (floor ms 1000)
  6. (local-time:unix-to-timestamp unix :nsec (* msec 1000000))))
  7. (defun doc->point (doc)
  8. (geo:point-deg
  9. (/ (get-element "latitudeE7" doc) 1d7)
  10. (/ (get-element "longitudeE7" doc) 1d7)))
  11. (defun doc->ts (doc)
  12. (local-time:unix-to-timestamp
  13. (floor (get-element "timestampMs" doc) 1000)))
  14. (defun day-kv (date)
  15. (ts->kv (local-time:parse-timestring date)))
  16. (defun $between (a from to)
  17. (kv ($>= a from) ($< a to)))
  18. (defun ts->kv (ts)
  19. (let ((nd (local-time:timestamp+ ts 1 :day)))
  20. ($between "timestampMs"
  21. (* 1000 (local-time:timestamp-to-unix ts))
  22. (* 1000 (local-time:timestamp-to-unix nd)))))
  23. (defun reverse-geocode (lat lon)
  24. (let* ((data (yason:parse
  25. (flexi-streams:octets-to-string
  26. (drakma:http-request
  27. (format nil
  28. "http://open.mapquestapi.com/nominatim/v1/reverse.php?format=json&lat=~A&lon=~A"
  29. lat lon)))))
  30. (address (gethash "address" data)))
  31. (values (gethash "display_name" data)
  32. address)))
  33. (defun make-place-doc (ts point)
  34. (let ((lat (geo:latitude-deg point))
  35. (lon (geo:longitude-deg point)))
  36. (multiple-value-bind (text address) (reverse-geocode lat lon)
  37. (kv
  38. (kv :ts (ts->ms ts))
  39. (kv :type "place")
  40. (kv :title text)
  41. (kv :language (gethash "country_code" address))
  42. (kv :loc (kv (kv :type "Point") ; GeoJSON Point
  43. (kv :coordinates (list lon lat))))))))
  44. (defun extract-places (docs)
  45. (loop
  46. for doc in docs
  47. for point = (doc->point doc)
  48. with last-place and moved and need-add
  49. when last-place do (setf moved
  50. (geo:distance>=
  51. (geo:distance-between
  52. point
  53. (doc->point last-place))
  54. (geo:distance-meters 200)))
  55. when moved do (setf last-place doc
  56. need-add t)
  57. when (and need-add
  58. (> (local-time:timestamp-difference
  59. (doc->ts doc)
  60. (doc->ts last-place))
  61. 400))
  62. collect (cons (doc->ts last-place) (doc->point last-place))
  63. and do (setf need-add nil)
  64. when (not last-place) do (setf last-place doc)))
  65. (defun takedown-import (from-date)
  66. (let ((now (local-time:now)))
  67. (loop
  68. for ts = (local-time:parse-timestring from-date) then (local-time:timestamp+ ts 1 :day)
  69. for locs = (docs (db.sort "locations" (ts->kv ts) :field "timestampMs" :limit 1440))
  70. for places = (extract-places locs)
  71. when places do
  72. (format t "Inserting ~A places for ~A~%" (length places) ts)
  73. (loop
  74. for place in places
  75. do (db.insert "events" (make-place-doc (car place) (cdr place))))
  76. until (local-time:timestamp> ts now)
  77. finally (return ts))))
  78. (defvar *google-cookie* "HSID=Aki-sRjrdW5Ikzy3v; SSID=Anhcow9ItEBTeSEg7; APISID=-70vjTcatbI3TD06/AwZG1FFCCDcT4k9fE; SAPISID=dZqsEdkN1kgwG5XK/AHKoDsreJPB4Vw_Ua; NID=67=iUAiGWHq9qJ29H3u0bbOwMDP4jQ8Ef3bL6w9u_eKXRwhTlVyyjsIIWQ11OgszFDjNrdSK_ibUXJot6keGMAqDetXyRTnTyQlR5E0a0DoTbOrul4bX7WEvBr-A24va66oFrMCQYwjSVgR4BK2Q5A1tVcw5tX_iFOH3HfwRZFXzUG6IHHI-96X1XPRoK0TH4D9LVBESdlf-XZLJ8yPv2s7b7NVVgFM1rYwsSbyvA-ps0CTC0DrCDL4L6MOixw0PtuWPsCE7F4-LFzAWAb-7yVhLpLJ; SID=DQAAALEBAAAQi6d7KrAJlOV7d9a8PsJSV0PmImGKfIQ-SUbWmiN8oyGMDYdPdM7Og6dF6VE45MMhzJ5Ckwselasme4hxuTOHqYJfPr7oCj8rz_71TIn1WO-GAkG3nYSh_6wvsG4L2ediBbHJB0LYRMfxYMynr5WEjHm1xDiRGyeIKnY3aZTp6h6rFFPg4ansPuPrig9cSBPpA0vLW5mUko9adS_NpWN8BAY9AQK01GyPq_QV1fDp-hTXwXTFNrYupU576r9-47xDzuG9GPecsihi8WBeFMwyvQBGixmlmxT8eFO6oh4p6Ocp_Ed3OVN-HLeZ0zO0oJSWR8rG_mUAmX9sAG80dEtGMvXvYPnza86nsQNgMyK82GQSHW083W3zxoDE3RoTb6sZh49J8TKPBRzMWL7d7CnUxahmUf-Ro06LLAt6rOOpw5JJzBLZr3UzvKzJWV-2WzEyJlNwmD8fkVFL5qyYBsihhdxWYENR3l3TRjQ5vzLB9QyoBgyka56oVreDAgtnQYB7M8CpY1TnBb_jHJbKSL9nAJYpW8xAwfte5PTb7px5K1rGj9JwSvwYhYwbfJIHh1N4ClwkdLlHBiTvVHkW9QDx")
  79. (defvar *google-manual-header* "EI9X7MP_UN6KaVDOoQ4mMn91XdQ:1400594464924")
  80. (defun load-history (from to &key (trim nil))
  81. (loop for loc in (cadadr (yason:parse
  82. (flexi-streams:octets-to-string
  83. (drakma:http-request
  84. "https://maps.google.com/locationhistory/b/1/apps/pvjson?t=0"
  85. :method :post
  86. :content (format nil "[null,~A,~A,~A]"
  87. (ts->ms from)
  88. (ts->ms to)
  89. (if trim "true" "false"))
  90. :additional-headers (list (cons "x-manualheader" *google-manual-header*)
  91. (cons "cookie" *google-cookie*))))))
  92. collect (list (ms->ts (parse-integer (cadr loc)))
  93. (cons (caddr loc)
  94. (cadddr loc)))))