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

0 Members and 1 Guest are viewing this topic.

Jeff H

  • Needs a day job
  • Posts: 6045
If someone can correctly categorize this problem please let me know but thinking its a Bin Packing problem or Subset Sum problem  and maybe a dash of Knapsack problem
 
A real world example of what challenge if needed for.
A temporary military base in the middle of dessert in a foreign country has to generate its own power,  even if it was in a location to connect to a countries power grid the base does not want to rely on the foreign countries power grid.

These bases will have a number of different  components that each require different amount of power.
For example will have
30 Billets  @ 14.4kW each
2 Changing stations @ 12.34kW
4 First Aid @ 15.3kW
etc.....
 
They will have a number 60kW generators.
Ideally or if the generators were paralleled feeding a grid you would take the total power and divide by 60(add 1 more if remainder) and that would the total number of generators needed.
These generators feed the components directly so unless you combine the components in a way that the sum equals the total generator output you are not using all the generators available power.

The goal is to group components together so they require the least amount of generators.

 Problem.
  • Generator OutPut - The total amount power the generator can generate.
  • Collection of component that each require a power. No components require more than the generator output so 1 component power is never more than the Generator OutPut .
  • There can be 1 or many of each component
.
 
The challenge is to take a collection of components and put them into groups that total sum is equal to or less the than a Generators Output so that the components will require the least amount generators.

You could use just a list of doubles or reals.

Jeff H

  • Needs a day job
  • Posts: 6045
Oh yeah just to throw this in,

Lets say your computer can calculate 1,000,000  different combinations per second.

It only takes 1 sec to calculate all different combinations for 20 items.
It only takes 36 years to calculate all different combinations for 50 items

gile

  • Water Moccasin
  • Posts: 2233
  • Marseille, France
Hi,

Here's simple first fit decreasing bin packing C# implementation.
Code - C#: [Select]
  1.         static List<List<double>> BinPack(IEnumerable<double> source, double packSize)
  2.         {
  3.             var groups = source
  4.                 .GroupBy(x => x)
  5.                 .OrderByDescending(g => g.Key)
  6.                 .Select(g => g.ToList())
  7.                 .ToList();
  8.             var result = new List<List<double>>();
  9.             while (groups.Count > 0)
  10.             {
  11.                 var list = new List<double>();
  12.                 var i = 0;
  13.                 while (i < groups.Count && groups.Count > 0)
  14.                 {
  15.                     if (list.Sum() + groups[i][0] <= packSize)
  16.                     {
  17.                         list.Add(groups[i][0]);
  18.                         groups[i].RemoveAt(0);
  19.                         if (groups[i].Count == 0)
  20.                         {
  21.                             groups.RemoveAt(i);
  22.                         }
  23.                     }
  24.                     else
  25.                     {
  26.                         i++;
  27.                     }
  28.                 }
  29.                 result.Add(list);
  30.             }
  31.             return result;
  32.         }
« Last Edit: December 05, 2014, 03:25:54 PM by gile »
Speaking English as a French Frog

Jeff H

  • Needs a day job
  • Posts: 6045
Thanks gile!!
Output looks great and need to stare at it a little longer to get it to soak in.

...
I wish I could borrow your brain 1 or 2 times a week.

gile

  • Water Moccasin
  • Posts: 2233
  • Marseille, France
Thanks Jeff.

A F# attempt:

Code - F#: [Select]
  1. let binPack packSize source =
  2.     let rec add lst x =
  3.         match lst with
  4.         | [] -> [[x]]
  5.         | h :: t when x + List.sum h <= packSize -> (x :: h) :: t
  6.         | h :: t -> h :: (add t x)
  7.     source |> Seq.sortBy (~-) |> Seq.fold add []
Speaking English as a French Frog

gile

  • Water Moccasin
  • Posts: 2233
  • Marseille, France
A tail recursive one:

Code - F#: [Select]
  1. let binPack packSize source =
  2.     let rec loop x acc = function
  3.         | [] -> ([x] :: acc) |> List.rev
  4.         | h :: t when x + List.sum h > packSize -> loop x (h :: acc) t
  5.         | h :: t -> ((x :: h) :: acc |> List.rev) @ t
  6.     source |> Seq.sortBy (~-) |> Seq.fold (fun l x -> loop x [] l) []
