二维下料

aimisiyou · 发表于 2016-11-13 16:20:06

本帖最后由 aimisiyou 于 2016-11-26 19:14 编辑

;;;对于所有n>=m均能实现，个别会出现重叠部位，只须将重叠部位的（1,1）进行调整即可
;;;算是最大限度的实现了（clfun pt n m a b (list 0 nil)）
(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 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)
      (if (member '(1 0) (cdr lst))
         (f (list (car pt) (+ (cadr pt) (+ (* n a) b))) (+ n 1) a b -1)
         (f pt (+ n 1) a b 1)
      )
      (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 (> (gcd n m) 1)
         (mapcar '(lambda (i j)  (clfun (list (+ (car pt)(* i (+ (* a (/ m (gcd n m))) (* b (/ n (gcd n m)))))) (+ (cadr pt) (* j (+ (* a (/ n (gcd n m))) (* b (/ m (gcd n m)))))))(/ n (gcd n m)) (/ m (gcd n m)) a b lst) )  (vfun (gcd n m)) (hfun (gcd n m)))
         (if (equal (cdr lst) (list nil))
            (progn
               (clfun pt (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2)) ))))
               (clfun (polar pt 0 (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2))) ) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
               (clfun (polar pt (/ pi 2) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2)))) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
               (clfun (list (+ (car pt) (+ (* a (/ m 2)) (* b (/ n 2))))(+ (cadr pt)(+ (* a (/ n 2)) (* b (/ m 2))))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2)) ))))
            )
            (if (= (car lst) 0)
                           (if (equal (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2)) ) (car (cdr lst)))                      (progn
                                       (clfun pt (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (cons (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2)) ) (cdr lst))))
                     (clfun (polar pt 0 (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2))) ) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
                     (clfun (polar pt (/ pi 2) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2)))) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
                     (clfun (list (+ (car pt) (+ (* a (/ m 2)) (* b (/ n 2))))(+ (cadr pt) (+ (* a (/ n 2)) (* b (/ m 2))))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (cons (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2)) ) (cdr lst))))
                  )
                  (progn
                     (clfun pt (/ n 2) (/ m 2) a b (cons 0 (cdr lst)))
                     (clfun (polar pt 0 (+ (* a (/ m 2)) (* b (/ n 2))) ) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2)) ))))
                     (clfun (polar pt (/ pi 2) (+ (* a (/ n 2)) (* b (/ m 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2)) ))))
                     (clfun (list (+ (car pt) (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2))))(+ (cadr pt) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2))))) (/ n 2) (/ m 2) a b (cons 0 (cdr lst)))
                  )
               )
                           (if (equal (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2)) ) (car (cdr lst)))                      (progn
                                       (clfun pt (/ n 2) (/ m 2) a b (cons 0 (list nil)))
                     (clfun (polar pt 0 (+ (* a (/ m 2)) (* b (/ n 2))) ) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (cons (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2)) ) (cdr lst))))
                     (clfun (polar pt (/ pi 2) (+ (* a (/ n 2)) (* b (/ m 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (cons (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2)) ) (cdr lst))))
                     (clfun (list (+ (car pt) (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2))))(+ (cadr pt) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2))))) (/ n 2) (/ m 2) a b (cons 0 (list nil)))
                  )
                  (progn
                     (clfun pt (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2)) ))))
                     (clfun (polar pt 0 (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2))) ) (/ n 2) (/ m 2) a b (cons 1 (cdr lst)))
                     (clfun (polar pt (/ pi 2) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2)))) (/ n 2) (/ m 2) a b (cons 1 (cdr lst)))
                     (clfun (list (+ (car pt) (+ (* a (/ m 2)) (* b (/ n 2))))(+ (cadr pt) (+ (* a (/ n 2)) (* b (/ m 2))))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2)) ))))
                                       )
                                       )
               )
               )
         )
      )
  )
