1: #! /usr/local/bin/perl -w 2: 3: use strict; 4: use warnings; 5: use diagnostics; 6: use Data::Dumper; 7: 8: # I found the Sunday Times teaser 2021 interesting enough 9: # to write a program to solve after I had a few goes on 10: # paper and kept getting it wrong. 11: # 12: # It manages to do what should be a depth first search 13: # using a simple for loop due to the relative simplicity 14: # of the search space. 15: # P.S. There is a prize for sending in the first correct 16: # answers, but you'll need to have a copy of the ST in 17: # order to find the address. 18: # 19: # Problem taken from Sunday Times 10-Jun-01 20: # 21: # Spladders, a game like snakes and ladders, is played 22: # on a board with spaces numbered 0..N . 23: # A Player starts at 0, casts the die and moves his 24: # counter forward the number of squares shown. If he 25: # lands on a prime, he moves up to the next prime. 26: # If he lands on a square, he moves down to the next 27: # lower square (e.g. 25 to 16). Tom and I played a game. 28: # I went first, and we each threw the die seven times. 29: # Each time, after Tom threw, his position was double mine 30: # (and never zero). 31: # 32: # What were our positions after seven throws ? 33: 34: my $last = 0; 35: my $next; 36: my %primes = (); 37: 38: for (2,3,5,7,11,13,17,19,23,29,31,37,41,43,47) 39: { 40: $primes{$last} = int($_); 41: $last = $_; 42: } 43: delete $primes{0}; 44: 45: my %squares = (); 46: map {$squares{$_ * $_} = int(($_ - 1) * ($_ - 1))} (1..10); 47: 48: my @posshim = (); 49: my @possme = (); 50: my $start = 0; 51: my @carry = (); 52: my @record = (0); 53: my @all = (); 54: my %record = (0=>[0]); 55: 56: ### roll 57: 58: for (1..7) 59: { 60: roll($_); 61: } 62: die "Failed, More than 1 possible sequence" 63: if @all > 1; 64: die "Failed, no possible sequences" 65: if @all < 0; 66: 67: print "-------\n\n"; 68: report("My final Sequence",@{$record{$all[0]}}); 69: 70: 71: ######### 72: 73: sub roll 74: { 75: my $roll = shift; 76: @carry = @record; 77: @record = @all = (); 78: report("-----\nRoll $roll",@carry); 79: for (@carry) 80: { 81: my $start = $_; 82: print "Starting with $_\n------\n"; 83: @possme = MyTry($start); 84: @posshim = HisTry($start*2); 85: 86: report("His possibles ",@posshim); 87: #report("My possibles",@possme); 88: 89: my @newme = carry_me(\@possme, @posshim); 90: report("My Matching possibles",@newme); 91: for my $val (@newme) 92: { 93: push(@record,$val) unless grep {$_ == $val} @record; 94: } 95: record($start,@newme); 96: } 97: } 98: 99: sub record 100: { 101: my $end = shift; 102: my @poss = @_; 103: my $i; 104: my @ref; 105: my $found = -1; 106: 107: #print Data::Dumper->Dump([\%record],["Record"]) , $/; 108: for my $poss (@poss) 109: { 110: my @new = @{$record{$end}}; 111: push(@new,$poss); 112: $record{$poss} = \@new; 113: report("Carrying Forward",@new); 114: push(@all,$poss); 115: 116: } 117: #print Data::Dumper->Dump([\%record],["Post - Record"]) , $/; 118: } 119: 120: sub report 121: { 122: my $name = shift; 123: my $values = join(', ',@_); 124: print "$name => [$values]\n"; 125: } 126: 127: sub HisTry 128: { 129: my $start = shift; 130: my @poss = (); 131: for my $die (1..6) 132: { 133: my $mid = $start + $die; 134: my $new = move($start,$die); 135: $new = move($start,$die); 136: my $valid = validHim($new); 137: #print "Him => $start + $die => $mid => $new $valid\n"; 138: push(@poss,$new) if $valid; 139: } 140: return @poss; 141: } 142: 143: sub MyTry 144: { 145: my $start = shift; 146: my @poss = (); 147: for my $die (1..6) 148: { 149: my $mid = $start + $die; 150: my $new = move($start,$die); 151: $new = move($start,$die); 152: my $valid = validMe($new); 153: #print "Me => $start + $die => $mid => $new $valid\n"; 154: push(@poss,$new) if $valid; 155: } 156: return @poss; 157: } 158: 159: sub carry_me 160: { 161: my $ref = shift; 162: my @him = @_; 163: my @new = (); 164: for my $value (@$ref) 165: { 166: push(@new,$value) if grep {$value*2 == $_} @him; 167: } 168: return @new; 169: } 170: 171: sub validHim 172: { 173: my $value = shift; 174: return 0 if $value % 2; 175: return 0 if $value == 0; 176: return 1; 177: } 178: 179: sub validMe 180: { 181: my $value = shift; 182: return 0 if $value == 0; 183: return 1; 184: } 185: 186: sub move 187: { 188: my $old = shift; 189: my $roll = shift; 190: my $new = $old + $roll; 191: $new = $primes{$new} if defined($primes{$new}); 192: $new = $squares{$new} if defined($squares{$new}); 193: return int($new); 194: }
Back to
Craft