because I tried to paste this whole thing into a comment and it ate my >s

use strict;
my $Names;
=pod
model of the "Names in Boxes" problem at
http://www.math.dartmouth.edu/~pw/solutions.pdf
the prisoners have names that are random ints 0 to 10000
and their hash algorithm is to mod their names by 100.
The wardens use a random shuffle.

revision: the mapping can't be a hash algorithm, that has
collisions, because it is CRUCUAL that the space is divided
into cycles. A "perfect hash"  would work, any correspondence
function will work. So the revised "BoxWithLabel" function
here finds the prisoner's name's position on the prisoners'
list of prisoner names. Also, no two prisoners have the
same name, otherwise the cycle partitioning fails too.

So if the prisoners, who have control over how they partition
themselves, partition themselves in a way that guarantees that
they are in, say, fifty buddy partitions, can they get 100%?

No, because, there's no way to accurately select
one's buddy's box.

The partitioning is controlled by BOTH the prisoner-selected
and the warden-selected mappings of names and boxes.

=cut

sub BoxWithLabel_Confused($) {
    $_[0] % 100
}
sub BoxWithLabel($) {
    $Names->[$_] == $_[0] and return $_ for 0 .. 99 ;
    die "FAILED TO FIND NAME $_[0] IN NAMES LIST";
}

sub newnames() {
    my %TooMany;
	@TooMany{map { int rand 10000} 1 .. 200} = ();
	[@{[ keys %TooMany ]}[0..99]];  # 100 UNIQUE names
};

sub shuffle($) {
   my @copy = @{$_[0]};
   my $r;
   for ( 0 .. 99 ){
      $r = rand 100;
      @copy[$_,$r] = @copy[$r,$_];
   };
   \@copy
};

my ($Boxes, $p, $FAILS, $SUCCESSES);
sub Attempt() {
   $Names = newnames;
   $Boxes = shuffle $Names;

   $p = -1;

   prisoner:
   while( $p++ < 99 ){
      my $pname = $Names->[$p];
      my $thisname = $pname ;
      #print "p $p ($thisname) searches\n";
      for ( 1 .. 50 ){
          my $boax = BoxWithLabel $thisname;
	      #print "in box $boax\n";
		  #print "containing ",$Boxes->[$boax],"\n";
          $thisname = $Boxes->[$boax];
          $pname == $thisname and next prisoner;
      };
      $FAILS++;
      return 0;
   };
   ++$SUCCESSES
};

my ($count, @Failurerecord);

while ($count++ < 10000){
    if (Attempt){
        # print "SUCCESS!\n";
    }else{
        print "trial $count FAILED at p=$p\n";
	  $Failurerecord[$p]++;
    };
    $count % 100 or
        print "after $count iterations, succeeding ",(100 * $SUCCESSES / $count),"% of the time\n";
};

for $p (1 .. 99){
    print "failed at prisoner $p $Failurerecord[$p] times\n";
    $p++
};

previous - next