laurent_r

These are some answers to the Week 52 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

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.

Just to make things slightly clearer, I would say that all adjacent digits should have an absolute difference of 1, so that 542, 454, or 654 are also stepping numbers.

Stepping Numbers in Perl

Given that the range is quite small, we can use a brute force approach on all numbers between the input values: check for every number in the range whether it fits the definition.

use strict;
use warnings;
use feature "say";

die "Please provide two numbers between 100 and 999" if @ARGV != 2;
my ($start, $end) = @ARGV;
chomp $end;
die "Invalid parameters" if $start !~ /^\d{3}$/ or $end !~ /^\d{3}$/;
($start, $end) = ($end, $start) if $start > $end;
for my $num ($start..$end) {
    my @digits = split //, $num;
    if (abs($digits[0] - $digits[1]) == 1 &&
        abs($digits[1] - $digits[2]) == 1) {
        say "$num is a stepping number.";
    }
}

This is an example execution:

$ perl stepping_numbers.pl 600 230
232 is a stepping number.
234 is a stepping number.
321 is a stepping number.
323 is a stepping number.
343 is a stepping number.
345 is a stepping number.
432 is a stepping number.
434 is a stepping number.
454 is a stepping number.
456 is a stepping number.
543 is a stepping number.
545 is a stepping number.
565 is a stepping number.
567 is a stepping number.

Note that there is another possible approach: we could construct only stepping numbers and check that they are in the range. We will show this in Raku.

Stepping Numbers in Raku

Using essentially the same brute-force algorithm as in Perl might lead to the following code:

use v6;

subset Three-digits of Int where 99 < * < 1000;

multi sub prefix:<dif1> (List $val) { 
    abs($val[0] - $val[1]) == 1 ?? True !! False;
}

sub MAIN (Three-digits $start is copy, Three-digits $end is copy) {
    ($start, $end) = ($end, $start) if $start > $end;

    for $start..$end -> $num {
        my $flag = True;
        for $num.comb.rotor: 2 => -1 -> $seq {
            $flag = False unless dif1 $seq;
        }
        say "$num is a stepping number." if $flag;
    }
}

This is an example output:

$ perl6 3-digits.p6 200 400
210 is a stepping number.
212 is a stepping number.
232 is a stepping number.
234 is a stepping number.
321 is a stepping number.
323 is a stepping number.
343 is a stepping number.
345 is a stepping number.

But, as said earlier, we could use a different algorithm: we could construct only stepping numbers and check that they are in the range. This leads to the following solution:

subset Three-digits of Int where 99 < * < 1000;

sub func (Three-digits $start is copy, Three-digits $end is copy) {
    ($start, $end) = ($end, $start) if $start > $end;
    for 1..9 -> $i {
        for $i-1, $i+1 -> $j {
            for $j-1, $j+1 -> $k {
                my $num = 100*$i + 10*$j + $k;
                say "$num is a stepping number." if $start < $num < $end;
            }
        }
    }
}

