Topic: CUT OFF PROBLEM

[m4rdy]

Merry Christmas to everyone here,

I know this has been discussed in http://www.theswamp.org/index.php?topic=34464.msg397353#msg397353 and , I had a problhttp://www.theswamp.org/index.php?topic=8943.0
But i can't modify the the routine from david,cab,tim.
This problem is pure math that beyond my knowledge.
I need to find the pattern of cut steel bars with minimum waste or left overs.
As the example:
1. List data cut order :

‘((23 7.65) (10 5.30) (54 3.67) (67 2.66) (44 9.71) (120 4.0))

(23 7.65) means 23 pcs with each length 7.65m’
(10 5.30) => 10  pcs 5.30m’

2. List data stock :

‘(750 12.0) represent 750 pcs with each length 12.0 m’

Goal :

Find the most minimum of waste (amount of left-overs) cut from stock.

Example of result :

‘((37  (4.0  4.0  4.0))
(10 (4.0 5.3 2.66 0.04))
(23 (7.65 3.67 0.68))
(4 (3.67 3.67 3.67 0.99)
(44 (9.71 2.29))
(19 (3.67 2.66 2.66 2.66 0.35))

This result means :
37 pcs with cut pattern 4.0m + 4.0m + 4.0m equal 12m (stock length)
10 pcs with cut pattern 4.0m + 5.3m + 2.66m + 0.04m (0.04m is waste) etc.

The total needed from stock 37+10+23+4+44+19 = 137 pcs @ 12m’

Calculating waste :

1.   Total length of waste
37*0 + 10*0.04 + 23*0.68 + 4*0.99 + 44*2.29 + 19*0.35 = 127.41m’
2.   Total length needed from stock
137*12 = 1644m’

So waste = 127.41/1644 = 0.0775.

I hope my explanation is clear enough.
This is reference :
en.wikipedia.org/wiki/Cutting_stock_problem
http://delphiforfun.org/Programs/Cutting%20Stock.htm


Thank you.

mardi

[CAB]

Not sure you were working with the latest versions.
http://www.theswamp.org/index.php?topic=26955.msg326631#msg326631

Maybe this will get you closer to your goal.

Code: [Select]

;;  key search words: drop cutoff pipe waste
;;  This is a revised version fixing bugs in earler versions
(defun c:test (/ lst maxlen explst)
 
  (setq lst'((23 7.65) (10 5.30) (54 3.67) (67 2.66) (44 9.71) (120 4.0)))
  (setq maxlen 12.01)

  (mapcar (function
            (lambda (x) (if explst
                          (repeat (car x) (setq explst (cons (cadr x) explst)))
                          (progn
                            (setq explst (list (cadr x)))
                            (repeat (1- (car x)) (setq explst (cons (cadr x) explst)))
                          )
                        ))) lst)
 
 
  (print (setq clst (get_cutlist explst maxlen)))
          (print "Number of Lengths ")(princ (length clst))
        ;(print "Drops")
        ;(mapcar '(lambda(x) (print (- MaxLen (apply '+ x)))) clst)
  (princ)
)

