Step Up and Get Lucky

THE WEEKLY CHALLENGE – PERL & RAKU #52

TASK #1

Stepping Numbers

Write a script to accept two numbers between 100 and 999. It should then print all Stepping Numbers between them.

A number is called a stepping number if the adjacent digits have a difference of 1. For example, 456 is a stepping number but 129 is not.

Method

This is another example of what I have begun to call problems in “Concrete Number Theory”; where the objectives are not merely placed in the relationships between values in the solutions, but in the physical way that these numbers are represented on a page.

In this example we do not care so much as to what a number represents, but rather whether its adjectant digits differ by 1. It is not restricted that the difference should be either ascending or descending or even consistant, thus we shall conclude not only that 123 fits the bill and also 654 and 656.

Adjecent digits can be extracted arithmatically using division by 10 and integer rounding. Sure, why not? It’s not exactly SpaceX stuff. But why go through that trouble when we can apply text processing to the number represented as a string? In Perl all we need do is look at a number like a string, using a string function for example, and a string pointer will be created and stored alongside the integer value with the scalar and be available to do string stuff forever after. Ahh, Perlguts. The good stuff.

For the record, Perlguts is demonstratively more fun than spongiform encephalopathy, albeit often producing the same effects. It is good to have a basic understanding of what’s behind the curtain though. Usually the number contained within a scalar and the string representing that number appear identical. With the interpreter silently switching behind the scenes, it is not unreasonable that the casual user might think of them as being the same physical data, read different ways, but they are not. Normally updating one or another of these values triggers an update of the other, but this is not necesaariy the case.

The stringified component of a scalar can even be a completely different thing: in the $! scalar, the string component holds a nice descriptive phrase, but the integer component holds a related but structurally very different error number. The two components need not even be related in any way, although getting this to happen requires some pretty gruesome under the hood tinkering. For the adventurous, the Scalar::Util module provides a dualvar() function that will construct such arbitrary scalars. For most users it’s good just to understand that a Perl scalar is in fact a rather complicated struct, comprised of many interconnected data fields, keeping track of namespaces, reference counts, reference blessing and many other relevant and changing pieces of information tuned to exactly what that particular scalar happens to be being used for.

But back to treating numbers as strings. We can do this in Perl, so we should. It’s dead simple to dice a string into a list of parts using split //. Once we have divided a number into three separate digits, comparing the first to the second, and the second to the third, will give us our answer. Wrapping this logic in a subroutine comparmentalizes it nicely. Again, we don’t care what the digits represent. We only care about the logic of the relationships, so this function only returns 1 for success and 0 for failure.

Feeding this function to grep {} creates a filter. Sorting the commandline inputs allows us to make a range to filter. The valid cases that pass through are printed out, one per line.

PERL 5 SOLUTION
[colincrain@boris:~/Code/PWC]$  perl 52_1_stepping.pl 300 500
321
323
343
345
432
434
454
456
use warnings;
use strict;
use feature ":5.26";

## ## ## ## ## MAIN:

my ($low, $high) = sort {$a <=> $b} @ARGV;

my @output = grep { stepping($_) } ($low..$high);

say for @output;


## ## ## ## ## SUBS:

sub stepping {
    my $num = shift;
    my ($a, $b, $c) = split //, $num;
    abs( $a - $b ) == 1 && abs( $b - $c ) == 1 ? 1 : 0;
}
raku solution

In the Perl 5 solution, it was straightforward to separate the digits of the target number using split // and check the differences between the first and second and second and third digits. In Raku we use comb for this, and it also works quite nicely. That solution is shown in the stepping1() sub below. We could have left it there; –It works! They said. –Leave it alone! They said. –Stop touching it!

But we didn’t. No, no we did not.

There is most definately a place for not overly abstracting and just writing code that gets the job done, with algorithms crafted to the dataset. In this case, we were restricted to a range of three digit numbers by the challenge, and so we hard-coded in the specific difference calculations. We rose to the challenge given and that’s fine. But logically the only real restriction on stepping numbers is to have at least one number to step from and one number to step to. So how can we address this?

