in reply to Bin packing problem variation repost (see[834245])

Not sure if the naïve approach is "Good Enough", but here it is for reference. I sort the list; pack one item into each bin (of 31); then reverse the bins for the next pass, thus hoping to balance out the weight.

Results:

Bin 1 (946): 311 151 151 124 123 86 Bin 2 (933): 296 152 150 124 123 88 Bin 3 (898): 261 152 150 124 122 89 Bin 4 (897): 257 153 150 124 122 91 Bin 5 (859): 216 154 149 126 122 92 Bin 6 (855): 210 154 148 126 122 95 Bin 7 (848): 203 154 147 126 122 96 Bin 8 (846): 199 155 147 126 122 97 Bin 9 (845): 198 156 146 126 121 98 Bin 10 (845): 198 156 145 127 121 98 Bin 11 (847): 197 157 145 128 121 99 Bin 12 (846): 196 157 144 129 121 99 Bin 13 (844): 195 157 144 129 120 99 Bin 14 (845): 195 158 144 129 120 99 Bin 15 (845): 193 158 143 130 118 103 Bin 16 (846): 192 160 143 130 118 103 Bin 17 (842): 188 160 143 130 118 103 Bin 18 (840): 187 160 142 131 117 103 Bin 19 (837): 183 160 141 131 117 105 Bin 20 (836): 182 161 141 131 116 105 Bin 21 (837): 182 161 141 132 116 105 Bin 22 (837): 181 162 141 132 116 105 Bin 23 (836): 180 162 140 132 115 107 Bin 24 (836): 177 163 139 133 115 109 Bin 25 (837): 177 164 139 133 115 109 Bin 26 (840): 177 165 139 134 114 111 Bin 27 (837): 174 166 138 134 114 111 Bin 28 (836): 173 166 137 135 114 111 Bin 29 (837): 173 167 137 135 113 112 Bin 30 (835): 172 167 136 135 113 112 Bin 31 (835): 171 168 136 135 113 112

And the code:

#!/usr/bin/perl use strict; use warnings; use 5.010; use POSIX 'ceil'; use List::Util 'sum'; my @a = sort { $b <=> $a } qw( 121 182 111 160 105 113 121 97 123 157 133 161 141 135 137 145 133 1 +37 151 118 126 141 174 181 154 109 198 114 122 162 91 99 116 122 195 19 +9 150 192 163 88 112 157 182 210 124 105 144 166 144 257 164 156 173 154 1 +93 142 143 126 118 130 107 86 131 154 131 147 134 118 115 135 141 158 1 +29 143 126 128 134 129 167 130 135 117 127 146 96 117 99 99 139 152 149 + 136 105 124 136 160 160 139 177 115 123 103 150 183 132 171 121 114 111 +113 131 144 122 141 111 139 145 109 114 122 103 160 153 147 172 155 122 +296 124 112 161 124 311 99 157 122 120 198 152 140 162 177 98 138 156 17 +7 103 180 187 173 150 135 168 132 196 112 195 126 113 116 105 116 151 216 +188 158 121 166 148 132 89 197 92 115 98 130 103 120 261 143 126 167 203 + 95 165 129 ); my $bins = pack_n( ceil(@a/6), \@a ); show_bins( $bins ); sub pack_n { my ($n, $data) = @_; my @bins; my $i = 0; my $delta = 1; for (@$data) { push @{$bins[$i]}, $_; $i += $delta; if ($i >= $n) { $i = $#bins; $delta = -1; } elsif ($i < 0) { $i = 0; $delta = 1; } } return \@bins; } sub show_bins { my $bins = shift; my $i = 1; for (@$bins) { my $size = sum @$_; say "Bin $i ($size): @$_"; $i++; } }

Good Day,
    Dean

