#!/usr/bin/perl -w
use strict;
use Quantum::Entanglement qw(:complex :DEFAULT);

=head1 beakers.pl

This is a game related to the Monty Hall problem.  In this case things
are complicated as the player (P) and the host (H) use quantum
mechanical probability amplitudes to place, guess and reveal the
position of the bead.

The game proceeds thus:

=over 4

=item Host hides bead under all the cups

The host decides the position of the bead by selecting its initial
probability amplitudes for being under cup a, b or c.  The host should
not tell the player where (or where-ish) he has put the bead.

=item Player guesses where the bead is

The player makes a guess at where the bead is, but does so by
spreading his guess out between each different cup, again by assigning
each cup a probaility amplitude.  The host should be allowed to see
the guess that the player makes.

=item Host quantum mechanically probes for location of bead

The host now lifts up the cups, but not by actually lifting up the
cups -- as that would collapse the wavefunction of the bead and end
the game.  Instead he spreads his peaking out between all the cups and
is informed if his guess is correct or false.

=item Player's guess then used to probe location of cup

The player's guess is then applied as a probe.  If the host lifted up
the correct cup, then the player wins if they guess the same cup as
was lifted up by the host.  If the host did not lift up the correct
cup, then the player wins if he selects the correct cup from the
remainder.  In both cases, we only find out if the player's guess
combined with the host's probing causes the player to win.  We still
don't know where the bead actually is.

=item The cups are finally lifted

We then pick up the cups, and cause the bead to collapse to a definite
location.

=done

Each choice made by a player or host should be entered as a set of
three comma separated perl expressions.  For a simple start, enter
plain numbers "1,2.5,0.3" -- the program will normalise them for you.
If you're not entirely real, you can use imaginary numbers: "1+i, 3,
i**3".

=cut

my (@host) = prompt("Enter host's initial amplitudes");
my $bead = entangle(eval("$host[0]"), 'a',
                    eval("$host[1]"), 'b', 
                    eval("$host[2]"), 'c', );

my (@play) = prompt("Enter player's initial choice amplitudes");
my $guess = entangle(eval("$play[0]"), 'a',
                     eval("$play[1]"), 'b', 
                     eval("$play[2]"), 'c', );

my (@look) = prompt("Host to chose amplitudes for where to look");
my $look = entangle(eval("$look[0]"), 'a',
                    eval("$look[1]"), 'b', 
                    eval("$look[2]"), 'c', );

if ($look eq $bead) {
    print "Host found the bead... was the player right?\n";
    if ($look eq $guess) {
        print "Yes, the player found the bead.  Player wins\n";
    }
    else {
        print "No, the player guessed elsewhere.  Host wins\n";
    }
}
else {
    print "Host doesn't uncover bead... was the player right?\n";
    if ($bead eq $guess) {
        print "Yes, the player wins\n";
    }
    else {
        print "no, the host wins\n";
    }
}
print "bead: $bead, player: $guess, look: $look\n";

sub prompt {
    print $_[0], "\n";
    my $answer = <stdin>;
    chomp($answer);
    return wantarray ? split(/,/, $answer) : $answer;
}
