graham-scan算法求点集凸包函数

落魄山人

根据graham-scan算法编写的凸包函数，欢迎测试及提出bug。。。
其中用到高飞鸟的向量相关函数／飞诗的排序函数（黄总修改版）／多段线生成函数是某位我不知名的前辈的，再此感谢。。
更新：根据user2128的反馈，进行修改。。。
更新2：取消大量的自定义函数，只保留判断左转函数，同时优化程序代码，使其更清晰可读，该算法的时间复杂度为O（nlogn）

2. ;;;name:graham-scan
   
3. ;;;desc:graham-scan算法计算点集凸包
   
4. ;;;arg:ptlst:点表
   
5. ;;;return:凸包点表
   
6. ;;;example:(graham-scan '(pt1 pt2 pt3 ...))
   
7. (defun graham-scan (ptlst / d i p0)
   
8.   (setq ptlst
   
9.   (vl-sort
   
10.     ptlst
    
11.     '(lambda (p1 p2)
    
12.        (cond
    
13.   ((< (cadr p1) (cadr p2)))
    
14.   ((equal (cadr p1) (cadr p2) 1e-8)
    
15.    (< (car p1) (car p2))
    
16.   )
    
17.        )
    
18.      )
    
19.   )
    
20.   )     ;点集坐标排序
    
21.   (setq p0 (car ptlst))   ;根据坐标排序结果选取Y值最小，同时X最小的点作为凸包的第一个点
    
22.   (setq ptlst
    
23.   (vl-sort
    
24.     (cdr ptlst)
    
25.     (function
    
26.       (lambda (p1 p2 / m n)
    
27.         (cond
    
28.    ((< (setq m (angle p1 p0)) (setq n (angle p2 p0))))
    
29.    ((equal m n 1e-8)
    
30.     (< (distance p1 p0) (distance p2 p0))
    
31.    )
    
32.         )
    
33.       )
    
34.     )
    
35.   )
    
36.   )     ;极角排序
    
37.      ;写凸包算法
    
38.   (setq d (list (cadr ptlst) (car ptlst) p0)) ;构建初始凸包点集
    
39.   (foreach curpt (cddr ptlst)  ;遍历剩余点
    
40.     (setq d (cons curpt d))  ;当前点入栈   
    
41.     (while (and (caddr d) (isLeft (caddr d) (cadr d) curpt))
    
42.       (setq d (cons curpt (cddr d))) ;判断这时候的凸包前三点是否左转，如果非左转，将第二点删除
    
43.     )
    
44.   )
    
45. )
    
46. ;;;name:isLeft
    
47. ;;;desc:判断点3-点2 与点2-点1 是否左转
    
48. ;;;arg:pt1:点1
    
49. ;;;arg:pt2:点2
    
50. ;;;arg:pt3:点3
    
51. ;;;return:nil为左转，t为右转或共线
    
