#!perl -w
use strict;

# perl script demonstrating the 'to switch or not to switch' problem
# when participating in a quiz.

my $n= shift || 3;
my $testcount= 10000;

my $g_noswitchwin;
my $g_switchwin;

####################
$g_noswitchwin=0; $g_switchwin=0;
for (1..$testcount) {
    DoQuiz3();
}
print "fixed with 3:    switch: $g_switchwin   noswitch: $g_noswitchwin\n";


####################
$g_noswitchwin=0; $g_switchwin=0;
for (1..$testcount) {
    DoQuiz_leaveone($n);
}
print "leave 1 closed:  switch: $g_switchwin   noswitch: $g_noswitchwin\n";


####################
$g_noswitchwin=0; $g_switchwin=0;
for (1..$testcount) {
    DoQuiz_openone($n);
}
print "open 1 more:     switch: $g_switchwin   noswitch: $g_noswitchwin\n";

exit(0);

# fixed with 3 boxes
sub DoQuiz3 {
    # fill one box with the prize
    my $theprize= random(3);

    # contestant chooses box
    my $firstchoice= random(3);

    # determine which box to show to be empty
    my $openedbox;
    if ($firstchoice==$theprize) {
        # can choose any other box.
        $openedbox= ($theprize+random(2)+1)%3;
    }
    else {
        # only one option remains
        $openedbox= otherthan($firstchoice, $theprize);
    }

    # the contestant does not switch
    if ($firstchoice==$theprize) {
        $g_noswitchwin++;
    }

    # the contestant does switch
    my $secondchoice= otherthan($firstchoice,$openedbox);
    if ($secondchoice==$theprize) {
        $g_switchwin++;
    }
}

# quizmaster opens all but 1 remaining
sub DoQuiz_leaveone {
    my ($n)= @_;

    # fill one box with the prize
    my $theprize= random($n);

    # contestant chooses box
    my $firstchoice= random($n);

    # determine which box to leave unopened
    my $closedbox;
    if ($firstchoice==$theprize) {
        # any of the still closed boxes is ok to leave unopened
        $closedbox= randomother($n, $theprize);
    }
    else {
        # only the box with the prize may be left unopened
        $closedbox= $theprize;
    }

    # the contestant does not switch
    if ($firstchoice==$theprize) {
        $g_noswitchwin++;
    }
    # the contestant does switch
    my $secondchoice= $closedbox;
    if ($secondchoice==$theprize) {
        $g_switchwin++;
    }
}

# quizmaster opens one more
sub DoQuiz_openone {
    my ($n)= @_;

    # fill one box with the prize
    my $theprize= random($n);

    # contestant chooses box
    my $firstchoice= random($n);

    # determine which box to open
    my $openedbox;
    if ($firstchoice==$theprize) {
        # any of the still closed boxes is ok to open
        $openedbox= randomother($n, $theprize);
    }
    else {
        $openedbox= randomother($n, $firstchoice, $theprize);
    }

    # the contestant does not switch
    if ($firstchoice==$theprize) {
        $g_noswitchwin++;
    }
    # the contestant does switch
    my $secondchoice= randomother($n, $firstchoice, $openedbox);
    if ($secondchoice==$theprize) {
        $g_switchwin++;
    }
}

# fixed answers for fixed 3 item quiz
sub otherthan {
    my ($a, $b)= @_;
    return 0 if ($a==1 && $b==2);
    return 1 if ($a==0 && $b==2);
    return 2 if ($a==0 && $b==1);
    return 0 if ($a==2 && $b==1);
    return 1 if ($a==2 && $b==0);
    return 2 if ($a==1 && $b==0);
}

# pick random number from 0 .. n-1
sub random {
    my ($n)= @_;
    while(1) {
        my $r= int(rand($n));
        return $r if ($r<$n);
    }
}

# pick random number from 0 .. n-1,
# but not number in @dontpick list.
sub randomother {
    my ($n, @dontpick)= @_;

    my %ref= map { ($_=>1) } @dontpick;

    while (1) {
        my $r= random($n);
        return $r if (!exists $ref{$r});
    }
}

#############################################
# other ways of picking the random numbers:
#  these give the same results as the simpler
#  version above

# pick random number from 0 .. n-1,
# but not $c or $p
sub randomother2 {
    my ($n, $c, $p)= @_;
    my $openedbox= ($p+random($n-2)+1)%$n;
    if ($c<$p) {
# ...C..n.P....
# ...C....P.n..
# .n.C....P....
        if ($openedbox<$c || $openedbox>=$p)
        {
            $openedbox= ($openedbox+1)%$n;
        }
    }
    else {
# ...P....C..n.
# .n.P....C....
# ...P.n..C....
        if ($p<=$openedbox && $openedbox<$c) 
        {
            $openedbox= ($openedbox+1)%$n;
        }
    }
    return $openedbox;
}

# pick random number from 0 .. n-1,
# but not $c
sub randomother1 {
    my ($n, $c)= @_;
    return ($c+random($n-1)+1)%$n;
}