点集凸包的autolisp实现（几何方法）
本帖最后由 freedom_ice 于 2022-10-30 17:22 编辑问题：给定一系列二维点集，求包围所有点的最小凸多边形。
思路：1.将二维点集按X升序排列，当X值相等时，按Y值升序；
2.沿着排序后的左下点P0（第一点）和右上点P1（最末点），作分界线line0，将点集分为上部和下部，上部的边界线为上包，下部的边界线为下包；
3.递归方法求上包。上包的下边线line0，找到上包点集中距离line0最远的点Pmax，得到两条分界线，点P0和Pmax组成line1，点Pmax和P1组成line2，同样方法求line1的上包和line2的上包，两者合并即为line0的上包，递归出口为点集中只有两个点时，即为要求的点，输出即可。
4.同样方法求下包，上包结果与下包合并即为所求凸包。
5.输出结果为一段一段的线段，所以会有重复的点，未经去重处理；
6.供探讨学习，未经完全验证，可能会有不可知的问题。比如对处于凸包边缘上的点未经特殊处理。
( defun c:tt()
( setq pts '( ( 5 4 ) ( 0 0 ) ( 1 1 ) ( 2 2 ) ( 2 3 ) ( 3 1 ) ( 3 0 ) ( 5 1 )) )
( setq pts '( ( 3 0 ) ( 4 1 ) ( 5 4 ) ( 2 2 ) ( 1 2 ) ( 3 4 ) ( 4 2 ) ( 3 2 ) ( 4 3 ) ) )
;( setq pts '( ( 1 1 ) ( 2 1 ) ( 3 2 ) ( 4 4 ) ) )
;( setq pts '( ( 5 4 ) ( 2 2 ) ) )
;( setq pts '( ( 1 1 ) ( 2 4 ) ( 3 4 ) ( 3 5 ) ( 4 4 ) ( 4.5 4.5 ) ( 4 5 ) ( 5 4 ) ( 6 4 ) ( 7 7 ) ) )
;( setq a ( IncreaseXY a ) )
;( setq line '(( 2 2 ) ( 0 0 ) ) )
;( setq pt '( 1.5 1 ) )
;( princ ( IsPtOnLine pt line ) )
;( UpBoundingPts pts )
;( princ ( UpBoundingPts pts ) )
;( princ "\n" )
;( princ ( DownBoundingPts pts ) )
( princ ( BoundingPts pts ) )
( princ )
)
;;;*****************************************************************************
;;;*****************************************************************************
;;;函数名: BoundingPts ***************************************************
;;;功能: 获取点集的凸包 ****************************************************
;;;参数: pts - 要判断的点集 ************************************************
;;;返回值: 凸包点集 **********************************************************
( defun BoundingPts ( pts / downpts j len linepts uppts )
( setq pts ( IncreaseXY pts ) )
( setq len ( length pts ) )
( if ( < len 4 )
pts
( progn
( setq linepts ( list ( car pts ) ( last pts ) ) )
( setq uppts linepts )
( setq downpts linepts )
( setq j 1 )
( repeat ( - len 2 )
( if ( = ( IsPtOnLine ( nth j pts ) linepts ) 1 )
( setq uppts ( cons ( nth j pts ) uppts ) )
)
( if ( = ( IsPtOnLine ( nth j pts ) linepts ) -1 )
( setq downpts ( cons ( nth j pts ) downpts ) )
)
( setq j ( 1+ j ) )
)
( append ( UpBoundingPts uppts ) ( DownBoundingPts downpts ) )
)
)
)
;;;*****************************************************************************
;;;*****************************************************************************
;;;*****************************************************************************
;;;*****************************************************************************
;;;*****************************************************************************
;;;函数名: DownBoundingPts ***************************************************
;;;功能: 获取点集的下包 ****************************************************
;;;参数: pts - 要判断的点集 ************************************************
;;;返回值: 下包点集 **********************************************************
( defun DownBoundingPts( pts / dis i j leftdownpts leftlinepts len linepts rightdownpts rightlinepts targetpt )
( setq pts ( IncreaseXY pts ) )
( setq len ( length pts ) )
( cond ( ( = len 2 ) ( append pts ) )
( ( > len 2 ) ( progn
( setq linepts ( list ( car pts ) ( last pts ) ) )
( setq leftdownpts nil )
( setq rightdownpts nil )
( setq dis 0 )
( setq i 1 )
( repeat ( - len 2 )
( if ( and ( > ( PtDisToLine ( nth i pts ) linepts ) dis )
( = ( IsPtOnLine ( nth i pts ) linepts ) -1 )
)
( setq dis ( PtDisToLine ( nth i pts ) linepts )
targetpt ( nth i pts )
)
)
( setq i ( 1+ i ) )
)
( if ( /= targetpt nil )
(progn
( setq leftlinepts ( list ( car pts ) targetpt ) )
( setq rightlinepts ( list targetpt ( last pts ) ) )
( setq leftdownpts leftlinepts )
( setq rightdownpts rightlinepts )
( setq j 1 )
( repeat ( - len 2 )
( if ( = ( IsPtOnLine ( nth j pts ) leftlinepts ) -1 )
( setq leftdownpts ( cons ( nth j pts ) leftdownpts ) )
)
( if ( = ( IsPtOnLine ( nth j pts ) rightlinepts ) -1 )
( setq rightdownpts ( cons ( nth j pts ) rightdownpts ) )
)
( setq j ( 1+ j ) )
)
( append ( DownBoundingPts leftdownpts )
( DownBoundingPts rightdownpts )
)
)
( append ( DownBoundingPts linepts ) )
)
)
)
)
)
;;;*****************************************************************************
;;;*****************************************************************************
;;;*****************************************************************************
;;;*****************************************************************************
;;;*****************************************************************************
;;;函数名: UpBoundingPts *****************************************************
;;;功能: 获取点集的上包 ****************************************************
;;;参数: pts - 要判断的点集 ************************************************
;;;参数: linepts - 直线上的两点 ********************************************
;;;返回值: 上包点集 **********************************************************
( defun UpBoundingPts( pts / a b c dis i j leftlinepts leftuppts len linepts output rightlinepts rightuppts target targetpt )
( setq pts ( IncreaseXY pts ) )
( setq len ( length pts ) )
( cond ( ( = len 2 ) ( append pts ) )
( ( > len 2 ) ( progn
( setq linepts ( list ( car pts ) ( last pts ) ) )
( setq leftuppts nil )
( setq rightuppts nil )
( setq dis 0 )
( setq i 1 )
( repeat ( - len 2 )
( if ( and ( > ( PtDisToLine ( nth i pts ) linepts ) dis )
( = ( IsPtOnLine ( nth i pts ) linepts ) 1 )
)
( setq dis ( PtDisToLine ( nth i pts ) linepts )
targetpt ( nth i pts )
)
)
( setq i ( 1+ i ) )
)
( if ( /= targetpt nil )
( progn
( setq leftlinepts ( list ( car pts ) targetpt ) )
( setq rightlinepts ( list targetpt ( last pts ) ) )
( setq leftuppts leftlinepts )
( setq rightuppts rightlinepts )
( setq j 1 )
( repeat ( - len 2 )
( if ( = ( IsPtOnLine ( nth j pts ) leftlinepts ) 1 )
( setq leftuppts ( cons ( nth j pts ) leftuppts ) )
)
( if ( = ( IsPtOnLine ( nth j pts ) rightlinepts ) 1 )
( setq rightuppts ( cons ( nth j pts ) rightuppts ) )
)
( setq j ( 1+ j ) )
)
( append ( UpBoundingPts leftuppts )
( UpBoundingPts rightuppts )
)
)
( append ( UpBoundingPts linepts ) )
)
)
)
)
)
;;;*****************************************************************************
;;;*****************************************************************************
;;;*****************************************************************************
;;;*****************************************************************************
;;;*****************************************************************************
;;;函数名: PtDisToLine *******************************************************
;;;功能: 判断点到直线的距离 ************************************************
;;;参数: pt - 要判断的点 ***************************************************
;;;参数: linepts - 直线上的两点 ********************************************
;;;返回值: 返回距离值 ********************************************************
( defun PtDisToLine( pt linepts / a b c output target )
;;linepts = ( ( x1 y1 ) ( x2 y2 ) )
;;x1 = ( caar linepts )
;;y1 = ( cadar linepts )
;;x2 = ( caadr linepts )
;;y2 = ( cadadr linepts )
( setq A ( - ( cadar linepts ) ( cadadr linepts ) ) )
( setq B ( - ( caadr linepts ) ( caar linepts ) ) )
( setq C ( - ( * ( caar linepts )( cadadr linepts ) ) ( * ( caadr linepts ) ( cadar linepts ) ) ) )
( setq target ( + ( * A ( car pt ) )
( * B ( cadr pt ) )
C) )
( setq target ( abs target ) )
;;点到直线的距离
( setq output ( / target ( expt ( + ( expt A 2 ) ( expt B 2 ) ) 0.5 ) ) )
)
;;;*****************************************************************************
;;;*****************************************************************************
;;;*****************************************************************************
;;;*****************************************************************************
;;;*****************************************************************************
;;;函数名: IsPtOnLine ********************************************************
;;;功能: 判断点是否在直线上 ************************************************
;;;参数: pt - 要判断的点 ***************************************************
;;;参数: linepts - 直线上的两点 ********************************************
;;;返回值: 点在直线上方 返回1 ************************************************
;;;返回值: 点在直线上 返回0 **************************************************
;;;返回值: 点在直线下方 返回-1 ***********************************************
( defun IsPtOnLine( pt linepts / a b c target )
;;linepts = ( ( x1 y1 ) ( x2 y2 ) )
;;x1 = ( caar linepts )
;;y1 = ( cadar linepts )
;;x2 = ( caadr linepts )
;;y2 = ( cadadr linepts )
( setq A ( - ( cadar linepts ) ( cadadr linepts ) ) )
( setq B ( - ( caadr linepts ) ( caar linepts ) ) )
( setq C ( - ( * ( caar linepts )( cadadr linepts ) ) ( * ( caadr linepts ) ( cadar linepts ) ) ) )
( setq target ( + ( * A ( car pt ) )
( * B ( cadr pt ) )
C) )
( if ( > target 0 )
1
( if ( = target 0 )
0
-1
)
)
)
;;;*****************************************************************************
;;;*****************************************************************************
;;;*****************************************************************************
;;;*****************************************************************************
;;;*****************************************************************************
;;;函数名: IncreaseXY ********************************************************
;;;功能: 点表按X升序排列，若X相等，则按Y坐标升序排列************************
;;;参数: SourceList - 源数据表**********************************************
;;;返回值: 排序后的数据表*****************************************************
( defun IncreaseXY( SourceList )
( setq SourceList ( vl-sort SourceList
( function ( lambda ( e1 e2 )
( if ( < ( car e1 ) ( car e2 ) )
( < ( car e1 ) ( car e2 ) )
( if ( = ( car e1 ) ( car e2 ) )
( <= ( cadr e1 ) ( cadr e2 ) )
)
)
)
)
)
)
)
;;;*****************************************************************************
;;;*****************************************************************************
;;;*****************************************************************************
( princ )
(defun tb (ptn / mode p0 p1 p2 tmp rr)
"点集逆时针凸包点"
(setq ptn(vl-sort ptn '(lambda (x y) (< (cadr x) (cadr y))))
p0 (car ptn)
ptn(vl-sort (cdr ptn)
'(lambda (x y) (< (angle p0 x) (angle p0 y)))
)
rr (angle p0 (car ptn))
tmp(list p0)
p1 p0
mode t
)
(while mode
(setq ptn (vl-remove-if '(lambda (x) (< (angle p1 x) rr)) ptn)
ptn (vl-sort ptn '(lambda (x y) (< (angle p1 x) (angle p1 y))))
p2(car ptn)
rr(angle p1 p2)
ptn (vl-remove p2 ptn)
ptn (if (not (member p0 ptn))
(cons p0 ptn)
ptn
)
)
(if (not (equal p2 p0 1e-3))
(setq tmp (cons p2 tmp)
p1 p2
)
(setq mode nil)
)
)
(reverse tmp)
)
http://atlisp.cn/static/videos/graham-scan.mp4
http://atlisp.cn/static/videos/graham-scan2.mp4
算法有些复杂，简单一些，找到最下面的一个点，然后依次找到所有点中到上一个点角度最靠右的那个点，就可以找到凸包了。
找最靠右的向量以上上个点到上一个点的向量作为标准方向。
ytianxia 发表于 2022-11-1 13:32
算法有些复杂，简单一些，找到最下面的一个点，然后依次找到所有点中到上一个点角度最靠右的那个点，就可以 ...
这就是凸包的向量算法吧，思路确实更清晰简单。下一步准备实现这个办法。感谢。 xyp1964 发表于 2022-11-3 19:31
牛！院长的代码好精炼！ xyp1964 发表于 2022-11-3 19:31
院长威武！！！！ 感谢楼主分享 楼主威武！！！！
页:
[1]