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

0 Members and 1 Guest are viewing this topic.

#### Lee Mac

• Seagull
• Posts: 12169
• London, England
##### Re: -={ Challenge }=- FOB MiniGrid(Bin packing - Subset Sum) Lispers please join in
« Reply #15 on: December 07, 2014, 06:41:07 AM »
A brute force approach:

Code - Auto/Visual Lisp: [Select]
`(defun binpack-brute ( l s / b q r )    (setq l (LM:permutations l)          r (binpack (car l) s)          q (length r)    )    (foreach x (cdr l)        (if (< (length (setq b (binpack x s))) q)            (setq r b q (length b))        )    )    r) (defun binpack ( l s / a b c x )    (foreach x (vl-sort-i l '>)        (setq c nil              x (nth x l)              a (vl-member-if '(lambda ( b ) (cond ((<= (+ x (apply '+ b)) s)) ((not (setq c (cons b c)))))) b)              b (append (reverse c) (cons (cons x (car a)) (cdr a)))        )    )) ;; Permutations  -  Lee Mac;; Returns a list of all permutations of elements in a list (defun LM:permutations ( l / f g )    (defun f ( l )        (if l (cons (car l) (f (vl-remove (car l) (cdr l)))))    )    (defun g ( a l )        (if l (if (= a (car l)) (cdr l) (cons (car l) (g a (cdr l)))))    )    (if (cdr l)        (f (apply 'append (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) (cons a b)) (LM:permutations (g a l)))) l)))        (list l)    ))`

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

#### Lee Mac

• Seagull
• Posts: 12169
• London, England
##### Re: -={ Challenge }=- FOB MiniGrid(Bin packing - Subset Sum) Lispers please join in
« Reply #16 on: December 07, 2014, 07:39:36 AM »
Another, using a best-fit decreasing algorithm:

Code - Auto/Visual Lisp: [Select]
`(defun bestfit-binpack ( lst cap / acc bin dif rtn spc tmp )    (foreach  itm (vl-sort-i lst '>)        (setq itm (nth itm lst)              spc cap              tmp nil              acc nil        )        (while (setq bin (car rtn))            (if (<= itm (setq dif (- cap (apply '+ bin))) spc)                (setq tmp (append (reverse acc) (cons (cons itm bin) (cdr rtn)))                      spc dif                )            )            (setq rtn (cdr  rtn)                  acc (cons bin acc)            )        )        (if tmp            (setq rtn tmp)            (setq rtn (reverse (cons (list itm) acc)))        )    ))`

#### Gasty

• Newt
• Posts: 89
##### Re: -={ Challenge }=- FOB MiniGrid(Bin packing - Subset Sum) Lispers please join in
« Reply #17 on: December 08, 2014, 06:48:41 PM »
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:
« Last Edit: December 08, 2014, 07:01:45 PM by Kerry »

#### Jeff H

• Needs a day job
• Posts: 6014
##### Re: -={ Challenge }=- FOB MiniGrid(Bin packing - Subset Sum) Lispers please join in
« Reply #18 on: December 09, 2014, 07:36:53 PM »
Thanks again everyone for your input.

#### ymg

• Swamp Rat
• Posts: 725
##### Re: -={ Challenge }=- FOB MiniGrid(Bin packing - Subset Sum) Lispers please join in
« Reply #19 on: January 31, 2015, 11:19:47 AM »
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

• Swamp Rat
• Posts: 725
##### Re: -={ Challenge }=- FOB MiniGrid(Bin packing - Subset Sum) Lispers please join in
« Reply #20 on: February 02, 2015, 03:52:18 PM »
Here's my entry for a Best Fit Decreasing binpack

Code - Auto/Visual Lisp: [Select]
`;; BFD-binpack         by ymg                                                 ;;; Best Fit Decreasing                                                        ;;; Arguments: l  List of items to put in bins                                 ;;;            c  Capacity of a bin                                            ;;;                                                                            ; (defun BFD-binpack (l c / i bin tmp)   (foreach  i (vl-sort-i l '>)       (setq i (nth i l)  tmp nil)       (cond	  ((not bin) (setq bin (list (list i))))	  (t (while (and (> i (- c (apply '+ (car bin)))) bin)	       (setq tmp (cons (car bin) tmp)  bin (cdr bin))	     )  	     (setq tmp (cons (cons i (car bin)) tmp)	 	   bin (append (reverse tmp) (cdr bin))		   bin (vl-sort bin (function (lambda (a b) (> (apply '+ a) (apply '+ b))))) 		   	     )	   	  )       )   ))   `

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: 1539
• Moscow (Russia)
##### Re: -={ Challenge }=- FOB MiniGrid(Bin packing - Subset Sum) Lispers please join in
« Reply #21 on: February 18, 2015, 10:20:24 AM »
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

