#!/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;
}

##</code><code>##

$ perl simulate.pl 
== LOOP 99900 ==
Success:   31139
Fail:      68861
Fail rate: 68.861%

##</code><code>##

---- LOOPS -------------
0 72 86 73 80
1 96 19 83 91 47 75 18 53 3 50 24 81 59 38 23 44 67 39 55 65
2 20 45 98 84 89 63 93 46 58 68 28 56 64 78 6 87 52 8 82 97 34 31 85 79 12 41 48 70 66 37 5 49 33 51 15 57 54 69 90 26 43 14 94 76 9 88 40
4 42 25 99 27 77 16 10 74 36 22
7 13 71 61 62 11 95 21 17 30
29
32
35 60 92
------------------------