Well…

  1. If we’re opening up the field of options, the very first thing to do is add
and $_.abs > 9

to our grep, to filter out single digit numbers. Once this is in we need not worry about them further.

  1. One nice addition from Perl to Raku is the :ex (for :exhaustive) adjective for regular expressions, which functions like /g with overlapping results. The parser will start at the left and progress the position over one char at a time, sending back a list of every possible match for a given pattern, even if it overlaps a previous match, in contrast to :g and /g which recommences the search at the end of the previous match. With the power of this, we can match
m:ex/\d\d/

which, given a 3-digit number, will match first the first two digits and then the last two. The number 123, for example, will return the list 12 and 23. For a longer number, it will continue like this, producing as many pairs as it can find.

  1. Once we have this initial breakdown we first section the digit pairs using comb, then apply a subtraction reduction metaoperator on the two digit list to get their difference. We take the absolute value, and now we have a list of the absolute differences between the sequential digits of the number. A sort of a derivative, if you will.
  2. Appending the value 1 and then applying an equality reduction metaoperator to this list is equivalent to the chained equation
$^a == $^b == 1

or alternately,

$^a == 1 && $^b == 1

which in turn is the same as

($a - $b).abs == 1 && ($b - $c).abs

as seen in stepping1().

Neat! This logic is laid out sequentially in stepping2().

Now these steps can be chained and combined to make the code as terse as we wish. Combining steps 1 and 2 is creating a list of match results and then doing something to that list, which flows nicely. This is shown in stepping3(). Removing the @parts variable completely may be desirable; this yields stepping4(), but note we need to explicitly cast an Array before we can append the 1 to it, as even the compiler is having trouble following by now. At this point, with two metaoperators, two manufactured lists and a tertiary decision we are getting pretty opaque. But then again we might as well get completely pathological about it and remove the entire subroutine:

sub MAIN (Int:D $from, Int:D $to) {
    .say for ($from…$to).grep({(==.map({([-] $_.comb).abs})).Array
        .append: 1)?? 1 !! 0 and $_.abs > 9});
}

Which works just fine, but seriously? Way to lose the plot, Batman! There’s way too much going on in that for one line. I think #3 is arguably the clearest, so we’ll leave that one in MAIN().

And it works on any integer inputs, positive or negitive, in any order. Nice.

sub MAIN (Int:D $from, Int:D $to) {
    .say for ($from...$to).grep({stepping3 $_ and $_.abs > 9});         # note 1
}

## ## ## ## ## SUBS:

sub stepping1 ($num) {
    my ($a, $b, $c) = $num.comb;
    ($a - $b).abs == 1 && ($b - $c).abs == 1 ?? 1 !! 0;
}

sub stepping2 ($num) {
    my @parts = $num ~~ m:ex/\d\d/;         # note 2
    @parts .= map({([-] $_.comb).abs });    # note 3
    ([==] @parts.append: 1) ?? 1 !! 0;      # note 4

}

sub stepping3 ($num) {
    my @parts = ($num ~~ m:ex/\d\d/)    
                    .map({([-] $_.comb).abs });    
    ([==] @parts.append: 1) ?? 1 !! 0;      # note 4

}

sub stepping4 ($num) {
    ([==] (($num ~~ m:ex/\d\d/).map({([-] $_.comb).abs })).Array.append: 1) ?? 1 !! 0;
}

TASK #2

Lucky Winner

Suppose there are following coins arranged on a table in a line in random order.

£1, 50p, 1p, 10p, 5p, 20p, £2, 2p

Suppose you are playing against the computer. Player can only pick one coin at a time from either ends. Find out the lucky winner, who has the larger amounts in total?

Comments

Right out of the gate, it’s a little ambiguous what exactly is going on here. At first I tried not to overthink it and decided it was a simple game of chance we were modeling, where each player takes the highest coin available and the winner has the largest pot. Just two people, perhaps sitting at a bar over drinks, having a small innocent wager to pass the time.

