二维下料

aimisiyou

ynhh 发表于 2016-7-20 10:28
请大师整理出一个完整的源码程序
来测试一下啊

重叠部分需要处理。

aimisiyou

其中图形（n，1)方向只有两种，+1代表右上台阶方式，-1代表右下台阶方式。

aimisiyou

(defun drawone(pt a b flag tfx)
  (if flag
    (entmake
      (list
        '(0 . "LWPOLYLINE")                        
        '(100 . "AcDbEntity")
        '(100 . "AcDbPolyline")
        '(90 . 4)                                 
        '(70 . 1)                                 
        (cons 10 (list (car pt) (cadr pt)))
        (cons 10 (list (+ (car pt) a) (cadr pt) ))
        (cons 10 (list (+ (car pt) a) (+ (cadr pt) (* b tfx)) ))
        (cons 10 (list (car pt) (+ (cadr pt) (* b tfx)) )  )                                    
      )
    )
    (entmake
      (list
        '(0 . "LWPOLYLINE")                        
        '(100 . "AcDbEntity")
        '(100 . "AcDbPolyline")
        '(90 . 4)                                 
        '(70 . 1)                                 
        (cons 10 (list (car pt) (cadr pt)))
        (cons 10 (list (+ (car pt) b) (cadr pt) ))
        (cons 10 (list (+ (car pt) b) (+ (cadr pt) (* a tfx)) ))
        (cons 10 (list (car pt) (+ (cadr pt) (* a tfx)) ) )                                    
      )
    )
  )
)
(defun f(pt n a b tfx)
  (if (= n 1)
      (drawone pt a b t tfx)
      (progn
          (f pt 1 a b tfx)
          (setq i 1)
          (while (< i n)
             (setq pt1 (list (car pt) (+ (cadr pt) (* tfx (+ b (* a i) (* a -1))))))
             (setq pt2 (list (+ (car pt) (- a b) (* i b)) (cadr pt) ))
             (drawone pt1 a b nil tfx)
             (drawone pt2 a b nil tfx)  
             (setq i (+ i 1))         
          )
          (f (list (+ (car pt) b) (+ (cadr pt) (* a tfx))) (- n 1) a b tfx)
      )
  )
)(f (getpoint) 5 10 9 1)
(f (getpoint) 5 10 9 -1)

aimisiyou

剩下的问题就是如何将（n,m）分解，求得每个叶子的方向（+1，-1）？

ssddssdd

正需要，支持楼主大人了！

aimisiyou

递归函数的效果。

aimisiyou

;;;函数为(clfun (getpoint) n m a b (list 0 nil))
;;;由于递归运行，对于部分（n,m）数据会出现结果异常或栈溢出、访问异常错误情况
;;目前检测正常的数据为(n,1) ,(n,2)、(4,3)、(3+4n,3)、(nk,k)形式的(n,m)      (其中n>=m)
;;;(n,m)=(5,3)时能运行，但结果不正确不知什么情况，看来递归运算出错率很高
(defun drawone(pt a b flag tfx)
  (if flag
    (entmake
      (list
        '(0 . "LWPOLYLINE")                        
        '(100 . "AcDbEntity")
        '(100 . "AcDbPolyline")
        '(90 . 4)                                 
        '(70 . 1)                                 
        (cons 10 (list (car pt) (cadr pt)))
        (cons 10 (list (+ (car pt) a) (cadr pt) ))
        (cons 10 (list (+ (car pt) a) (+ (cadr pt) (* b tfx)) ))
        (cons 10 (list (car pt) (+ (cadr pt) (* b tfx)) )  )                                      
      )
    )
    (entmake
      (list
        '(0 . "LWPOLYLINE")                        
        '(100 . "AcDbEntity")
        '(100 . "AcDbPolyline")
        '(90 . 4)                                 
        '(70 . 1)                                 
        (cons 10 (list (car pt) (cadr pt)))
        (cons 10 (list (+ (car pt) b) (cadr pt) ))
        (cons 10 (list (+ (car pt) b) (+ (cadr pt) (* a tfx)) ))
        (cons 10 (list (car pt) (+ (cadr pt) (* a tfx)) )  )                                      
      )
    )
  )
)
(defun f(pt n a b tfx)
  (if (= n 1)
      (drawone pt a b t tfx)
      (progn
          (f pt 1 a b tfx)
          (setq i 1)
          (while (< i n)
             (setq pt1 (list (car pt) (+ (cadr pt) (* tfx (+ b (* a i) (* a -1))))))
             (setq pt2 (list (+ (car pt) (- a b) (* i b)) (cadr pt) ))
             (drawone pt1 a b nil tfx)
             (drawone pt2 a b nil tfx)  
             (setq i (+ i 1))         
          )
          (f (list (+ (car pt) b) (+ (cadr pt) (* a tfx))) (- n 1) a b tfx)
      )
  )
)
(defun det (n m)
  (setq n1 (/ (+ n 1) 2) n2 (/ n 2) m1 (/ (+ m 1) 2) m2 (/ m 2))
  (setq va (list (list n1 m1) (list n2 m2) (list (- n1 n2) (- m1 m2))))
)
(defun vfun (tmin)
  (setq i 0 vlst nil)
  (while (< i tmin)
     (repeat tmin (setq vlst (cons i vlst)))
     (setq i (+ i 1))
   )
  vlst
)
(defun hfun (tmin)
   (setq j 0 lst nil hlst nil)
   (while (< j tmin)
          (setq lst (cons j lst))  
          (setq j (+ j 1))
    )
   (repeat tmin (setq hlst (append lst hlst)))
   hlst
)
(defun clfun (pt n m a b lst)
  (if (= m 1)
      (if (= (car lst) 0)
          (progn
              (if (member '(0 1) (cdr lst))
                  (f pt (+ n 1) a b 1)
                  (f (list (car pt) (+ (cadr pt) (+ (* n a) b))) (+ n 1) a b -1)
               )
           )
          (progn
             (if (member '(0 1) (cdr lst))
                 (f (list (car pt) (+ (cadr pt) (+ (* n a) b))) (+ n 1) a b -1)
                 (f pt (+ n 1) a b 1)
              )
           )
       )
      (if (> (setq tmin (gcd n m)) 1)
          (mapcar '(lambda (i j)  (clfun (list (+ (car pt)(* i (+ (* a (/ m tmin)) (* b (/ n tmin))))) (+ (cadr pt) (* j (+ (* a (/ n tmin)) (* b (/ m tmin))))))(/ n

tmin) (/ m tmin) a b lst) )  (vfun tmin) (hfun tmin))        
          (progn
            (if (= (car lst) 0)
                 (cond
                   ((equal (cdr lst) (list nil))
                    (progn
                      (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)) )
                      (clfun pt nd md a b (cons 0 (list (caddr (det n m)))))
                      (clfun (polar pt 0 (+ (* a md) (* b nd)) ) nx mx a b (cons 1 (list nil)))
                      (clfun (polar pt (/ pi 2) (+ (* a nd) (* b md))) nx mx a b (cons 1 (list nil)))
                      (clfun (list (+ (car pt) (+ (* a mx) (* b nx)))(+ (cadr pt)(+ (* a nx) (* b mx)))) nd md a b (cons 0 (list (caddr (det n m)))))
                     )
                   )
                  ((equal (car (cdr lst)) (list 1 1))                                                           
                   (if (and (= (- n m) 1) (= (rem m 2) 0))                                                      
                       (progn
                         (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)))
                         (clfun pt nx mx a b (cons 0 (cdr lst)))
                         (clfun (polar pt 0 (+ (* a mx) (* b nx)) ) nd md a b (cons 1 (list (caddr (det n m)))))
                         (clfun (polar pt (/ pi 2) (+ (* a nx) (* b mx))) nd md a b (cons 1 (list (caddr (det n m)))))
                         (clfun (list (+ (car pt) (+ (* a md) (* b nd)))(+ (cadr pt) (+ (* a nd) (* b md)))) nx mx a b (cons 0 (cdr lst)))
                        )
                        (progn
                           (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)))            
                           (clfun pt nd md a b (cons 0 (cons (caddr (det n m)) (cdr lst))))
                           (clfun (polar pt 0 (+ (* a md) (* b nd)) ) nx mx a b (cons 1 (list nil)))
                           (clfun (polar pt (/ pi 2) (+ (* a nd) (* b md))) nx mx a b (cons 1 (list nil)))
                           (clfun (list (+ (car pt) (+ (* a mx) (* b nx)))(+ (cadr pt) (+ (* a nx) (* b mx)))) nd md a b (cons 0 (cons (caddr (det n m)) (cdr lst))))
                         )
                      )
                    )
                   ((equal (car (cdr lst)) (list 1 0))
                     (if (equal (caddr (det n m)) (list 1 0) )
                         (progn
                            (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)))
                            (clfun pt nd md a b (cons 0 (cons (caddr (det n m)) (cdr lst))))
                            (clfun (polar pt 0 (+ (* a md) (* b nd)) ) nx mx a b (cons 1 (list nil)))
                            (clfun (polar pt (/ pi 2) (+ (* a nd) (* b md))) nx mx a b (cons 1 (list nil)))
                            (clfun (list (+ (car pt) (+ (* a mx) (* b nx)))  (+ (cadr pt) (+ (* a nx) (* b mx)))  ) nd md a b (cons 0 (cons (caddr (det n m)) (cdr

lst))))
                           )
                          (progn
                             (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)))
                             (clfun pt nd md a b (cons 0 (cdr lst)))
                             (clfun (polar pt 0 (+ (* a md) (* b nd)) ) nx mx a b (cons 1 (list (caddr (det n m)))))
                             (clfun (polar pt (/ pi 2) (+ (* a nd) (* b md))) nx mx a b (cons 1 (list (caddr (det n m)))))
                             (clfun (list (+ (car pt) (+ (* a mx) (* b nx)))  (+ (cadr pt) (+ (* a nx) (* b mx)))) nd md a b (cons 0  (cdr lst)))
                            )
                          )
                       )     
                      ((equal (car (cdr lst)) (list 0 1))
                              (if (equal (caddr  (det n m)) (list 0 1))
                                  (progn
                                     (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)))
                                     (clfun pt nd md a b (cons 0 (cons (caddr (det n m)) (cdr lst))))
                                     (clfun (polar pt 0 (+ (* a md) (* b nd))) nx mx a b (cons 1 (list nil)))
                                     (clfun (polar pt (/ pi 2) (+ (* a nd) (* b md))) nx mx a b (cons 1 (list nil)))
                                     (clfun (list (+ (car pt) (+ (* a mx) (* b nx)))  (+ (cadr pt) (+ (* a nx) (* b mx)))  ) nd md a b (cons 0 (cons (caddr (det n m))

(cdr lst))))
                                    )
                                   (progn
                                      (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)))
                                      (clfun pt nx mx a b lst)
                                      (clfun (polar pt 0 (+ (* a mx) (* b nx)) ) nd md a b (cons 1 (list (caddr  (det n m)))))
                                      (clfun (polar pt (/ pi 2) (+ (* a nx) (* b mx))) nd md a b (cons 1 (list (caddr  (det n m)))))
                                      (clfun (list (+ (car pt) (+ (* a md) (* b nd)))  (+ (cadr pt) (+ (* a nd) (* b md)))) nx mx a b lst)
                                    )
                                )
                         )
                   )
                  (cond
                     ((equal (cdr lst) (list nil))
                             (progn
                                (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)))
                                (clfun pt nd md a b (cons 0 (list (caddr (det n m)))))
                                (clfun (polar pt 0 (+ (* a md) (* b nd)) ) nx mx a b (cons 1 (list nil)))
                                (clfun (polar pt (/ pi 2) (+ (* a nd) (* b md))) nx mx a b (cons 1 (list nil)))
                                (clfun (list (+ (car pt) (+ (* a mx) (* b nx)))  (+ (cadr pt) (+ (* a nx) (* b mx)))  ) nd md a b (cons 0 (list (caddr (det n m)))))
                              )
                                  )
                     ( (equal (car (cdr lst)) (list 1 1))
                       (if (and (= (- n m) 1) (= (rem m 2) 0))                                                      
                           (progn
                              (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr
dlst)))
                              (clfun pt nd md a b (cons 0 (list (caddr (det n m)))))
                              (clfun (polar pt 0 (+ (* a md) (* b nd)) ) nx mx a b (cons 1 (cdr lst)))
                              (clfun (polar pt (/ pi 2) (+ (* a nd) (* b md))) nx mx a b (cons 1 (cdr lst)))
                              (clfun (list (+ (car pt) (+ (* a mx) (* b nx)))  (+ (cadr pt) (+ (* a nx) (* b mx)))) nd md a b (cons 0 (list (caddr (det n m)))))
                            )
                           (progn
                              (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr
dlst)))                                                        
                              (clfun pt nx mx a b (cons 0 (list nil)))
                              (clfun (polar pt 0 (+ (* a mx) (* b nx)) ) nd md a b (cons 1 (cons (caddr (det n m)) (cdr lst))))
                              (clfun (polar pt (/ pi 2) (+ (* a nx) (* b mx))) nd md a b (cons 1 (cons (caddr (det n m)) (cdr lst))))
                             (clfun (list (+ (car pt) (+ (* a md) (* b nd))) (+ (cadr pt) (+ (* a nd) (* b md)))) nd md a b (cons 0 (list nil)))
                            )
                         )
                   )
                   ( (equal (car (cdr lst)) (list 1 0))
                     (if (equal (caddr (det n m)) (list 1 0) )
                         (progn
                            (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)))
                            (clfun pt nx mx a b (cons 0 (list nil)))
                            (clfun (polar pt 0 (+ (* a mx) (* b nx)) ) nd md a b (cons 1 (cons (caddr (det n m)) (cdr lst))))
                            (clfun (polar pt (/ pi 2) (+ (* a nx) (* b mx))) nd md a b (cons 1 (cons (caddr (det n m)) (cdr lst))))
                           (clfun (list (+ (car pt) (+ (* a md) (* b nd)))  (+ (cadr pt) (+ (* a nd) (* b md)))  ) nx mx a b (cons 0 (list nil)))
                          )
                         (progn
                            (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)))
                            (clfun pt nd md a b (cons 0 (list (caddr (det n m)))))
                            (clfun (polar pt 0 (+ (* a md) (* b nd)) ) nx mx a b (cons 1 (cdr lst)))
                            (clfun (polar pt (/ pi 2) (+ (* a nd) (* b md))) nx mx a b (cons 1 (cdr lst)))
                            (clfun (list (+ (car pt) (+ (* a mx) (* b nx))) (+ (cadr pt) (+ (* a nx) (* b mx)))) nd md a b (cons 0 (list (caddr (det n m)))))
                           )
                        )
                    )     
                   ( (equal (car (cdr lst)) (list 0 1))
                     (if (equal (caddr (det n m)) (list 0 1))
                         (progn
                             (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)))
                             (clfun pt nx mx a b (cons 0 (list nil)))
                             (clfun (polar pt 0 (+ (* a mx) (* b nx)) ) nd md a b (cons 1 (cons (caddr (det n m)) (cdr lst))))
                             (clfun (polar pt (/ pi 2) (+ (* a nx) (* b mx))) nd md a b (cons 1 (cons (caddr (det n m)) (cdr
lst))))
                             (clfun (list (+ (car pt) (+ (* a md) (* b nd)))  (+ (cadr pt) (+ (* a nd) (* b md)))) nx mx a b (cons 0 (list nil)))
                           )
                          (progn
                               (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)))
                               (clfun pt nd md a b (cons 0 (list (caddr (det n m)))))
                               (clfun (polar pt 0 (+ (* a md) (* b nd)) ) nx mx a b (cons 1 (cdr lst)))
                               (clfun (polar pt (/ pi 2) (+ (* a nd) (* b md))) nx mx a b (cons 1 (cdr lst)))
                               (clfun (list (+ (car pt) (+ (* a mx) (* b nx))) (+ (cadr pt) (+ (* a nx) (* b mx)))) nd md a b (cons 0 (list (caddr (det n m)))))
                            )
                        )                    
                    )                                          
                 )
               )
            )
         )
    )
)
(clfun (getpoint) 4 3 10 6 (list 0 nil))

