use strict; use warnings; # Austrian Pub dice # The board has nine hinged pegs numbered 1 to 9. # There are two d6 dice. # The objective is to get the lowest score (usually played with over five rounds # each player having one go during a round). # # A proceeds as follows: The player rolls the two dice (see terminal exception below). # He must flip over one or two pegs that add up to the sum of the dice. # If he can he rolls and proceeds. If he cannot his go is over. # # Terminal exception: IF the player is left with the "one" peg and nothing else, # he rolls only one die. # The collection of pegs at any time can vary in value from 0 (perfect score) # to 45 (beginning of a go). my $max_pegs_value = 45; # We need to constantly use the probability distribution of rolling two dice. # So this is a mapping from the sum of the two dice to the probability of rolling that. my %prob = (); $prob{2} = 1/36; $prob{3} = 2/36; $prob{4} = 3/36; $prob{5} = 4/36; $prob{6} = 5/36; $prob{7} = 6/36; $prob{8} = 5/36; $prob{9} = 4/36; $prob{10} = 3/36; $prob{11} = 2/36; $prob{12} = 1/36; # Need to know how to break up a peg value into its possible values so cache those here. my %peg_value_breakdown = (); my %peg_values = (); for(my $i = 0; $i < 2**9; $i++) { my ($pegs, $value) = split_number_into_pegs($i); $peg_value_breakdown{$value} = [] unless exists $peg_value_breakdown{$value}; push @{$peg_value_breakdown{$value}}, $pegs; $peg_values{$pegs} = $value; } # In order to work out the best strategy we need to know the best strategy for # simpler positions. So we iterate through total peg values from 1 to $max_pegs_value. my %expected_value = (""=>0); for(my $i = 1; $i <= $max_pegs_value; $i++) { my @combinations = @{$peg_value_breakdown{$i}}; my $no_combinations = scalar(@combinations); print "total peg value: $i, combinations: $no_combinations\n"; foreach my $c (@combinations) { my $p = calculate_expected($c); $expected_value{$c} = $p; print "\t$c:\t$p\n"; } } exit(0); # To take a number between 0 and 511 inclusive and map it into a set of pegs. sub split_number_into_pegs { my $number = shift; my $pegs = ""; my $value = 0; for(my $i = 1; $i <= 9; $i++) { if ($number & 2**($i-1)) { $pegs .= "$i,"; $value += $i; } } chop $pegs; return ($pegs, $value); } sub calculate_expected { my $state = shift; if ($state eq "1") { return 5/6; } my $expected = 0; my $value = $peg_values{$state}; foreach my $v (sort keys %prob) { my $new_state = generate_new_states($state, $v); if (defined($new_state)) { my $e = $expected_value{select_best_state($new_state)}; $expected += $prob{$v}*$e; # print "$v->$e,"; } else { $expected += $prob{$v}*$value; # print "$v->$value,"; } } #print "\n"; return $expected; } sub generate_new_states { my $state = shift; my $dice_roll = shift; my @new_states = (); if (state_has_peg($state, $dice_roll)) { push @new_states, state_remove_peg($state, $dice_roll); } # consider possibility of two pegs for(my $i = 1; $i < $dice_roll; $i++) { if (state_has_peg($state, $i)) { my $blah = state_remove_peg($state, $i); if (state_has_peg($blah, $dice_roll-$i)) { push @new_states, state_remove_peg($blah, $dice_roll-$i); } } } return undef if scalar(@new_states) == 0; return \@new_states; } sub state_remove_peg { my $state = shift; my $peg = shift; my $s = ",$state,"; $s =~ s/\,${peg}\,/,/; $s =~ s/^(,)//; $s =~ s/(,)$//; return $s; } sub state_has_peg { my $state = shift; my $peg = shift; return ",$state," =~ /\,${peg}\,/; } sub select_best_state { my $states = shift; my $value = undef; my $best_state = undef; foreach my $s (@$states) { if (!defined($value) or $expected_value{$s} < $value) { $best_state = $s; $value = $expected_value{$s}; } } return $best_state; }