#! 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@reqs\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 @{$_} ] } @solutions;
printf "%-50s %30s = %d\n"
	, "@{$_}"
	, "@table{ @{$_} }"
	, do{ my $t=0; $t += $_ for @table{ @{$_} }; $t; }
		for @solutions[0 .. 19];

print scalar localtime, $/;