注册 登录
明经CAD社区 返回首页

mahuan1279的个人空间 http://bbs.mjtd.com/?7303115 [收藏] [复制] [分享] [RSS]

日志

最小覆盖圆优化O(n)

热度 2已有 1705 次阅读2014-10-28 18:59 |个人分类:LISP|系统分类:应用| 最小覆盖圆

;;;求点集包容矩形对角线交点坐标p_j
(defun kcen (plst)
  (setq xlst (vl-sort (mapcar '(lambda (x)  (car x)  ) plst ) '<))
  (setq xmin (car xlst))
  (setq xmax (last xlst))
  (setq ylst (vl-sort (mapcar '(lambda (x)  (cadr x)  ) plst ) '<))
  (setq ymin (car ylst))
  (setq ymax (last ylst))
  (setq p_j (list (/ (+ xmin xmax) 2.0) (/ (+ ymin ymax) 2.0)))
  p_j
)
;;;求点集中各元素到p_j的距离,并根据距离由大到小的规则对点集排序(第一点p_1,就算最远点有多个也不影响程序正确性)
(defun p_dmax (p plst)
   (setq lst (vl-sort plst '(lambda(a b) (> (distance p a) (distance p b))) ))
   lst
)
;;;求第二点p_2
(defun fmax (p_1 p_j p)
 (setq d1 (distance p_1 p_j))
 (setq d2 (distance p_1 p))
 (setq d3 (distance p_j p))
 (setq dn (/ (* d2 d2 d1) (+ (* d1 d1) (* d2 d2) (* d3 d3 -1))  ))
 dn
)
(defun pfmax (p_1 p_j plst)
   (setq lst (vl-sort plst '(lambda(a b) (> (fmax p_1 p_j a) (fmax p_1 p_j b))) ))
   lst
)
;;;求第三点
(defun cc (p_1 p_2 p)
 (setq d1 (distance p_1 p))
 (setq d2 (distance p_2 p))
 (setq d3 (distance p_1 p_2))
 (setq cosa (/ (+ (* d1 d1) (* d2 d2) (* d3 d3 -1)) (* d1 d2 2) ))
 cosa
)
(defun tmax (p_1 p_2 plst)
   (setq lst (vl-sort plst '(lambda(a b) (> (cc p_1 p_2 a) (cc p_1 p_2 b) )) ))
    lst
)
;;;取点函数
(defun fp ()
    (setq sn (ssget ":N" '((0 . "point"))))
    (setq i 0 n (sslength sn) plst nil)
    (while (< i n)
        (setq plst (cons (cdr (assoc 10 (entget (ssname sn i)))) plst))
         (setq i (+ i 1))
    )
    plst
 )
 (defun c:fmin()
(setq plst (fp))
(setq p_j (kcen plst))
(setq p_1 (car (p_dmax p_j plst)))
(setq p_2 (car (pfmax p_1 p_j (vl-remove p_1 plst))))
(setq p_3 (car (tmax p_1 p_2 (vl-remove p_2 (vl-remove p_1 plst)))))
(if (< (cc p_1 p_2 p_3) 0)
       (progn
         (command "circle" "2p" p_1 p_2 "")
         (command "line" p_1 p_2 "")
        )
      (if (> (cc p_1 p_3 p_2) 0)
         (progn
            (command "circle" "3p" p_1 p_2 p_3 "")
            (command "line" p_1 p_2 p_3 p_1 "")
          )
         (progn 
            (setq p_2 (car (tmax p_1 p_3 (vl-remove p_1 (vl-remove p_3 plst))))) 
            (command "circle" "3p" p_1 p_2 p_3 "")
            (command "line" p_1 p_2 p_3 p_1 "")
          )
      )
  )
)
 已同步至 mahuan1279的微博
 已同步至 mahuan1279的微博

路过

雷人

握手

鲜花

鸡蛋

发表评论 评论 (2 个评论)

回复 自贡黄明儒 2014-11-6 13:55
看起来很简洁的样子,不知你同高飞大师发的那个比较过没有?
回复 kkq0305 2021-6-7 00:40
不错
第一段 可以
(mapcar '(lambda (x) (* 0.5 x)) (mapcar '+ (apply 'mapcar (cons 'min lst)) (apply 'mapcar (cons 'min lst))))

facelist doodle 涂鸦板

您需要登录后才可以评论 登录 | 注册

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-4-24 00:28 , Processed in 0.143683 second(s), 17 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

返回顶部