二维下料

aimisiyou

_$ (defun fnum (LA LB aa bb)
  (if (or (< (min LA LB) bb) (< (max LA LB) aa) (< (* LA LB) (* aa bb)))
      (setq va 0)
      (setq va (max
                  (+ (/ LA bb) (fnum LA (- LB aa) aa bb))
                  (+ (/ LA aa) (fnum LA (- LB bb) aa bb))
                  (+ (/ LB bb) (fnum (- LA aa) LB aa bb))
                  (+ (/ LB aa) (fnum (- LA bb) LB aa bb))
               )
   )
  )
)
FNUM
_$ (fnum 54 34 10 7)
26
仅从程序运行结果上看，54*34母材上是可以裁出26个小矩形的，但内部递归过程不清楚，也就不知道怎么裁出来26个的。
感觉不可能裁出26个啊，程序哪里出现问题了？

aimisiyou

_$ (fnum 17 67 10 7)
18
17*67/70=16.27<18

_$ (fnum 37 27 10 7)
15
37*27/70=14.27<15程序哪里出问题了！！！

aimisiyou

网上搜了下，一大堆条带法之类的，这些算法只能说是接近最优解，但不能保证一定得到最优解。

aimisiyou

这个算法不知怎么实现？

aimisiyou

上传文件以供参考。

aimisiyou

