Author Topic: The Cutting Stock Problem (Optimizing Cutting of Rebar or Other Material)  (Read 17574 times)

0 Members and 1 Guest are viewing this topic.

ymg

  • Guest
Bear with me, this post is a bit long.

Here's an implementation of the 1D Cutting Stock Problem as per a method proposed
in the following paper:

  A GENERALIZED APPROACH TO THE SOLUTION OF ONE-DIMENSIONAL STOCK-CUTTING PROBLEM FOR SMALL SHIPYARDS

For a bit of background, CAB, in a previous post proposed a method where he develops the list of Lengths
and the list of Demand into a long list, where the Lengths are repeated as specified by the Demand list.

He then proceed to binpack the developed list into bins of size equal to the standard stock length.

T.Willey in another post seems to have essentially the same strategy in his CutPipes function.

For the Generalized Approach we order the list of Lengths in decreasing order and make the associated list of Demand follows.

The Feasible Cutting Patterns for the First Length with a Demand greater than Zero are then generated.

The resulting List of Patterns is then expanded to includes so that each pattern is associated with:
                Trim Loss tl,   Stock Material sm (Nb of times we apply this pattern without exceeding  any of Demand.)
                and finally  Parts Used pu (How many parts are being cut.)

This expanded list is sorted with the following criteria:
                Minimum Trim Loss, Maximum Stock Material and Minimum Parts Used.

The best pattern to used now sits at the top of our patterns list, and is used to adjust the List of Demand.

The process loop back to Generate the Feasible Cutting Pattern until all Demand are satisfied.

As a side note, I have intentionally kept the function "genpat" separated so it can be used to generates all feasible patterns
or only the subset of pattern for  a given demanded length.   The "genpat" function was coded as per Appendix I of
the following paper:
        Cutting Stock Waste Reduction Using Genetic Algorithms  by  Y. Khalifa, O. Salem and A. Shahin