;;  CAB 03/10/06
;;  updated 12/27/06
;;  updated 01/22/09
;;  updated 01/23/09
(defun get_cutlist (lst maxlen / cutlst itm ptr tl x finallst remove-at tmp tp)
  ;;  (RemoveNth 3 '(0 1 2 3 4 5))  CAB 12/27/2006
  (defun removeNth (i lst)
    (setq i (1+ i))
    (vl-remove-if '(lambda (x) (zerop (setq i (1- i)))) lst)
  )
  ;; sort the list with largest first
  (setq lst (mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst '>)))
  ;;  catch any length over MaxLen & break them
  (if (not (vl-every '(lambda (x) (<= x MaxLen)) lst))
    (progn
      (while (> (setq tmp (car lst)) MaxLen)
        (setq lst (cdr (append lst (list MaxLen (- tmp MaxLen)))))
      )
      (setq lst (mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst '>)))
    )
  )
  ;;  step through lst
  (if (= (length lst) 1)
    (setq finallst (list lst))
    (progn
      (while lst
        (setq cutlst (list (car lst)) ; start new cutlist w/ first item
              lst    (reverse (cdr lst)) ; remove first item
              eol    (1- (length lst)) ; point to end of list
              tl     (apply '+ cutlst) ; total length so far
              ptr    0
        )

        ;; build the cutlst
        (while
          (cond
            ((null lst) nil)
            ((> ptr eol) nil)
            ((< (+ (nth ptr lst) tl) MaxLen)
             (setq cutlst (cons (nth ptr lst) cutlst)
                   tl     (+ tl (car cutlst))
                   lst    (removeNth ptr lst)
                   eol    (1- eol)
             )
            )
            ((setq ptr (1+ ptr)))
          )
        )
        ;;  no more cuts fit, go to next
        (setq finallst (cons cutlst finallst)
              cutlst   nil
              lst      (reverse lst)
        )
      )
    )
  )
  finallst
)

[m4rdy]

Not sure you were working with the latest versions.
http://www.theswamp.org/index.php?topic=26955.msg326631#msg326631

You're right, I missed that one in my searching.

Maybe this will get you closer to your goal.

Thank you Alan,
I'll study your routine.

mardi

[roy_043]

I have stumbled upon this older topic and while analysing CAB's code have noticed two issues. I am just mentioning them here for those 'following along':

• The 'catch any length over MaxLen & break them' code only breaks once.
• The line: '((setq ptr (1+ ptr)))' is not required because of the way lst is ordered. It will only slow things down.
  

The function get_cutlist with these issues fixed:

Code - Auto/Visual Lisp: [Select]

1. (defun get_cutlist (lst maxLen / RemoveNth cutLst eol finalLst ptr tl tmp)
2.  
3.   ;;  (RemoveNth 3 '(0 1 2 3 4 5))  CAB 12/27/2006
4.   (defun RemoveNth (i lst)
5.     (setq i (1+ i))
6.     (vl-remove-if '(lambda (x) (zerop (setq i (1- i)))) lst)
7.   )
8.  
9.   ;;  sort the list with largest first
10.   (setq lst (mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst '>)))
11.   ;;  catch any length over maxLen & break them
12.   (if (> (car lst) maxLen)
13.     (progn
14.       (while (> (setq tmp (car lst)) maxLen)
15.         (setq lst (cdr lst))
16.         (repeat (fix (/ tmp maxLen))
17.           (setq lst (append lst (list maxLen)))
18.         )
19.         (if (/= 0.0 (rem tmp maxLen))
20.           (setq lst (append lst (list (rem tmp maxLen))))
21.         )
22.       )
23.       (setq lst (mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst '>)))
24.     )
25.   )
26.   ;;  step through lst
27.   (if (= (length lst) 1)
28.     (setq finalLst (list lst))
29.     (progn
30.       (while lst
31.         (setq cutLst (list (car lst))    ; start new cutlist with first item
32.               lst    (reverse (cdr lst)) ; remove first item
33.               eol    (1- (length lst))   ; point to end of list
34.               tl     (apply '+ cutLst)   ; total length so far
35.               ptr    0
36.         )
37.         ;;  build the cutLst
38.         (while
39.           (and
40.             (<= ptr eol)
41.             (<= (+ (nth ptr lst) tl) maxLen) ; '<=' instead of '<' ?
42.           )
43.           (setq cutLst (cons (nth ptr lst) cutLst)
44.                 tl     (+ tl (car cutLst))
45.                 lst    (RemoveNth ptr lst)
46.                 eol    (1- eol)
47.           )
48.         )
49.         ;;  no more cuts fit, go to next
50.         (setq finalLst (cons cutLst finalLst)
51.               cutLst   nil
52.               lst      (reverse lst)
53.         )
54.       )
55.     )
56.   )
57.   finalLst
58. )

[ymg]

Roy,

FWIW, I had a thread a while back on this subject.

You may find it here:  The Cutting Stock Problem (Optimizing Cutting of Rebar or Other Material)

ymg

[roy_043]

Thanks Ymg. Actually your thread has led me to this one and it is already on my list of interesting topics worth studying.

[ymg]

Roy,

I had done comparison of Cab's and David's way back in april.

They both boil down to first fit binpack.

Although it does give you some measure of optimization, it is very
often below what could be done.

ymg

[roy_043]

Yes Ymg, you confirm my findings. These algorithms have limited optimization.