如何实现下台阶算法？（将一矩形置于板材右边最大高度处，向下向左移动，且向下移动优先，即原本已无法再向下移动，故开始向左移动，而在向左移动的过程中若发现又能继续向下移动，则先向下移动，直至无法向下向左移动为止，接着排放下一个矩形）。先按（序号，长，宽）给出10个小矩形数据及母材宽20（高度不限）。
(setq lst '((1 12 6) (2 4 7) (3 6 7) (4 10 2) (5 2 5) (6 6 4)(7 4 2) (8 4 6)(9 7 9)(10 4 5)))
然后给出一个矩形排放顺序及每个矩形状态(1为旋转90度，0为不旋转)，如(setq mlst '(1 2 3 4 5 6 7 8 9 10))
(setq nlst '(3 8 6 4 2 5 9 1 7 10))
(setq rlst   '(1 0 0 1 0 1 0 1 0 1))
如何根据数据自动生成排放图形？

如图1为(f mlst rlst)，图2为(f nlst rlst).

aimisiyou

考虑剩余矩形法，如图，左一为中间排放状态，此时剩余矩形为右边六个蓝色矩形框，若此时排放的矩形长宽分别为a,b,算法如下：1、将剩余矩形框按从低到高，从左到右排序；

2、从排完序后的剩余矩形框中依次检查矩形框长宽是否均大于a,b，
      若是，则将该矩形放在此矩形框的左下角（更新剩余矩形框），排放下一个矩形（跳转到1）；
      否则，检查下一个矩形框；

3、若所有矩形框均不满足，则终止运行（即无法排入该矩形）

aimisiyou

对于剩余矩形法，如图2，矩形3应该放在矩形1的右侧（显然这样利用率更高），但按照下台阶法，矩形3应放在矩形2的上边。
所以，要实现下台阶法，还要消除掉中间架空的矩形框。但图3中，按下台阶法，矩形3又是应该放在矩形1的右侧。

该如何处理好架空情况？

yzhyxh

aimisiyou

下面如何求剩余矩形?
开始令S=（（0,0,DA,DB））
在左下角放入矩形R1(a,b),
则此时剩余矩形为S-R1=(B1,B2)=（（0,b,DA,DB-b)（a,0,DA-a,DB) ）再放入矩形R2（c,d），
若剩余矩形中矩形框与R2相交，则分解矩形框，并对包含的矩形框合并，更新剩余矩形。
即（B1,B2）-R2
=((0 ,b,a,DB-b) (0,d,DA,DB-d) (a+c,0,DA-a-c,DB) (a+c,b,DA-a-c,DB-b)(a,d,DA-a,DB-d))
=((0 ,b,a,DB-b) (0,d,DA,DB-d) (a+c,0,DA-a-c,DB) )

aimisiyou

放入的矩形R与剩余矩形S（其中一个矩形框）相交的情况只有26种，如图。令S=（Sx,Sy,Sa,Sb）,R=（Rx,Ry,Ra,Rb）
做函数（f   S   R ）.

aimisiyou

(defun fenfun (s r)
  (cond
      ((and (= (car r) (car s))
            (= (cadr r) (cadr s))
            (= (caddr r) (caddr s))
            (= (cadddr r) (cadddr s))  
         )      
        (setq va nil)
      )     
      ((and (<= (car r) (car s))
            (<= (cadr r) (cadr s))
            (< (car s) (+ (car r) (caddr r)) (+ (car s) (caddr s)))
            (< (cadr s) (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)))  
          )      
         (setq va (list
                       (list (car s) (+ (cadr r) (cadddr r)) (caddr s) (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))) )
                       (list (+ (car r) (caddr r)) (cadr s)  (- (+ (car s) (caddr s)) (+ (car r) (caddr r))) (cadddr s))
                   )
          )
       )
      ((and (= (car r) (car s))
            (< (cadr r) (cadr s))
            (< (caddr r) (caddr s))
            (< (cadr s) (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)))  
          )
         (setq va (list
                       (list (car s) (+ (cadr r) (cadddr r)) (caddr s) (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))) )
                       (list (+ (car r) (caddr r)) (cadr s)  (- (+ (car s) (caddr s)) (+ (car r) (caddr r))) (cadddr s))
                  )
          )
       )
      ((and (< (car s ) (car r ) (+ (car r) (caddr r)) (+ (car s) (caddr s)))
            (< (cadr r) (cadr s) (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)))  
        )
        (setq va (list
                       (list (car s) (cadr s) (- (car r)(car s)) (cadddr s) )
                       (list (car s) (+ (cadr r) (cadddr r)) (caddr s)  (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))))
                       (list (+ (car r) (caddr r)) (cadr s) (- (+ (car s) (caddr s)) (+ (car r) (caddr r))) (cadddr s))
                  )
          )
       )
      ((and (< (car s ) (car r ) (+ (car s) (caddr s)) )
            (<= (+ (car s) (caddr s)) (+ (car r) (caddr r)) )
            (< (cadr r) (cadr s) (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)))  
        )
        (setq va (list
                       (list (car s) (cadr s) (- (car r) (car s))(cadddr s) )
                       (list (car s) (+ (cadr r) (cadddr r))  (caddr s)  (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))))
                  )
          )
       )
      ((and (= (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r)) )
            (<= (car r ) (car s ) )
            (< (car s)  (+ (car r) (caddr r)) (+ (car s) (caddr s)))
            (<= (cadr r) (cadr s) )  
        )
        (setq va (list
                       (list (+ (car r) (caddr r)) (cadr s) (- (+ (car s) (caddr s)) (+ (car r) (caddr r))) (cadddr s) )
                  )
          )
       )
      ((and (= (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r)) )
            (< (car s ) (car r ) (+ (car r) (caddr r)) (+ (car s) (caddr s)))
            (< (cadr r) (cadr s) )  
        )
        (setq va (list
                       (list (car s ) (cadr s ) (- (car r) (car s))(cadddr s) )
                       (list (+ (car r) (caddr r)) (cadr s) (- (+ (car s) (caddr s)) (+ (car r) (caddr r))) (cadddr s) )
                  )
          )
       )
      ((and (= (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r)) )
            (< (car s ) (car r )  (+ (car s) (caddr s)))
            (<= (cadr s) (+ (car r) (caddr r)))
            (< (cadr r) (cadr s) )  
        )
        (setq va (list
                       (list (car s ) (cadr s ) (- (car r) (car s))(cadddr s) )
                  )
          )
       )
      ((and (< (car s ) (car r )  (+ (car s) (caddr s)) (+ (car r) (caddr r)))
            (< (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)))
            (= (cadr r) (cadr s) )  
        )
        (setq va (list
                       (list (car s ) (cadr s ) (- (car r) (car s))(cadddr s) )
                       (list (car s ) (+ (cadr r)(cadddr r)) (caddr s)(- (cadddr s)(cadddr r)))
                  )
          )
       )
      ((and (<= (car r ) (car s )  (+ (car s) (caddr s)) (+ (car r) (caddr r)))
            (< (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)))
            (= (cadr r) (cadr s) )  
        )
        (setq va (list
                       (list (car s ) (+ (cadr r)(cadddr r)) (caddr s) (- (cadddr s)(cadddr r)))
                  )
          )
       )
      ((and (< (car r ) (car s ) (+ (car r) (caddr r)) (+ (car s) (caddr s)) )
            (< (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)))
            (= (cadr r) (cadr s) )  
        )
        (setq va (list
                       (list (car s ) (+ (cadr r)(cadddr r)) (caddr s) (- (cadddr s)(cadddr r)))
                       (list (+ (car r) (caddr r)) (cadr s ) (- (+ (car s) (caddr s)) (+ (car r) (caddr r))) (cadddr s))
                  )
          )
       )
      ((and (< (car s ) (car r ) (+ (car s) (caddr s)) (+ (car r) (caddr r)) )
            (< (cadr s ) (cadr r ) (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)) )
        )
        (setq va (list
                       (list (car s)(cadr s)(caddr s) (- (cadr r) (cadr s)) )
                       (list (car s)(cadr s) (- (car r) (car s)) (cadddr s))
                       (list (car s)(+ (cadr r) (cadddr r)) (caddr s ) (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))) )
                  )
          )
       )
      ((and (<= (car r ) (car s) (+ (car s) (caddr s)) (+ (car r) (caddr r)) )
            (< (cadr s ) (cadr r ) (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)) )
        )
        (setq va (list
                       (list (car s)(cadr s)(caddr s) (- (cadr r) (cadr s)) )
                       (list (car s)(+ (cadr r) (cadddr r)) (caddr s ) (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))) )
                  )
          )
       )
      ((and (< (car r ) (car s ) (+ (car r) (caddr r)) (+ (car s) (caddr s)) )
            (< (cadr s ) (cadr r ) (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)) )
        )
        (setq va (list
                       (list (car s)(cadr s)(caddr s) (- (cadr r) (cadr s)) )
                       (list (+ (car r)(caddr r)) (cadr s) (- (+ (car s) (caddr s)) (+ (car r) (caddr r))) (cadddr s))
                       (list (car s)(+ (cadr r) (cadddr r)) (caddr s ) (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))) )
                  )
          )
       )
      ((and (< (car s ) (car r )  (+ (car s) (caddr s)) (+ (car r) (caddr r)))
            (< (cadr s ) (cadr r ))
            (= (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r)))
        )
        (setq va (list
                       (list (car s ) (cadr s )(- (car r) (car s))(cadddr s) )
                       (list (car s ) (cadr s )(caddr s)(- (cadr r) (cadr s)) )
                  )
          )
       )
      ((and (<= (car r ) (car s )  (+ (car s) (caddr s)) (+ (car r) (caddr r)))
            (< (cadr s ) (cadr r ))
            (= (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r)))  
        )
        (setq va (list
                       (list (car s ) (cadr s )(caddr s)(- (cadr r) (cadr s)) )
                  )
          )
       )
      ((and (< (car r ) (car s )  (+ (car r) (caddr r)) (+ (car s) (caddr s)))
            (< (cadr s ) (cadr r ))
            (= (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r)))  
        )
        (setq va (list
                       (list (car s ) (cadr s )(caddr s)(- (cadddr s) (cadddr r)) )
                       (list (+ (car r)(caddr r)) (cadr s) (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))) (cadddr s) )
                  )
          )
       )
       (t (setq va s))
)
)