(clfun (getpoint) 5 3 10 7 (list 0 nil))

aimisiyou · 发表于 2016-11-13 21:42:37

本帖最后由 aimisiyou 于 2016-11-26 19:15 编辑

奇怪了？按理说右边运行的结果应该是左图的复制3*3，但实际运行结果却是方向改变了（相对左图），不知哪里出了问题？如果这个问题解决，对所有n>=m应该都能正确运行了。

aimisiyou · 发表于 2016-11-13 22:43:41

本帖最后由 aimisiyou 于 2016-11-26 19:11 编辑

;;;找到原因了，原来是hfun函数里的变量lst 和clfun函数参数里的lst重名了，修改后就可以了;;;对于所有n>=m都可以正确运行了

(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 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 llst nil hlst nil)
(while (< j tmin)
      (setq llst (cons j llst))
      (setq j (+ j 1))
)
(repeat tmin (setq hlst (append llst hlst)))
hlst
)
(defun clfun (pt n m a b lst)
(if (= m 1)
   (if (= (car lst) 0)
      (if (member '(1 0) (cdr lst))
         (f (list (car pt) (+ (cadr pt) (+ (* n a) b))) (+ n 1) a b (- 0 1))
         (f pt (+ n 1) a b 1)
      )
      (if (member '(0 1) (cdr lst))
         (f (list (car pt) (+ (cadr pt) (+ (* n a) b))) (+ n 1) a b (- 0 1))
         (f pt (+ n 1) a b 1)
      )
   )
   (if (> (gcd n m) 1)
         (mapcar '(lambda (i j)  (clfun (list (+ (car pt)(* i (+ (* a (/ m (gcd n m))) (* b (/ n (gcd n m)))))) (+ (cadr pt) (* j (+ (* a (/ n (gcd n m))) (* b (/ m (gcd n m)))))))(/ n (gcd n m)) (/ m (gcd n m)) a b lst)) (vfun (gcd n m)) (hfun (gcd n m)))
         (if (equal (cdr lst) (list nil))
            (progn
               (clfun pt (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
               (clfun (polar pt 0 (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2))) ) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
               (clfun (polar pt (/ pi 2) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2)))) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
               (clfun (list (+ (car pt) (+ (* a (/ m 2)) (* b (/ n 2))))(+ (cadr pt)(+ (* a (/ n 2)) (* b (/ m 2))))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
            )
            (if (= (car lst) 0)
                           (if (equal (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))) (car (cdr lst)))                      (progn
                                       (clfun pt (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (cons (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2)) ) (cdr lst))))
                     (clfun (polar pt 0 (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2))) ) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
                     (clfun (polar pt (/ pi 2) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2)))) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
                     (clfun (list (+ (car pt) (+ (* a (/ m 2)) (* b (/ n 2))))(+ (cadr pt) (+ (* a (/ n 2)) (* b (/ m 2))))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (cons (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))) (cdr lst))))
                  )
                  (progn
                     (clfun pt (/ n 2) (/ m 2) a b lst)
                     (clfun (polar pt 0 (+ (* a (/ m 2)) (* b (/ n 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
                     (clfun (polar pt (/ pi 2) (+ (* a (/ n 2)) (* b (/ m 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
                     (clfun (list (+ (car pt) (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2))))(+ (cadr pt) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2))))) (/ n 2) (/ m 2) a b lst)
                  )
               )
                           (if (equal (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))) (car (cdr lst)))                      (progn
                                       (clfun pt (/ n 2) (/ m 2) a b (cons 0 (list nil)))
                     (clfun (polar pt 0 (+ (* a (/ m 2)) (* b (/ n 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (cons (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))) (cdr lst))))
                     (clfun (polar pt (/ pi 2) (+ (* a (/ n 2)) (* b (/ m 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (cons (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))) (cdr lst))))
                     (clfun (list (+ (car pt) (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2))))(+ (cadr pt) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2))))) (/ n 2) (/ m 2) a b (cons 0 (list nil)))
                  )
                  (progn
                     (clfun pt (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
                     (clfun (polar pt 0 (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2)))) (/ n 2) (/ m 2) a b lst)
                     (clfun (polar pt (/ pi 2) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2)))) (/ n 2) (/ m 2) a b  lst)
                     (clfun (list (+ (car pt) (+ (* a (/ m 2)) (* b (/ n 2))))(+ (cadr pt) (+ (* a (/ n 2)) (* b (/ m 2))))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2)) ))))
                                       )
                                       )
               )
               )
         )
      )
  )