52. ;;;example:(isLeft '(0 1) '(3 2) '(4 3))
    
53. (defun isLeft (pt1 pt2 pt3)
    
54.   (< (- (* (- (car pt2) (car pt1)) (- (cadr pt3) (cadr pt1)))
    
55. (* (- (cadr pt2) (cadr pt1)) (- (car pt3) (car pt1)))
    
56.      )
    
57.      1e-8
    
58.   )
    
59. )
    
60. ;;;测试函数
    
61. (defun c:tt (/ ss i lst)
    
62.   (if (setq ss (ssget '((0 . "POINT"))))
    
63.     (progn
    
64.       (repeat (setq i (sslength ss))
    
65. (setq
    
66.    lst
    
67.     (cons (cdr (assoc 10 (entget (ssname ss (setq i (1- i))))))
    
68.    lst
    
69.     )
    
70. )
    
71.       )
    
72.       (setq lst (graham-scan lst))
    
73.       (entmakex
    
74. (append
    
75.    (list
    
76.      '(000 . "LWPOLYLINE")
    
77.      '(100 . "AcDbEntity")
    
78.      '(100 . "AcDbPolyline")
    
79.      (cons 90 (length lst))
    
80.      '(070 . 1)
    
81.    )
    
82.    (mapcar '(lambda (x) (cons 10 x)) lst)
    
83. )
    
84.       )
    
85.     )
    
86.   )
    

;;;name:graham-scan<br /> ;;;desc:graham-scan算法计算点集凸包<br /> ;;;arg:ptlst:点表<br /> ;;;return:凸包点表<br /> ;;;example:(graham-scan '(pt1 pt2 pt3 ...))<br /> (defun graham-scan (ptlst / d i p0)<br />   (setq ptlst<br />   (vl-sort<br />     ptlst<br />     '(lambda (p1 p2)<br />        (cond<br />   ((< (cadr p1) (cadr p2)))<br />   ((equal (cadr p1) (cadr p2) 1e-8)<br />    (< (car p1) (car p2))<br />   )<br />        )<br />      )<br />   )<br />   )     ;点集坐标排序<br />   (setq p0 (car ptlst))   ;根据坐标排序结果选取Y值最小，同时X最小的点作为凸包的第一个点<br />   (setq ptlst<br />   (vl-sort<br />     (cdr ptlst)<br />     (function<br />       (lambda (p1 p2 / m n)<br />         (cond<br />    ((< (setq m (angle p1 p0)) (setq n (angle p2 p0))))<br />    ((equal m n 1e-8)<br />     (< (distance p1 p0) (distance p2 p0))<br />    )<br />         )<br />       )<br />     )<br />   )<br />   )     ;极角排序<br />      ;写凸包算法<br />   (setq d (list (cadr ptlst) (car ptlst) p0)) ;构建初始凸包点集<br />   (foreach curpt (cddr ptlst)  ;遍历剩余点<br />     (setq d (cons curpt d))  ;当前点入栈    <br />     (while (and (caddr d) (isLeft (caddr d) (cadr d) curpt))<br />       (setq d (cons curpt (cddr d))) ;判断这时候的凸包前三点是否左转，如果非左转，将第二点删除<br />     )<br />   )<br /> )<br /> ;;;name:isLeft<br /> ;;;desc:判断点3-点2 与点2-点1 是否左转<br /> ;;;arg:pt1:点1<br /> ;;;arg:pt2:点2<br /> ;;;arg:pt3:点3<br /> ;;;return:nil为左转，t为右转或共线<br /> ;;;example:(isLeft '(0 1) '(3 2) '(4 3))<br /> (defun isLeft (pt1 pt2 pt3)<br />   (< (- (* (- (car pt2) (car pt1)) (- (cadr pt3) (cadr pt1)))<br /> (* (- (cadr pt2) (cadr pt1)) (- (car pt3) (car pt1)))<br />      )<br />      1e-8<br />   )<br /> )<br /> ;;;测试函数<br /> (defun c:tt (/ ss i lst)<br />   (if (setq ss (ssget '((0 . "POINT"))))<br />     (progn<br />       (repeat (setq i (sslength ss))<br /> (setq<br />    lst<br />     (cons (cdr (assoc 10 (entget (ssname ss (setq i (1- i))))))<br />    lst<br />     )<br /> )<br />       )<br />       (setq lst (graham-scan lst))<br />       (entmakex<br /> (append<br />    (list<br />      '(000 . "LWPOLYLINE")<br />      '(100 . "AcDbEntity")<br />      '(100 . "AcDbPolyline")<br />      (cons 90 (length lst))<br />      '(070 . 1)<br />    )<br />    (mapcar '(lambda (x) (cons 10 x)) lst)<br /> )<br />       )<br />     )<br />   )<br />

USER2128

点取一个矩形的4个角点，运行正确，点取一个矩形的每边端点和中点时，不正确

shh1980

支持一下楼主，留个脚印先！

自贡黄明儒

graham-scan 已经包括排序，只不过是按角度排序的。

落魄山人

自贡黄明儒 发表于 2016-5-30 22:01
graham-scan 已经包括排序，只不过是按角度排序的。

是的，不过第一次按坐标排序是为了找到一个起点，找到这个起点后，其余点按跟起点的极角排序

cchessbd

经过我的测试，您这个速度是比较快，但是有点小bug，函数有时候会返回nil导致无法画线。
正在想法修复中。。。

nzl1116

cchessbd 发表于 2024-6-5 12:04
经过我的测试，您这个速度是比较快，但是有点小bug，函数有时候会返回nil导致无法画线。
正在想法修复中。 ...

如果只选三个点，就画不出来了，就是在(foreach curpt (cddr ptlst) ...)结束后多写一个d就能解决了。
vl-sort排序也有问题，应该先equal。