设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

12
返回列表 发新帖
楼主: aimisiyou

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

[复制链接]

已领礼包: 1599个

财富等级: 堆金积玉

 楼主| 发表于 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),可大大减少运行时间。
88.png
77.png
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1599个

财富等级: 堆金积玉

 楼主| 发表于 2019-9-26 21:38:57 | 显示全部楼层
本帖最后由 aimisiyou 于 2019-9-26 21:41 编辑

碰到了一个硬茬,运行了半小时才出结果。
双递减1的效率确实有点太低了,双循环的次数约为500*300=15万!!!需要优化下。
99.png
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1599个

财富等级: 堆金积玉

 楼主| 发表于 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))))
)
)
101.png
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1599个

财富等级: 堆金积玉

 楼主| 发表于 2019-10-1 22:47:48 | 显示全部楼层
本帖最后由 aimisiyou 于 2019-10-1 22:48 编辑

源代码有些纰漏导致运行结果图片不正确,楼上已改正。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1599个

财富等级: 堆金积玉

 楼主| 发表于 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语句一直处于死循环状态,三个分区的毛坯个数之和永远大于整体的毛坯个数。看来连分数法应适用在一定范围内,而不是所有范围。
001.png

点评

居然忘了连分法两个前提条件: 1、gcd(c,d)=1; 2、min(LA,LB)>=c*d-c-d.  详情 回复 发表于 2019-11-4 10:32
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1599个

财富等级: 堆金积玉

 楼主| 发表于 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.
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|小黑屋|手机版|Archiver|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )  

GMT+8, 2020-1-23 13:00 , Processed in 0.168851 second(s), 34 queries , Gzip On, WinCache On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表