I’m pretty sure this was the intent, two players and one lucky winner. But this got me thinking about alternate strategies, where one might chose not to take the largest coin now, to set up for a larger prize later. On closer examination of the terms, with careful play there is no luck at all.

The game uses 8 coins, one of each of the currency of the United Kingdom. Summing these together gives us 388 pence, which you may immediately notice, is less than half of the largest coin, £2 or 200p. Consequently, whoever gets the £2 coin wins the game.

This revelation shifts the goal from maximizing the gain per turn to aquiring the £2 coin, and it turns out that, much like tic-tac-toe, with an 8 coin game the first to draw will invariably win. So there is no lucky winner; rather than a friendly wager it appears we have a bar bet hustle, with a insincere instigator pulling a fast one on an unsuspecting dupe.

Method

The algorithm to win is straightforward: if the £2 coin is at any time exposed, take it. If it is contained within the line, it will have some number of coins surrounding it to the left and right. The first draw takes a coin from whichever side has a larger count of coins. Because there are 7 coins and the £2 piece, the surrounding coins will always be odd for the first draw, and so one side will always be larger than the other. The second player is given an even count and is forced to break the symmetry, which the first player then reestablishes. This play proceeds until eventually the £2 coin is surrounded by a single coin on each side, and the second player, by taking one or the other, reveals the prize.

After the £2 piece is secured, the first player proceeds by moving the focus to the next largest remaining coin and starting the process anew, repeating until there are no more coins to draw.

As for the hapless fate of the second player, mimicking the strategy of the first will not work, and puts him or her at a disadvantage compared to just getting the best coins available. Because we should always do our best even when destiny is fated against us, to fight the good fight at Ragnarök, a strategy of taking the larget coin available is enacted. If the play is winner-take-all, it really doesn’t matter what the second player does, as no style of play can obtain the £2 coin. But as stated in stanza 77 of the Hávamál:

Deyr fé,
deyja frændur,
deyr sjálfur ið sama;
ek veit einn
at aldri deyr
dómr um dauðan hvern.
 
Cattle die,
kinsmen die,
you yourself will die,
I know one thing
that never dies
the reputation1 of the dead

Perhaps it would be better to reference the famous koan by the Master Ma-Tzu Daoyi:

“If you call this a stick, I will hit you with it.
If you do not call this a stick, I will hit you with it.
What do you choose to do?”

The enlightenment of the double-bind is to not play the game.


  1. the crux here in translation is the word dómr, a cognate with the Old English word döm, or “doom”. This differs from the modern meaning somewhat, not focusing on the downfall aspect, but rather the fatalism of the judgment that comes at that moment. Hence “judgment” is closer. In the pre-Christian Norse world a man was judged throughout his life by his actions, first by his peers and later by the gods themselves. Thus the judgment is the thing rather than the act, the record of life actions judged. Thus I have gone with the word “reputation” here, as this perhaps best portrays that record.

The Hustle

One scenario would be for the hustler to strike up a conversation with the mark, to pool some coins and play a game: winner take all and the loser to buy a round. The hustler even produces the two-pound coin as a show of good faith, here we are willing to risk a sizable stake, more than half! It’s important not to put too much weight in the one-of-every-coin angle, as this variable can then be manipulated later; the change present should appear to be random. By strategically placing coins in several pockets the final count of eight coins can be assembled without appearing contrived. Producing the largest coin could be a pretense to draw first, which the hustler knows will ensure a win. The hustler pockets the change. When the mark objects, he is prompted to buy another round of drinks and obtain some more change, stating “Ok this time you draw first!” . Once the change is placed on the table, the hustler pushes some back saying “too much” and then completes the pot with his half of the stake. This both gives the semblance of goodwill again, a show to not appear greedy, but more importantly gives full opportunity to craft the makeup of the pot. This time an additional coin is slipped in to make the final count odd. As long as a single large coin dominates, with an odd starting count the second player to draw, in this case the hustler again, will always win.

One-Liner: whist not particularly useful, the following short program is technically correct and does not waste valuable resources computing pointless details:

