Return to test.pl CVS log

Up to [LON-CAPA] / loncom / homework / caparesponse

Annotation of loncom/homework/caparesponse/test.pl, revision 1.3

1.1       albertel    1: use strict;
1.3     ! albertel    2: use warnings;
1.1       albertel    3: 
1.3     ! albertel    4: my $n = 0;
        !             5: my $total = 0;
        !             6: my $num_left = 0;
        !             7: my @order;
        !             8: 
        !             9: sub factorial {
        !            10:     my $input = CORE::int(shift);
        !            11:     return "Error - unable to take factorial of an negative number ($input)" if $input < 0;
        !            12:     return "Error - factorial result is greater than system limit ($input)" if $input > 170;
        !            13:     return 1 if $input == 0;
        !            14:     my $result = 1; 
        !            15:     for (my $i=2; $i<=$input; $i++) { $result *= $i }
        !            16:     return $result;
        !            17: }
        !            18: 
        !            19: sub init {
        !            20:     my ($size) = @_;
        !            21:     @order = (0..$size-1);
        !            22:     $n = $size;
        !            23:     $total = $num_left = &factorial($size);
        !            24: }
        !            25: 
        !            26: sub get_next {
        !            27:     if ($num_left == $total) {
        !            28: 	$num_left--;
        !            29: 	return @order;
        !            30:     }
        !            31: 
        !            32: 
        !            33:     # Find largest index j with a[j] < a[j+1]
        !            34: 
        !            35:     my $j = scalar(@order) - 2;
        !            36:     while ($order[$j] > $order[$j+1]) {
        !            37: 	$j--;
        !            38:     }
        !            39: 
        !            40:     # Find index k such that a[k] is smallest integer
        !            41:     # greater than a[j] to the right of a[j]
        !            42: 
        !            43:     my $k = scalar(@order) - 1;
        !            44:     while ($order[$j] > $order[$k]) {
        !            45: 	$k--;
        !            46:     }
        !            47: 
        !            48:     # Interchange a[j] and a[k]
        !            49: 
        !            50:     @order[($k,$j)] = @order[($j,$k)];
        !            51: 
        !            52:     # Put tail end of permutation after jth position in increasing order
        !            53: 
        !            54:     my $r = scalar(@order) - 1;
        !            55:     my $s = $j + 1;
        !            56: 
        !            57:     while ($r > $s) {
        !            58: 	@order[($s,$r)]=@order[($r,$s)];
        !            59: 	$r--;
        !            60: 	$s++;
        !            61:     }
        !            62: 
        !            63:     $num_left--;
        !            64:     return(@order);
        !            65: }
        !            66: 
        !            67: &init(9);
        !            68: while($num_left) {
        !            69:     print(join(':',&get_next()).$/);
        !            70: }