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