Perl-Sensitive Sunglasses PerlMonks

### Re: Bin packing problem variation repost (see[834245])

by choroba (Chancellor)
 on Apr 17, 2010 at 15:22 UTC ( #835256=note: print w/replies, xml ) Need Help??

After reading jethro's reply, I tried kind of a random solution. It is far from complete, but at least finds a solution to this particular problem :)

```use strict;
use warnings;

use POSIX qw(ceil floor);

my \$show_steps = 0;

my \$min = 840;
my \$max = 900;

my \$deadlock_rand = 5; # how often random groups are selected
my \$tuplet_rand = 10;  # how often a tuplet is selected even if not op
+timal

my @a = qw(
121 182 111 160 105 113 121 97 123 157 133 161 141 135 137 145
133 137 151 118 126 141 174 181 154 109 198 114 122 162 91 99
116 122 195 199 150 192 163 88 112 157 182 210 124 105 144 166
144 257 164 156 173 154 193 142 143 126 118 130 107 86 131 154
131 147 134 118 115 135 141 158 129 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 177 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
);

sub num { \$a <=> \$b }

@a = sort num @a;
my \$sum = 0;
\$sum += \$_ foreach @a;

my \$mingroupcount = ceil \$sum/\$max;
my \$maxgroupcount = floor \$sum/\$min;
# print <<"%%";
# min group count: \$mingroupcount
# max group count: \$maxgroupcount
# %%

my %groups;

## Fill the groups somehow for start.
my \$i = 0;
foreach my \$a(@a){
\$i++;
\$i = 0 if \$i > \$mingroupcount;
push @{ \$groups{\$i}{list} },\$a;
}

sub gsum {
my \$gsum = 0;
\$gsum += \$_ foreach @_;
return \$gsum;
} # gsum

foreach my \$gid (keys %groups){
\$groups{\$gid}{sum} = gsum(@{\$groups{\$gid}{list}});
}

my (\$minsum,\$maxsum,\$largest_gid,\$smallest_gid);
(\$minsum,\$maxsum) = (\$max,\$min);
foreach my \$gid (keys %groups){
if(\$groups{\$gid}{sum} < \$minsum){
\$minsum = \$groups{\$gid}{sum};
\$smallest_gid = \$gid;
}
if(\$groups{\$gid}{sum} > \$maxsum){
\$maxsum = \$groups{\$gid}{sum};
\$largest_gid = \$gid;
}
}

my \$steps = 0;

until (\$minsum >= \$min and \$maxsum <= \$max) {

\$smallest_gid = int(rand(scalar keys %groups));
while (\$largest_gid == \$smallest_gid){
\$largest_gid = int(rand(scalar keys %groups));
}
\$minsum = \$groups{\$smallest_gid}{sum};
\$maxsum = \$groups{\$largest_gid}{sum}
}

my @delta = sort num (\$min-\$minsum,\$maxsum-\$max);
#   print "[@delta] ";

## Find candidates to make both selected groups better (in most
## cases, randomly you can do whatever)
my @tuples;
foreach my \$big (@{ \$groups{\$largest_gid}{list} }){
foreach my \$small (@{ \$groups{\$smallest_gid}{list} }){
my \$delta = \$big-\$small;
#       print "(\$delta) ";
push @tuples,[\$small,\$big] if (\$delta > \$delta[0] and \$delta < \$
+delta[1])
or rand(100)<\$tuplet_rand;
}
}
#   print "\n";

## Switch the two selected members of the two groups.
if(@tuples){
\$steps++;
my \$tuple = \$tuples[rand(\$#tuples)];
push @{ \$groups{\$smallest_gid}{list} },\$tuple->[1];
push @{ \$groups{\$largest_gid}{list} },\$tuple->[0];

my \$delete = 0;
while (@{ \$groups{\$smallest_gid}{list} }[\$delete] != \$tuple->[0]){
\$delete++;
}
my @newlist;
for(my \$i=0;\$i<@{ \$groups{\$smallest_gid}{list} };\$i++){
push @newlist,@{ \$groups{\$smallest_gid}{list} }[\$i]
unless \$i == \$delete;
}
@{ \$groups{\$smallest_gid}{list} } = @newlist;

\$delete = 0;
while (@{ \$groups{\$largest_gid}{list} }[\$delete] != \$tuple->[1]){
\$delete++;
}
@newlist=();
for(my \$i=0;\$i<@{ \$groups{\$largest_gid}{list} };\$i++){
push @newlist,@{ \$groups{\$largest_gid}{list} }[\$i]
unless \$i == \$delete;
}
@{ \$groups{\$largest_gid}{list} } = @newlist;
\$groups{\$largest_gid}{sum} = gsum(@{ \$groups{\$largest_gid}{list} }
+);
\$groups{\$smallest_gid}{sum} = gsum(@{ \$groups{\$smallest_gid}{list}
+ });
}

#   foreach my \$gid(keys %groups){
#     print \$groups{\$gid}{sum}," ";
#   }

## Find the group with smallest and greatest sum
(\$minsum,\$maxsum) = (\$max,\$min);
foreach my \$gid (keys %groups){
if(\$groups{\$gid}{sum} < \$minsum){
\$minsum = \$groups{\$gid}{sum};
\$smallest_gid = \$gid;
}
if(\$groups{\$gid}{sum} > \$maxsum){
\$maxsum = \$groups{\$gid}{sum};
\$largest_gid = \$gid;
}
}

#   print "\n  \$minsum \$maxsum\n\n";

if(\$show_steps){
foreach my \$gid (keys %groups) {
print "  \$steps: ",\$groups{\$gid}{sum}," [";
print join',',sort num @{\$groups{\$gid}{list}};
print "]\n";
}
print "\n";
}
}

# print "\nFinished\n";
print "Steps: \$steps\n";
foreach my \$gid(keys %groups){
print \$groups{\$gid}{sum}," [";
print join',',sort num @{\$groups{\$gid}{list}};
print "]\n";
}

And one of the solutions:

```840 [103,118,130,143,158,188]
840 [88,261,154,123,116,98]
841 [156,181,139,126,112,127]
842 [165,134,135,124,116,168]
842 [174,112,162,107,146,141]
842 [89,124,137,152,173,167]
844 [182,155,122,137,126,122]
846 [103,118,130,143,160,192]
846 [113,124,136,151,171,151]
847 [103,118,130,143,160,193]
847 [177,141,136,97,139,157]
848 [203,117,149,109,129,141]
849 [115,140,156,180,92,166]
850 [142,177,134,111,122,164]
850 [95,126,139,177,147,166]
853 [103,120,131,144,160,195]
853 [216,96,147,99,141,154]
854 [99,210,114,111,133,187]
855 [105,120,131,144,160,195]
855 [128,199,133,158,138,99]
856 [113,124,152,150,167,150]
856 [296,99,117,113,115,116]
858 [105,121,131,144,161,196]
858 [112,123,135,311,86,91]
860 [154,111,257,114,98,126]
860 [182,114,135,157,115,157]
861 [105,121,132,145,161,197]
862 [153,173,122,122,129,163]
862 [198,150,126,132,135,121]
863 [105,121,132,145,162,198]
863 [183,109,172,148,122,129]

Update 1: The code sometimes gives no output, entering an endless loop. Most of the times, though, it finds a solution.

Update 2: To overcome the deadlock, you can randomly pick some other group instead of the largest/smallest, i.e. change the code at the end of the loop to something like this:

```  (\$minsum,\$maxsum) = (\$max,\$min);
foreach my \$gid (keys %groups){
if(\$groups{\$gid}{sum} < \$minsum and rand(100)<99){
\$minsum = \$groups{\$gid}{sum};
\$smallest_gid = \$gid;
}
if(\$groups{\$gid}{sum} > \$maxsum and rand(100)<99){
\$maxsum = \$groups{\$gid}{sum};
\$largest_gid = \$gid;
}
}

Update 3: Code updated to handle the random escapes from the deadlock.

Create A New User
Node Status?
node history
Node Type: note [id://835256]
help
Chatterbox?
 [Corion]: choroba: Ooooh - I didn't think of that! I write my presentations as POD and if it "roughly" looks like Perl code, I should also syntax-check that... [haukex]: Yes sorry I don't run them all the time, my POD tests are only run as author tests (and are excluded when I'm using Devel::Cover) [Corion]: choroba: Hmm - no, I keep the snippets inline, but as my framework also has support for capturing output etc., maybe I should do the same... [Corion]: haukex: Yes, that approach is sane, and it heals the fragility of Pod parsers in a nice way while still syntax-checking stuff [choroba]: Unfortunately, none of it is online [haukex]: I figured that POD tests make sense, but only as author tests [choroba]: I mean, the slides are, but not the makefile with scripts to create them [Corion]: haukex: I've only now arrived at that revelation ;) [Corion]: choroba: I use spod5, which also has that support, and also implements its own kinda-make stuff [haukex]: But that module I just linked to assumes that most verbatim blocks are runnable code, I have other modules where that's not the case, so there I just copy-and-paste the synopsis into the author tests...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (10)
As of 2017-02-27 12:27 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
Before electricity was invented, what was the Electric Eel called?

Results (385 votes). Check out past polls.