Here is the code:     
Code - Auto/Visual Lisp: [Select]
  1. ;; 1d-csp       by ymg                                                        ;
  2. ;;                                                                            ;
  3. ;; Cutting Stock Problem as per approach described in:                        ;
  4. ;;                                                                            ;
  5. ;;               A GENERALIZED APPROACH TO THE SOLUTION                       ;
  6. ;;                  OF ONE-DIMENSIONAL STOCK-CUTTING                          ;
  7. ;;                    PROBLEM FOR SMALL SHIPYARDS.                            ;
  8. ;;              by Ahmet Cemil Dikili and Baris Barlas                        ;
  9. ;;                                                                            ;
  10. ;; Link:  http://jmst.ntou.edu.tw/marine/19-4/368-376.pdf                     ;
  11. ;;                                                                            ;
  12. ;; Argument: l   List, Demanded Lengths                                       ;
  13. ;;           d   List, Number of Corresponding Demanded Length.               ;
  14. ;;          ls   Real, Length of Standard Stock.                              ;
  15. ;;                                                                            ;
  16. ;; Returns: A List of Cutting Patterns, where each member is composed         ;
  17. ;;          of 3 items as follow: Item 1, Nb of times to apply Pattern.       ;
  18. ;;                                Item 2, List of integers where each         ;
  19. ;;                                        element correspond to the nb of     ;
  20. ;;                                        times to use a demanded length.     ;
  21. ;;                                Item 3, Total Waste for this Pattern.       ;
  22. ;;                                                                            ;
  23.  
  24. (defun 1D-CSP (l d ls / a ch cp idx maxint p tl sm pu v)
  25.    (setq maxint 2147483647
  26.             idx (vl-sort-i l '>)
  27.               l (mapcar '(lambda (x) (nth x l)) idx)
  28.               d (mapcar '(lambda (x) (nth x d)) idx)         
  29.    )
  30.    (while  (> (apply '+ d) 0)
  31.       (setq v (genpat l d ls nil) p nil)      
  32.       (foreach a v
  33.          (setq tl (- ls (apply '+ (mapcar '(lambda (a l) (* a l)) a l)))
  34.                sm (apply 'min (mapcar '(lambda (a d) (if (> a 0) (/ d a) maxint)) a d))
  35.                pu (* sm (apply '+ a))
  36.                 p (cons (list a tl sm pu) p)
  37.          )
  38.       )
  39.      
  40.       ; Here we Sort the Set of Patterns on Min tl, Max sm and Min pu         ;
  41.       ; The Chosen Pattern will bubble up to top of the list.                 ;
  42.      
  43.       (setq p (vl-sort (reverse p) '(lambda (a b) (if (= (cadr a) (cadr b))
  44.                                            (if (= (caddr a) (caddr b))
  45.                                               (< (cadddr a) (cadddr b))  
  46.                                               (> (caddr a) (caddr b))
  47.                                            )     
  48.                                            (< (cadr  a) (cadr  b))
  49.                                         )
  50.                           )
  51.               )
  52.       )
  53.      
  54.       ; Building the Cutting Plan, then Adjusting the Demand List.            ;
  55.      
  56.       (setq ch (car p))
  57.       (setq cp (cons (list (caddr ch) (car ch) (* (cadr ch) (caddr ch))) cp))
  58.       (setq  d (mapcar '(lambda (d p) (- d (* p (caddr ch)))) d (car ch)))      
  59.    )
  60.    (reverse cp)
  61. )
  62.  
  63.  
  64. ;; genpat                  by ymg                                             ;
  65. ;;                                                                            ;
  66. ;; Procedure for Generating the Efficient Feasible Cutting Patterns           ;
  67. ;; http://www.cs.bham.ac.uk/~wbl/biblio/gecco2006/docs/p1675.pdf              ;
  68. ;; Appendix 1                                                                 ;
  69. ;; Part of "Cutting Stock Waste Reduction Using Genetic Algorithms"           ;
  70. ;;              by Y. Khalifa, O. Salem and A. Shahin                         ;
  71. ;;                                                                            ;
  72. ;; Argument: l   List, Demanded Lengths in Descending Order.                  ;
  73. ;;           d   List, Number of Corresponding Demanded Length.               ;
  74. ;;          ls   Real, Length of Standard Bar.                                ;
  75. ;;         all   Boolean, if true, Generate all Feasible Patterns.            ;
  76. ;;                        if false, Generates only the Set of Patterns        ;
  77. ;;                                  for the First Demand > 0                  ;
  78. ;;                                                                            ;
  79.  
  80. (defun genpat (l d ls all / a i j p  s)
  81.    (setq i 0) (while (zerop (nth i d)) (setq i (1+ i)))
  82.    (if (= (1+ i) (length d)) (setq all t))
  83.    (while (or (not a) (if all (> (apply '+ (cdr a)) 0) (> (nth i (reverse a)) 0)))
  84.       (cond
  85.           (a (setq a (cdr a))
  86.              (while (zerop (car a)) (setq a (cdr a)))
  87.              (setq a (cons (1- (car a)) (cdr a))
  88.                    j (length a)
  89.                    s (apply '+ (mapcar '(lambda (a l) (* a l)) (reverse a) l))
  90.              )
  91.            )
  92.            (t (setq j 0 s 0))
  93.       )  
  94.       (while (< j (length l))
  95.          (setq a (cons (min (floor (/ (- ls s) (nth j l))) (nth j d)) a)
  96.                s (+ s (* (car a) (nth j l)))
  97.                j (1+ j)
  98.          )
  99.       )
  100.       (setq p (cons (reverse a) p))
  101.    )  
  102.    (if all (reverse p) (reverse (cdr p)))
  103. )
  104.  
  105. ;; Ceiling function, Returns the smallest integer not less than x.            ;
  106. (defun ceil  (x) (if (> (rem x 1) 0) (+ (fix x) 1) (fix x)))
  107. ;; Floor function, Returns the largest integer not greater than x.            ;
  108. (defun floor (x) (if (minusp (rem x 1)) (- (fix x) 1) (fix x)))
  109.  
  110.  
  111. (defun c:test (/ l1 l2 d1 d2 ls1 ls2)
  112.    (defun prinlst (p l / i idx)
  113.      (setq idx (vl-sort-i l '>)
  114.              l (mapcar '(lambda (x) (nth x l)) idx)
  115.      )
  116.      (princ (strcat "\nL: " (vl-princ-to-string l)))
  117.      (foreach i p (princ (strcat "\n" (vl-princ-to-string i))))
  118.      (princ "\n")
  119.      (princ (strcat "\n   Nb of Stock used: " (itoa (apply '+ (mapcar 'car p)))))
  120.      (princ (strcat "\n Nb of Parts Cutted: " (itoa (apply '+ (mapcar '(lambda (a) (* (car a) (apply '+ (cadr a)))) p)))))
  121.      (princ (strcat "\nTotal Length Wasted: " (rtos (apply '+ (mapcar 'caddr p)) 2 2)))
  122.      (princ "\n\n\n")      
  123.    )
  124.    ;; Problem 1                              ;
  125.    (setq l1 '(60.0 50.0 30.0 25.0 20.0 10.0)
  126.          d1 '(6 7 15 20 9 16)
  127.         ls1 100.0
  128.    )
  129.    ;; Problem 2                              ;
  130.    (setq l2 '(40.0 30.0 20.0 10.0 5.0)
  131.          d2 '(7 10 6 4 2)
  132.         ls2 100.0
  133.    )
  134.    ;; Problem 3 by Cab                       ;
  135.    (setq l3 '(7.65 5.30 3.67 2.66 9.71 4.00)
  136.          d3 '(23 10 54 67 44 120)
  137.          ls3 12.01
  138.    )
  139.    ;; Problem 4  by Jeff H.                  ;
  140.    (setq l4 '(15.3 14.4 12.34)
  141.          d4 '(4 30 2)
  142.          ls4  60.0
  143.    )
  144.    ;; Problem 5  by ElpanovEvgenyi          ;
  145.    (setq l5 '(62 20  9 8 12 17 6)
  146.          d5 '(1 1 2 1 1 1 1 1)
  147.          ls5 80
  148.    )
  149.    (textscr)
  150.    (prinlst (1d-csp l1 d1 ls1) l1)
  151.    (prinlst (1d-csp l2 d2 ls2) l2)
  152.    (prinlst (1d-csp l3 d3 ls3) l3)  
  153.    (prinlst (1d-csp l4 d4 ls4) l4)
  154.    (prinlst (1d-csp l5 d5 ls5) l5)
  155.    (princ)  
  156. )
  157.  

ymg
« Last Edit: February 18, 2015, 03:29:11 PM by ymg »

serge_c

  • Newt
  • Posts: 39
Re: The Cutting Stock Problem (Optimizing Cutting of Rebar or Other Material)
« Reply #1 on: February 18, 2015, 09:06:05 AM »
Hi ymg !!!
Sorry but I can't undestand how it works ?
I saw a lisp file, I put it in mine attached file , I can not understand the meaning of the results?

ymg

  • Guest
Re: The Cutting Stock Problem (Optimizing Cutting of Rebar or Other Material)
« Reply #2 on: February 18, 2015, 09:38:56 AM »
sergiu,

For example in problem 3, the lengths in decreasing order are:

      (9.71 7.65 5.3 4.0 3.67 2.66)

And the result for this problem is:

(44 (1 0 0 0 0 0) 101.2)
(23 (0 1 0 1 0 0) 8.28)
(10 (0 0 1 1 0 1) 0.5)
(29 (0 0 0 3 0 0) 0.29)
(19 (0 0 0 0 1 3) 6.84)
(11 (0 0 0 0 3 0) 11.0)
(1 (0 0 0 0 2 0) 4.67)

   Nb of Stock used: 137
 Nb of Parts Cutted: 318
Total Length Wasted: 132.78

So it means:

Cut 44 bars with only Length 9.71, loss is 101.2
Cut 23 bars with length 7.65 and 4.00, loss is 8.28
Cut 10 bars,  lengths 5.3, 4.00 and 2.66, loss is 0.5
Cut 29 bars,  lengths 4.00, 4.00, 4.00, loss is 0.29
 and so on.

Each result is a list of sublist.
Each sublist contains 3 items:

Item1 : How many times you cut the pattern
Item2 : Is a list of integers, meaning how many times a length is cut.
Item3 : Is a number representing the total loss generated by applying this pattern.

ymg

« Last Edit: February 18, 2015, 09:50:32 AM by ymg »

serge_c

  • Newt
  • Posts: 39
Re: The Cutting Stock Problem (Optimizing Cutting of Rebar or Other Material)
« Reply #3 on: February 20, 2015, 10:23:18 AM »
Ymg , the third problem is what a need ,I understood it , I change some values manualy and it work realy fine, now the big problem is how to introduce them automaticaly in lisp file,it gona take a long way to do it manualy , first I need to export and sort them in excell after that to copy them to lisp file .
One more iDea it will be cool if every problem will reprezent a diameter for example: Problem 1 :∅10; Problem 2 :∅12; Problem 3 :∅14;... ∅16;∅18;∅20;∅22;∅25;
∅28; Problem 10 :∅32;

ymg

  • Guest
Re: The Cutting Stock Problem (Optimizing Cutting of Rebar or Other Material)
« Reply #4 on: February 20, 2015, 05:50:54 PM »
sergiu,

Here I've modified the lisp so it will read
your file if you save it as csv.

Don't want to mess with direct from excel
as there are too many versions.

The Output is still crude and to the text screen.

To Run issue the command "SERGIU"

Code - Auto/Visual Lisp: [Select]
  1. ;; 1d-csp       by ymg                                                        ;
  2. ;;                                                                            ;
  3. ;; Cutting Stock Problem as per approach described in:                        ;
  4. ;;                                                                            ;
  5. ;;               A GENERALIZED APPROACH TO THE SOLUTION                       ;
  6. ;;                  OF ONE-DIMENSIONAL STOCK-CUTTING                          ;
  7. ;;                    PROBLEM FOR SMALL SHIPYARDS.                            ;
  8. ;;              by Ahmet Cemil Dikili and Baris Barlas                        ;
  9. ;;                                                                            ;
  10. ;; Link:  http://jmst.ntou.edu.tw/marine/19-4/368-376.pdf                     ;
  11. ;;                                                                            ;
  12. ;; Argument: l   List, Demanded Lengths in Decreasing order.                  ;
  13. ;;           d   List, Number of Corresponding Demanded Length.               ;
  14. ;;          ls   Real, Length of Standard Stock.                              ;
  15. ;;                                                                            ;
  16. ;; Returns: A List of Cutting Patterns, where each member is composed         ;
  17. ;;          of 3 items as follow: Item 1, Nb of times to apply Pattern.       ;
  18. ;;                                Item 2, List of integers where each         ;
  19. ;;                                        element correspond to the nb of     ;
  20. ;;                                        times to use a demanded length.     ;
  21. ;;                                Item 3, Total Waste for this Pattern.       ;
  22. ;;                                                                            ;
  23.  
  24. (defun 1D-CSP (l d ls / a ch cp idx maxint p tl sm pu v)
  25.    (setq maxint 2147483647)
  26.            
  27.    (while  (> (apply '+ d) 0)
  28.       (setq v (genpat l d ls nil) p nil)      
  29.       (foreach a v
  30.          (setq tl (- ls (apply '+ (mapcar '(lambda (a l) (* a l)) a l)))
  31.                sm (apply 'min (mapcar '(lambda (a d) (if (> a 0) (/ d a) maxint)) a d))
  32.                pu (* sm (apply '+ a))
  33.                 p (cons (list a tl sm pu) p)
  34.          )
  35.       )
  36.      
  37.       ; Here we Sort the Set of Patterns on Min tl, Max sm and Min pu         ;
  38.       ; The Chosen Pattern will bubble up to top of the list.                 ;
  39.      
  40.       (setq p (vl-sort p '(lambda (a b) (if (= (cadr a) (cadr b))
  41.                                            (if (= (caddr a) (caddr b))
  42.                                               (< (cadddr a) (cadddr b))  
  43.                                               (> (caddr a) (caddr b))
  44.                                            )     
  45.                                            (< (cadr  a) (cadr  b))
  46.                                         )
  47.                           )
  48.               )
  49.       )
  50.      
  51.       ; Building the Cutting Plan, then Adjusting the Demand List.            ;
  52.      
  53.       (setq ch (car p))
  54.       (setq cp (cons (list (caddr ch) (car ch) (* (cadr ch) (caddr ch))) cp))
  55.       (setq  d (mapcar '(lambda (d p) (- d (* p (caddr ch)))) d (car ch)))      
  56.    )
  57.    (reverse cp)
  58. )
  59.  
  60.  
  61. ;; genpat                  by ymg                                             ;
  62. ;;                                                                            ;
  63. ;; Procedure for Generating the Efficient Feasible Cutting Patterns           ;
  64. ;; http://www.cs.bham.ac.uk/~wbl/biblio/gecco2006/docs/p1675.pdf              ;
  65. ;; Appendix 1                                                                 ;
  66. ;; Part of "Cutting Stock Waste Reduction Using Genetic Algorithms"           ;
  67. ;;              by Y. Khalifa, O. Salem and A. Shahin                         ;
  68. ;;                                                                            ;
  69. ;; Argument: l   List, Demanded Lengths in Descending Order.                  ;
  70. ;;           d   List, Number of Corresponding Demanded Length.               ;
  71. ;;          ls   Real, Length of Standard Bar.                                ;
  72. ;;         all   Boolean, if true, Generate all Feasible Patterns.            ;
  73. ;;                        if false, Generates only the Set of Patterns        ;
  74. ;;                                  for the First Demand > 0                  ;
  75. ;;                                                                            ;
  76.  
  77. (defun genpat (l d ls all / a i j p  s)
  78.    (setq i 0) (while (zerop (nth i d)) (setq i (1+ i)))
  79.    (if (= (1+ i) (length d)) (setq all t))
  80.    (while (or (not a) (if all (> (apply '+ (cdr a)) 0) (> (nth i (reverse a)) 0)))
  81.       (cond
  82.           (a (setq a (cdr a))
  83.              (while (zerop (car a)) (setq a (cdr a)))
  84.              (setq a (cons (1- (car a)) (cdr a))
  85.                    j (length a)
  86.                    s (apply '+ (mapcar '(lambda (a l) (* a l)) (reverse a) l))
  87.              )
  88.            )
  89.            (t (setq j 0 s 0))
  90.       )  
  91.       (while (< j (length l))
  92.          (setq a (cons (min (floor (/ (- ls s) (nth j l))) (nth j d)) a)
  93.                s (+ s (* (car a) (nth j l)))
  94.                j (1+ j)
  95.          )
  96.       )
  97.       (setq p (cons (reverse a) p))
  98.    )  
  99.    (if all (reverse p) (reverse (cdr p)))
  100. )
  101.  
  102. ;; Ceiling function, Returns the smallest integer not less than x.            ;
  103. (defun ceil  (x) (if (> (rem x 1) 0) (+ (fix x) 1) (fix x)))
  104. ;; Floor function, Returns the largest integer not greater than x.            ;
  105. (defun floor (x) (if (minusp (rem x 1)) (- (fix x) 1) (fix x)))
  106.  
  107.  
  108. (defun c:test (/ l1 l2 d1 d2 ls1 ls2)
  109.    (setq prob '(("Problem 1  by Dikili & Barlas          \n"
  110.                   (60.0 50.0 30.0 25.0 20.0 10.0)
  111.                   (6 7 15 20 9 16)
  112.                   100.0
  113.                 )
  114.                 ("Problem 2  by Dikili & Barlas          \n"
  115.                   (40.0 30.0 20.0 10.0 5.0)
  116.                   (7 10 6 4 2)
  117.                   100.0
  118.                 )
  119.                 ("Problem 3 by CAB                       \n"        
  120.                   (9.71 7.65 5.30 4.00 3.67 2.66)
  121.                   (44 23 10 54 120 67)
  122.                   12.01
  123.                 )
  124.                 ("Problem 4  by Jeff H.                  \n"
  125.                   (15.3 14.4 12.34)
  126.                   (4 30 2)
  127.                    60.0
  128.                 )
  129.                 ("Problem 5  by ElpanovEvgenyi           \n"  
  130.                  (62 20 17 12 9 8 6)
  131.                  (1 1 1 1 1 2 1 1)
  132.                  80
  133.                 )
  134.                 ("Problem 6  by Khalifa, Salem & Shahin  \n"
  135.                   (19.0 15.5 15 12 10 8.5)
  136.                   (4 4 4 4 4 4 4)
  137.                   40.00
  138.                 )
  139.                 ("Problem 7  by Khalifa, Salem & Shahin  \n"
  140.                   (12.146 11.896 11.729 9.396 9.0625 7.229 4.177 3.0)
  141.                   (2 2 32 6 4 4 28 6)
  142.                   40.00
  143.                 )
  144.                 ("Problem 8  by sergiu                   \n"
  145.                   (4.500 3.600 3.100 1.400 0.750)
  146.                   (97 610 395 211 300)
  147.                   12.000
  148.                 )
  149.                )
  150.    )
  151.    (foreach pr prob
  152.       (solve pr)
  153.    )  
  154.    (princ)  
  155. )
  156.  
  157. ;; solve       by ymg                                                         ;
  158. ;;                                                                            ;
  159. ;; A temporary, somewhat crude Output for testing purposes.                   ;
  160. ;; Could be replaced by an Acad table or an Output to Excel                   ;
  161. ;;                                                                            ;
  162. ;; Argument:                                                                  ;
  163. ;;           pr, List of 4 items (title l d ls)                               ;
  164. ;;              Where title,  is a String                                     ;
  165. ;;                        l,  List of Demanded Lengths in Decreasing Order    ;
  166. ;;                        d,  List of Associated Demand                       ;
  167. ;;                       ls,  Length of a Standard Bar.                       ;
  168. ;;                                                                            ;
  169. ;; The routine calls "1D-CSP"                                                 ;
  170. ;;                                                                            ;
  171.  
  172. (defun solve (pr / p tit l d ls i)
  173.    (textscr)
  174.    (setq tit (car   pr)
  175.            l (cadr  pr)
  176.            d (caddr pr)
  177.           ls (last  pr)
  178.            p (1d-csp l d ls)
  179.    )
  180.    (princ tit)
  181.    (princ (strcat "\nD: " (vl-princ-to-string d)))
  182.    (princ (strcat "\nL: " (vl-princ-to-string l)))
  183.    (foreach i p (princ (strcat "\n" (vl-princ-to-string i))))
  184.    (princ "\n")
  185.    (princ (strcat "\n   Nb of Stock used: " (itoa (apply '+ (mapcar 'car p)))))
  186.    (princ (strcat "\n Nb of Parts Cutted: " (itoa (apply '+ (mapcar '(lambda (a) (* (car a) (apply '+ (cadr a)))) p)))))
  187.    (princ (strcat "\nTotal Length Wasted: " (rtos (apply '+ (mapcar 'caddr p)) 2 2)))
  188.    (princ "\n\n\n")        
  189. )
  190.  
  191. ;; ReadCSV  -  Lee Mac                                                        ;
  192. ;; Parses a CSV file into a list of lists,                                    ;
  193. ;;              each sublist is a row of CSV cell values.                     ;
  194. ;;                                                                            ;
  195.  
  196. (defun ReadCSV ( filename / _csv->lst file line lst )
  197.  
  198.     (defun _csv->lst ( str / pos )
  199.         (if (setq pos (vl-string-position 44 str))
  200.             (cons (substr str 1 pos) (_csv->lst (substr str (+ pos 2))))
  201.             (list str)
  202.         )
  203.     )
  204.  
  205.     (if (setq file (open (findfile filename) "r"))
  206.         (progn
  207.             (while (setq line (read-line file))
  208.                 (setq lst (cons (_csv->lst line) lst))
  209.             )
  210.             (close file)
  211.         )
  212.     )
  213.     (reverse lst)
  214. )
  215.  
  216. ;; massoc       by Gile Chanteau                                              ;
  217. ;;                                                                            ;
  218. ;; Returns a list of all items associated with the specified key              ;
  219. ;; in an association list.                                                    ;
  220. ;;                                                                            ;
  221. ;; Arguments:                                                                 ;
  222. ;;    k,  The value to search for in the list.                                ;
  223. ;;    l,  List of Associations                                                ;
  224. ;;                                                                            ;
  225.  
  226. (defun massoc (k l)
  227.   (if (setq l (member (assoc k l) l))
  228.     (cons (cdar l) (massoc k (cdr l)))
  229.   )
  230. )
  231.  
  232. ;; distinct     by Gile Chanteau                                              ;
  233. ;; Deletes all duplicates in a list.                                          ;
  234. ;;                                                                            ;
  235. ;; Argument                                                                   ;
  236. ;; l   List                                                                   ;
  237. ;;                                                                            ;
  238. (defun distinct (l)
  239.   (if l
  240.     (cons (car l) (distinct (vl-remove (car l) l)))
  241.   )
  242. )
  243.  
  244.  
  245. (defun c:sergiu (/ a d data fn l ld ls size title)
  246.    (setq ls 12000)                            ; Length of Standard Bar                ;
  247.    (prompt "Select CSV File Containing Your Data :")
  248.    (setq fn (getfiled "Import CSV File" "" "csv" 8))
  249.          
  250.    (setq data (cdr (ReadCSV fn))              ; cdr is to discard the line of titles  ;
  251.          size (distinct (mapcar 'cadr data))  ; size is the list of distinct diameters;
  252.          data (mapcar '(lambda (a) (list (cadr a) (atoi (caddr a)) (atoi (last a)))) data)
  253.    )
  254.    ;; Data is now an association list and length and demand are in Integers.          ;
  255.    (foreach diam size
  256.       (setq title (strcat "Cutting Patterns for Diam. " diam)
  257.               ld  (vl-sort (massoc diam data) '(lambda (a b) (> (car a) (car b))))
  258.                l  (mapcar 'car  ld)
  259.                d  (mapcar 'cadr ld)        
  260.       )
  261.       (solve (list title l d ls))
  262.    )
  263.    (princ)
  264. )  
  265.  

ymg
« Last Edit: February 21, 2015, 06:13:54 AM by ymg »

serge_c

  • Newt
  • Posts: 39
Re: The Cutting Stock Problem (Optimizing Cutting of Rebar or Other Material)
« Reply #5 on: February 21, 2015, 02:42:08 AM »
Command " sergiu " : funny !!!
"The Output is still crude , in to the text screen" That's right , it gonna be more useful in table format, but is enough for you , you really work to much !!!
Phanks a lot , you help the economy of Moldova and not only Moldova I think !!!  :-)

ymg

  • Guest
Re: The Cutting Stock Problem (Optimizing Cutting of Rebar or Other Material)
« Reply #6 on: February 21, 2015, 05:09:22 AM »
sergiu,

Long live Moldova!!

Modified the SERGIU command, as we do not really
need to build the prob list.

So a litlle more concise here:

Code - Auto/Visual Lisp: [Select]
  1. (defun c:sergiu (/ a d data fn l ld ls size title)
  2.    (setq ls 12000)                            ; Length of Standard Bar                ;
  3.    (prompt "Select CSV File Containing Your Data :")
  4.    (setq fn (getfiled "Import CSV File" "" "csv" 8))
  5.          
  6.    (setq data (cdr (ReadCSV fn))              ; cdr is to discard the line of titles  ;
  7.          size (distinct (mapcar 'cadr data))  ; size is the list of distinct diameters;
  8.          data (mapcar '(lambda (a) (list (cadr a) (atoi (caddr a)) (atoi (last a)))) data)
  9.    )
  10.    ;; Data is now an association list and length and demand are in Integers.          ;
  11.    (foreach diam size
  12.       (setq title (strcat "Cutting Patterns for Diam. " diam)
  13.               ld  (vl-sort (massoc diam data) '(lambda (a b) (> (car a) (car b))))
  14.                l  (mapcar 'car  ld)
  15.                d  (mapcar 'cadr ld)        
  16.       )
  17.       (solve (list title l d ls))
  18.    )
  19.    (princ)
  20. )  
  21.  

Also in the 1d-csp routine we no longer need to sort the input list l and d
since we are doing it in the main calling routine.

ymg
« Last Edit: February 21, 2015, 05:49:13 AM by ymg »

ymg

  • Guest
Re: The Cutting Stock Problem (Optimizing Cutting of Rebar or Other Material)
« Reply #7 on: February 26, 2015, 09:02:34 AM »
I've analyzed the method of Dikili and Barlas proposed here.

There is Good news and Bad news.

On the bad side:

Because of the sequential nature of the solution the method
sometimes fail to identify solutions with less patterns.

Also, when the problem does not have a good dispersion of
length, the propose solution sometimes deteriorates to worse
than a simple First Fit Decreasing binpack.

On the good side:

It potentially finds solution better than simple binpack.

Below are two examples solutions by the two methods.
A third solution from a commercial program is also offered.
All solutions are list where: item 1   Nb of times to apply a pattern
                                           item 2   List of length composing the pattern
                                           item 3   Waste generated by pattern

Quote
Problem 1   D: (44 23 10 54 120 67)
                   L: (9.71 7.65 5.3 4.0 3.67 2.66)
                 Ls: 12.000

Dikili & Barlas
(44 (9.71) 2.29)
(23 (7.65 4.0) 0.35)
(10 (5.3 4.0 2.66) 0.04)
(7 (4.0 4.0 4.0) 0.0)
(19 (3.67 2.66 2.66 2.66) 0.35)                   
(33 (3.67 3.67 3.67) 0.99)
(1 (3.67 3.67) 4.66)


Nb of Stock used      : 137
Nb of Parts Cut         : 318
Total Length Wasted : 153.19
Percent Efficiency      : 90.6819 %
FFD-binpack
(44 (9.71) 2.29)
(23 (7.65 4.00) 0.35)
(5  (5.30 5.30) 1.40)
(10 (4.0 4.0 4.0) 0.00)
(1  (3.67 4.0 3.67) 0.66)
(39 (3.67 3.67 3.67) 0.99)
(1  (2.66 3.67 2.66 2.66) 0.35)
(16 (2.66 2.66 2.66 2.66) 1.36)           

Nb of Stock used      : 139
Nb of Parts Cut         : 318
Total Length Wasted : 177.19
Percent Efficiency      : 89.3771 %
A better solution from a commercial program.
(19 (4.00 2.66 2.66 2.66) 0.02)
(10 (5.30 4.00 2.66) 0.04)
(23 (7.65 4.00) 0.35)
(40 (3.67 3.67 3.67) 0.99)
(44 (9.71) 2.29)
(1  (4.00 4.00) 4.00)



Nb of Stock used      : 137
Nb of Parts Cut         : 318
Total Length Wasted : 153.19
Percent Efficiency      : 90.6819 %



Problem 2   D: (97 610 395 211 300)
                   L: (4.5 3.6 3.1 1.4 0.75)
                 Ls: 12.000


Dikili & Barlas
(75 (4.5 3.1 1.4 0.75 0.75 0.75 0.75)  0.0) 
(11 (4.5 4.5 1.4 1.4) 0.2)
(19 (3.6 1.4 1.4 1.4 1.4 1.4 1.4)  0.0)
(197 (3.6 3.6 3.6)  1.2)
(106 (3.1 3.1 3.1)  2.7)
(1 (3.1 3.1)  5.8 )



Nb of Stock used       : 409
Nb of Parts Cut          : 1613
Total Length Wasted : 530.60
Percent Efficiency      : 89.1891 %




FFD-binpack
(48  (1.4 4.5 4.5 1.4) 0.2)
(1   (3.6 4.5 3.6) 0.3)
(202 (3.6 3.6 3.6 0.75) 0.45)
(1   (3.1 3.6 3.6 1.4) 0.3)
(98  (1.4 3.1 3.1 3.1 0.75) 0.55)
(16  (3.1 3.1 3.1 1.4) 1.3)
(17  (3.1 3.1 3.1) 2.7)
(1   (3.1) 8.9)

Nb of Stock used      : 384
Nb of Parts Cut         : 1613
Total Length Wasted : 230.60
Percent Efficiency      : 94.9957 %
A Better Solution from a Commercial Program.
(2   (3.6 1.4 1.4 1.4 1.4 1.4 1.4) 0.0)
(1   (3.1 1.4 0.75 0.75 0.75 0.75 0.75 0.75 0.75 0.75 0.75 0.75) 0.0)
(1   (0.75 0.75 0.75 0.75 0.75 0.75 0.75 0.75 0.75 0.75 0.75 0.75 0.75 0.75 0.75 0.75) 0.0)
(197 (3.6 3.1 3.1 1.4 0.75) 0.05)
(97  (4.5 3.6 3.6) 0.3)
(72  (3.6 3.6 3.6 0.75) 0.45)
(1   (3.6 1.4 0.75 0.75 0.75 0.75 0.75) 3.25)


Nb of Stock used      : 371
Nb of Parts Cut         : 1613
Total Length Wasted : 74.60
Percent Efficiency      : 98.3243 %


You can see in the second problem that the solution has deteriorated
to below binpack.

So as a next step, we could explore Dikili by changing the order that
we apply the patterns.

Both method being fast, we could compare Dikili's solution to a binpack,
and output the best.

I do believe however that a better overall solution would be
offered by applying a Genetic Algorithm.

With a proper evaluation function, we could have more constraints
on the solution.

On top of that a GA would return a range of possible solutions
instead of a single one. 

However, this would be at the cost of a much longer run time.

ymg
« Last Edit: February 26, 2015, 10:12:03 AM by ymg »

ymg

  • Guest
Re: The Cutting Stock Problem (Optimizing Cutting of Rebar or Other Material)
« Reply #8 on: February 26, 2015, 12:40:38 PM »
Here's the routine to generate Cut Patterns
by First Fit Decreasing binpack.

Code - Auto/Visual Lisp: [Select]
  1. ;; binpack-cut               by ymg                                           ;
  2. ;;                                                                            ;
  3. ;;                                                                            ;
  4. ;;                                                                            ;
  5. ;; Will return a Patterns List for Cutting the Demanded Lengths               ;
  6. ;;                                                                            ;
  7.  
  8. (defun c:binpack-cut (/ prob pr tit l d ls bins i p )
  9.    (setq prob '(("Problem 1  by Dikili & Barlas          \n"
  10.                   (60.0 50.0 30.0 25.0 20.0 10.0)
  11.                   (6 7 15 20 9 16)
  12.                   100.0
  13.                 )
  14.                )
  15.    )
  16.    (foreach pr prob
  17.       (setq tit (car   pr)
  18.               l (cadr  pr)
  19.               d (caddr pr)
  20.              ls (float (last  pr))
  21.       )
  22.      
  23.       (setq bins (distinct# (ffd-binpack (longlst l d) ls)))
  24.       (foreach i bins
  25.          (setq p (cons (reverse (cons (- ls (apply '+ (car i))) i)) p))
  26.       )
  27.       (setq p (reverse p))
  28.       (textscr)
  29.       (princ tit)
  30.       (princ (strcat "\n D: " (vl-princ-to-string d)))
  31.       (princ (strcat "\n L: " (vl-princ-to-string l)))
  32.       (princ (strcat "\nLs: " (rtos ls 2 3)))
  33.       (princ "\n")
  34.       (foreach i p (princ (strcat "\n" (vl-princ-to-string i))))
  35.       (princ "\n")
  36.       (princ (strcat "\nNb of Stock used    : " (itoa (setq su (apply '+ (mapcar 'car p))))))
  37.       (princ (strcat "\nNb of Parts Cut     : " (itoa (apply '+ (mapcar '(lambda (a) (* (car a) (length (cadr a)))) p)))))
  38.       (princ (strcat "\nTotal Length Wasted : " (rtos (setq w (apply '+ (mapcar '(lambda (a) (* (car a) (caddr a))) p))) 2 2)))
  39.       (princ (strcat "\nNb Patterns used    : " (itoa (length p))))
  40.       (princ (strcat "\nPercent Efficiency  : " (rtos (* 100 ( / (- (* su ls) w) (* su ls))) 2 4) " %"))
  41.       (princ "\n\n\n")
  42.    )
  43.    (princ)
  44. )
  45.  
  46. ;; distinct#    by ymg  (Derived from Distinct by Gile Chanteau               ;
  47. ;; Returns a list of distinct Item and Quantity ((item qty)......)            ;
  48. ;; Argument                                                                   ;
  49. ;; l   List                                                                   ;
  50. ;;                                                                            ;
  51.  
  52. (defun distinct# (l)
  53.    (if l
  54.      (cons (list (car l) (- (length l) (length (setq l (vl-remove (car l) l))))) (distinct# l))    
  55.    )
  56. )
  57.  
  58.  
  59. ;; FFD-binpack         by ymg    (Simplified Gile Chanteau's solution.        ;
  60. ;; First Fit Decreasing                                                       ;
  61. ;; Arguments: l  List of items to put in bins                                 ;
  62. ;;            c  Capacity of a bin                                            ;
  63. ;;                                                                            ;
  64.  
  65. (defun FFD-binpack (l c / i b tmp)
  66.    (foreach  i (vl-sort-i l '>)
  67.        (setq i (nth i l)  tmp nil)
  68.        (cond     
  69.           (b (while (and (> i (- c (apply '+ (car b)))) b)
  70.                (setq tmp (cons (car b) tmp)  b (cdr b))
  71.              )  
  72.              (setq b (append (reverse (cons (reverse (cons i (car b))) tmp)) (cdr b)))               
  73.           )
  74.           (t (setq b (list (list i))))
  75.        )
  76.    )
  77. )
  78.  
  79. ; Expand a list of length and quantity into a long list with repeating items  ;
  80.  
  81. (defun longlst (l d / i j ll)
  82.   (setq j -1)
  83.   (foreach i d
  84.     (setq j (1+ j))
  85.     (repeat i (setq ll (cons (nth j l) ll)))
  86.   )
  87. )
  88.  

ymg

serge_c

  • Newt
  • Posts: 39
 Hi Ymg again !!!
Here is a real example that last method "Dikili and Barlas" gives better solutions that "problem 8": Command: BINPACK-CUT Problem 1  by Dikili & Barlas

 D: (6 32 158 42 45)
 L: (7500.0 6000.0 4500.0 4000.0 3000.0)
Ls: 12000

(6 (7500.0 4500.0) 0.0)
(16 (6000.0 6000.0) 0.0)
(45 (4500.0 4500.0 3000.0) 0.0)
(31 (4500.0 4500.0) 3000.0)
(14 (4000.0 4000.0 4000.0) 0.0)

Nb of Stock used    : 112
Nb of Parts Cut     : 283
Total Length Wasted : 93000
Nb Patterns used    : 5
Percent Efficiency  : 93.0804 %
//////////////////////////////////////////////////////////////////////////////////// Second one
Cutting Patterns for Diam. 28
D: (6 32 158 42 45)
L: (7500 6000 4500 4000 3000)
(6 (1 0 1 0 0) 0)
(22 (0 1 0 0 2) 0)
(5 (0 2 0 0 0) 0)
(1 (0 0 2 0 1) 0)
(75 (0 0 2 0 0) 225000)
(14 (0 0 0 3 0) 0)

   Nb of Stock used: 123
 Nb of Parts Cutted: 283
Total Length Wasted: 225000
« Last Edit: April 06, 2015, 09:46:06 AM by sergiu_ciuhnenco »

ymg

  • Guest
sergiu,

Thanks Sergiu, my only points was that in certain hard case
Dikili & Barlas sometimes returns a result worse than ffd-binpack.

So pending that I or somebody else comes up with something
better, it is wise to run both ffd-binpack and Dikili and keep
the best.

ymg

andy_lee

  • Newt
  • Posts: 147
Hello ymg.

Can you upload a demo gif ? thanks.
andy.
Best regards.

serge_c

  • Newt
  • Posts: 39
Ymg , I want to ask you for the last favor, If you can do the same thing  for Dikili & Barlas problems like you do it for previous problems ( what I mean , to not introducing manualy all numbers , but to make the proces a little bit faster) ..
Thanks in advance !!!

ymg

  • Guest
sergiu,

Here goes, it will now run both methods
for each diameters.

Code - Auto/Visual Lisp: [Select]
  1. ;; 1d-csp       by ymg                                                        ;
  2. ;;                                                                            ;
  3. ;; Cutting Stock Problem as per approach described in:                        ;
  4. ;;                                                                            ;
  5. ;;               A GENERALIZED APPROACH TO THE SOLUTION                       ;
  6. ;;                  OF ONE-DIMENSIONAL STOCK-CUTTING                          ;
  7. ;;                    PROBLEM FOR SMALL SHIPYARDS.                            ;
  8. ;;              by Ahmet Cemil Dikili and Baris Barlas                        ;
  9. ;;                                                                            ;
  10. ;; Link:  http://jmst.ntou.edu.tw/marine/19-4/368-376.pdf                     ;
  11. ;;                                                                            ;
  12. ;; Argument: l   List, Demanded Lengths in Decreasing order.                  ;
  13. ;;           d   List, Number of Corresponding Demanded Length.               ;
  14. ;;          ls   Real, Length of Standard Stock.                              ;
  15. ;;                                                                            ;
  16. ;; Returns: A List of Cutting Patterns, where each member is composed         ;
  17. ;;          of 3 items as follow: Item 1, Nb of times to apply Pattern.       ;
  18. ;;                                Item 2, List of integers where each         ;
  19. ;;                                        element correspond to the nb of     ;
  20. ;;                                        times to use a demanded length.     ;
  21. ;;                                Item 3, Waste per Bar for this Pattern.     ;
  22. ;;                                                                            ;
  23.  
  24. (defun 1D-CSP (l d ls / a ch cp idx maxint p tl sm pu v)
  25.    (setq maxint 2147483647)
  26.            
  27.    (while  (> (apply '+ d) 0)
  28.       (setq v (genpat l d ls nil) p nil)      
  29.       (foreach a v
  30.          (setq tl (- ls (apply '+ (mapcar '(lambda (a l) (* a l)) a l)))
  31.                sm (apply 'min (mapcar '(lambda (a d) (if (> a 0) (/ d a) maxint)) a d))
  32.                pu (* sm (apply '+ a))
  33.                 p (cons (list a tl sm pu) p)
  34.          )
  35.       )
  36.      
  37.       ; Here we Sort the Set of Patterns on Min tl, Max sm and Min pu         ;
  38.       ; The Chosen Pattern will bubble up to top of the list.                 ;
  39.      
  40.       (setq p (vl-sort (reverse p) '(lambda (a b) (if (= (cadr a) (cadr b))
  41.                                            (if (= (caddr a) (caddr b))
  42.                                               (< (cadddr a) (cadddr b))  
  43.                                               (> (caddr a) (caddr b))
  44.                                            )     
  45.                                            (< (cadr  a) (cadr  b))
  46.                                         )
  47.                           )
  48.               )
  49.       )
  50.      
  51.      
  52.       ; Building the Cutting Plan, then Adjusting the Demand List.            ;
  53.       ;(if (not (setq i (getint "\nChoose pattern : "))) 0)
  54.       (setq ch (car p))
  55.       (setq cp (cons (list (caddr ch) (pat2len (car ch) l) (cadr ch) ) cp))
  56.       (setq  d (mapcar '(lambda (d p) (- d (* p (caddr ch)))) d (car ch)))    
  57.    )  
  58.    (reverse cp)
  59. )
  60.  
  61.  
  62.  
  63.  
  64.  
  65. ;; genpat                  by ymg                                             ;
  66. ;;                                                                            ;
  67. ;; Procedure for Generating the Efficient Feasible Cutting Patterns           ;
  68. ;; http://www.cs.bham.ac.uk/~wbl/biblio/gecco2006/docs/p1675.pdf              ;
  69. ;; Appendix 1                                                                 ;
  70. ;; Part of "Cutting Stock Waste Reduction Using Genetic Algorithms"           ;
  71. ;;              by Y. Khalifa, O. Salem and A. Shahin                         ;
  72. ;;                                                                            ;
  73. ;; Argument: l   List, Demanded Lengths in Descending Order.                  ;
  74. ;;           d   List, Number of Corresponding Demanded Length.               ;
  75. ;;          ls   Real, Length of Standard Bar.                                ;
  76. ;;         all   Boolean, if true, Generate all Feasible Patterns.            ;
  77. ;;                        if false, Generates only the Set of Patterns        ;
  78. ;;                                  for the First Demand > 0                  ;
  79. ;;                                                                            ;
  80.  
  81. (defun genpat (l d ls all / a i j p  s)
  82.    (setq i 0) (while (zerop (nth i d)) (setq i (1+ i)))
  83.    (if (= (1+ i) (length d)) (setq all t))
  84.    (while (or (not a) (if all (> (apply '+ (cdr a)) 0) (> (nth i (reverse a)) 0)))
  85.       (cond
  86.           (a (setq a (cdr a))
  87.              (while (zerop (car a)) (setq a (cdr a)))
  88.              (setq a (cons (1- (car a)) (cdr a))
  89.                    j (length a)
  90.                    s (apply '+ (mapcar '(lambda (a l) (* a l)) (reverse a) l))
  91.              )
  92.            )
  93.            (t (setq j 0 s 0))
  94.       )  
  95.       (while (< j (length l))
  96.          (setq a (cons (min (floor (/ (- ls s) (nth j l))) (nth j d)) a)
  97.                s (+ s (* (car a) (nth j l)))
  98.                j (1+ j)
  99.          )
  100.       )
  101.       (setq p (cons (reverse a) p))
  102.    )  
  103.    (if all (reverse p) (reverse (cdr p)))
  104. )
  105.  
  106. (defun readcsv ( fname / str2lst f lin l)
  107.  
  108.     ; str2lst    by Gile Chanteau                                             ;
  109.     (defun str2lst (s d / p)
  110.         (if (setq p (vl-string-search d s))
  111.            (cons (substr s 1 p) (str2lst (substr s (+ p 2)) d))
  112.            (list s)
  113.         )
  114.     )
  115.  
  116.     (cond ((setq f (open (findfile fname) "r"))
  117.               (while (setq lin (read-line f))
  118.                  (setq l (cons (str2lst lin ",") l))
  119.               )
  120.               (close f)
  121.           )
  122.     )  
  123.     (reverse l)
  124. )
  125.  
  126. ;; massoc                                                                     ;
  127. ;;                                                                            ;
  128. ;; Returns a list of all items associated with the specified key              ;
  129. ;; in an association list.                                                    ;
  130. ;;                                                                            ;
  131. ;; Arguments:                                                                 ;
  132. ;;    k,  The value to search for in the list.                                ;
  133. ;;    l,  List of Associations                                                ;
  134. ;;                                                                            ;
  135.  
  136. (defun massoc (k l / i)       ; recursive version    ;
  137.     (if (setq i (assoc k l))
  138.        (cons (cdr i) (massoc k (cdr (member i l))))
  139.     )
  140. )
  141. (defun massoc (k l / i r)     ; Iterative version    ;
  142.     (while (setq i (assoc k l))
  143.         (setq r (cons (cdr i) r) l (cdr (member i l)))
  144.     )
  145.     (reverse r)
  146. )
  147.  
  148.  
  149. ;; distinct     by Gile Chanteau                                              ;
  150. ;; Deletes all duplicates in a list.                                          ;
  151. ;;                                                                            ;
  152. ;; Argument                                                                   ;
  153. ;; l   List                                                                   ;
  154. ;;                                                                            ;
  155.  
  156. (defun distinct (l) (if l (cons (car l) (distinct (vl-remove (car l) l)))))
  157.  
  158.  
  159. ;; distinct#    by ymg  (Derived from Distinct by Gile Chanteau               ;
  160. ;; Returns a list of distinct Item and Quantity ((item qty)......)            ;
  161. ;; Argument                                                                   ;
  162. ;; l   List                                                                   ;
  163. ;;                                                                            ;
  164.  
  165. ;(defun distinct# (l)
  166. ;   (if l
  167. ;     (cons (cons (car l) (- (length l) (length (setq l (vl-remove (car l) l))))) (distinct# l))    
  168. ;   )
  169. ;)
  170. ; Modified to return ((qty (pattern) waste) (...) (...))
  171. (defun distinct# (l / i)
  172.    (if l
  173.       (cons (cons (- (length l) (length (setq l (vl-remove (setq i (car l)) l)))) i) (distinct# l))    
  174.    )
  175. )
  176.  
  177. ;; Ceiling function, Returns the smallest integer not less than x.            ;
  178. (defun ceil  (x) (if (> (rem x 1) 0) (+ (fix x) 1) (fix x)))
  179. ;; Floor function, Returns the largest integer not greater than x.            ;
  180. (defun floor (x) (if (minusp (rem x 1)) (- (fix x) 1) (fix x)))
  181.  
  182.  
  183.  
  184. ;; FFD-binpack         by ymg                                                 ;
  185. ;; First Fit Decreasing                                                       ;
  186. ;; Arguments: l  List of items to put in bins                                 ;
  187. ;;            c  Capacity of a bin                                            ;
  188. ;;                                                                            ;
  189.  
  190. (defun FFD-binpack (l c / i b tb)
  191.    (foreach  i (vl-sort-i l '>)
  192.        (setq i (nth i l) tb nil)
  193.        (cond     
  194.           (b (while (and (> i (cadar b)) b)
  195.                (setq tb (cons (car b) tb)  b (cdr b))
  196.              )
  197.              (setq b (append (reverse (cons (list (reverse (cons i (reverse (caar b))))(if (cadar b) (- (cadar b) i) (- c i))) tb)) (cdr b)))
  198.           )
  199.           (t (setq b (list (list (list i) (- c i)))))
  200.        )         
  201.    )
  202. )
  203.  
  204.  
  205.  
  206. ;; longlst                                                                    ;
  207. ;; Expand a list of length and quantity into a long list with repeating items ;
  208. ;;                                                                            ;
  209. (defun longlst (l d / i j ll)
  210.   (setq j 0)
  211.   (foreach i d
  212.      (repeat i (setq ll (cons (nth j l) ll)))
  213.      (setq j (1+ j))
  214.   )
  215.   ll
  216. )
  217.  
  218. ;; pat2len                                                                    ;
  219. ;; Expand a pattern to length                                                 ;
  220. ;; (0 2 0 1 0) -> (l1 l1 l3)                                                  ;
  221. (defun pat2len (p l /  r)
  222.    (while p
  223.      (repeat (car p) (setq r (cons (car l) r)))
  224.         (setq l (cdr l) p (cdr p))
  225.    )
  226.    (reverse r)
  227. )
  228. ;; len2pat                                                                    ;
  229. ;; Inverse of pat2len                                                         ;
  230. ;; (l1 l1 l3) -> (0 2 0 1 0)                                                  ;
  231. (defun len2pat (p l)
  232.    (setq p (mapcar '(lambda (a) (cons (cdr a) (car a))) (distinct# p)))
  233.    (mapcar '(lambda (a) (if (setq c (assoc a p)) (cdr c) 0)) l)  
  234. )  
  235.  
  236. ;; printres                                                                   ;
  237. ;;                                                                            ;
  238. ;; Crude Patterns and Statistic Output to the Text Screen.                    ;
  239. ;;                                                                            ;
  240.  
  241. (defun printres (tit l d ls p / a su w)
  242.    (textscr)
  243.    (princ (strcat "\n" tit))
  244.    (princ (strcat "\n D: " (vl-princ-to-string d)))
  245.    (princ (strcat "\n L: " (vl-princ-to-string l)))
  246.    (princ (strcat "\nLs: " (if (= 'INT (type ls)) (itoa ls) (rtos ls 2 3))))
  247.    (princ "\n")
  248.    (foreach i p
  249.       (princ (strcat "\n" (vl-princ-to-string i)))
  250.    )
  251.    (princ "\n")
  252.    (princ (strcat "\nNb of Stock used    : " (itoa (setq su (apply '+ (mapcar 'car p))))))
  253.    (princ (strcat "\nNb of Parts Cut     : " (itoa (apply '+ (mapcar '(lambda (a) (* (car a) (length (cadr a)))) p)))))
  254.    (princ (strcat "\nTotal Length Wasted : " (if (= 'INT (type (setq w (apply '+ (mapcar '(lambda (a) (* (car a) (caddr a))) p))))) (itoa w) (rtos w 2 2))))
  255.    (princ (strcat "\nNb Patterns used    : " (itoa (length p))))
  256.    (princ (strcat "\nPercent Efficiency  : " (rtos (* 100 ( / (- (* su (float ls)) w) (* su ls))) 2 4) " %"))
  257.    (princ "\n\n")
  258. )
  259.  
  260.  
  261. (defun c:sergiu (/ a d data fn l ld ls size title)
  262.    (setq ls 12000)                            ; Length of Standard Bar                ;
  263.    (prompt "Select CSV File Containing Your Data :")
  264.    (setq fn (getfiled "Import CSV File" "" "csv" 8))
  265.          
  266.    (setq data (cdr (readcsv fn))              ; cdr is to discard the line of titles  ;
  267.          size (distinct (mapcar 'cadr data))  ; size is the list of distinct diameters;
  268.          data (mapcar '(lambda (a) (list (cadr a) (atoi (caddr a)) (atoi (last a)))) data)
  269.    )
  270.    ;; Data is now an association list and length and demand are in Integers.          ;
  271.  
  272.    (foreach diam size
  273.       (setq tit (strcat "File: " fn "  -  Cutting Patterns for Diam. " diam)
  274.              ld (vl-sort (massoc diam data) '(lambda (a b) (> (car a) (car b))))
  275.               l (mapcar 'car  ld)
  276.               d (mapcar 'cadr ld)          
  277.               p (1d-csp l d ls)
  278.       )
  279.       (printres (strcat "Dikili & Barlas - " tit) l d ls p)
  280.       (printres (strcat "FFD-binpack - " tit) l d ls (distinct# (ffd-binpack (longlst l d) ls)))
  281.    )  
  282.    (princ)  
  283. )
  284.  

ymg
« Last Edit: April 07, 2015, 05:54:46 AM by ymg »

ymg

  • Guest
emk2012,

You supply  list L, Length of bars needed.
You also supply list D, How many of each length are required.
You also give LS which is the length of the long bar from which
the smaller lengths are going to be cut.

The program then cut all the pieces, using two different methods
in order to minimize the waste.

Output is a set of cut patterns: