【越飞越高讲堂12】最小包围盒和最大距离点对

shiyan001

楼主讲的透彻。

chmenf087

Mark，论坛为什么没有收藏功能。。。

linjian257

谢谢高飞鸟无私的分享与精细的讲解

caoliu023

受益匪浅,努力学习

tender138

非常感谢这样无私高手！！！祝家庭幸福！！！

自贡黄明儒

有外就有内，那最大内接正方形该怎么求？

自贡黄明儒

highflybir 发表于 2010-6-4 23:24
在上篇帖子中我已经说明了这个算法的大致思想。下面我贴出源码，具体算法我要强调的一点是：
我构造了一个循 ...

正在研读你指引给我的这个链接。
前段时间之所以关心素数，觉得让使用者输入200~2000有点不知所措，故改成如下

2. ;;;The procedure for Test
   
3. (defun C:w1 (/ AREA1 AREA2 LST N PP PTLIST SCORE SEL T0 X)
   
4.   (princ "\nPlease select LWPOLYLINE,LINE,SPLINE,POINT")
   
5.   (cond
   
6.     ((setq
   
7.        sel (ssget (list '(0 . "POINT,LWPOLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE")))
   
8.      )
   
9.      (initget 7)
   
10.      (setq n (getint "\n精度:"))
    
11.      (setq t0 (getvar "TDUSRTIMER"))          ;The start time of this algorithm
    
12.      (setq lst (Sprime2 200 2000))          ;素数
    
13.      (setq area1 0)
    
14.      (while (and (setq x (car lst)) (not (equal area1 area2 n)))
    
15.        (setq area2 area1)
    
16.        (setq ptlist (Graham-scan (getpt sel x)))      ;construct the CCW Hull of this set.
    
17.        ;|;扫描后的点本身就逆时针(sort-by-angle-distance)，下面一句好象没有什么用处。
    
18.    (if (<= (det (car ptlist) (cadr ptlist) (caddr ptlist)) 0.0)
    
19.                   ;ensure the hull is CCW.
    
20.      (setq ptlist (reverse ptlist))        ;if it isn't CCW,then reverse it
    
21.    )|;
    
22.        (setq score (MinAreaRectangle ptlist))
    
23.        (setq area1 (cdr score))
    
24.        (setq lst (cdr lst))
    
25.      )     
    
26.      (princ "\nIt takes :")
    
27.      (princ (* (- (getvar "TDUSRTIMER") t0) 86400))      ;The End time
    
28.      (princ "seconds")
    
29.      (if (setq pp (car score))            ;start calculating
    
30.        (make-poly pp)              ;draw rectangle.
    
31.      )
    
32.     )
    
33.   )
    
34.   (princ)
    
35. )
    
36. ;;[功能] 小于n的质数
    
37. ;;(SPrime 100)=>(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97)
    
38. (defun Sprime (n / I K L LST ROOT)  
    
39.   (setq i 1)
    
40.   (setq root (sqrt n))
    
41.   (while (<= (setq i (+ i 2)) n) (setq l (cons i l)))
    
42.   (setq l (reverse l))
    
43.   (while (and (setq k (car l)) (<= k root))
    
44.     (setq l (vl-remove-if '(lambda (x) (= (rem x k) 0)) (cdr l)))
    
45.     (setq lst (cons k lst))
    
46.   )
    
47.   (append '(2) (reverse lst) l)  
    
48. )
    
49. ;;[功能] n1 n2之间的质数
    
50. ;;(Sprime 200 2000)
    
51. (defun Sprime2 (n1 n2 / LST)
    
52.   (setq lst (Sprime n2))
    
53.   (vl-remove-if '(lambda (x) (< x n1)) lst)
    
54. )

;;;The procedure for Test<br /> (defun C:w1 (/ AREA1 AREA2 LST N PP PTLIST SCORE SEL T0 X)<br />   (princ "\nPlease select LWPOLYLINE,LINE,SPLINE,POINT")<br />   (cond<br />     ((setq<br />        sel (ssget (list '(0 . "POINT,LWPOLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE")))<br />      )<br />      (initget 7)<br />      (setq n (getint "\n精度:"))<br />      (setq t0 (getvar "TDUSRTIMER"))          ;The start time of this algorithm<br />      (setq lst (Sprime2 200 2000))          ;素数<br />      (setq area1 0)<br />      (while (and (setq x (car lst)) (not (equal area1 area2 n)))<br />        (setq area2 area1)<br />        (setq ptlist (Graham-scan (getpt sel x)))      ;construct the CCW Hull of this set.<br />        ;|;扫描后的点本身就逆时针(sort-by-angle-distance)，下面一句好象没有什么用处。<br />    (if (<= (det (car ptlist) (cadr ptlist) (caddr ptlist)) 0.0)<br />                   ;ensure the hull is CCW.<br />      (setq ptlist (reverse ptlist))        ;if it isn't CCW,then reverse it<br />    )|;<br />        (setq score (MinAreaRectangle ptlist))<br />        (setq area1 (cdr score))<br />        (setq lst (cdr lst))<br />      )     <br />      (princ "\nIt takes :")<br />      (princ (* (- (getvar "TDUSRTIMER") t0) 86400))      ;The End time<br />      (princ "seconds")<br />      (if (setq pp (car score))            ;start calculating<br />        (make-poly pp)              ;draw rectangle.<br />      )<br />     )<br />   )<br />   (princ)<br /> )<br /> ;;[功能] 小于n的质数<br /> ;;(SPrime 100)=>(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97)<br /> (defun Sprime (n / I K L LST ROOT)  <br />   (setq i 1)<br />   (setq root (sqrt n))<br />   (while (<= (setq i (+ i 2)) n) (setq l (cons i l)))<br />   (setq l (reverse l))<br />   (while (and (setq k (car l)) (<= k root))<br />     (setq l (vl-remove-if '(lambda (x) (= (rem x k) 0)) (cdr l)))<br />     (setq lst (cons k lst))<br />   )<br />   (append '(2) (reverse lst) l)  <br /> )<br /> ;;[功能] n1 n2之间的质数<br /> ;;(Sprime 200 2000)<br /> (defun Sprime2 (n1 n2 / LST)<br />   (setq lst (Sprime n2))<br />   (vl-remove-if '(lambda (x) (< x n1)) lst)<br /> )

拖拖_拉拉_

太强了～～

自贡黄明儒

vlisp2012 发表于 2013-4-1 19:48
想要批量实现任意四边形和三角形的最小包围盒，没成功。
哪位大师，帮一下忙！

这个扫锚程序很强大，用处多，加上最近的取点函数，就可对任意曲线求最小包围盒了

自贡黄明儒

highflybir 发表于 2010-6-4 23:24
在上篇帖子中我已经说明了这个算法的大致思想。下面我贴出源码，具体算法我要强调的一点是：
我构造了一个循 ...

(setq INF 1e309)
放在win7 编译后的lisp中，不认识，我改成(setq INF 1e200)就对了。是什么原因?