采用连分数法求解单一规格矩形直切下料问题

aimisiyou · 发表于 2019-9-26 20:23:52

本帖最后由 aimisiyou 于 2019-9-26 20:27 编辑

当LA、LB、c、d有公约数k时,可简化为求（LA/k,LB/k,c/k,d/k）
如（3800,1700,320,180）=（380,170,32,18）=（190,85,16,9），可大大减少运行时间。

aimisiyou · 发表于 2019-9-26 21:38:57

本帖最后由 aimisiyou 于 2019-9-26 21:41 编辑

碰到了一个硬茬，运行了半小时才出结果。
双递减1的效率确实有点太低了，双循环的次数约为500*300=15万！！！需要优化下。

aimisiyou · 发表于 2019-9-27 08:48:43

本帖最后由 aimisiyou 于 2019-10-1 22:40 编辑

;;;现在的速度大大提高了，基本秒杀。
;;;剪切下料的毛坯数最大，且剪切刀数最小。
(defun c:tt()
(defun xl (LA LB c d)
(defun LF (c d) ;;;c>d
  (setq lst nil)
  (if (= (rem c d) 0)
   (setq lst (list (/ c d)))
   (setq lst (cons (/ c d) (LF d (rem c d))))
)
)
(defun HF (lst)
(if (<= (length lst) 2)
   (if (= (length lst) 2)
         (setq va (list (+ 1 (* (car lst)(cadr lst))) (cadr lst)))
               (setq va (list (car lst) 1))
            )
         (setq va (list (+ (cadr (HF (cdr lst))) (* (car lst)(car (HF (cdr lst))))) (car (HF (cdr lst)))))
  )
)
(defun FCC(k1 k2 c d)
  (if (= d 1)
   (setq num_cc (* k1 k2 c))
      (progn
      (if (= (rem (length (LF c d)) 2) 0)
            (setq cd (HF (reverse (cdr (reverse (LF c d))))))
            (setq cd (HF (reverse (cons (- (last (LF c d)) 1) (cdr (reverse (LF c d)))))))
      )
      (setq r2 (rem k1 (cadr cd)))
      (setq t2 (rem k2 (cadr cd)))
      (setq num_cc (+ (* (/ k1 (cadr cd)) k2 (car cd))  (* (/ k2 (cadr cd)) r2 (car cd))  (FCC r2 t2 (car cd) (cadr cd))))
            )
)
)
(defun FDD (k1 k2 c d)
  (if (= d 1)
   (setq num_cc (max (+ (* k2 (/ k1 c)) (* (rem k1 c) (/ k2 c)))
                        (+ (* k1 (/ k2 c)) (* (rem k2 c) (/ k1 c)))
                                    )
         )
      (progn
      (if (= (rem (length (LF c d)) 2) 0)
            (setq cd (HF (reverse (cons (- (last (LF c d)) 1) (cdr (reverse (LF c d)))))))
            (setq cd (HF (reverse (cdr (reverse (LF c d))))))
      )
      (setq r1 (rem k1 (car cd)))
      (setq t1 (rem k2 (car cd)))
      (setq num_cc (+ (* (/ k1 (car cd)) k2 (cadr cd))  (* (/ k2 (car cd)) r1 (cadr cd))  (FDD r1 t1 (car cd) (cadr cd))))
            )
)
)
(defun ff (L a b flag)
(setq i 0 flst nil)
(while (<= (* a i) L)
         (setq flst (cons (list i (/ (- L (* i a)) b) (rem (- L (* i a)) b)) flst))
         (setq i (+ i 1))
)
(setq lst (vl-sort flst '(lambda (x y)  (<= (caddr x) (caddr y)) ) ) )
(setq nmin (caddr (car lst)))
(if flag
   (progn
         (setq flst (vl-remove-if-not '(lambda (x) (= (caddr x) nmin)) lst) )
         (setq flst (vl-sort flst '(lambda (x y) (> (car x) (car y)) ) ) )
         (setq va (car flst))
         (if (= (car va) 0)
            (progn
               (setq flst (vl-remove-if '(lambda (x) (= (caddr x) nmin)) lst))
               (setq nmin (caddr (car flst)))
               (setq flst (vl-remove-if-not '(lambda (x) (= (caddr x) nmin)) flst) )
               (setq flst (vl-sort flst '(lambda (x y) (> (car x) (car y)) ) ))
               (setq va (car flst))
            )
         )
      )
   (progn
         (setq lst (vl-remove-if-not '(lambda (x) (= (caddr x) nmin)) lst) )
         (setq lst (vl-sort lst '(lambda (x y) (> (car x) (car y)) ) ) )
         (setq va (car lst))
      )
   )
   va
)
(if (/= (last (ff (rem LA (* c d)) c d nil)) 0)
(if (> LA (* c d))
   (progn
      (setq na (- (/ LA (* c d)) 1))
      (setq lsta (ff (+ (* c d)(rem LA (* c d))) c d nil))
   )
   (progn
      (setq na 0)
      (setq lsta (ff LA c d nil))
   )
      )
(progn
   (setq na (/ LA (* c d)))
   (setq lsta (ff (rem LA (* c d)) c d nil))
)
)
(if (/= (last (ff (rem LB (* c d)) c d nil)) 0)
(if (> LB (* c d))
   (progn
      (setq nb (- (/ LB (* c d)) 1))
      (setq lstb (ff (+ (* c d)(rem LB (* c d))) c d nil))
      )
   (progn
      (setq nb 0)
      (setq lstb (ff LB c d nil))
      )
      )
(progn
   (setq nb (/ LB (* c d)))
   (setq lstb (ff (rem LB (* c d)) c d nil))
   )
)
(if (or (< (min LA LB) d) (< (max LA LB) c))
(setq num 0)
(setq num (+ (* na nb c d)
         (* (car lsta) nb c)
                     (* (cadr lsta) nb d)
                     (* (car lstb) na c)
                     (* (cadr lstb) na d)
                     (* (car lsta) (cadr lstb))
                     (* (cadr lsta) (car lstb))
                     (FCC (car lsta) (car lstb) c d)
                     (FDD (cadr lsta) (cadr lstb) c d)
               )
   )
)
)
(defun jq(LA LB a b)
(if (= (rem LA b) (rem LB a) 0)
  (setq vat (list 0 0 0))
  (progn
(if (< LA a)
   (setq vat (list 0 0 0))
      (progn
(setq x (- LA (rem LA a)))
(setq flag t)
(while (and flag (>= x 0))
   (setq y 0)
   (while (and flag (<= y LB))
   (if (= (xl LA LB a b)
         (max (+ (* (/ x a) (/ LB b)) (* (/ (- LA x) b) (/ (- LB y) a)) (xl (- LA x) (+ y (rem (- LB y) a)) a b))
               (+ (* (/ x a) (/ y b)) (* (/ LA b) (/ (- LB y) a)) (xl (- LA x) (+ y (rem (- LB y) a)) a b))
                  )
            )
         (progn
               (setq flag nil)
               (if (>= (+ (* (/ x a) (/ LB b)) (* (/ (- LA x) b) (/ (- LB y) a)))
                  (+ (* (/ x a) (/ y b)) (* (/ LA b) (/ (- LB y) a)))
               )
            (setq vat (list x y 1))
               (setq vat (list x y 0))
                        )
            )
         (if flag (setq y (+ y b)))
         )
         )
         (if flag (setq x (- x a)))
   )
      )
)
)
)
vat
)

(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 drawone (pt a b)
(f pt 1 a b t 1)

)
(defun drawmore (ppt n m a b)
   (setq i 0 j 0)
   (while (< i n)
            (while (< j m)
                  (drawone (list (+ (car ppt) (* i a)) (+ (cadr ppt) (* j b))) a b)
                  (setq j (+ j 1))
            )
            (setq i (+ i 1) j 0)
   )
)
(setq pt (getpoint "\n插入点位置："))
(setq LA (getint "母材长边长度\nLA=：")
   LB (getint "母材短边长度\nLB=：")
   c (getint "构件长边长度\nc=：")
   d (getint "构件短边长度\nd=：")
)
(entmake
      (list
            '(0 . "LWPOLYLINE")
            '(100 . "AcDbEntity")
            '(100 . "AcDbPolyline")
            '(90 . 4)
            '(70 . 1)
            (cons 10 (list (car pt) (cadr pt)))
            (cons 10 (list (+ (car pt) LA) (cadr pt)))
            (cons 10 (list (+ (car pt) LA) (+ (cadr pt) LB)))
            (cons 10 (list (car pt) (+ (cadr pt) LB)))
            (cons 210 '(0 0 1))
      )
)
(while (and (>= (min LA LB) d) (>= (max LA LB) c))
   (setq xylst (jq LA LB c d))
      (if (= (caddr xylst) 0)
         (progn
         (drawmore pt (/ (car xylst) c)(/ (cadr xylst) d) c d)
               (setq dis1 (rem LA d))
         (setq dis2 (rem (- LB (cadr xylst)) c))
         (drawmore (polar (polar pt (/ pi 2) (+ (cadr xylst) dis2)) 0 dis1) (/ LA d)(/ (- LB (cadr xylst)) c) d c)
               )
         (progn
         (drawmore pt (/ (car xylst) c)(/ LB d) c d)
               (setq dis1 (rem (- LA (car xylst)) d))
         (setq dis2 (rem (- LB (cadr xylst)) c))
         (drawmore (polar (polar pt (/ pi 2) (+ (cadr xylst) dis2)) 0 (+ (car xylst) dis1)) (/ (- LA (car xylst)) d)(/ (- LB (cadr xylst)) c) d c)
               )
         )
         (setq LA (+ (- LA (car xylst)) (rem (car xylst) c)))
         (setq LB (+ (cadr xylst) (rem (- LB (cadr xylst)) c) ))
         (setq pt (polar pt 0 (- (car xylst) (rem (car xylst) c))))
)
)

aimisiyou · 发表于 2019-10-1 22:47:48

本帖最后由 aimisiyou 于 2019-10-1 22:48 编辑

源代码有些纰漏导致运行结果图片不正确，楼上已改正。

aimisiyou · 发表于 2019-10-6 18:50:43

本帖最后由 aimisiyou 于 2019-10-6 19:04 编辑

发现存在一些问题，如（3000 2000 80 70）会出现死机（一直处于运行状态）。但（300 200 8 7）却不会。理应两者的布局应相同（毛坯个数相同），仅仅比例大小不一样而已。经检查，（xl 300 200 8 7）=1068,而（xl 3000 2000 80 70）=950.故while语句一直处于死循环状态，三个分区的毛坯个数之和永远大于整体的毛坯个数。看来连分数法应适用在一定范围内，而不是所有范围。

aimisiyou · 发表于 2019-11-4 10:32:16

aimisiyou 发表于 2019-10-6 18:50
发现存在一些问题，如（3000 2000 80 70）会出现死机（一直处于运行状态）。但（300 200 8 7）却不会。理应 ...

居然忘了连分法两个前提条件：
1、gcd(c,d)=1;
2、min(LA,LB)>=c*d-c-d.

aimisiyou · 发表于 2020-4-8 14:38:57

本帖最后由 aimisiyou 于 2024-4-17 16:47 编辑

命令: tt

插入点位置：母材长边长度
LA=：4500
母材短边长度
LB=：3500
构件长边长度
c=：109
构件短边长度
d=：79
(47591.3 6713.79 0.0)

(109 79)(53 41)运行时间有些长。是否还可以优化？

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

[研讨] 采用连分数法求解单一规格矩形直切下料问题

点评