(clfun (getpoint) 97 35 10 7 (list 0 nil))

aimisiyou · 发表于 2016-11-13 22:57:36

本帖最后由 aimisiyou 于 2016-11-14 12:01 编辑

总结下：
1、递归中各函数中不能有相同变量名！！！
2、递归中不能有简化，如(setq tmin (gcd n m)),后面用tmin代换，程序会产生错误！！！

3、递归中循环不要用while、foreach、repeat、(setq i (+ i 1))等语句！！！（已经试用过均有错误）若要用循环，使用mapcar函数！！！

4、若涉及二叉树结构，用表(list 0 nil)进行二叉树分解（左0右1，附带权值），最后根据叶子判断方向！！！

aimisiyou · 发表于 2016-11-13 23:56:54

本帖最后由 aimisiyou 于 2016-11-14 00:45 编辑

余下的问题就是如何将（DA,DB）转换为合适的（n,m），或者说(DA,DB)面积在K1*K2个（n,m）内且利用率达到最大，即DA*DB/(K1*(n*a+m*b)*K2*(m*a+n*b))达到最大？

aimisiyou · 发表于 2016-11-15 14:57:48

将构件按横排和竖排两种方式尽量排，选取剩余面积较小的作为优选，求出此时剩余面积S,若S<a*b,显然已经是最优的；否则求t=S/(a-b)^2，即剩余面积相当于t个空格，即当满布（边距为0）且纵横交排产生的空格数小于t时可进行优化。

aimisiyou · 发表于 2016-11-16 00:04:06

aimisiyou 发表于 2016-11-13 22:43

有点奇怪的是，递归里面的mapcar函数后面的两个表参数  （vfun (gcd n m)）和（hfun (gcd n m)）元素个数不相等，但运行的效果却等同于（foreach i  （vfun (gcd n m)）
   （foreach j（hfun (gcd n m)）
      ………………
   ）
）
难道是误打误撞对了？

aimisiyou · 发表于 2016-11-26 14:06:34

(defun f(pt n a b flag tfx)
  (if (= n 1)
   (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))))
            )
         )
      )
   (progn
      (f pt 1 a b flag tfx)
      (setq i 1)
      (while (< i n)
         (setq pt1 (list (car pt) (+ (cadr pt) (* tfx (+ (if flag b a) (* (if flag a b) -1) (* (if flag a b) i))))))
         (setq pt2 (list (+ (car pt) (- (if flag a b) (if flag b a)) (* i (if flag b a))) (cadr pt)))
         (f pt1 1 a b (not flag) tfx)
         (f pt2 1 a b (not flag) tfx)
         (setq i (+ i 1))
      )
      (f (list (+ (car pt) (if flag b a)) (+ (cadr pt) (* (if flag a b) tfx))) (- n 1) a b flag tfx)
   )
)
)

aimisiyou · 发表于 2016-11-26 19:06:09

本帖最后由 aimisiyou 于 2016-11-26 19:39 编辑