aimisiyou

接下来考虑合并问题。先来个简单问题，将表lst='((1 3)(2 5)(1 2)(4 8)(5 6)(3 9))中区间合并，规则是若一个区间在另一个区间内，则此区间舍去只保留较大区间，如 （1 2）在（1 3）区间内，故舍去（1 2）只保留（1 3），（5 6）在（4 8）区间内，而（4 8 ）在（3 9）区间内，故舍去（5  6）和（4  8），保留（3  9），故lst合并后的结果为'((1 3)(2 5)(3 9))。如何自定义函数实现？

pezyl

我得天，佩服楼主的钻研精神

aimisiyou

_$ (defun hefun (lst)
   (setq i 0 vlst nil n (length lst) )
   (while (< i n)
        (setq a (nth i lst) j 0 sum 0 flag t)
        (while (and flag (< j n))
           (setq b (nth j lst))
           (if (and (<= (car b)  (car a) )
                    (<= (cadr a) (cadr b))
               )
              (setq sum (+ 1 sum))
            )
           (setq j (+ j 1))
           (if (> sum 1) (setq flag nil))
         )
       (if flag (setq vlst (cons a vlst)))
       (setq i (+ i 1))
  )
  (reverse vlst)
)
HEFUN
_$  (hefun '((1 3)(2 5)(1 2)(4 8)(5 6)(3 9)))
((1 3) (2 5) (3 9))
_$ (hefun '((4 8)(5 6)(3 9)))
((3 9))
_$