• Swamp Rat
• Posts: 725
##### Re: -={ Challenge }=- FOB MiniGrid(Bin packing - Subset Sum) Lispers please join in
« Reply #22 on: February 18, 2015, 02:55:17 PM »
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: 8Total Length Wasted: 17.00`
ymg
« Last Edit: February 18, 2015, 03:23:35 PM by ymg »

#### ymg

• Swamp Rat
• Posts: 725
##### Re: -={ Challenge }=- FOB MiniGrid(Bin packing - Subset Sum) Lispers please join in
« Reply #23 on: March 07, 2015, 02:26:57 PM »
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]
`;; FFD-binpack         by ymg                                                 ;;; First Fit Decreasing                                                       ;;; Arguments: l  List of items to put in bins                                 ;;;            c  Capacity of a bin                                            ;;;                                                                            ; (defun FFD-binpack (l c / i b tb)   (foreach  i (vl-sort-i l '>)       (setq i (nth i l) tb nil)       (cond	  	  (b (while (and (> i (cadar b)) b)	       (setq tb (cons (car b) tb)  b (cdr b))	     )  	                 (setq b (append (reverse (cons (list (reverse (cons i (reverse (caar b))))(if (cadar b) (- (cadar b) i) (- c i))) tb)) (cdr b)))          )          (t (setq b (list (list (list i) (- c i)))))       )	     )   ;(mapcar 'car b) ;Add this if you want bins without remainder              ;) ;; BFD-binpack         by ymg                                                 ;;; Best Fit Decreasing                                                        ;;; Arguments: l  List of items to put in bins                                 ;;;            c  Capacity of a bin                                            ;;;                                                                            ; (defun BFD-binpack (l c / i b m tb)   (foreach  i (vl-sort-i l '>)       (setq i (nth i l)  tb nil)       (cond	  	  (b (while (and (> i (cadar b)) b)	       (setq tb (cons (car b) tb)  b (cdr b))	     )  	     (if (setq m  (mapcar '(lambda (a) (if (minusp (- (cadr a) i)) 0 (cadr a))) b))	        (repeat (vl-position (apply 'max m) m)	           (setq tb (cons (car b) tb)  b (cdr b))	        )	     )  	     (setq b (append (reverse (cons (list (reverse (cons i (reverse (caar b))))(if (cadar b) (- (cadar b) i) (- c i))) tb)) (cdr b)))	   	  )	  (t (setq b (list (list (list i) (- c i)))))       )	     )   ;(mapcar 'car b) ;Add this if you want bins without remainder              ;)  ;; WFD-binpack         by ymg                                                 ;;; Worst Fit Decreasing                                                       ;;; Arguments: l  List of items to put in bins                                 ;;;            c  Capacity of a bin                                            ;;;                                                                            ; (defun WFD-binpack (l c / i b m maxi tb)   (setq maxi 1.7e308)   (foreach  i (vl-sort-i l '>)       (setq i (nth i l)  tb nil)       (cond	  	  (b (while (and (> i (cadar b)) b)	       (setq tb (cons (car b) tb)  b (cdr b))	     )  	     (if (setq m  (mapcar '(lambda (a) (if (minusp (- (cadr a) i)) maxi (cadr a))) b))	        (repeat (vl-position (apply 'min m) m)	           (setq tb (cons (car b) tb)  b (cdr b))	        )	     )  	     (setq b (append (reverse (cons (list (reverse (cons i (reverse (caar b))))(if (cadar b) (- (cadar b) i) (- c i))) tb)) (cdr b)))	   	  )	  (t (setq b (list (list (list i) (- c i)))))       )	     )   ;(mapcar 'car b) ;Add this if you want bins without remainder              ;) `

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: 6014
##### Re: -={ Challenge }=- FOB MiniGrid(Bin packing - Subset Sum) Lispers please join in
« Reply #24 on: November 02, 2015, 10:37:59 AM »
Thanks guys these things will be on National Geographic.