Pathologically Eclectic Rubbish Lister PerlMonks

### The Best fit by capacity of Box

by Gerryjun (Scribe)
 on Jan 12, 2003 at 06:00 UTC Need Help??
Gerryjun has asked for the wisdom of the Perl Monks concerning the following question:

Hello! I would like some help on logic on how to approach my problem! My problem is I have a database of schools with each having a requirement of books!

School Name - Number of Book

now I need to sort this Schools as much as possible in alphabetical order and best fit them in a 400 capacity box of books!

Replies are listed 'Best First'.
Re: The Best fit by capacity of Box
by BrowserUk (Pope) on Jan 12, 2003 at 06:56 UTC

This will allocate the books to schools in alphabetic order, skipping over any that need more than are left once their position is reached. How you would deal with any left unallocated at the end depends upon your needs.

If however, you want to try and skip an earlier large need because two later smaller ones would allow you to allocated the 400 exactly (or more exactly) then you are into what I believe is called a 'NP-complete problem'. Which is to say, you would probably need to try all the possible combinations (or is that permutations? I can never remember) in order to come to a descision as to which of them is the "Best fit". If this is the case, then say so, and we can help you

```#! perl -slw
use strict;

my %table;
my \$n=0;
for my \$c ('A' .. 'Z') {
\$table{ +sprintf '%s%03d', \$c, ++\$n } = int(10+rand 100);
}

my \$allocated = 0;
for my \$school (sort keys %table) {
my \$needed = \$table{\$school};
next if \$allocated + \$needed > 400;
print "\$school:\$needed";
last if (\$allocated += \$needed) >= 400;
}
print 'Total allocated: ', \$allocated;

__DATA__
c:\test>226210
A001:107
B002:72
C003:15
D004:59
E005:106
O015:34
Total allocated: 393

Examine what is said, not who speaks.

The 7th Rule of perl club is -- pearl clubs are easily damaged. Use a diamond club instead.

Re: The Best fit by capacity of Box
by BrowserUk (Pope) on Jan 12, 2003 at 12:22 UTC

As it is an interesting problem to solve, I had a go at finding the exact fit solutions.

The code below will handle up 31 schools. Actually it will handle 31 unique values which means it would handle more schools if any of them have the same requirements. It would probably handle more if you used Math::BigInt in the appropriate places, but the resultant slowdown would probably make it painful to use.

As it it, it solves 20 unique values in around 2 minutes and 23 in around 16 minutes. I haven't tried it on 31, as I think it would take many hours. I guess I ought to be able to estimate it, but my brain has given up for now.

```#! perl -sw
use strict;
use Data::Dumper;

sub listm{ grep{ \$_[0] & (1 << \$_) }0 .. 31 }

#! build test data
my %table;
my \$n=0;
for my \$c ('A' .. 'T') {
\$table{ +sprintf '%s%03d', \$c, ++\$n } = int(20+rand 100);
}
print Dumper \%table, \$/;

print scalar localtime, \$/;
#! Invert table
my %reqs;
while (my (\$key, \$value)= each %table) {
push @{\$reqs{\$value}}, \$key;
}

#print Dumper \%reqs, \$/;

#! get array of unique requirements
my @reqs = keys %reqs;
print 'checking permutations of ', scalar @reqs, " unique values\n@req
+s\n\n";

#! test the permutations and capture those with a \$total <= 400
my (\$perms, @ok) = (0);
for my \$perm (1 .. (2 ** @reqs)-1 ) {
\$perms++;
my \$total = 0;
\$total += \$_ for @reqs[ listm(\$perm) ];
next if \$total > 400;
push @ok, [\$total, @reqs[ listm(\$perm) ] ];
#    print \$total, ' : ', do{local \$"='|'; "@{[ @reqs[ listm(\$perm)] ]
+}";}; #!"
}
print 'Checked ', \$perms, ' possible permutations', \$/;
#! sort the possible solutions
@ok = sort{ \$b->[0] <=> \$a->[0] } @ok;

#! check for one (or more) complete solutions
my \$count=0;
1 while \$ok[\$count++][0] == 400;
print 'There are at least ', --\$count, ' complete solutions', \$/;

#! Generate solutions.
my @solutions;
for my \$sol (0 .. \$count-1) {
my @n = [];
for my \$val ( @{ \$ok[\$sol] }[ 1..\$#{\$ok[\$sol]} ] ) {
my \$schools = @{\$reqs{\$val}};
if (\$schools > 1) {
my @m = @n;
@n = map{
my \$school = \$_;
map{ [ @{\$_}, \$school ] } @m
} @{\$reqs{\$val}};
}
else {
push @{\$_}, @{ \$reqs{\$val} }[0] for @n;
}
}
push @solutions, @n;
}
print 'There are actually ', scalar @solutions, ' possible solutions.
+Alpha-sorted, the first 20 are:', \$/;
@solutions = sort{ "@{\$a}" cmp "@{\$b}" } map { [ sort @{\$_} ] } @solut
+ions;
printf "%-50s %30s = %d\n"
, "@{\$_}"
, "@table{ @{\$_} }"
, do{ my \$t=0; \$t += \$_ for @table{ @{\$_} }; \$t; }
for @solutions[0 .. 19];

print scalar localtime, \$/;

Some sample output

Maybe you will find it useful.

Examine what is said, not who speaks.

The 7th Rule of perl club is -- pearl clubs are easily damaged. Use a diamond club instead.

Re: (nrd) The best fit by capacity of box
by newrisedesigns (Curate) on Jan 12, 2003 at 14:59 UTC

Are the books all the same size? Do each of the schools order at least 400 books?

If not, I'd buy some different boxes.

Sort them by amount, divide each amount by 400. (If the box has a capacity of 400 books, odds are the manufacturer has a schmatic on how they would fit.) Put them in boxes. Put the leftovers in smaller boxes. Ship them out. Good luck.

Also... the books where shipped to you, right? Well, then why don't you use the original boxes? That would potentially save some book-to-box packing time and you'd be recycling.

John J Reiser
newrisedesigns.com

Re: The Best fit by capacity of Box
by osama (Scribe) on Jan 12, 2003 at 09:32 UTC

• Do you have only 400 of each book? or Do you want to send each school 400 books in each box??? you are not clear.
• How many books does each school need (as many as you can give them??)

if 1st choice (400 of each book):

I propose for each book (\$qty=400?)
1. Get number of schools needing it \$n
2. min books per school \$bps= int(\$qty/\$n);
3. get extra books \$extra=\$qty-\$bps*\$n;
4. give 1 extra book to schools (start alphabetically)

if 2nd choice (400 books/box, many boxes/school):

I think yu could probably use statistics... evaluate the needs of each school.... do you need an exact solution? do you have time to bruteforce it?

Create A New User
Node Status?
node history
Node Type: perlquestion [id://226210]
Approved by grinder
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (7)
As of 2018-04-19 11:49 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
My travels bear the most uncanny semblance to ...

Results (73 votes). Check out past polls.

Notices?