[讨论] 求点集共线精简程序

caoyin · 发表于 2007-4-11 11:43

以下是判断点集共线程序，总感觉太复杂，请高手出招！！

;; 判断点集共线
(defun on_line (plst / a b c)
(setq a (car plst) b (cadr plst) c (cdr (cdr plst)))
(not (vl-catch-all-error-p
(vl-catch-all-apply
'mapcar (list '(lambda (x / an)
(setq an (angle a x))
(if (not (or (equal an (angle b x) 1e-6)
(equal an (angle x b) 1e-6)
)
)
(exit)
)
)
c
)
)
)
)
)

zml84 · 发表于 2007-4-11 20:03

本帖最后由作者于 2007-4-11 20:08:10 编辑

;;;功能：判断点集共线
;;;日期：zml84 于 2007-04-11
;;;==============================
(defun on_line (plst / a b c temp)
(if (< (length plst) 3)
nil
(if (setq a (car plst)
b (cadr plst)
c (caddr plst)
temp (or (equal (angle a b) (angle a c) 1e-6)
(equal (angle a b) (angle c a) 1e-6)
)
)
(if (= (length plst) 3)
t
(on_line (cdr plst))
)
nil
)
)
)

;;;==============================
;;;测试
(defun c:tt (/ lst)
(setq lst (list
'(0 0)
'(3 3)
'(-1 -1)
'(10 10)
)
)
(princ lst)
(princ (on_line lst))
(princ)
)

byghbcx · 发表于 2007-4-12 09:08

这个程序简单吧,而且运行时间要减少,只要找到一个点不在线上,即退出循环

;;;功能：判断点集共线
;;;日期：byghbcaixin 于 2007-04-12

(defun on_line (ptlst / n k)
(setq n 2 k nil)
(while (and (not k) (< n (length ptlst)))
(if (inters (car ptlst) (cadr ptlst) (car ptlst) (nth n ptlst) nil) (setq k t))
(setq n (1+ n))
)
k
)

caoyin · 发表于 2007-4-12 09:42

本帖最后由作者于 2007-4-12 10:01:24 编辑

多谢两位！

我用 exit 仍然可以退出循环

byghbcx 的 inters 思路比较好!!

把最后的返回改成 (not k) 看起来比较直观

顺便问以下，怎样能测试程序的运行时间（具体数据），谢谢！

byghbcx · 发表于 2007-4-12 10:48

这个时间很短,基本不用测试,如需测试可加入

(defun on_line (ptlst / n k t0)
(setq n 2 k nil)
(setq t0 (getvar "TDUSRTIMER"))
(while (and (not k) (< n (length ptlst)))
(if (inters (car ptlst) (cadr ptlst) (car ptlst) (nth n ptlst) nil) (setq k t))
(setq n (1+ n))
)
(princ "\n共用时")
(princ (* (- (getvar "TDUSRTIMER") t0) 86400000))
(princ "毫秒")
k
)

zml84 · 发表于 2007-4-12 18:34

本帖最后由作者于 2007-4-12 18:46:38 编辑

将第1、2、3楼的代码整合起来，修改测试代码后，测试结果如下：

命令:
命令: TT
测试on_line_01 : T 共用时16.0毫秒
测试on_line_02 : T 共用时891.0毫秒
测试on_line_022 : T 共用时485.0毫秒
测试on_line_03 : nil 共用时1313.0毫秒命令:
命令: TT
测试on_line_01 : T 共用时15.0毫秒
测试on_line_02 : T 共用时1000.0毫秒
测试on_line_022 : T 共用时547.0毫秒
测试on_line_03 : nil 共用时1922.0毫秒
命令:
命令: TT
测试on_line_01 : T 共用时16.0毫秒
测试on_line_02 : T 共用时813.0毫秒
测试on_line_022 : T 共用时485.0毫秒
测试on_line_03 : nil 共用时1375.0毫秒

复制代码

不知为何，3楼的代码返回NIL？·！
全部代码如下：

