Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
    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: }
    

In reply to Solver for Sunday Times teaser 2021 by Brovnik

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • 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.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others scrutinizing the Monastery: (7)
As of 2024-03-28 12:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found