Author Topic: -={ Challenge }=- FOB MiniGrid(Bin packing - Subset Sum) Lispers please join in  (Read 9338 times)

0 Members and 1 Guest are viewing this topic.

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
A brute force approach:

Code - Auto/Visual Lisp: [Select]
  1. (defun binpack-brute ( l s / b q r )
  2.     (setq l (LM:permutations l)
  3.           r (binpack (car l) s)
  4.           q (length r)
  5.     )
  6.     (foreach x (cdr l)
  7.         (if (< (length (setq b (binpack x s))) q)
  8.             (setq r b q (length b))
  9.         )
  10.     )
  11.     r
  12. )
  13.  
  14. (defun binpack ( l s / a b c x )
  15.     (foreach x (vl-sort-i l '>)
  16.         (setq c nil
  17.               x (nth x l)
  18.               a (vl-member-if '(lambda ( b ) (cond ((<= (+ x (apply '+ b)) s)) ((not (setq c (cons b c)))))) b)
  19.               b (append (reverse c) (cons (cons x (car a)) (cdr a)))
  20.         )
  21.     )
  22. )
  23.  
  24. ;; Permutations  -  Lee Mac
  25. ;; Returns a list of all permutations of elements in a list
  26.  
  27. (defun LM:permutations ( l / f g )
  28.     (defun f ( l )
  29.         (if l (cons (car l) (f (vl-remove (car l) (cdr l)))))
  30.     )
  31.     (defun g ( a l )
  32.         (if l (if (= a (car l)) (cdr l) (cons (car l) (g a (cdr l)))))
  33.     )
  34.     (if (cdr l)
  35.         (f (apply 'append (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) (cons a b)) (LM:permutations (g a l)))) l)))
  36.         (list l)
  37.     )
  38. )

Don't even try it for lists longer than ~7  :evil:

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Another, using a best-fit decreasing algorithm:

Code - Auto/Visual Lisp: [Select]
  1. (defun bestfit-binpack ( lst cap / acc bin dif rtn spc tmp )
  2.     (foreach  itm (vl-sort-i lst '>)
  3.         (setq itm (nth itm lst)
  4.               spc cap
  5.               tmp nil
  6.               acc nil
  7.         )
  8.         (while (setq bin (car rtn))
  9.             (if (<= itm (setq dif (- cap (apply '+ bin))) spc)
  10.                 (setq tmp (append (reverse acc) (cons (cons itm bin) (cdr rtn)))
  11.                       spc dif
  12.                 )
  13.             )
  14.             (setq rtn (cdr  rtn)
  15.                   acc (cons bin acc)
  16.             )
  17.         )
  18.         (if tmp
  19.             (setq rtn tmp)
  20.             (setq rtn (reverse (cons (list itm) acc)))
  21.         )
  22.     )
  23. )

Gasty

  • Newt
  • Posts: 90
Hi,

Interesting problem, if you need a more pro approach, you should try a solver, as the problem lies inside the boundaries of linear programming, and there are several solutions in the market (Gurobi, Lindo, etc), some for free, like MS Solver Foundation(http://msdn.microsoft.com/en-us/library/ff524509(v=vs.93).aspx). But the non free solutions are very expensive, in the range of multi thousand to hundred of thousand bucks. Even the MS free solution has a commercial version that cost 100.000 or something like that. Any way the problem is exact the same as 1D Cutting Stock Problem (1DCSP), that have multiple applications in the industry, like paper roll cutting, steel bar material calculation and optimization, etc. This paper from Amsterdam Optimization has a lot of examples and even a solution for the 1DCSP:http://amsterdamoptimization.com/models/msf/oml.pdf .

Gaston Nunez

edit:
kdub-> pdf link amended.
« Last Edit: December 08, 2014, 07:01:45 PM by Kerry »

Jeff H

  • Needs a day job
  • Posts: 6144
Thanks again everyone for your input.

ymg

  • Guest
lee,

Gile's FFD binpack could also be transformed into
a BFD by ordering the returned acc values
in decreasing order of bin total value.

Code: [Select]
(vl-sort acc (function  (lambda(a b)(> (apply '+ a) (apply '+ b)))))
Although I did not check your way is probably more efficient.

According to Korf's paper BFD tends to be closer to optimal.

A New Algorithm for Optimal Bin Packing

ymg
« Last Edit: January 31, 2015, 02:32:09 PM by ymg »

ymg

  • Guest
Here's my entry for a Best Fit Decreasing binpack

Code - Auto/Visual Lisp: [Select]
  1. ;; BFD-binpack         by ymg                                                 ;
  2. ;; Best Fit Decreasing                                                        ;
  3. ;; Arguments: l  List of items to put in bins                                 ;
  4. ;;            c  Capacity of a bin                                            ;
  5. ;;                                                                            ;
  6.  
  7. (defun BFD-binpack (l c / i bin tmp)
  8.    (foreach  i (vl-sort-i l '>)
  9.        (setq i (nth i l)  tmp nil)
  10.        (cond
  11.           ((not bin) (setq bin (list (list i))))
  12.           (t (while (and (> i (- c (apply '+ (car bin)))) bin)
  13.                (setq tmp (cons (car bin) tmp)  bin (cdr bin))
  14.              )  
  15.              (setq tmp (cons (cons i (car bin)) tmp)
  16.                    bin (append (reverse tmp) (cdr bin))
  17.                    bin (vl-sort bin (function (lambda (a b) (> (apply '+ a) (apply '+ b)))))               
  18.              )     
  19.           )
  20.        )
  21.    )
  22. )  
  23.  

For a First Fit Decreasing, simply delete line 17 in above code.

ymg
« Last Edit: February 02, 2015, 03:56:56 PM by ymg »

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
if i have arguments:
Code: [Select]
(setq l '(62 20  9 8 12 17 9 6)
      s 80
)
no code gives me the solution:
Code: [Select]
'(62 9 9)  :-(

ymg

  • Guest
Evgenyi,

What the binpack function does is minimize the number
of bin used.

What you are after is minimizing the waste in each bin.

If you use the 1d-csp routine shown  here and gives as argument :
Code: [Select]
(setq l '(62 20  9 8 12 17 9 6)
         d'(1 1 1 1 1 1 1 1)
         s 80 
)

The routine will return:
Code: [Select]
((1 (1 0 0 1 0 0 0 1) 0) (1 (0 1 1 0 1 1 1 0) 17))
Since your l list gets sorted in descending order of l
l is now equal to:
Code: [Select]
(62 20 17  12 9 9 8 6)
The first pattern (1 0 0 1 0 0 0 1) means (62 0 0 12 0 0 0 0 6)

Which is an equivalent answer to (62 9 9)

Code: [Select]
L: (62 20 17 12 9 9 8 6)
(1 (1 0 0 1 0 0 0 1) 0)
(1 (0 1 1 0 1 1 1 0) 17)

   Nb of Stock used: 2
 Nb of Parts Cutted: 8
Total Length Wasted: 17.00

ymg
« Last Edit: February 18, 2015, 03:23:35 PM by ymg »

ymg

  • Guest
The binpack algorithm of Gile's could be made faster by
keeping and updating the remainder value in every bin.
Routines as modified should run about 4x faster

It also simplify the job if you want Best Fit Decreasing
or Worst Fit Decreasing.

Here are my version:

Code - Auto/Visual Lisp: [Select]
  1. ;; FFD-binpack         by ymg                                                 ;
  2. ;; First Fit Decreasing                                                       ;
  3. ;; Arguments: l  List of items to put in bins                                 ;
  4. ;;            c  Capacity of a bin                                            ;
  5. ;;                                                                            ;
  6.  
  7. (defun FFD-binpack (l c / i b tb)
  8.    (foreach  i (vl-sort-i l '>)
  9.        (setq i (nth i l) tb nil)
  10.        (cond     
  11.           (b (while (and (> i (cadar b)) b)
  12.                (setq tb (cons (car b) tb)  b (cdr b))
  13.              )             
  14.              (setq b (append (reverse (cons (list (reverse (cons i (reverse (caar b))))(if (cadar b) (- (cadar b) i) (- c i))) tb)) (cdr b)))
  15.           )
  16.           (t (setq b (list (list (list i) (- c i)))))
  17.        )         
  18.    )
  19.    ;(mapcar 'car b) ;Add this if you want bins without remainder              ;
  20. )
  21.  
  22. ;; BFD-binpack         by ymg                                                 ;
  23. ;; Best Fit Decreasing                                                        ;
  24. ;; Arguments: l  List of items to put in bins                                 ;
  25. ;;            c  Capacity of a bin                                            ;
  26. ;;                                                                            ;
  27.  
  28. (defun BFD-binpack (l c / i b m tb)
  29.    (foreach  i (vl-sort-i l '>)
  30.        (setq i (nth i l)  tb nil)
  31.        (cond     
  32.           (b (while (and (> i (cadar b)) b)
  33.                (setq tb (cons (car b) tb)  b (cdr b))
  34.              )  
  35.              (if (setq m  (mapcar '(lambda (a) (if (minusp (- (cadr a) i)) 0 (cadr a))) b))
  36.                 (repeat (vl-position (apply 'max m) m)
  37.                    (setq tb (cons (car b) tb)  b (cdr b))
  38.                 )
  39.              )  
  40.              (setq b (append (reverse (cons (list (reverse (cons i (reverse (caar b))))(if (cadar b) (- (cadar b) i) (- c i))) tb)) (cdr b)))      
  41.           )
  42.           (t (setq b (list (list (list i) (- c i)))))
  43.        )         
  44.    )
  45.    ;(mapcar 'car b) ;Add this if you want bins without remainder              ;
  46. )
  47.  
  48.  
  49. ;; WFD-binpack         by ymg                                                 ;
  50. ;; Worst Fit Decreasing                                                       ;
  51. ;; Arguments: l  List of items to put in bins                                 ;
  52. ;;            c  Capacity of a bin                                            ;
  53. ;;                                                                            ;
  54.  
  55. (defun WFD-binpack (l c / i b m maxi tb)
  56.    (setq maxi 1.7e308)
  57.    (foreach  i (vl-sort-i l '>)
  58.        (setq i (nth i l)  tb nil)
  59.        (cond     
  60.           (b (while (and (> i (cadar b)) b)
  61.                (setq tb (cons (car b) tb)  b (cdr b))
  62.              )  
  63.              (if (setq m  (mapcar '(lambda (a) (if (minusp (- (cadr a) i)) maxi (cadr a))) b))
  64.                 (repeat (vl-position (apply 'min m) m)
  65.                    (setq tb (cons (car b) tb)  b (cdr b))
  66.                 )
  67.              )  
  68.              (setq b (append (reverse (cons (list (reverse (cons i (reverse (caar b))))(if (cadar b) (- (cadar b) i) (- c i))) tb)) (cdr b)))      
  69.           )
  70.           (t (setq b (list (list (list i) (- c i)))))
  71.        )         
  72.    )
  73.    ;(mapcar 'car b) ;Add this if you want bins without remainder              ;
  74. )
  75.  

Also note that if you don't mind the bins in reverse order the following line:

Code: [Select]
  (setq b (append (reverse (cons (list (reverse (cons i (reverse (caar b))))(if (cadar b) (- (cadar b) i) (- c i))) tb)) (cdr b)))
could be simplified to this:

Code: [Select]
(setq b (append (reverse (cons (list (cons i (caar b)) (if (cadar b) (- (cadar b) i) (- c i))) tb)) (cdr b)))
Which is very similar to what Gile had.

ymg
« Last Edit: March 07, 2015, 04:03:33 PM by ymg »

Jeff H

  • Needs a day job
  • Posts: 6144
Thanks guys these things will be on National Geographic.
  :-D