;; 判断点集共线
(defun on_line_01 (plst / a b c)
(setq a (car plst)
b (cadr plst)
c (cdr (cdr plst))
)
(not
(vl-catch-all-error-p
(vl-catch-all-apply
'mapcar
(list '(lambda (x / an)
(setq an (angle a x))
(if (not (or (equal an (angle b x) 1e-6)
(equal an (angle x b) 1e-6)
)
)
(exit)
)
)
c
)
)
)
)
)
;;;==============================
;;;功能：判断点集共线
;;;日期：zml84 于 2007-04-11
;;;==============================
(defun on_line_02 (plst / a b c)
(if (< (length plst) 3)
nil
(if (setq a (car plst)
b (cadr plst)
c (caddr plst)
temp (or (equal (angle a b) (angle a c) 1e-6)
(equal (angle a b) (angle c a) 1e-6)
)
)
(if (= (length plst) 3)
t
(on_line_02 (cdr plst))
)
nil
)
)
)
;;;==============================
(defun on_line_022 (plst / a b c)
;;; (if (< (length plst) 3)
;;; nil
(if (setq a (car plst)
b (cadr plst)
c (caddr plst)
temp (or (equal (angle a b) (angle a c) 1e-6)
(equal (angle a b) (angle c a) 1e-6)
)
)
(if (= (length plst) 3)
t
(on_line_022 (cdr plst))
)
nil
)
;;; )
)
;;;==============================
;;;功能：判断点集共线
;;;日期：byghbcaixin 于 2007-04-12
(defun on_line_03 (ptlst / n k)
(setq n 2
k nil
)
(while (and (not k) (< n (length ptlst)))
(if (inters (car ptlst)
(cadr ptlst)
(car ptlst)
(nth n ptlst)
nil
)
(setq k t)
)
(setq n (1+ n))
)
k
)
;;;==============================
;;;测试
(defun c:tt (/ lst i t0)
(setq lst '()
i 1
)
(repeat 5000
(setq lst (cons (list i i) lst)
i (1+ i)
)
)
;;====
(princ "\n测试on_line_01 : ")
(setq t0 (getvar "TDUSRTIMER"))
(princ (on_line_01 lst))
(princ " 共用时")
(princ (* (- (getvar "TDUSRTIMER") t0) 86400000))
(princ "毫秒")
;;====
(princ "\n测试on_line_02 : ")
(setq t0 (getvar "TDUSRTIMER"))
(princ (on_line_02 lst))
(princ " 共用时")
(princ (* (- (getvar "TDUSRTIMER") t0) 86400000))
(princ "毫秒")
;;====
(princ "\n测试on_line_022 : ")
(setq t0 (getvar "TDUSRTIMER"))
(princ (on_line_022 lst))
(princ " 共用时")
(princ (* (- (getvar "TDUSRTIMER") t0) 86400000))
(princ "毫秒")
;;====
(princ "\n测试on_line_03 : ")
(setq t0 (getvar "TDUSRTIMER"))
(princ (on_line_03 lst))
(princ " 共用时")
(princ (* (- (getvar "TDUSRTIMER") t0) 86400000))
(princ "毫秒")
(princ)
)

;;  判断点集共线
(defun on_line_01 (plst / a b c)
    (setq a (car plst)
   b (cadr plst)
   c (cdr (cdr plst))
    )
    (not
 (vl-catch-all-error-p
     (vl-catch-all-apply
  'mapcar
  (list '(lambda (x / an)
      (setq an (angle a x))
      (if (not (or (equal an (angle b x) 1e-6)
     (equal an (angle x b) 1e-6)
        )
          )
          (exit)
      )
         )
        c
  )
     )
 )
    )
)
;;;==============================
;;;功能：判断点集共线
;;;日期：zml84 于 2007-04-11
;;;==============================
(defun on_line_02 (plst / a b c)
    (if (< (length plst) 3)
 nil
 (if (setq a    (car plst)
    b    (cadr plst)
    c    (caddr plst)
    temp (or (equal (angle a b) (angle a c) 1e-6)
      (equal (angle a b) (angle c a) 1e-6)
         )
     )
     (if (= (length plst) 3)
  t
  (on_line_02 (cdr plst))
     )
     nil
 )
    )
)
;;;==============================
(defun on_line_022 (plst / a b c)
;;;    (if (< (length plst) 3)
;;; nil
    (if (setq a    (car plst)
       b    (cadr plst)
       c    (caddr plst)
       temp (or (equal (angle a b) (angle a c) 1e-6)
         (equal (angle a b) (angle c a) 1e-6)
     )
 )
 (if (= (length plst) 3)
     t
     (on_line_022 (cdr plst))
 )
 nil
    )
;;;    )
)
;;;==============================
;;;功能：判断点集共线
;;;日期：byghbcaixin 于 2007-04-12
(defun on_line_03 (ptlst / n k)
    (setq n 2
   k nil
    )
    (while (and (not k) (< n (length ptlst)))
 (if (inters (car ptlst)
      (cadr ptlst)
      (car ptlst)
      (nth n ptlst)
      nil
     )
     (setq k t)
 )
 (setq n (1+ n))
    )
    k
)

;;;==============================
;;;测试
(defun c:tt (/ lst i t0)
    (setq lst '()
   i   1
    )
    (repeat 5000
 (setq lst (cons (list i i) lst)
       i   (1+ i)
 )
    )
    ;;====
    (princ "\n测试on_line_01 : ")
    (setq t0 (getvar "TDUSRTIMER"))
    (princ (on_line_01 lst))
    (princ "  共用时")
    (princ (* (- (getvar "TDUSRTIMER") t0) 86400000))
    (princ "毫秒")
    ;;====
    (princ "\n测试on_line_02 : ")
    (setq t0 (getvar "TDUSRTIMER"))
    (princ (on_line_02 lst))
    (princ "  共用时")
    (princ (* (- (getvar "TDUSRTIMER") t0) 86400000))
    (princ "毫秒")
    ;;====
    (princ "\n测试on_line_022 : ")
    (setq t0 (getvar "TDUSRTIMER"))
    (princ (on_line_022 lst))
    (princ "  共用时")
    (princ (* (- (getvar "TDUSRTIMER") t0) 86400000))
    (princ "毫秒")
    ;;====
    (princ "\n测试on_line_03 : ")
    (setq t0 (getvar "TDUSRTIMER"))
    (princ (on_line_03 lst))
    (princ "  共用时")
    (princ (* (- (getvar "TDUSRTIMER") t0) 86400000))
    (princ "毫秒")
    (princ)
)

byghbcx · 发表于 2007-4-13 09:13

看来,只有ANGLE算法最省时,INTERS算法较费时,运行时间不能看语句的长短.再发一个简单代码吧:

(defun on_line_04 (ptlst / k)
(command "_.ucs" "n" "3" (car ptlst) (cadr ptlst) "")
(setq k t)
(mapcar '(lambda(x) (if (/= (cadr (trans x 0 1)) 0.0) (setq k nil))) ptlst)
(command "_.ucs" "w")
k
)

caoyin · 发表于 2007-4-13 09:55

回 byghbcx

避免每次循环都对 le a b求值

(defun on_line (ptlst / le n k a b)
(setq n 2 k T le (length ptlst) a (car ptlst) b (cadr ptlst))
(while (and k (< n le))
    (if (inters a b a (nth n ptlst) nil)
      (setq k nil)
    )
    (setq n (1+ n))
)
k
)

修改后返回 125 毫秒

caoyin · 发表于 2007-4-13 11:23

本帖最后由作者于 2007-4-13 12:01:27 编辑

;;来一个更简洁的

;;求点集共线---by caoyin
(defun on_line (plst / p)
(setq p (apply 'mapcar (cons '+ plst)))
(not (inters (car plst) p (cadr plst) p nil))
)

byghbcx · 发表于 2007-4-13 15:31

这个测试不正确,从理论上讲也是不对的.如果所有点共线,那么这所有点的代数和所构成的点(X1+X2+X3+...Xn,Y1+Y2+Y3+...Yn)一定在这条线上.反之则不然,如果两个点或更多的点不共线,而它们的代数和的点在线上,所以不能以此来判断.

你可以测试一下，你把不在线上的点加到点集的末尾,返回的也是Ｔ，这可能与ＩＮＴＥＲＳ的精度有关．如果不是精度问题，按道理，加入一个'(0 100)点，应该返回ＮＩＬ，但同时加入两个点'(0 100)、点'(100 0)应该返回Ｔ。

账号		自动登录	找回密码
密码			注册

[讨论] 求点集共线精简程序

点评

本帖子中包含更多资源

浏览过的版块