aimisiyou

f若是数值函数，我们很容易判断递归运行的过程，如：
(defun f (n)
        (if (or (= n 1) (= n 2))
             1
              (+ (f (- n 1))  (f (- n 2)))
        )
  )
但若是图形函数tf,是否也可以按数值递归运算来理解，其运行过程如何理解？如：
(defun tf (n m)
      (if (= m 1)
             (entmakex (list '(0 . "CIRCLE") (cons 8 "0") (cons 10 (list 0 0)) (cons 40 n)(cons 62 2) ) )
             (progn
                     (tf  (+ n 1) (/  m 2) )  
                     (tf  (-  n 1) (/  m 2) )
               )
        )
)
(tf 10 10)
检测运行的结果没有什么问题，按照递归的思路也确实得到8个圆。难道是递归里运用mapcar函数 (mapcar '(lambda (i j)  (clfun (list (+ (car pt)(* i (+ (* a (/ m tmin)) (* b (/ n tmin))))) (+ (cadr pt) (* j (+ (* a (/ n tmin)) (* b (/ m tmin))))))(/ n tmin) (/ m tmin) a b lst) )  (vfun tmin) (hfun tmin)) 导致的问题？

aimisiyou

(defun det (n m)
  (setq n1 (/ (+ n 1) 2) n2 (/ n 2) m1 (/ (+ m 1) 2) m2 (/ m 2))
  (setq va (list (list n1 m1) (list n2 m2) (list (- n1 n2) (- m1 m2))))
)
(defun tf (k n m lst)
   (if (= m 1)
       (setq va (list k n 1 lst))
       (if (> (setq tmin (gcd n m)) 1)
           (setq va (tf (* k tmin) (/ n tmin) (/ m tmin) lst))
           (progn
              (if (= (car lst) 0)
                  (cond
                    ((equal (car (cdr lst)) nil)  
                                          (setq va (list
                                                       (setq lst1  (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 0 (list (caddr (det n m))))) )
                                                                   (setq lst2 (tf k (/ n 2) (/ m 2) (cons 1 (list nil))))
                                                              )
                                            )
                                         )
                     ((equal (car (cdr lst)) (list 1 1))
                      (if (and (= (- n m) 1) (= (rem m 2) 0))
                          (setq va (list
                                                                 (tf k (/ n 2) (/ m 2) lst )
                                                                                 (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 1 (list (caddr (det n m)))))
                                                                     )
                                                    )
                           (setq va (list
                                                                  (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 0 (cons (caddr (det n m)) (cdr lst))) )
                                                                                  (tf k (/ n 2) (/ m 2) (cons 1 (list nil)))
                                                                          )
                            )
                         )
                                           )
                       ((equal (car (cdr lst)) (list 1 0))
                        (if (equal (caddr (det n m)) (list 1 0) )
                            (setq va (list
                                                                       (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 0 (cons (caddr (det n m)) (cdr lst))))
                                                                                   (tf k (/ n 2) (/ m 2) (cons 1 (list nil)))
                                                                           )
                                                         )
                             (setq va (list
                                                                        (tf k (/ n 2) (/ m 2) (cons 0 (cdr lst)) )
                                            (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 1 (list (caddr (det n m)))))
                                                                                )
                              )
                           )
                                                 )
                         ((equal (car (cdr lst)) (list 0 1))  
                          (if (equal (caddr (det n m)) (list 0 1) )
                              (setq va (list
                                                                            (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 0 (cons (caddr (det n m)) (cdr lst)))) (tf k (/ n 2) (/ m 2) (cons 1 (list nil)))
                                                                                )
                                                                )
                                (setq va (list
                                                                                (tf k (/ n 2) (/ m 2) (cons 0 (cdr lst)) )
                                                                                                (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 1 (list (caddr (det n m)))))
                                                                                  )
                                  )
                               )
                            )
                       (cond
                           ((equal (car (cdr lst)) nil)  
                             (setq va (list
                                                                          (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 0 (list (caddr (det n m)))) )
                                                                                          (tf k (/ n 2) (/ m 2) (cons 1 (list nil)))
                                                                            )
                                                          )
                             )
                            ((equal (car (cdr lst)) (list 1 1))
                              (if (and (= (- n m) 1) (= (rem m 2) 0))
                                  (setq va (list
                                                                                  (tf k (/ n 2) (/ m 2) lst )
                                                                                                  (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 1 (list (caddr (det n m)))))
                                                                                        )
                                                                        )
                                    (setq va (list
                                                                                     (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 0 (cons (caddr (det n m)) (cdr lst))))
                                                                                                 (tf k (/ n 2) (/ m 2) (cons 1 (list nil)))
                                                                                          )
                                    )
                                 )
                                                           )
                              ((equal (car (cdr lst)) (list 1 0))
                               (if (equal (caddr (det n m)) (list 1 0) )
                                   (setq va (list
                                                                                 (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 0 (cons (caddr (det n m)) (cdr lst))))
                                                                                                 (tf k (/ n 2) (/ m 2) (cons 1 (list nil)))
                                                                                          )
                                                                     )
                                    (setq va (list
                                                                                        (tf k (/ n 2) (/ m 2) (cons 0 (cdr lst)))
                                                                                                        (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 1 (list (caddr (det n m)))))
                                                                                           )
                                      )
                                  )
                                                            )
                                ((equal (car (cdr lst)) (list 0 1))  
                                  (if (equal (caddr (det n m)) (list 0 1) )
                                      (setq va (list
                                                                                      (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 0 (cons (caddr (det n m)) (cdr lst)))) (tf k (/ n 2) (/ m 2) (cons 1 (list nil)))
                                                                                                )
                                                                           )
                                      (setq va (list
                                                                                          (tf k (/ n 2) (/ m 2) (cons 0 (cdr lst)))
                                                                                                          (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 1 (list (caddr (det n m)))))
                                                                                                )
                                       )
                                     )
                                   )
                             )
                        )
                  )
            )
                )
    )
)
(tf 1 6 5 (list 0 nil))
_$ (tf 1 6 5 (list 0 nil))
((3 1 1 (0 (0 1))) nil)
_$ (tf 1 7 5 (list 0 nil))
(((2 1 1 (0 (0 1) (1 1))) (1 2 1 (1 nil))) nil)
_$ (tf 1 8 5 (list 0 nil))
(((2 1 1 (0 (0 1) (0 1))) (1 2 1 (1 nil))) (2 2 1 (1 nil)))
_$  (tf 1 9 5 (list 0 nil))
((((1 1 1 (0 (1 1) (1 1))) (1 2 1 (1 (1 0)))) (1 2 1 (1 nil))) (2 2 1 (1 nil)))
_$  (tf 1 10 5 (list 0 nil))
(5 2 1 (0 nil))
_$ (tf 1 11 5 (list 0 nil))
((3 2 1 (0 (1 1))) nil)
_$ (tf 1 12 5 (list 0 nil))
((3 2 1 (0 (0 1))) (2 3 1 (1 nil)))
_$ (tf 1 13 5 (list 0 nil))
(((2 2 1 (0 (1 1) (1 1))) (1 3 1 (1 nil))) (2 3 1 (1 nil)))
_$ (tf 1 14 5 (list 0 nil))
(((1 3 1 (0 (0 1))) (2 2 1 (1 (1 1)))) nil)_$ (tf 1 12 11 (list 0 nil))
((6 1 1 (0 (0 1))) nil)
似乎摸出点端倪，即递归只能半边运行（即左边需继续递归，右边能化简为K,1形式），若两边都需要继续递归或右边需继续递归，左边能化简为K,1形式时，只进行左边的递归运算，右边的stop了，导致结果不正确！

