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: }
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.