#! /usr/local/bin/perl -w use strict; use warnings; use diagnostics; use Data::Dumper; # I found the Sunday Times teaser 2021 interesting enough # to write a program to solve after I had a few goes on # paper and kept getting it wrong. # # It manages to do what should be a depth first search # using a simple for loop due to the relative simplicity # of the search space. # P.S. There is a prize for sending in the first correct # answers, but you'll need to have a copy of the ST in # order to find the address. # # Problem taken from Sunday Times 10-Jun-01 # # Spladders, a game like snakes and ladders, is played # on a board with spaces numbered 0..N . # A Player starts at 0, casts the die and moves his # counter forward the number of squares shown. If he # lands on a prime, he moves up to the next prime. # If he lands on a square, he moves down to the next # lower square (e.g. 25 to 16). Tom and I played a game. # I went first, and we each threw the die seven times. # Each time, after Tom threw, his position was double mine # (and never zero). # # What were our positions after seven throws ? my \$last = 0; my \$next; my %primes = (); for (2,3,5,7,11,13,17,19,23,29,31,37,41,43,47) { \$primes{\$last} = int(\$_); \$last = \$_; } delete \$primes{0}; my %squares = (); map {\$squares{\$_ * \$_} = int((\$_ - 1) * (\$_ - 1))} (1..10); my @posshim = (); my @possme = (); my \$start = 0; my @carry = (); my @record = (0); my @all = (); my %record = (0=>[0]); ### roll for (1..7) { roll(\$_); } die "Failed, More than 1 possible sequence" if @all > 1; die "Failed, no possible sequences" if @all < 0; print "-------\n\n"; report("My final Sequence",@{\$record{\$all[0]}}); ######### sub roll { my \$roll = shift; @carry = @record; @record = @all = (); report("-----\nRoll \$roll",@carry); for (@carry) { my \$start = \$_; print "Starting with \$_\n------\n"; @possme = MyTry(\$start); @posshim = HisTry(\$start*2); report("His possibles ",@posshim); #report("My possibles",@possme); my @newme = carry_me(\@possme, @posshim); report("My Matching possibles",@newme); for my \$val (@newme) { push(@record,\$val) unless grep {\$_ == \$val} @record; } record(\$start,@newme); } } sub record { my \$end = shift; my @poss = @_; my \$i; my @ref; my \$found = -1; #print Data::Dumper->Dump([\%record],["Record"]) , \$/; for my \$poss (@poss) { my @new = @{\$record{\$end}}; push(@new,\$poss); \$record{\$poss} = \@new; report("Carrying Forward",@new); push(@all,\$poss); } #print Data::Dumper->Dump([\%record],["Post - Record"]) , \$/; } sub report { my \$name = shift; my \$values = join(', ',@_); print "\$name => [\$values]\n"; } sub HisTry { my \$start = shift; my @poss = (); for my \$die (1..6) { my \$mid = \$start + \$die; my \$new = move(\$start,\$die); \$new = move(\$start,\$die); my \$valid = validHim(\$new); #print "Him => \$start + \$die => \$mid => \$new \$valid\n"; push(@poss,\$new) if \$valid; } return @poss; } sub MyTry { my \$start = shift; my @poss = (); for my \$die (1..6) { my \$mid = \$start + \$die; my \$new = move(\$start,\$die); \$new = move(\$start,\$die); my \$valid = validMe(\$new); #print "Me => \$start + \$die => \$mid => \$new \$valid\n"; push(@poss,\$new) if \$valid; } return @poss; } sub carry_me { my \$ref = shift; my @him = @_; my @new = (); for my \$value (@\$ref) { push(@new,\$value) if grep {\$value*2 == \$_} @him; } return @new; } sub validHim { my \$value = shift; return 0 if \$value % 2; return 0 if \$value == 0; return 1; } sub validMe { my \$value = shift; return 0 if \$value == 0; return 1; } sub move { my \$old = shift; my \$roll = shift; my \$new = \$old + \$roll; \$new = \$primes{\$new} if defined(\$primes{\$new}); \$new = \$squares{\$new} if defined(\$squares{\$new}); return int(\$new); }