File: grahamhull.l

package info (click to toggle)
euslisp 9.31%2Bdfsg-3
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 55,448 kB
  • sloc: ansic: 41,610; lisp: 3,339; makefile: 286; sh: 238; asm: 138; python: 53
file content (35 lines) | stat: -rw-r--r-- 1,143 bytes parent folder | download | duplicates (2)
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))