;;;只要满足a>b对所有的n,m均可.
(defun c:tt()
;;;(t 1)横上；(t -1)横下；(nil 1)竖上；(nil -1)竖下；
(defun f(pt n a b flag tfx)
  (if (= n 1)
   (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))))
            )
         )
      )
   (progn
      (f pt 1 a b flag tfx)
      (setq i 1)
      (while (< i n)
         (setq pt1 (list (car pt) (+ (cadr pt) (* tfx (+ (if flag b a) (* (if flag a b) -1) (* (if flag a b) i))))))
         (setq pt2 (list (+ (car pt) (- (if flag a b) (if flag b a)) (* i (if flag b a))) (cadr pt)))
         (f pt1 1 a b (not flag) tfx)
         (f pt2 1 a b (not flag) tfx)
         (setq i (+ i 1))
      )
      (f (list (+ (car pt) (if flag b a)) (+ (cadr pt) (* (if flag a b) tfx))) (- n 1) a b flag tfx)
   )
)
)
(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 llst nil hlst nil)
(while (< j tmin)
      (setq llst (cons j llst))
      (setq j (+ j 1))
)
(repeat tmin (setq hlst (append llst hlst)))
hlst
)
(defun clfun1 (pt n m a b lst)
(if (= m 1)
  (if (= (car lst) 0)
(if (member '(1 0) (cdr lst))
   (f (list (car pt) (+ (cadr pt) (+ (* n a) b))) (+ n 1) a b t -1)
   (f pt (+ n 1) a b t 1)
   )
  (if (member '(0 1) (cdr lst))
(f (list (car pt) (+ (cadr pt) (+ (* n a) b))) (+ n 1) a b t -1)
(f pt (+ n 1) a b t 1)
)
)
  (if (> (gcd n m) 1)
   (mapcar '(lambda (i j)  (clfun1 (list (+ (car pt)(* i (+ (* a (/ m (gcd n m))) (* b (/ n (gcd n m)))))) (+ (cadr pt) (* j (+ (* a (/ n (gcd n m))) (* b (/ m (gcd n m)))))))(/ n (gcd n m)) (/ m (gcd n m)) a b lst)) (vfun (gcd n m)) (hfun (gcd n m)))
   (if (equal (cdr lst) (list nil))
      (progn
      (clfun1 pt (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
      (clfun1 (polar pt 0 (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2))) ) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
      (clfun1 (polar pt (/ pi 2) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2)))) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
      (clfun1 (list (+ (car pt) (+ (* a (/ m 2)) (* b (/ n 2))))(+ (cadr pt)(+ (* a (/ n 2)) (* b (/ m 2))))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
      )
      (if (= (car lst) 0)
      (if (equal (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))) (car (cdr lst)))
   (progn
         (clfun1 pt (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (cons (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2)) ) (cdr lst))))
         (clfun1 (polar pt 0 (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2))) ) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
         (clfun1 (polar pt (/ pi 2) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2)))) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
         (clfun1 (list (+ (car pt) (+ (* a (/ m 2)) (* b (/ n 2))))(+ (cadr pt) (+ (* a (/ n 2)) (* b (/ m 2))))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (cons (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))) (cdr lst))))
)
         (progn
            (clfun1 pt (/ n 2) (/ m 2) a b lst)
            (clfun1 (polar pt 0 (+ (* a (/ m 2)) (* b (/ n 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
            (clfun1 (polar pt (/ pi 2) (+ (* a (/ n 2)) (* b (/ m 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
            (clfun1 (list (+ (car pt) (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2))))(+ (cadr pt) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2))))) (/ n 2) (/ m 2) a b lst)
                  )
               )
      (if (equal (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))) (car (cdr lst)))
            (progn
                     (clfun1 pt (/ n 2) (/ m 2) a b (cons 0 (list nil)))
                     (clfun1 (polar pt 0 (+ (* a (/ m 2)) (* b (/ n 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (cons (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))) (cdr lst))))
                     (clfun1 (polar pt (/ pi 2) (+ (* a (/ n 2)) (* b (/ m 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (cons (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))) (cdr lst))))
                     (clfun1 (list (+ (car pt) (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2))))(+ (cadr pt) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2))))) (/ n 2) (/ m 2) a b (cons 0 (list nil)))
                  )
                  (progn
                     (clfun1 pt (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
                     (clfun1 (polar pt 0 (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2)))) (/ n 2) (/ m 2) a b lst)
                     (clfun1 (polar pt (/ pi 2) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2)))) (/ n 2) (/ m 2) a b  lst)
                     (clfun1 (list (+ (car pt) (+ (* a (/ m 2)) (* b (/ n 2))))(+ (cadr pt) (+ (* a (/ n 2)) (* b (/ m 2))))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2)) ))))
                  )
                  )
               )
               )
         )
      )
)
(defun clfun2 (pt n m a b lst)
(if (= n 1)
  (if (= (car lst) 0)
(if (member '(0 1) (cdr lst))
   (f (list (car pt) (+(cadr pt) (+ (* m b) a))) (+ m 1) a b nil -1)
   (f pt (+ m 1) a b nil 1)
   )
  (if (member '(1 0) (cdr lst))
(f (list (car pt) (+ (cadr pt) (+ (* m b) a))) (+ m 1) a b nil -1)
(f pt (+ m 1) a b nil 1)
)
)
  (if (> (gcd n m) 1)
   (mapcar '(lambda (x y)  (clfun2 (list (+ (car pt)(* x (+ (* a (/ m (gcd n m))) (* b (/ n (gcd n m)))))) (+ (cadr pt) (* y (+ (* a (/ n (gcd n m))) (* b (/ m (gcd n m)))))))(/ n (gcd n m)) (/ m (gcd n m)) a b lst)) (vfun (gcd n m)) (hfun (gcd n m)))
   (if (equal (cdr lst) (list nil))
      (progn
      (clfun2 pt (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
      (clfun2 (polar pt 0 (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2))) ) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
      (clfun2 (polar pt (/ pi 2) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2)))) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
      (clfun2 (list (+ (car pt) (+ (* a (/ m 2)) (* b (/ n 2))))(+ (cadr pt)(+ (* a (/ n 2)) (* b (/ m 2))))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
      )
      (if (= (car lst) 0)
      (if (equal (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))) (car (cdr lst)))
   (progn
         (clfun2 pt (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (cons (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2)) ) (cdr lst))))
         (clfun2 (polar pt 0 (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2))) ) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
         (clfun2 (polar pt (/ pi 2) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2)))) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
         (clfun2 (list (+ (car pt) (+ (* a (/ m 2)) (* b (/ n 2))))(+ (cadr pt) (+ (* a (/ n 2)) (* b (/ m 2))))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (cons (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))) (cdr lst))))
)
         (progn
            (clfun2 pt (/ n 2) (/ m 2) a b lst)
            (clfun2 (polar pt 0 (+ (* a (/ m 2)) (* b (/ n 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
            (clfun2 (polar pt (/ pi 2) (+ (* a (/ n 2)) (* b (/ m 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
            (clfun2 (list (+ (car pt) (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2))))(+ (cadr pt) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2))))) (/ n 2) (/ m 2) a b lst)
                  )
               )
      (if (equal (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))) (car (cdr lst)))
            (progn
                     (clfun2 pt (/ n 2) (/ m 2) a b (cons 0 (list nil)))
                     (clfun2 (polar pt 0 (+ (* a (/ m 2)) (* b (/ n 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (cons (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))) (cdr lst))))
                     (clfun2 (polar pt (/ pi 2) (+ (* a (/ n 2)) (* b (/ m 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (cons (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))) (cdr lst))))
                     (clfun2 (list (+ (car pt) (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2))))(+ (cadr pt) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2))))) (/ n 2) (/ m 2) a b (cons 0 (list nil)))
                  )
                  (progn
                     (clfun2 pt (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
                     (clfun2 (polar pt 0 (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2)))) (/ n 2) (/ m 2) a b lst)
                     (clfun2 (polar pt (/ pi 2) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2)))) (/ n 2) (/ m 2) a b  lst)
                     (clfun2 (list (+ (car pt) (+ (* a (/ m 2)) (* b (/ n 2))))(+ (cadr pt) (+ (* a (/ n 2)) (* b (/ m 2))))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2)) ))))
                  )
                  )
               )
               )
         )
   )
)
(setq ppt (getpoint "\n插入点位置："))
(setq nn (getint "\nn=：") mm (getint "\nm=：") aa (getint "\na=：") bb (getint "\nb=："))
(if (> nn mm)
(clfun1 ppt nn mm aa bb (list 0 nil))
(clfun2 ppt nn mm aa bb (list 0 nil))
)
)

