Monty Hall

monty.pl

package MySim;

use Zydeco;
use List::Util qw( shuffle sample );

# Next line shouldn't be needed, but I guess a bug somewhere in Zydeco...
BEGIN { package MySim::Types; use Type::Library -base; }

class Door {
	param prize  ( type => Bool, default => false, is => ro );
	field opened ( type => Bool, default => false, is => rw );
	field chosen ( type => Bool, default => false, is => rw );
	
	method open () {
		$self->opened( true );
	}
	
	method choose () {
		$self->chosen( true );
	}
	
	method abandon () {
		$self->chosen( false );
	}
}

abstract class Host {
	
	method open_door_for_dramatic_effect ( @doors ) {
		
		# Don't open the door which the player picked, or an already open door.
		my @candidates = grep !$_->opened && !$_->chosen, @doors;
		
		$self->choose_door( @candidates )->open();
	}
	
	# A host who knows where the prize is
	class WithKnowledge {
		
		factory new_host;
		
		# Will pick a door without the prize.
		method choose_door ( @doors ) {
			my ( $door ) = sample 1, grep !$_->prize, @doors;
			return $door;
		}
	}
	
	# A host without any more knowledge than the player
	class ZeroKnowledge {
		
		factory new_zero_knowledge_host;
		
		# Will pick any door.
		method choose_door ( @doors ) {
			my ( $door ) = sample 1, @doors;
			return $door;
		}
	}
}

abstract class Player {
	
	# Players always initially choose a door at random.
	method pick_initial_door ( @doors ) {
		my ( $door ) = sample 1, @doors;
		$door->choose();
		return;
	}
	
	class Fickle {
		
		factory new_fickle_player;
		
		# A fickle player will always switch to the other unopened door.
		method opportunity_to_alter ( @doors ) {
			my ( $previously_chosen ) = grep $_->chosen, @doors;
			my ( $new_choice ) = grep !$_->chosen && !$_->opened, @doors;
			$previously_chosen->abandon();
			$new_choice->choose();
			return;
		}
	}
	
	class Stubborn {
		
		factory new_stubborn_player;
		
		# A stubborn player will not change their choice.
		method opportunity_to_alter ( @doors ) {
			return;
		}
	}
}

class Game {
	param host   ( type => Host );
	param player ( type => Player );
	
	param door_count = 3;
	
	method BUILD ( $args ) {
		$self->door_count >= 3 or die;
	}
	
	method simulate_round () {
		
		# Three doors; prize behind one.
		my @doors = shuffle(
			Door->new( prize => true ),
			map( Door->new, 2 .. $self->door_count ),
		);
		
		# Player picks a door.
		$self->player->pick_initial_door( @doors );
		
		# Host opens a door from the remaining doors.
		$self->host->open_door_for_dramatic_effect( @doors )
			for 3 .. $self->door_count;
		
		# The player is given an opportunity to alter their choice.
		$self->player->opportunity_to_alter( @doors );
		
		# Return true if the player won.
		my ( @chosen ) = grep $_->chosen, @doors;
		die if @chosen != 1; # sanity check!
		return $chosen[0]->prize;
	}

	method simulate_rounds ( PositiveInt $n ) {
		my $wins = 0;
		for ( 1 .. $n ) {
			$wins++ if $self->simulate_round();
		}
		return $wins;
	}
}

my $ITER  = 10_000;
my $DOORS = 3;

{
	say "Classic host, fickle player, $DOORS doors:";
	my $game = MySim->new_game(
		host       => MySim->new_host,
		player     => MySim->new_fickle_player,
		door_count => $DOORS,
	);
	my $wins = $game->simulate_rounds( $ITER );
	say "  Player won $wins out of $ITER.";
}

say "--";

{
	say "Classic host, stubborn player, $DOORS doors:";
	my $game = MySim->new_game(
		host       => MySim->new_host,
		player     => MySim->new_stubborn_player,
		door_count => $DOORS,
	);
	my $wins = $game->simulate_rounds( $ITER );
	say "  Player won $wins out of $ITER.";
}

say "--";

{
	say "Zero-knowledge host, fickle player, $DOORS doors:";
	my $game = MySim->new_game(
		host       => MySim->new_zero_knowledge_host,
		player     => MySim->new_fickle_player,
		door_count => $DOORS,
	);
	my $wins = $game->simulate_rounds( $ITER );
	say "  Player won $wins out of $ITER.";
}

say "--";

{
	say "Zero-knowledge host, stubborn player, $DOORS doors:";
	my $game = MySim->new_game(
		host       => MySim->new_zero_knowledge_host,
		player     => MySim->new_stubborn_player,
		door_count => $DOORS,
	);
	my $wins = $game->simulate_rounds( $ITER );
	say "  Player won $wins out of $ITER.";
}

say "--";

__END__
Classic host, fickle player, 3 doors:
  Player won 6685 out of 10000.
--
Classic host, stubborn player, 3 doors:
  Player won 3287 out of 10000.
--
Zero-knowledge host, fickle player, 3 doors:
  Player won 3296 out of 10000.
--
Zero-knowledge host, stubborn player, 3 doors:
  Player won 3292 out of 10000.
--