perl -e 'print "First player to draw is the lucky winner.\n"'
PERL 5 SOLUTION
use warnings;
use strict;
use feature ":5.26";

## ## ## ## ## MAIN:

my @draw = shuffle( 100, 50, 1, 10, 5, 20, 200, 2 );
my $coins = \@draw;

say "draw:\n", join ', ', $coins->@*;
say '';
    
my %player = map {$_ => 0} (0,1);
my $turn = 0;

while (scalar $coins->@*) {
    my $taken = $turn == 0 ? player0_move($coins) 
                           : player1_move($coins);
    $player{"$turn"} += $taken;
    say "player $turn takes:";
    say "\t$taken";
    say "\t\tplayer total : $player{$turn} ";
    say '';
    
    ## toggle the turn bit
    $turn ^= 1;
}

say "player 0 : $player{0}";
say "player 1 : $player{1}";

sub shuffle {
    my @input = @_;
    my @output;
    while (scalar @input) {
        my $idx = int rand (scalar @input);
        push @output, splice(@input, $idx, 1);
    }
    return @output;
}

sub player0_move {
## apply the winning algorithm to the line
## return the coin taken
    my $coins  = shift @_;
    my $length = scalar $coins->@* - 1;

    ## target_index will always be defined as target is largest value 
    ## coin in the line    
    my $target = find_target( $coins );
    my ($target_index) = grep { $coins->[$_] == $target } (0..$length);

    my $left  = $target_index;
    my $right = $length - $target_index;
    
    if ($right == 0) {
        return pop $coins->@*;
    }
    elsif ($left == 0 or $left > $right) {
        return shift $coins->@*;
    }
    else {
        return pop $coins->@*;
    }
}

sub player1_move {
## remove the largest coin from the the ends of the line 
    my $coins  = shift @_;
    return $coins->[0] > $coins->[scalar $coins->@* - 1] ? shift $coins->@* 
                                                         : pop $coins->@*;
}

sub find_target {
## determines the highest value coin left in the line and returns the value
## without altering the coin list
    my $coins = shift;
    my @sorted = sort {$b <=> $a} $coins->@*;
    return $sorted[0];
}

## included as a bonus, works just fine
sub find_target2 { return +( sort {$b <=> $a} $_[0]->@* )[0] }
raku solution
sub MAIN () {

    my @coins = ( 100, 50, 1, 10, 5, 20, 200, 2 ).pick: *;
    my %player;
    my $turn = 0;
    
    say "draw:\n", @coins.join: ', ';
    say '';
    
    while @coins.elems > 0 {
        my $taken = $turn == 0 ?? player0_move( @coins )
                               !! player1_move( @coins );
        %player{$turn} += $taken;
    
        say "player $turn takes:   $taken \n";
        say "\t player total:   %player{$turn} ";
        say '';

        ## toggle the turn bit
        $turn +^= 1;        
    }

    say "player 0 : %player{0}";
    say "player 1 : %player{1}";
}

sub player0_move ( @coins ) {
## apply the winning algorithm to the line
## return the coin taken

    ## target is the highest value coin left in the line
    my $target = @coins.sort({$^b <=> $^a}).head;
    my ($target_index) = @coins.grep: $target, :k;

    my $left  = $target_index;
    my $right = @coins.end - $target_index;
    
    ## check the ends of the line first and take 
    ## if not take from the larger side and return coin
    if $right == 0 {
        @coins.pop;
    }
    elsif $left == 0 or $left > $right {
        @coins.shift;
    }
    else {
        @coins.pop;
    }
}

sub player1_move ( @coins ) {
## remove the largest coin from the the ends of the line 
    @coins.head > @coins.tail ?? @coins.shift !! @coins.pop;
}


The Perl Weekly Challenge, that idyllic glade wherein we stumble upon the holes for these sweet descents, is now known as

The Weekly Challenge – Perl and Raku

It is the creation of the lovely Mohammad Sajid Anwar and a veritable swarm of contributors from all over the world, who gather, as might be expected, weekly online to solve puzzles. Everyone is encouraged to visit, learn and contribute at

https://perlweeklychallenge.org