Perl Weekly Challenge 052: Stepping Numbers & Lucky Winner

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.

The naive approach would be to iterate over all the numbers from 100 to 999 and check the difference between each adjacent digits.

#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

NUMBER: for my $n (100 .. 999) {
    my @digits = split //, $n;
    for my $i (1 .. $#digits) {
        next NUMBER
            unless 1 == abs($digits[$i - 1] - $digits[$i]);
    }
    say $n;
}

In fact, for the given range this is enough. But if we try to print all the stepping numbers of length 7 (1_000_000 .. 9_999_999), it takes more than 10 seconds.

The more efficient way is to generate all the stepping numbers directly. Imagine we start from a single digit. Usually, we can extend the number in two ways: add the digit + 1 as the next digit, or digit - 1 (for 0 and 9, we only have one option). This process can be repeated until the number has the required length.

I implemented this technique as a recursive subroutine.

#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

my $LENGTH = 3;

my @stepping_numbers;

sub prolong {
    my (@short) = @_;
    my $last = $short[-1];
    for my $next (grep $_ >= 0 && $_ <= 9,
                  $last - 1, $last + 1
    ) {
        if ($LENGTH == @short + 1) {
            push @stepping_numbers, join "", @short, $next;
        } else {
            prolong(@short, $next);
        }
    }
}

prolong($_) for 1 .. 9;
say for @stepping_numbers;

Changing the length to 7 makes almost no change in the running time; it usually finishes under 0.01 seconds.

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?

Let’s have a look at the coins first. The winner must take the £2, as all the other coins sump up to only £1.88.

If the number of the coins is even, there is a winning strategy for the player who starts the game: if they can take the £2 coin, let them do it. If they can’t, they must prevent the opponent from taking it: if it lies at position 1 or -2, let them not take the coin at position 0 or -1, respectively. Otherwise, they can play randomly.

I used Moo to implement the game as it made the code easier to read. Also, I only used pence in the code, to stay in the realm of integers (read Never Use Floats for Money if you haven't read it yet).

The program implements a simple command line game. You can play it against the computer who knows the best strategy. If the computer starts, it always wins. If you start, you can win unless you make a mistake.

Note that I only implemented everything from the point of view of player 1. The method switch switches the players so the situation of player 2 can be analysed in the same way.

Note that the attributes player1 and player2 are declared with the init_arg => undef. It means you can’t specify the amount of money for the player in the constructor, instead, the default is used, which is zero. Similarly, the remaining attribute contains the remaining (not yet taken) coins; it’s initialised lazily and used coins as the builder, i.e. it’s initialised to the list of the starting coins.

#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

{   package My::Game;
    use Moo;

    has [qw[ player1 player2 ]] => (
                  is => 'rw', default => 0, init_arg => undef);
    has coins => (is => 'ro', required => 1);
    has remaining => (
                  is => 'rw', lazy => 1, builder => 'coins');

    sub auto {
        my ($self) = @_;
        if (1 == @{ $self->remaining }
            || $self->remaining->[0] == 200
        ) {
            $self->turn('l');
        } elsif ($self->remaining->[-1] == 200
                 || $self->remaining->[1] == 200
             ) {
            $self->turn('r');
        } else {
            $self->turn('l');
        };
    }

    sub turn {
        my ($self, $where) = @_;
        $where = lc substr $where, 0, 1;
        my $pos = { l => 0, r => -1 }->{$where};
        $self->player1($self->player1
                       + splice @{ $self->remaining }, $pos, 1);
        $self->switch;
    }

    sub switch {
        my ($self) = @_;
        my $p = $self->player1;
        $self->player1($self->player2);
        $self->player2($p);
    }

    sub finished {
        ! @{ $_[0]->remaining }
    }

    sub status {
        my ($self) = @_;
        $self->player1, ', ', $self->player2,
            ": @{ $self->remaining }";
    }

    sub result {
        my ($self) = @_;
        die "Not yet finished" unless $self->finished;
        return ('draw', 'Player 1 wins', 'Player 2 wins')[
            $self->player1 <=> $self->player2 ]
    }

}

use List::Util qw{ shuffle };
my @coins = shuffle(100, 50, 1, 10, 5, 20, 200, 2);

say "@coins";
say "Input 'left' or 'right' (or just 'l' or 'r').";

my $starting_player = 1 + int rand 2;
say "Starting player: $starting_player";

my $game = 'My::Game'->new(coins => \@coins);
$game->auto if 2 == $starting_player;

until ($game->finished) {
    say $game->status;
    my $where;
    do {
        chomp( $where = <> );
    } until $where =~ /^(l(eft)?|r(ight)?)$/i;

    $game->turn($where);

    $game->auto unless $game->finished;
}

$game->switch if 2 == $starting_player;
say $game->status, $game->result;

Leave a comment

About E. Choroba

user-pic I blog about Perl.