#! 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 choice
    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} @allocated ]}]";
        
        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{ $_ }{ allocated }
    ? "[ @{ $sections{ $_ }{ allocated } } ]"
    : "[EMPTY]"
    for sort keys %sections;

print "\nUnallocated; [@students]";

##</code><code>##

[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]