aimisiyou

这跟理想中的递归有出入啊！！！

aimisiyou

_$  (tf 1 32 9 (list 0 nil))
((((2 2 1 (0 (0 1) (0 1) (0 1))) (1 4 1 (1 nil))) (2 4 1 (1 nil))) (4 4 1 (1 nil)))

aimisiyou

(defun f (n)
        (if (or (= n 1) (= n 2))
             (list 1)
             (list (f (- n 1))  (f (- n 2)))
        )
  )
F
_$ (f 3)
((1) (1))
_$ (f 4)
(((1) (1)) (1))
_$ (f 5)
((((1) (1)) (1)) ((1) (1)))
_$ (f 6)
(((((1) (1)) (1)) ((1) (1))) (((1) (1)) (1)))
_$ (f 7)
((((((1) (1)) (1)) ((1) (1))) (((1) (1)) (1))) ((((1) (1)) (1)) ((1) (1))))
这情况又是符合左右都进行递归运算的啊。奇了怪了？

aimisiyou

突然发现（97,35）分解不下去了！！！看来二分法对所有的（n,m）未必都有效!

aimisiyou

原来是出了点小插曲，修改后就可以了。
(defun det (n m)
  (setq n1 (/ (+ n 1) 2) n2 (/ n 2) m1 (/ (+ m 1) 2) m2 (/ m 2))
  (setq va (list (list n1 m1) (list n2 m2) (list (- n1 n2) (- m1 m2))))
)
(defun tf (k n m lst)
   (if (= m 1)
       (setq va (list k n 1 lst))
       (if (> (setq tmin (gcd n m)) 1)
           (setq va (tf (* k tmin) (/ n tmin) (/ m tmin) lst))
           (progn
              (if (= (car lst) 0)
                  (cond
                    ((equal (car (cdr lst)) nil)  
                            (setq va (list
                                          (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 0 (list (caddr (det n m)))))
                                          (tf k (/ n 2) (/ m 2) (cons 1 (list nil)))
                                       )
                                                      )
                      )
                     ((equal (car (cdr lst)) (list 1 1))
                      (if (and (= (- n m) 1) (= (rem m 2) 0))
                          (setq va (list
                                          (tf k (/ n 2) (/ m 2) lst )
                                          (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 1 (list (caddr (det n m)))))
                                     )
                            )
                           (setq va (list
                                         (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 0 (cons (caddr (det n m)) (cdr lst))) )
                                         (tf k (/ n 2) (/ m 2) (cons 1 (list nil)))
                                     )
                            )
                         )
                       )
                       ((equal (car (cdr lst)) (list 1 0))
                        (if (equal (caddr (det n m)) (list 1 0) )
                            (setq va (list
                                         (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 0 (cons (caddr (det n m)) (cdr lst))))
                                         (tf k (/ n 2) (/ m 2) (cons 1 (list nil)))
                                       )
                              )
                             (setq va (list
                                            (tf k (/ n 2) (/ m 2) (cons 0 (cdr lst)) )
                                            (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 1 (list (caddr (det n m)))))
                                                                                )
                              )
                           )
                         )
                         ((equal (car (cdr lst)) (list 0 1))  
                          (if (equal (caddr (det n m)) (list 0 1) )
                              (setq va (list
                                           (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 0 (cons (caddr (det n m)) (cdr lst))))
                                                                                   (tf k (/ n 2) (/ m 2) (cons 1 (list nil)))
                                         )
                                )
                                (setq va (list
                                              (tf k (/ n 2) (/ m 2) (cons 0 (cdr lst)) )
                                              (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 1 (list (caddr (det n m)))))
                                           )
                                  )
                               )
                            )
                                            )
                       (cond
                           ((equal (car (cdr lst)) nil)  
                             (setq va (list
                                           (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 0 (list (caddr (det n m)))) )
                                           (tf k (/ n 2) (/ m 2) (cons 1 (list nil)))
                                        )
                               )
                             )
                            ((equal (car (cdr lst)) (list 1 1))
                              (if (and (= (- n m) 1) (= (rem m 2) 0))
                                  (setq va (list
                                                (tf k (/ n 2) (/ m 2) lst )
                                                (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 1 (list (caddr (det n m)))))
                                             )
                                    )
                                    (setq va (list
                                                  (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 0 (cons (caddr (det n m)) (cdr lst))))
                                                  (tf k (/ n 2) (/ m 2) (cons 1 (list nil)))
                                               )
                                    )
                                 )
                               )
                              ((equal (car (cdr lst)) (list 1 0))
                               (if (equal (caddr (det n m)) (list 1 0) )
                                   (setq va (list
                                                (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 0 (cons (caddr (det n m)) (cdr lst))))
                                                (tf k (/ n 2) (/ m 2) (cons 1 (list nil)))
                                              )
                                     )
                                    (setq va (list
                                                  (tf k (/ n 2) (/ m 2) (cons 0 (cdr lst)))
                                                  (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 1 (list (caddr (det n m)))))
                                              )
                                      )
                                  )
                                 )
                                ((equal (car (cdr lst)) (list 0 1))  
                                  (if (equal (caddr (det n m)) (list 0 1) )
                                      (setq va (list
                                                  (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 0 (cons (caddr (det n m)) (cdr lst)))) (tf k (/ n 2) (/ m 2) (cons 1 (list nil)))
                                                )
                                       )
                                      (setq va (list
                                                   (tf k (/ n 2) (/ m 2) (cons 0 (cdr lst)))
                                                   (tf k (/ (+ n 1) 2) (/ (+ m 1) 2) (cons 1 (list (caddr (det n m)))))
                                                )
                                       )
                                     )
                                   )
                             )
                        )
                  )
            )
    )
)
(tf 1 6 5 (list 0 nil))
DET
TF
((3 1 1 (0 (0 1))) ((1 2 1 (0 (1 0))) (1 1 1 (1 nil))))
_$ (tf 1 7 5 (list 0 nil))
(((2 1 1 (0 (0 1) (1 1))) (1 2 1 (1 nil))) ((1 2 1 (0 (1 0))) (1 1 1 (1 nil))))
_$ (tf 1 8 5 (list 0 nil))
(((2 1 1 (0 (0 1) (0 1))) (1 2 1 (1 nil))) (2 2 1 (1 nil)))
_$ (tf 1 9 5 (list 0 nil))
((((1 1 1 (0 (1 1) (1 1))) (1 2 1 (1 (1 0)))) (1 2 1 (1 nil))) (2 2 1 (1 nil)))
_$ (tf 1 10 5 (list 0 nil))
(5 2 1 (0 nil))
_$ (tf 1 11 5 (list 0 nil))
((3 2 1 (0 (1 1))) ((1 3 1 (0 (1 0))) (1 2 1 (1 nil))))
_$ (tf 1 97 35 (list 0 nil))
((((4 3 1 (0 (1 0) (1 1))) (((2 2 1 (0 (1 1) (1 1) (1 1))) (1 3 1 (1 nil))) (2 3 1 (1 nil)))) ((6 2 1 (0 (0 1))) (3 4 1 (1 nil)))) (((6 2 1 (0 (0 1) (0 1))) (3 4 1 (1 nil))) (8 3 1 (1 nil))))
_$ (tf 1 37 29 (list 0 nil))
((((4 1 1 (0 (1 1) (1 1))) ((2 2 1 (0 (1 0) (1 0))) (2 1 1 (1 nil)))) (((2 1 1 (0 (1 1))) ((1 2 1 (0 (1 0) (1 0))) (1 1 1 (1 nil)))) ((2 1 1 (0 (0 1))) (1 2 1 (1 nil))))) (((4 1 1 (0 (1 1))) ((2 2 1 (0 (1 0) (1 0))) (2 1 1 (1 nil)))) ((4 1 1 (0 (0 1))) (2 2 1 (1 nil)))))
_$

aimisiyou

aimisiyou 发表于 2016-11-3 22:37

_$ (tf 1 32 9 (list 0 nil))
((((2 2 1 (0 (0 1) (0 1) (0 1))) (1 4 1 (1 nil))) (2 4 1 (1 nil))) (4 4 1 (1 nil)))