1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35
|
;;; convex-hull of 2D points using Graham scan
(defun eliminate-concave-vertex (vertices)
(cond ((null (cddr vertices)) nil)
((< (triangle (car vertices) (cadr vertices) (caddr vertices)) 0.0)
(rplacd vertices (cddr vertices))
(eliminate-concave-vertex vertices)
t)
((eliminate-concave-vertex (cdr vertices))
(eliminate-concave-vertex vertices))
(t nil)))
(defun grahamhull (vertices &optional (normal #f(0 0 1)))
(let* ((o (vector-mean vertices)) (len (length vertices))
(sorted-vertices)
(result)
(ang)
(vs)
(v)
(start (farthest o vertices))
(vstart (normalize-vector (v- start o)))
(vtemp (floatvector 0 0 0)))
(setq vertices (remove start vertices :count 1))
(print start)
(dolist (v vertices)
(v- v o vtemp)
(normalize-vector vtemp vtemp)
(setq ang (vector-angle vstart vtemp normal))
(if (< ang 0.0) (setq ang (+ ang 2pi)))
(push (list ang v) sorted-vertices))
(setq sorted-vertices (mapcar #'cadr (sort sorted-vertices #'< #'car)))
(setq result (cons start sorted-vertices ))
(eliminate-concave-vertex result)
result))
|