aimisiyou · 发表于 2016-11-26 22:14:12

本帖最后由 aimisiyou 于 2016-11-26 22:16 编辑

考虑DA、DB均不是a,b的倍数时，将一边转化为k1*a+k2*b(其中K1尽量取最大，k2尽量取最小)，另一边转化为k3*b+k4*a(其中K3尽量取最大，k4尽量取最小).如图，a=10,b=7,底边方向为11a+2b,高度方向12b+2a。

aimisiyou · 发表于 2016-11-26 23:12:40

本帖最后由 aimisiyou 于 2016-11-27 15:15 编辑

看来每边要减去数倍的a,b的最小公倍数M，直到DA、DB均小于M才行，再进行后续的判断。

aimisiyou · 发表于 2016-12-10 21:46:59

本帖最后由 aimisiyou 于 2016-12-10 22:18 编辑

偶然发现（29,19）分解会出现重叠现象。另外还有（29,10）、（29,14）、（29,22）、（29,26）、（53,10）、（53,14）、（53,22）、（53,24）、（53,26）……有看来分解规则需要稍作调整。

aimisiyou · 发表于 2016-12-10 23:46:52

给出（29,19）的分解及作图。

aimisiyou · 发表于 2016-12-11 00:13:46

本帖最后由 aimisiyou 于 2016-12-11 00:15 编辑