This program displays the same result as the previous solution when given the same inputs. Note that the outer loop (for 1..9 -> $i {) could easily be improved in terms of performance by using the first digit of the input numbers for the range. However, the program is so fast that this is not required.

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?

I do not fully understand the last sentence as a clear task. My interpretation will be to write a computer program that will win each time it can.

Looking at the challenge, the winner is the player that picks the 200p coin, since the sum of all other coins is less than 200p. Since, in any game, one of the player can end up picking the 200p coin, we don’t need to care about the other coins, we just need to optimize our strategy to get the 200p coin.

For this, we should try to leave an odd number of coins on either side of the 200p coin, so that the other player is forced to leave an even number of coins and eventually 0 coin on either side. With 8 coins, the first player can always win.

Lucky Winner in Perl

Optimizing for the 200p coin leads to the following program:

use strict;
use warnings;
use feature "say";

my @coins = @ARGV > 0 ? @ARGV : (100, 50, 1, 10, 5, 20, 200, 2);

my ($index200) = grep $coins[$_] == 200, 0..$#coins;
my @before = @coins[0..$index200-1];
my @after = @coins[$index200+1..$#coins];
ask();
while (my $move = <STDIN>) {
    chomp $move;
    last if $move eq "";
    my $coin;
    if ($move eq "B") {
        $coin = shift @before // 200;
    } elsif ($move eq "E") {
        $coin = pop @after // 200;
    } else {
        say "Invalid choice"; next;
    }
    if ($coin == 200) {
        say "You win!"; last;      
    }
    if (@before == 0) {
        say "I pick the 200p coin at start and win"; last;
    } elsif (@after == 0) {
        say "I pick the 200p coin at end and win"; last;
    }
    if (@before % 2 == 0) {
        $coin = shift @before;
    } elsif (@after %2 == 0) {
        $coin = pop @after;
    } else {
        # no winning move, let's hope for a mistake
        if (@before > @after) {
            $coin = shift @before;
        } else {
            $coin = pop @after;
        }
    }
    ask();
}

sub ask {
    say "New situation = @before 200 @after";
    say "Pick a coin at beginning (B) or end (E)";
}

Running it displays the following sample output:

$ perl  coins.pl
New situation = 100 50 1 10 5 20 200 2
Pick a coin at beginning (B) or end (E)
B
New situation = 1 10 5 20 200 2
Pick a coin at beginning (B) or end (E)
B
New situation = 5 20 200 2
Pick a coin at beginning (B) or end (E)
B
New situation = 20 200
Pick a coin at beginning (B) or end (E)
E
You win!

Or:

$ perl  coins.pl
New situation = 100 50 1 10 5 20 200 2
Pick a coin at beginning (B) or end (E)
E
I pick the 200p coin at end and win

Lucky winner in Raku

Just as in Perl, we are looking for the 200p coin:

my @coins = @*ARGS.elems > 0 ?? @*ARGS !! (100, 50, 1, 10, 5, 20, 200, 2);

say @coins;
my ($index200) = grep { @coins[$_] == 200}, 0..@coins.end;
my @before = @coins[0..$index200-1];
my @after = @coins[$index200+1..@coins.end];
loop  {
    my $move = ask();
    last if $move eq "";
    my $coin;
    if ($move eq "B") {
        $coin = @before.elems ?? shift @before !! 200;
    } elsif ($move eq "E") {
        $coin = @after.elems ?? pop @after !! 200;
    } else {
        say "Invalid choice"; next;
    }
    if ($coin == 200) {
        say "You win!"; last;      
    }
    if (@before.elems == 0) {
        say "I pick the 200p coin at start and win"; last;
    } elsif (@after.elems == 0) {
        say "I pick the 200p coin at end and win"; last;
    }
    if (@before %% 2) {
        $coin = shift @before;
    } elsif (@after %% 2) {
        $coin = pop @after;
    } else {
        # no winning move, let's hope for a mistake
        if (@before.elems > @after.elems) {
            $coin = shift @before;
        } else {
            $coin = pop @after;
        }
    }
}

sub ask () {
    say "New situation = @before[] 200 @after[]";
    my $choice = prompt "Pick a coin at beginning (B) or end (E) ";
}

This program leads to similar results as the Perl program:

$ perl6 coins.p6
[100 50 1 10 5 20 200 2]
New situation = 100 50 1 10 5 20 200 2
Pick a coin at beginning (B) or end (E) E
I pick the 200p coin at end and win

Or:

$ perl6 coins.p6
[100 50 1 10 5 20 200 2]
New situation = 100 50 1 10 5 20 200 2
Pick a coin at beginning (B) or end (E) B
New situation = 1 10 5 20 200 2
Pick a coin at beginning (B) or end (E) B
New situation = 5 20 200 2
Pick a coin at beginning (B) or end (E) B
New situation = 20 200
Pick a coin at beginning (B) or end (E) E
You win!

Wrapping up

The next week Perl Weekly Challenge is due to start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, March 29, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.