Have a play with this and see how you get on.
Update: Corrected error in output code to display [EMPTY] if a course ends up with no students. Uncommented and improved format of output.
#! perl -slw
use strict;
use List::Util qw[ shuffle max min reduce ];
our $SECTIONS ||= 15;
our $STUDENTS ||= 50;
our $MAXSECT ||= 20;
#srand( 1 );
## Gen some test data
my %sections = map{;
sprintf( "Section_%02d", $_ )
=>
{available => 0 }
} 0 .. $SECTIONS - 1;
my @sections = sort keys %sections;
my $n = $STUDENTS;
$sections{ $sections[ rand @sections ] }{ available }++
while $n--;
printf "Sections: %d \n\t%s\n", scalar keys %sections, join "\n\t",
map{ join " $_ =>", %{ $sections{ $_ } } } @sections;
my %students = map{
my $prefs = 1+int( rand $SECTIONS );
sprintf( "Student_%02d", $_ )
=>
[ ( shuffle( 0 .. $SECTIONS-1 ) )[ 0 .. $prefs-1 ] ]
} 0 .. $STUDENTS-1;
my @students = sort keys %students;
printf "Students: %d [%s\n]\n", scalar keys %students, join ', ',
map{ "\n\t$_\t[ @{ $students{ $_ } } ]" } @students;
my $maxChoices = max( map{ scalar @{ $students{ $_ } } } @students );
##
for my $choice ( 0 .. $maxChoices ) {
my $byChoice = reduce{
push @{ $a }, []
if defined $a->[ -1 ][ 0 ]
and ( $students{ $students[ $a->[ -1 ][ 0 ] ] }[ $choice ]
+||1e99 )
!= ( $students{ $students[ $b ] }[ $choice ]
+||1e99 ) ;
push @{ $a->[ -1 ] }, $b;
$a
} [[]], sort{
($students{ $students[ $a ] }[ $choice ]||99999)
<=>
($students{ $students[ $b ] }[ $choice ]||99999) ## By nth cho
+ice
or
@{ $students{ $students[ $a ] } }
<=>
@{ $students{ $students[ $b ] } } ## or number of
+choices
} 0 .. $#students;
my @allocated;
for my $chose ( @$byChoice ) {
next unless defined $students{ $students[ $chose->[ -1 ] ] }[
+$choice ];
my $section = sprintf "Section_%02d",
$students{ $students[ $chose->[ -1 ] ] }[ $choice ];
# print "Sect:$section; avail: $sections{ $section }{ available
+ }",
"\t[@{[ sort {$a<=>$b} @$chose ]}][@{[ sort {$a<=>$b} @alloc
+ated ]}]";
if( @$chose <= $sections{ $section }{ available } ) {
push @{ $sections{ $section }{ allocated } }, @students[ @
+$chose ];
$sections{ $section }{ available } -= @$chose;
push @allocated, @$chose;
# print "Alloc1: \t\t\t[@{[ sort {$a<=>$b} @$chose ]}]",
"[@{[ sort {$a<=>$b} @allocated ]}]";
next;
}
my @lastChoice = grep{
$#{ $students{ $students[ $_ ] } } == $choice
} @$chose;
# print "lastchoice: \t\t[@lastChoice]";
if( @lastChoice
and @lastChoice <= $sections{ $section }{ available }
) {
push @{ $sections{ $section }{ allocated } },
@students[ @lastChoice ];
$sections{ $section }{ available } -= @lastChoice;
@{ $chose } = grep{
my $allocated = $_;
!grep{ $_ == $allocated } @lastChoice
} @$chose;
push @allocated, @lastChoice;
# print "Alloc2: \t\t\t[@{[ sort {$a<=>$b} @$chose ]}]",
"[@{[ sort {$a<=>$b} @allocated ]}]";
}
if( @$chose and $sections{ $section }{ available } ) {
my @random = ( shuffle( @$chose ) )
[ 0 .. $sections{$section}{available} -1 ];
push @{ $sections{ $section }{ allocated } }, @students[ @
+random ];
$sections{ $section }{ available } = 0;
@{ $chose } = grep{
my $allocated = $_;
!grep{ $_ == $allocated } @random
} @$chose;
push @allocated, @random;
# print "Alloc3: \t\t\t[@{[ sort {$a<=>$b} @$chose ]}]",
"[@{[ sort {$a<=>$b} @allocated ]}]";
}
}
delete @students[ @allocated ];
@students = grep{ defined } @students;
# print "left: @students";
last unless @students;
}
print "$_($sections{ $_ }{ available }) => ", ref $sections{ $_ }{ all
+ocated }
? "[ @{ $sections{ $_ }{ allocated } } ]"
: "[EMPTY]"
for sort keys %sections;
print "\nUnallocated; [@students]";
Output:
[16:10:52.01] P:\test>411129 -STUDENTS=50 -SECTIONS=15
Sections: 15
available Section_00 =>2
available Section_01 =>3
available Section_02 =>1
available Section_03 =>3
available Section_04 =>9
available Section_05 =>3
available Section_06 =>3
available Section_07 =>5
available Section_08 =>3
available Section_09 =>2
available Section_10 =>6
available Section_11 =>1
available Section_12 =>2
available Section_13 =>5
available Section_14 =>2
Students: 50 [
Student_00 [ 6 14 8 10 1 3 2 13 5 12 4 ],
Student_01 [ 6 0 7 13 4 9 14 1 3 2 8 ],
Student_02 [ 11 10 9 ],
Student_03 [ 13 14 4 2 12 3 8 11 5 7 9 6 1 0 ],
Student_04 [ 11 3 9 ],
Student_05 [ 4 13 0 1 9 11 6 8 7 14 5 12 3 ],
Student_06 [ 5 13 9 10 7 0 ],
Student_07 [ 0 9 11 6 5 12 ],
Student_08 [ 5 ],
Student_09 [ 4 ],
Student_10 [ 3 6 1 0 12 8 13 14 5 10 9 4 2 11 7 ],
Student_11 [ 5 14 ],
Student_12 [ 0 11 2 6 10 8 9 1 7 12 5 14 3 ],
Student_13 [ 4 2 9 14 3 7 12 ],
Student_14 [ 4 3 2 6 13 0 14 12 7 9 10 5 ],
Student_15 [ 2 8 10 13 12 7 3 0 6 ],
Student_16 [ 6 11 1 3 7 2 5 0 12 10 ],
Student_17 [ 6 3 13 10 7 0 5 9 14 1 11 2 ],
Student_18 [ 0 7 11 12 9 1 13 4 3 14 6 8 5 2 10 ],
Student_19 [ 14 9 13 12 3 2 7 1 10 8 4 5 ],
Student_20 [ 0 13 8 3 4 6 11 1 12 10 9 5 7 14 2 ],
Student_21 [ 6 0 ],
Student_22 [ 4 6 12 2 7 1 3 ],
Student_23 [ 0 ],
Student_24 [ 2 9 1 13 5 0 12 3 11 8 4 7 10 6 ],
Student_25 [ 9 6 11 12 ],
Student_26 [ 13 7 8 10 12 11 4 ],
Student_27 [ 9 11 8 10 13 ],
Student_28 [ 14 0 4 8 10 9 13 3 6 2 5 7 12 1 11 ],
Student_29 [ 3 10 0 8 4 ],
Student_30 [ 2 5 14 13 12 1 10 0 7 8 4 9 3 ],
Student_31 [ 3 ],
Student_32 [ 1 14 0 9 ],
Student_33 [ 2 3 8 13 4 12 5 10 7 6 0 14 1 11 ],
Student_34 [ 7 12 9 11 13 10 1 2 14 8 5 6 3 ],
Student_35 [ 6 11 ],
Student_36 [ 1 4 8 11 ],
Student_37 [ 12 13 1 11 0 ],
Student_38 [ 0 7 14 5 13 ],
Student_39 [ 14 6 2 11 0 12 4 3 5 8 13 10 7 9 1 ],
Student_40 [ 13 0 14 4 1 8 10 6 9 11 12 2 5 7 3 ],
Student_41 [ 9 0 13 ],
Student_42 [ 3 2 5 11 8 13 10 14 4 ],
Student_43 [ 1 3 2 13 8 10 4 11 0 ],
Student_44 [ 0 7 ],
Student_45 [ 8 9 12 10 4 6 2 11 13 0 ],
Student_46 [ 8 3 6 0 4 ],
Student_47 [ 7 5 4 9 13 ],
Student_48 [ 8 1 7 14 4 6 11 3 10 ],
Student_49 [ 6 0 5 13 12 8 ]
]
Section_00(0) => [ Student_23 Student_44 ]
Section_01(0) => [ Student_32 Student_36 Student_43 ]
Section_02(0) => [ Student_15 ]
Section_03(0) => [ Student_31 Student_29 Student_10 ]
Section_04(2) => [ Student_09 Student_13 Student_22 Student_14 Student
+_05 Student_39 Student_24 ]
Section_05(0) => [ Student_08 Student_11 Student_06 ]
Section_06(0) => [ Student_17 Student_49 Student_01 ]
Section_07(0) => [ Student_47 Student_34 Student_38 Student_18 Student
+_16 ]
Section_08(0) => [ Student_46 Student_48 Student_45 ]
Section_09(0) => [ Student_27 Student_41 ]
Section_10(2) => [ Student_00 Student_12 Student_42 Student_30 ]
Section_11(0) => [ Student_02 ]
Section_12(0) => [ Student_37 Student_25 ]
Section_13(0) => [ Student_26 Student_03 Student_40 Student_20 Student
+_33 ]
Section_14(0) => [ Student_19 Student_28 ]
Unallocated; [Student_04 Student_07 Student_21 Student_35]
Examine what is said, not who speaks.
"But you should never overestimate the ingenuity of the sceptics to come up with a counter-argument." -Myles Allen
"Think for yourself!" - Abigail
"Time is a poor substitute for thought"--theorbtwo
"Efficiency is intelligent laziness." -David Dunham
"Memory, processor, disk in that order on the hardware side. Algorithm, algorithm, algorithm on the code side." - tachyon