给出（29,26）的分解及作图。注意分解树最左叶子点（2,1）方向为+1，即（2,1）图形右侧竖直方向上最顶为b，即（0,1），与（15,13）、（14,13）的差值（1,0）不相同，故（15,13）左下角和右上角处的（2,1）中的（1,1）须翻转调整。

aimisiyou · 发表于 2016-12-11 10:41:15

本帖最后由 aimisiyou 于 2016-12-11 11:16 编辑

为避免局部翻转调整，将分解规则重新定义如下：
1、一般情况下，权值赋在左路径上；
2、若左路径上为全为（1,1），则叶子点方向为+1；
3、若左路径上为（1,1）,(0,1)的重复组合，则叶子点方向为+1；
4、若左路径上全为（1,0），则叶子点方向为-1；
5、若左路径上全为（0,1），则叶子点方向为+1；
6、若左路径上以（1,0）开始，则后续左路径上只能接（1,0），否则权值赋在右路径上；
7、若左路径上以（0,1）或（1,1）开始，则后续左路径上只能接（0,1）或（1,1），否则权值赋在右路径上；8、若右路径上为全为（1,1），则叶子点方向为-1；
9、若右路径上为为（1,1）,(0,1)的重复组合，则叶子点方向为-1；
10、若右路径上为全为（1,0），则叶子点方向为+1；
11、若右路径上为全为（0,1），则叶子点方向为-1；
12、若右路径上以（1,0）开始，则后续右路径上只能接（1,0），否则权值赋在左路径上；
13、若右路径上以（0,1）或（1,1）开始，则后续右路径上只能接（0,1）或（1,1），否则权值赋在左路径上；
14、通长路径上为空的叶子点方向规定为+1.（其实方向正负均无影响）

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

[原创] 二维下料