Speaking English as a French Frog

gile

  • Water Moccasin
  • Posts: 2233
  • Marseille, France
A LISP version:

Code - Auto/Visual Lisp: [Select]
  1. (defun binPack (packsize source / insert result)
  2.   (defun insert (x lst)
  3.     (cond
  4.       ((null lst) (list (list x)))
  5.       ((<= (+ x (apply '+ (car lst))) packSize)
  6.        (cons (cons x (car lst)) (cdr lst))
  7.       )
  8.       (T (cons (car lst) (insert x (cdr lst))))
  9.     )
  10.   )
  11.   (foreach x (vl-sort source '>)
  12.     (setq result (insert x result))
  13.   )
  14. )

The same with a while loop in the local function to avoid recursivity (AutoLISP doesn't optimize tail recursion).
Code - Auto/Visual Lisp: [Select]
  1. (defun binPack (packsize source / insert result)
  2.   (defun insert (x lst / done acc)
  3.     (while (not done)
  4.       (cond
  5.         ((null lst)
  6.          (setq acc  (reverse (cons (list x) acc))
  7.                done T
  8.          )
  9.         )
  10.         ((> (+ x (apply '+ (car lst))) packSize)
  11.          (setq acc (cons (car lst) acc)
  12.                lst (cdr lst)
  13.          )
  14.         )
  15.         (T
  16.          (setq acc  (append (reverse (cons (cons x (car lst)) acc)) (cdr lst))
  17.                done T
  18.          )
  19.         )
  20.       )
  21.     )
  22.     acc
  23.   )
  24.   (foreach x (vl-sort source '>)
  25.     (setq result (insert x result))
  26.   )
  27. )
« Last Edit: December 06, 2014, 07:56:25 AM by gile »
Speaking English as a French Frog

gile

  • Water Moccasin
  • Posts: 2233
  • Marseille, France
A simpler C# implementation:

Code - C#: [Select]
  1.         private static List<List<double>> BinPacking(IEnumerable<double> source, double packSize)
  2.         {
  3.             var result = new List<List<double>>();
  4.             foreach (var item in source.OrderByDescending(x => x))
  5.             {
  6.                 var done = false;
  7.                 for (int i = 0; i < result.Count; i++)
  8.                 {
  9.                     var list = result[i];
  10.                     if (item + list.Sum() <= packSize)
  11.                     {
  12.                         list.Add(item);
  13.                         done = true;
  14.                         break;
  15.                     }
  16.                 }
  17.                 if (!done)
  18.                 {
  19.                     var list = new List<double>() { item };
  20.                     result.Add(list);
  21.                 }
  22.             }
  23.             return result;
  24.         }
Speaking English as a French Frog

Lee Mac

  • Seagull
  • Posts: 12283
  • London, England
Good stuff gile  :-)

A minor point, but I think:
Code - Auto/Visual Lisp: [Select]
  1. (loop x (cdr lst))

should be
Code - Auto/Visual Lisp: [Select]
  1. (insert x (cdr lst))

gile

  • Water Moccasin
  • Posts: 2233
  • Marseille, France
Oopss!...
Thanks Lee. Corrected now.
Speaking English as a French Frog

It's Alive!

  • BricsCAD
  • Needs a day job
  • Posts: 6956
  • AKA Daniel
How about a data set?

It's Alive!

  • BricsCAD
  • Needs a day job
  • Posts: 6956
  • AKA Daniel
double dbls[] ={ 80, 26, 57, 18, 8, 45, 16, 22, 29, 5, 11, 8, 27, 54, 13, 17, 21, 63, 14, 16, 45, 6, 32, 57, 24, 18, 27, 54, 35, 12, 43, 36, 72, 14, 28, 3, 11, 46, 27, 42, 59, 26, 41, 15, 41, 68};

Enter Bin size: 80
Test = TRUE
BinNum = 1, BinSize = 80.000000 (80.000000 )
BinNum = 2, BinSize = 80.000000 (45.000000 35.000000 )
BinNum = 3, BinSize = 80.000000 (54.000000 26.000000 )
BinNum = 4, BinSize = 80.000000 (54.000000 26.000000 )
BinNum = 5, BinSize = 80.000000 (59.000000 21.000000 )
BinNum = 6, BinSize = 80.000000 (63.000000 17.000000 )
BinNum = 7, BinSize = 80.000000 (68.000000 12.000000 )
BinNum = 8, BinSize = 80.000000 (27.000000 24.000000 18.000000 11.000000 )
BinNum = 9, BinSize = 80.000000 (72.000000 8.000000 )
BinNum = 10, BinSize = 80.000000 (45.000000 29.000000 6.000000 )
BinNum = 11, BinSize = 80.000000 (57.000000 18.000000 5.000000 )
BinNum = 12, BinSize = 79.000000 (43.000000 36.000000 )
BinNum = 13, BinSize = 79.000000 (57.000000 22.000000 )
BinNum = 14, BinSize = 79.000000 (41.000000 27.000000 11.000000 )
BinNum = 15, BinSize = 78.000000 (46.000000 32.000000 )
BinNum = 16, BinSize = 78.000000 (42.000000 28.000000 8.000000 )
BinNum = 17, BinSize = 78.000000 (16.000000 16.000000 15.000000 14.000000 14.000000 3.000000 )
BinNum = 18, BinSize = 68.000000 (41.000000 27.000000 )
BinNum = 19, BinSize = 13.000000 (13.000000 )

Lee Mac

  • Seagull
  • Posts: 12283
  • London, England
Still using the first-fit decreasing algorithm, some slightly shorter code, but slower than gile's variant:
Code - Auto/Visual Lisp: [Select]
  1. (defun binpack ( l s / a b c x )
  2.     (foreach x (vl-sort-i l '>)
  3.         (setq c nil
  4.               x (nth x l)
  5.               a (vl-member-if '(lambda ( b ) (cond ((<= (+ x (apply '+ b)) s)) ((not (setq c (cons b c)))))) b)
  6.               b (append (reverse c) (cons (cons x (car a)) (cdr a)))
  7.         )
  8.     )
  9. )
Code: [Select]
(setq l '(80 26 57 18 8 45 16 22 29 5 11 8 27 54 13 17 21 63 14 16 45 6 32 57 24 18 27 54 35 12 43 36 72 14 28 3 11 46 27 42 59 26 41 15 41 68)
      s  80
)
_$ (binpack l s)
((80) (8 72) (12 68) (17 63) (21 59) (22 57) (5 18 57) (26 54) (26 54) (32 46) (35 45) (6 29 45) (36 43) (8 28 42) (11 27 41) (11 27 41) (3 18 24 27) (14 14 15 16 16) (13))
_$ (length (binpack l s))
19

gile, beware of vl-sort if testing with integers  :wink:
« Last Edit: December 06, 2014, 07:10:55 PM by Lee Mac »

It's Alive!

  • BricsCAD
  • Needs a day job
  • Posts: 6956
  • AKA Daniel
here's my entry
Code - C: [Select]
  1. #include <map>
  2. #include <vector>
  3. #include <algorithm>
  4.  
  5. class BinKey;
  6. typedef std::vector<double> Bin;
  7. typedef std::multimap<BinKey,Bin> BinMap;
  8.  
  9. class BinKey
  10. {
  11. private:
  12.   double m_size;
  13.   bool m_isFull;
  14. public:
  15.   BinKey()
  16.     : m_size(0),m_isFull(false){}
  17.   BinKey(double val)
  18.     : m_size(val),m_isFull(false){}
  19.   bool operator<(const BinKey & rhs ) const
  20.   {
  21.     return this->size() > rhs.size();
  22.   }
  23.   double size() const { return m_size; }
  24.   bool isFull() const { return m_isFull; }
  25.   void isFull(bool val) { m_isFull = val; }
  26. };
  27.  
  28. class BinPacker
  29. {
  30. private:
  31.   Bin m_bin;
  32.   BinMap m_binMap;
  33.   const size_t m_binSize;
  34.  
  35. public:
  36.   BinPacker(const Bin &bin, size_t binSize) : m_bin(bin),m_binSize(binSize)
  37.   {
  38.   }
  39.  
  40.   ~BinPacker(void)
  41.   {
  42.   }
  43.  
  44.   void eval()
  45.   {
  46.     std::sort(m_bin.begin(), m_bin.end(),std::greater<double>());
  47.     double minVal = m_bin.back();
  48.  
  49.     for(auto vecIter = m_bin.begin(); vecIter != m_bin.end() ; ++vecIter)
  50.     {
  51.       if(m_binMap.size() == 0)
  52.         m_binMap.insert(std::make_pair(BinKey(),Bin()));
  53.  
  54.       bool erase = false;
  55.       BinMap::iterator lastIter;
  56.  
  57.       for(auto mapIter = m_binMap.begin(); mapIter != m_binMap.end(); ++mapIter)
  58.       {
  59.         const double siz = m_binSize - mapIter->first.size();
  60.         if(!mapIter->first.isFull() &&  siz >= *vecIter && *vecIter <= m_binSize)
  61.         {
  62.           lastIter = mapIter;
  63.           erase = true;
  64.           break;
  65.         }
  66.       }
  67.       if(erase)
  68.       {
  69.         BinKey newKey(lastIter->first.size()+*vecIter);
  70.         if(m_binSize - newKey.size() < minVal)
  71.           newKey.isFull(true);
  72.         auto thisIter = m_binMap.insert(std::make_pair(newKey,Bin()));
  73.         lastIter->second.push_back(*vecIter);
  74.         thisIter->second.swap(lastIter->second);
  75.         m_binMap.erase(lastIter);
  76.       }
  77.       else
  78.       {
  79.         if(*vecIter <=  m_binSize)
  80.         {
  81.           auto thisIter = m_binMap.insert(std::make_pair(BinKey(*vecIter),Bin()));
  82.           thisIter->second.push_back(*vecIter);
  83.         }
  84.       }
  85.     }
  86.   }
  87. };
  88.  

gile

  • Water Moccasin
  • Posts: 2233
  • Marseille, France
Nice, Daniel (even I'm not really able to read C).
I also thought of a way more OOP, but I did not go further because I thought it did not much compared to a simple method and I tend in these challenges, to choose conciseness.

Code - C#: [Select]
  1. using System.Collections.Generic;
  2. using System.Linq;
  3.  
  4. namespace BinPacking
  5. {
  6.     public class Bin
  7.     {
  8.         private double _size;
  9.         public double FreeSpace { get; private set; }
  10.         public List<double> Content { get; private set; }
  11.         public Bin(double size, double value)
  12.         {
  13.             _size = size;
  14.             FreeSpace = size - value;
  15.             Content = new List<double>() { value };
  16.         }
  17.         public bool TryInsert(double value)
  18.         {
  19.             if (value > FreeSpace)
  20.                 return false;
  21.             FreeSpace -= value;
  22.             Content.Add(value);
  23.             return true;
  24.         }
  25.     }
  26.  
  27.     public class BinPacker
  28.     {
  29.         private double _size;
  30.         public List<Bin> Content { get; private set; }
  31.         public BinPacker(IEnumerable<double> source, double size)
  32.         {
  33.             _size = size;
  34.             Content = new List<Bin>();
  35.             Fill(source.OrderByDescending(x => x));
  36.         }
  37.  
  38.         private void Fill(IOrderedEnumerable<double> source)
  39.         {
  40.             foreach (double item in source)
  41.             {
  42.                 bool inserted = false;
  43.                 foreach (Bin bin in Content)
  44.                 {
  45.                     if(bin.TryInsert(item))
  46.                     {
  47.                         inserted = true;
  48.                         break;
  49.                     }
  50.                 }
  51.                 if (!inserted)
  52.                 {
  53.                     Content.Add(new Bin(_size, item));
  54.                 }
  55.             }
  56.         }
  57.     }
  58. }
  59.  
Speaking English as a French Frog

Lee Mac

  • Seagull
  • Posts: 12283
  • 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: 12283
  • 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: 6045
Thanks again everyone for your input.

ymg

  • Swamp Rat
  • Posts: 725
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
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: 1542
  • 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)  :-(
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

ymg

  • Swamp Rat
  • Posts: 725
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

  • Swamp Rat
  • Posts: 725
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: 6045
Thanks guys these things will be on National Geographic.
  :-D