#! 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]";