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]";
[download]

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

Thanks for the post, Sorry for my late reply -- works been busy, and my "client" (aka: my girlfriend) has been too busy grading finals to discuss how she really wants it to work, and what kind of "scoring" she wants to apply to permutations.

Your approach is really cool (that reduce call is psycho by the way) but it doesn't seem to do very well in some simple cases.

By iterating over "0 .. $maxChoices" at the core, and assigning people to sections as early as it can, it produces a lot of solutions in which people are left out of sections, even if another solution exists in which they do get into a section at the expense of someone else getting their second choice instead of their first. (It's definitely important to pay attention to people's prefrences, but a solution in which everyone gets their last choice is definitely better then a solution in which 90% of people get their first choice, and the other 10% don't get anything)...

Read more... (2 kB)

Unfortunately, I don't see an easy way to fix this. A "try it several times and pick the best run" won't do much good, since randomness isn't even a factor in these problem cases (the "Alloc1" and "Alloc2" allocations are deterministic)

Thoughts?

Thoughts?

Yes. You need a Jiggle® :)

1. For each unallocated student's choices
2. For each student currently allocated to that choice.
3. For each of their alternate choices
4. If that alternate has spaces
5. Swap the unallocated student with the allocated student, and assign the previously placed student into the section with places available.
6. Repeat until everyone is allocated; or you gave it your best shot.

Of course, that doesn't guarentee a solution, but it seems to do remarkably well if a solution is possible.

I couldn't reproduce your exact example (without hard coding it) but I found a couple of similar one that the above Jiggle solves:

[ 7:13:08.03] P:\test>411129.pl -STUDENTS=5 -SECTIONS=3 -R=473
Use of uninitialized value in sprintf at P:\test\411129.pl line 121.
!473!
Sections: 3
        available Section_000 =>2
        available Section_001 =>2
        available Section_002 =>1
Students: 5 [
        Student_000     [ 1 2 ],
        Student_001     [ 2 ],
        Student_002     [ 0 ],
        Student_003     [ 0 2 1 ],
        Student_004     [ 2 0 ]
]

Unallocated after main pass; [Student_004]
Sections with places: [Section_001]

looking at placed student Student_002
looking at placed student Student_003
moved Student_003 to Section_001 and put Student_004 in Section_000


Unallocated after one-level jiggle(TM); []
Section_000(0) => [ Student_004 Student_002 ]
Section_001(0) => [ Student_000 Student_003 ]
Section_002(0) => [ Student_001 ]

[ 7:27:12.45] P:\test>411129.pl -STUDENTS=5 -SECTIONS=3 -R=114
Use of uninitialized value in sprintf at P:\test\411129.pl line 121.
!114!
Sections: 3
        available Section_000 =>2
        available Section_001 =>2
        available Section_002 =>1
Students: 5 [
        Student_000     [ 1 2 0 ],
        Student_001     [ 0 ],
        Student_002     [ 2 1 ],
        Student_003     [ 0 2 1 ],
        Student_004     [ 0 2 ]
]

Unallocated after main pass; [Student_004]
Sections with places: [Section_001]

looking at placed student Student_001
looking at placed student Student_003
moved Student_003 to Section_001 and put Student_004 in Section_000


Unallocated after one-level jiggle(TM); []
Section_000(0) => [ Student_004 Student_001 ]
Section_001(0) => [ Student_000 Student_003 ]
Section_002(0) => [ Student_002 ]
[download]

And one which it didn't, but I don't thinkhas a solution with a one-level Jiggle?:

[ 7:27:22.42] P:\test>411129.pl -STUDENTS=5 -SECTIONS=3 -R=847
!847!
Sections: 3
        available Section_000 =>3
        available Section_001 =>1
        available Section_002 =>1
Students: 5 [
        Student_000     [ 0 1 ],
        Student_001     [ 1 2 0 ],
        Student_002     [ 2 1 ],
        Student_003     [ 2 ],
        Student_004     [ 1 0 ]
]

Unallocated after main pass; [Student_002]
Sections with places: [Section_000]

looking at placed student Student_000
looking at placed student Student_004
Failed to replace Student_002


Unallocated after one-level jiggle(TM); [Student_002]
Section_000(1) => [ Student_000 Student_004 ]
Section_001(0) => [ Student_001 ]
Section_002(0) => [ Student_003 ]
[download]

It also seems to work pretty well on much larger tasks (Output substantially trimmed to show just those affected by the jiggle:

Read more... (6 kB)

Of course, you could code a 2-level Jiggle fairly easily, and you could go on to try for a recursive Jiggle. Though I think that it might be better to simply rotate the displaced students through the @students array until a solution is found (if possible).

Regardless, the Jiggle seems to solve most solvable runs I've tried almost immediately, so it would need a solvable example, that it didn't find a solution for, before the extra effort would be worthwhile.

The main body of the code is unchanged except I made the generator a little less prone to producing insoluble datasets.

The Jiggle code is the at the end. It's fairly well commented. It uses a couple of discuised gotos (next/last on the outer loop) and a crude sentinel to break the infinite loop possibility with insoluable datasets. It could be better structured, but try it and see what you think?

Read more... (9 kB)

PS. Sorry for leaving PM to do the wrapping -- it's been a long night :)

---

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