#! perl -slw use strict; our $N ||= 1e6; my %stats; my @data = 'A' .. 'Z'; for my $n ( 1 .. $N ) { my @scratch = @data; foreach my $first ( @data ) { for my $j ( reverse $#scratch -2 .. $#scratch ) { my $r = rand( $j + 1 ); @scratch[ $j, $r ] = @scratch[ $r, $j ]; if( $scratch[ $j ] eq $first ) { my $r = rand $j; @scratch[ $j, $r ] = @scratch[ $r, $j ]; } } ++$stats{ $_ } for @scratch[ -3 .. -1 ]; } system 'cls'; printf "%8d\n", $n; printf "%s : %6d ( %+3d ) %s\n", $_, $stats{ $_ }, $stats{ $_ } - ( 3 * $n ), '#' x abs( $stats{ $_ } - ( 3 * $n ) ) for @data; }