#!/usr/bin/env perl # https://www.youtube.com/watch?v=iSNsgj1OCLA use v5.40; use strict; use warnings; use diagnostics; use Array::Contains; my $PRISONERCOUNT = 100; # How many prisoners my $OPENBOXES = $PRISONERCOUNT / 2; # Every prisoner can open half the boxes my $LOOPCOUNT = 10_000; my $DEBUG = 0; STDOUT->autoflush(1); my @results = (0, 0); for(my $l = 0; $l < $LOOPCOUNT; $l++) { if($DEBUG) { print "== SIMULATION $l ==\n"; } elsif($l % 100 == 0) { print "== SIMULATION $l of $LOOPCOUNT ==\r"; # non-debug: overwrite the line without scrolling } $results[simulate()]++; } print "\n"; print "Success: ", $results[1], "\n"; print "Fail: ", $results[0], "\n"; print "Fail rate: ", $results[0] / ($results[0] + $results[1]) * 100, "%\n"; sub simulate { my $boxes = generateBoxes(); DumpBoxes($boxes) if($DEBUG); print "Checking prisoner " if($DEBUG); for(my $i = 0; $i < $PRISONERCOUNT; $i++) { print $i, " " if($DEBUG); if(!checkBoxes($boxes, $i, $OPENBOXES)) { print "Failed!\n" if($DEBUG); return 0; } } print "OK\n" if($DEBUG); return 1; } sub generateBoxes { print "Generating boxes...\n" if($DEBUG); my @boxes; while(scalar @boxes < $PRISONERCOUNT) { my $prisoner = int(rand($PRISONERCOUNT)); if(!contains($prisoner, \@boxes)) { push @boxes, $prisoner; } } return \@boxes; } sub checkBoxes($boxes, $prisoner, $count) { my $currentbox = $prisoner; while($count) { my $val = $boxes->[$currentbox]; # Get content of current box if($val == $prisoner) { return 1; } $currentbox = $val; $count--; } return 0; } sub DumpBoxes($boxes) { print "---- BOXES -------------\n"; for(my $i = 0; $i < $PRISONERCOUNT; $i++) { print $i, " => ", $boxes->[$i], "\n"; } print "---- LOOPS -------------\n"; my @seen; for(my $i = 0; $i < $PRISONERCOUNT; $i++) { my $currentbox = $i; my $count = 100; my $ok = 1; my @current; while($count) { if(contains($currentbox, \@seen)) { $ok = 0; # Part of already known loop last; } push @current, $currentbox; my $val = $boxes->[$currentbox]; if($val == $i) { last; # Loop done } $currentbox = $val; } if($ok) { print join(' ', @current), "\n"; push @seen, @current; } } print "------------------------\n"; return; }