Replies are listed 'Best First'.
Re^2: Bin packing problem variation repost (see[834245])
by BrowserUk (Patriarch) on Apr 15, 2010 at 14:18 UTC

    I haven't run your code, but as I see no reference to either 840 or 900 within it, I somehow think you missed some of the requirements?


    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.

      Here's some code using randomizations and a modified "best fit" algorithm. It enforces the 900 cap, but still ignores the 840 minimum (mostly out of necessity). The naïve approach above has better load balance than I have been able to achieve here (and is also simpler and faster).

      Update: Added some more packing algorithms (though, "next fit" and "worst fit" are unlikely to produce any results)

      #!/usr/bin/perl use strict; use warnings; use 5.010; use POSIX 'ceil'; use List::Util qw/ sum shuffle min /; my @a = sort { $b <=> $a } qw( 121 182 111 160 105 113 121 97 123 157 133 161 141 135 137 145 133 1 +37 151 118 126 141 174 181 154 109 198 114 122 162 91 99 116 122 195 19 +9 150 192 163 88 112 157 182 210 124 105 144 166 144 257 164 156 173 154 1 +93 142 143 126 118 130 107 86 131 154 131 147 134 118 115 135 141 158 1 +29 143 126 128 134 129 167 130 135 117 127 146 96 117 99 99 139 152 149 + 136 105 124 136 160 160 139 177 115 123 103 150 183 132 171 121 114 111 +113 131 144 122 141 111 139 145 109 114 122 103 160 153 147 172 155 122 +296 124 112 161 124 311 99 157 122 120 198 152 140 162 177 98 138 156 17 +7 103 180 187 173 150 135 168 132 196 112 195 126 113 116 105 116 151 216 +188 158 121 166 148 132 89 197 92 115 98 130 103 120 261 143 126 167 203 + 95 165 129 ); my $MAX_ITEMS = 6; my $bins = try_hard( ceil(@a/6), 900, \@a, \&pack_best_fit, 5000 ); show_bins( $bins ); sub min_bin { min(map sum(@$_), @{$_[0]}) } sub show_bins { my $bins = shift; my $i = 1; for (@$bins) { my $size = sum @$_; say "Bin $i ($size): @$_"; $i++; } } sub try_hard { my ($bins, $size, $data, $sub, $attempts) = @_; my $best; my $max; for (1..$attempts) { my $new = $sub->($bins, $size, $data); next unless @$new == $bins; my $test = min_bin($new); next if $max and $test <= $max; $best = $new; $max = $test; } continue { @$data = shuffle @$data } return $best; } sub pack_best_fit { my ($n, $size, $data) = @_; my @bins = map [], 1..$n; our @free = map $size, 1..$n; for my $item (@$data) { my $i = [-1, 1+$size]; for (0..$#free) { next unless $free[$_] >= $item and @{$bins[$_]} < $MAX_ITEMS; @$i = ($_, $free[$_]) if $free[$_] < $$i[1]; } $i = $$i[0]; if ($i >= 0) { push @{$bins[$i]}, $item; $free[$i] -= $item; } else { push @bins, [$item]; push @free, $size-$item; } } return \@bins; } sub pack_next_fit { my ($n, $size, $list) = @_; my @bins = ([]); my $free = $size; for my $item (@$list) { if ($free >= $item and @{$bins[-1]} < $MAX_ITEMS) { push @{$bins[-1]}, $item; $free -= $item; } else { push @bins, [$item]; $free = $size-$item; } } return \@bins; } sub pack_first_fit { my ($n, $size, $list) = @_; my @bins = ([]); my @free = ($size); for my $item (@$list) { my $i; for (0..$#free) { if ($free[$_] >= $item and @{$bins[$_]} < $MAX_ITEMS) { $i = $_; last; } } if (defined $i) { push @{$bins[$i]}, $item; $free[$i] -= $item; } else { push @bins, [$item]; push @free, $size-$item; } } return \@bins; } sub pack_worst_fit { my ($n, $size, $data) = @_; my @bins = map [], 1..$n; our @free = map $size, 1..$n; for my $item (@$data) { my $i = 0; for (1..$#free) { $i = $_ if $free[$_] > $free[$i]; } if ($free[$i] >= $item and @{$bins[$i]} < $MAX_ITEMS) { push @{$bins[$i]}, $item; $free[$i] -= $item; } else { push @bins, [$item]; push @free, $size-$item; } } return \@bins; }

      Good Day,
          Dean

      No, I saw those. I just chose to ignore them :) ... In particular, I did some additional tests using randomization with the traditional bin packing algorithms and found that the less-packed bins were typically filled to only 760 or so. Additionally, since sum(@a)/31 = 851.7, strictly enforcing the 840-900 limits is difficult/unlikely. Thus, I took the 840-900 limits to really mean "as balanced as possible", hence my solution.

      Good Day,
          Dean