mirrors/lqml
1
Fork 0
mirror of https://gitlab.com/eql/lqml.git synced 2025-12-06 02:30:38 -08:00
Code Issues Projects Releases Packages Wiki Activity

revision

Browse source
This commit is contained in:
pls.153 2023-07-31 16:55:09 +02:00
parent ec54cd7564
commit 82c1920cc7
1 changed files with 9 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

20
examples/wear-os-gps/lisp/distance.lisp
View file

@ -8,22 +8,20 @@
(defun to-deg (rad)
(/ (* 180 rad) pi))
(defun point-distance (from to)
(defun distance (from to)
"Coordiante distance according to Haversine formula."
(let ((from-x (car from))
(from-y (cdr from))
(to-x (car to))
(to-y (cdr to)))
(if (and (numberp from-x)
(numberp to-x))
(let* ((dlat (to-rad (- to-x from-x)))
(dlon (to-rad (- to-y from-y)))
(destructuring-bind ((lat-1 . lon-1) (lat-2 . lon-2))
(list from to)
(if (and (numberp lat-1)
(numberp lat-2))
(let* ((dlat (to-rad (- lat-2 lat-1)))
(dlon (to-rad (- lon-2 lon-1)))
(h-dlat (sin (/ dlat 2)))
(h-dlon (sin (/ dlon 2))))
(setf h-dlat (expt h-dlat 2)
h-dlon (expt h-dlon 2))
(let* ((y (+ h-dlat (* (cos (to-rad from-x))
(cos (to-rad to-x))
(let* ((y (+ h-dlat (* (cos (to-rad lat-1))
(cos (to-rad lat-2))
h-dlon)))
(x (* 2 (asin (sqrt y)))))
(* x +earth-mean-radius+ 1000)))