凉凉 本来为了下一次 虽然已经是上一次了 出游打算把这个代码写了, 但是因为被社牛和宴会达人打断了前摇, 所以只留下了调 bug 调到一半难产的代码. (bug 应该是哪个函数里面把经纬度给写反了).
省流版本:
- OpenStreetMap 有 API 可以用来调用
- Overpass API 可以用来查询 (虽然后来感觉不太好用)
- OSRM API 用于路径规划 (不过因为数据还是基于 OpenStreetMap 的, 所以效果一般, 毕竟数据不够)
- Nominatim API 用于地名反差找
叠甲: 懒得写了, 已经玩不动了. 所以代码里面有 bug 很正常. 代码没有协议, do whatever u want to it. (那个带 F-word 的协议名称忘了)
(ql:quickload '(dexador yason str quri))
(defpackage #:hang-out
(:use :cl))
(in-package :hang-out)
(defconstant +overpass-url+
"https://overpass-api.de"
"Main Overpass API url.")
(defun overpass-query (query)
(yason:parse
(dex:get (quri:make-uri
:defaults +overpass-url+
:path "/api/interpreter"
:query `(("data" . ,query))))))
(defconstant +nominatim-url+
"https://nominatim.openstreetmap.org"
"Nominatim url.")
(defun nominatim-search (query &key proxy (limit 3))
(yason:parse
(dex:get (quri:make-uri
:defaults +nominatim-url+
:path "/search"
:query `(("q" . ,query)
("limit" . ,limit)
("format" . "json")))
:proxy proxy)))
(defconstant +osrm-url+
"http://router.project-osrm.org"
"OSRM API url")
(defclass geo-points ()
((note :initarg :note
:accessor note)
(latitude :initarg :latitude
:reader lat)
(longitude :initarg :longitude
:reader long)
(weight :initarg :weight
:accessor weight
:initform 1)))
(defmethod print-object ((point geo-points) stream)
(with-slots (note latitude longitude) point
(format stream "#<~a:~a,~a>" note longitude latitude)))
(defun make-geo-point (latitude longitude &key (weight 1) note)
"Make an instance of `geo-points' object."
(make-instance 'geo-points
:latitude latitude
:longitude longitude
:weight weight
:note note))
(defmethod weighted-point ((point geo-points) &optional force-weight)
(with-slots (latitude longitude weight) point
(let ((w (or force-weight weight)))
(make-geo-point (* w latitude)
(* w longitude)))))
(defun sum (geo-point-list)
(loop with lat = 0
with long = 0
for point in geo-point-list
do (incf lat (lat point))
do (incf long (long point))
finally (return (make-geo-point lat long))))
(defmethod div ((point geo-points) (divider number))
(with-slots (latitude longitude) point
(make-geo-point (/ latitude divider)
(/ longitude divider))))
(defun search-points (query &key (proxy "socks5://127.0.0.1:7890"))
(labels ((->num (str)
(with-input-from-string (in str)
(read in)))
(->geo-point (dat)
(make-geo-point (->num (gethash "lon" dat))
(->num (gethash "lat" dat))
:note (gethash "name" dat))))
(mapcar #'->geo-point
(nominatim-search query :proxy proxy))))
(defmethod find-nearest-geo-landmark ((point geo-points)
&key (range 500)
(tag-filter "amenity"))
(let* ((query (format
nil
"[out:json];node(around:~a,~a,~a)[\"~a\"];out;"
range (lat point) (long point) tag-filter))
(response (overpass-query query))
(node (first (gethash "elements" response))))
(make-geo-point (gethash "lat" node)
(gethash "lon" node))))
(defun osrm-snap-to-nearest-street (geo-point
&key (profile "driving")
(number 1))
(mapcar (lambda (dat)
(let* ((location (gethash "location" dat))
(long (first location))
(lat (second location)))
(make-geo-point lat long)))
(with-slots (latitude longitude) geo-point
(gethash
"waypoints"
(yason:parse
(dex:get (quri:make-uri
:defaults +osrm-url+
:path (format nil "/nearest/v1/~a/~a,~a"
profile longitude latitude)
:query `(("number" . ,number)))))))))
(defun osrm-route (geo-points &key (profile "driving")
(alternatives "false"))
(labels ((->coordinate (point)
(format nil "~a,~a" (long point) (lat point))))
(yason:parse
(dex:get (quri:make-uri
:defaults +osrm-url+
:path (format nil "/route/v1/~a/~{~a~^;~}"
profile
(mapcar #'->coordinate geo-points))
:query `(("alternatives" . ,alternatives)))))))
(defun distance-to-go-from-a-to-b (a b)
(let ((route (first (gethash "routes" (osrm-route (list a b))))))
(gethash "distance" route)))
(defun time-to-go-from-a-to-b (a b)
(let ((route (first (gethash "routes" (osrm-route (list a b))))))
(gethash "duration" route)))
(defun mean-geo-points (geo-points
&key (max-iter 10)
(update-weight-fn
#'distance-to-go-from-a-to-b))
"为一组 `geo-points' 进行加权平均数."
(let ((mean (find-nearest-geo-landmark
(div (sum (mapcar #'weighted-point geo-points))
(apply #'+ (mapcar #'weight geo-points))))))
(if (<= max-iter 0)
mean
(mean-geo-points
(loop for geo-point in geo-points
do (setf (weight geo-point)
(funcall update-weight-fn geo-point mean))
collect geo-point)
:max-iter (1- max-iter) ; 多次迭代找到合理的位置
:update-weight-fn update-weight-fn))))
;; Test Codes
(eval-when (:execute)
(defparameter p1
(first (search-points "中国科学院大学,玉泉路")))
(defparameter p2
(first (search-points "物理所,中关村")))
(mean-geo-points (list p1 p2))
)