Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

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

In reply to Re^3: [OT] simple algorithm for assigning students to class sections by BrowserUk
in thread [OT] simple algorithm for assigning students to class sections by hossman

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others scrutinizing the Monastery: (7)
    As of 2021-01-25 17:58 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      Notices?