#!/usr/bin/perl use strict; use warnings; use Data::Dumper; 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 ); # count the sum of all numbers in a and derive from that the minimum and maximum number of packs my $sum; $sum+= $_ for @a; my $minimum= int(($sum-1)/900)+1; my $maximum= int($sum/840); print "Sum is $sum, minimal $minimum packs, maximal $maximum packs\n"; die "No solution possible\n" if ($maximum<1); # put numbers into packs (an array of arrays) without looking much at correctness my @packs=[]; my @packsum; while (@a) { $_= shift @a; push @{$packs[$#packs]}, $_; $packsum[$#packs]+= $_; if ($packsum[$#packs]>840 and @a) { push @packs, []; } } # print Dumper(\@packs,\@packsum); # now the loop with optimization and destruction my $steps; my $wanttogrow=0; while (1) { # if not enough packs, remove values from other packs to create a new one while (@packs<$minimum) { grow_another_pack(\@packs,\@packsum); } # too much packs can't happen, we avoid this #switch two numbers, if possible between an overfilled pack and an underfilled pack optimized_switching(\@packs,\@packsum); if (finished(\@packsum)) { last }; # if we did lots of incremental optimization without success, turn to destruction $steps++; if ($wanttogrow) { if (@packs==$maximum) { $wanttogrow= 0; } else { grow_another_pack(\@packs,\@packsum); } } else { if (@packs==$minimum) { $wanttogrow= 1; } else { remove_a_pack(\@packs,\@packsum); } } #just randomly switch some numbers, check for success even though unlikely if (random_switching(\@packs,\@packsum)) { last }; if (finished(\@packsum)) { last }; }