日志
最小覆盖圆递归算法
|||
(defun fmax (pt cen p)
(setq d1 (distance pt cen))
(setq d2 (distance pt p))
(setq d3 (distance cen p))
(setq dn (/ (* d2 d2 d1) (+ (* d1 d1) (* d2 d2) (* d3 d3 -1)) ))
dn
)
(defun pfmax (pt cen plst)
(setq lst (vl-sort plst '(lambda(a b) (> (fmax pt cen a) (fmax pt cen b))) ))
lst
)
(defun cc (p1 p2 p)
(setq d1 (distance p1 p))
(setq d2 (distance p2 p))
(setq d3 (distance p1 p2))
(setq cosa (/ (+ (* d1 d1) (* d2 d2) (* d3 d3 -1)) (* d1 d2 2) ))
cosa
)
(defun tmax (p1 p2 plst)
(setq lst (vl-sort plst '(lambda(a b) (> (cc p1 p2 a) (cc p1 p2 b) )) ))
lst
)
(defun pcen2 (p1 p2)
(setq cen (list (/ (+ (car p1) (car p2)) 2.0) (/ (+ (cadr p1) (cadr p2)) 2.0) ))
(setq r (/ (distance p1 p2) 2.0))
(setq va (list cen r))
va
)
(defun pcen3 (p1 p2 p3)
(setq t1 (pcen2 p1 p2))
(setq pt1 (car t1) )
(setq pt2 (polar pt1 (+ (angle p1 p2) (/ pi 2)) (cadr t1)))
(setq t2 (pcen2 p1 p3))
(setq pt3 (car t2) )
(setq pt4 (polar pt3 (+ (angle p1 p3) (/ pi 2)) (cadr t2)))
(setq cen (inters pt1 pt2 pt3 pt4 nil))
(setq r (distance p1 cen))
(setq va (list cen r))
va
)
(defun p (pt cen plst)
(setq p2 (car (pfmax pt cen plst)))
(setq p3 (car (tmax pt p2 (vl-remove p2 plst))))
(if (< (cc pt p2 p3) 0)
(setq va (pcen2 pt p2))
(setq va (pcen3 pt p2 p3))
)
)
;;; 主程序，涉及递归
(defun f (plst)
(if (= (length plst) 2)
(setq va (pcen2 (car plst) (cadr plst)))
(if (<= (distance (car plst) (car (f (cdr plst)) )) (cadr (f (cdr plst))) )
(setq va (f (cdr plst)))
(setq va (p (car plst) (car (f (cdr plst))) (cdr plst)))
)
)
va
)
(defun fp ()
(setq plst nil)
(while (/= (setq pt (getpoint)) nil)
(setq plst (cons pt plst))
)
(reverse plst)
)
(fp)
(princ (f plst))
(command "circle" (car (f plst)) (cadr (f plst)))
已同步至 mahuan1279的微博 已同步至 mahuan1279的微博
