正十七边形

zdqwy19

;|正十七边形做法。
1.给一圆O，作两垂直的直径AB、CD.
2.在OA上作E点使OE=1/4AO,连结CE.
3.作∠CEB的平分线EF.
4.作∠FEB的平分线EG,交CO于P.
5.作∠GEH=45°,交CD于Q.
6.以CQ为直径作圆,交OB于K.
7.以P为圆心,PK为半径作圆,交CD于L、M.
8.分别过M、L作CD的垂线,交圆O于N、R.
9.作弧NR的中点S,以SN为半径将圆O分成17等份.|;
;多项式列表
(defun t1(m / i)
  (setq i 17)
  (mapcar '(lambda(x)
             (setq i (1- i))
             (if(member i m) 1 x))
          '(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)))
;多项式相乘
(defun t2(m n / a b e c d f)
  (setq a nil b ((lambda(x / j)(repeat x (setq j (cons 0 j)))) 16) e ((lambda(x / j)(repeat x (setq j (cons 0 j)))) 32))
  (foreach x m
    (setq c (mapcar '(lambda(y)(* x y)) n))
    (setq d (append a c b))
    (setq e (mapcar '+ d e))
    (setq a (cons 0 a))
    (setq b (cdr b)))
  (setq f e)
  (repeat 16 (setq f (cdr f)))
  (mapcar '+ f (cons 0 e)))
;多项式乘积
(defun t3(m / a)
  (setq a (car m))
  (cond
    ((equal m (list a a a a a a a a a a a a a a a a)) a)
    (t nil)))
;分解多项式
(defun t4(n p / m)
  (foreach w p
    (foreach y '(0 1)
      (set (read(strcat "m" (itoa y))) (cons (nth (+ w w y) n) (eval(read(strcat "m" (itoa y))))))))
  (foreach y '(0 1) (setq m (cons (reverse(eval(read(strcat "m" (itoa y))))) m)))
  (foreach y '(0 1) (set (read(strcat "m" (itoa y))) nil))
  (setq m (reverse m)))
;求解二次方程 ax^2 + bx + c = 0
(defun quad (a b c / x1 x2)
  (cond
    ;; 处理 a = 0 的情况（一次方程）
    ((equal a 0.0 1e-8)
     (if (equal b 0.0 1e-8)
       (if (equal c 0.0 1e-8)
         (list "无穷多解");(princ "\n无穷多解（方程恒等）")
         (list "无解");(princ "\n无解（矛盾方程）")
       )
       (list (/ (- c) b));(princ (strcat "\nx = " (rtos (/ (- c) b) 2 8)))
     )
    )
    ;; 一般二次方程
    (t
     (setq delta (- (* b b) (* 4.0 a c)))
     (if (>= delta 0.0)
       ;; 实数根
       (progn
         (setq sqrt-delta (sqrt delta))
         (setq x1 (/ (- (- b) sqrt-delta) (* 2.0 a)))
         (setq x2 (/ (+ (- b) sqrt-delta) (* 2.0 a)))
         (list x2 x1)
       )
       ;; 复数根
       (progn
         (setq real-part (/ (- b) (* 2.0 a)))
         (setq imag-part (/ (sqrt (- delta)) (* 2.0 a)))
         (list (strcat (rtos real-part 2 8) "-" (rtos imag-part 2 8) "i") (strcat (rtos real-part 2 8) "+" (rtos imag-part 2 8) "i"))
       )
     )
    )
  )
)
;方程式
(defun c:tt(/ i n m h m01 f1 f2 f01 f02 f03 f04 f11 f12 f21 f22)
  (setq i 0 n nil)
  (repeat 16 (setq n (cons (setq i (rem (if(= i 0) 1 (* i 3)) 17)) n)))
  (setq n (reverse n))
  (setq m nil)
  (setq m (t4 n '(0 1 2 3 4 5 6 7)))

  (setq m01 (quad 1 (t3 (mapcar '+ (t1 (car m)) (t1 (cadr m)))) (- (t3 (t2 (t1 (car m)) (t1 (cadr m)))))))
  (setq f1 (car m01) f2 (cadr m01))

  (setq n (car m) h (cadr m) m nil)
  (setq m (t4 n '(0 1 2 3)))
  (setq m01 (quad 1 (- f1) (- (t3 (t2 (t1 (car m)) (t1 (cadr m)))))))
  (setq f01 (car m01) f02 (cadr m01))

  (setq n h m nil)
  (setq m (t4 n '(0 1 2 3)))
  (setq m01 (quad 1 (- f2) (- (t3 (t2 (t1 (car m)) (t1 (cadr m)))))))
  (setq f03 (car m01) f04 (cadr m01))
  (setq m01 (quad 1 (- f01) f03))
  (setq f11 (car m01) f12 (cadr m01))
  (setq m01 (quad 1 (- f01) f04))
  (setq f21 (car m01) f22 (cadr m01))
  (princ (strcat "\ncos(2π/17) = " (rtos (/ (apply 'max (apply 'append (mapcar '(lambda(x)(if(<= -2.0 x 2.0) (list x) nil)) (list f11 f21)))) 2) 2 17)))
  (princ)
  )