Perl Weekly Challenge: Week 52

Challenge 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.

This is easy enough to do by just grepping through the numbers from 100 to 999 and looking for ones where the difference between the first and the second digits is 1, and the difference between the second and third digits is 1. Actually, because we are using subtraction, the difference could be 1 or -1. Using the abs() function removes the need to worry about signs.

say join q{ }, grep {
    my @digits = split //;

    abs($digits[0] - $digits[1]) == 1 && abs($digits[1] - $digits[2]) == 1;
} 100 .. 999;

(Full code on Github.)

This is the Raku version:

(100 .. 999).grep({
    my @digits = $_.comb;
    abs(@digits[0] - @digits[1]) == 1 && abs(@digits[1] - @digits[2]) == 1;
}).join(q{ }).say;

(Full code on Github.)

Challenge 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?

This time, I'll show the Raku version of my solution first.

The problem description doesn't state whether the player goes first or the computer so I actually run the simulation twice. The boolean $playerTurn_ parameter to run() determines if the player is going first or not. I assign $playerTurn_ to $playerTurn because in Raku, function parameters are immutable by default and I'm going to need to change the value later. I thought I could get around this by declaring $playerTurn_ is rw but that resulted in a cryptic error, Parameter '$playerTurn' expected a writable container, but got Bool value. I don't understand what that means.

sub run(Bool $playerTurn_) {
    my $playerTurn = $playerTurn_;

Next are some variables defining the line of coins and the players and computers running totals.

    my @coins = (100, 50, 1, 10, 5, 20, 200, 2);
    my $playerAmount = 0;
    my $computerAmount = 0;

Then while coins remain...

    while @coins.elems {

Another assumption I'm making is that each opponent is making the best possible move (i.e. taking the coin that is worth the most money) that they can make in their turn. This can be modelled with the minmax algorithm.

In the function below, I compare the total value of the coin list minus the leftmost coin versus the total value of the coin list minus the rightmost coin. note the use of the [+] operator to sum up the lists in a compact way.

sub minmax(@coins) {
    return [+] @coins[1 .. *-1] > [+] @coins[0 .. *-2];
}

Going back to run() based on minmax() I decide whether to take off the leftmost or rightmost coin.

        my $amount = minmax(@coins) ?? @coins.shift !! @coins.pop;

Based on whose turn it is, I add the amount of that coin to the current choosers running total and pass the turn to their opponent.

        if ($playerTurn) {
            $playerAmount += $amount;
            $playerTurn = False;
        } else {
            $computerAmount += $amount;
            $playerTurn = True;
        }
    }

    if ($playerAmount > $computerAmount) {
        return (True, $playerAmount / 100);
    } else {
        return (False, $computerAmount / 100);
    }
}

In the main function I run this simulation twice, once with the player going first and then with the computer going first and print the result.

multi sub MAIN() {
    say 'Assuming both take the best coin...';
    for (True, False) -> $playerTurn {
        print 'If the ', ($playerTurn ?? 'player' !! 'computer'),
            ' goes first, ';
        my ($winner, $amount) = run($playerTurn);
        print 'the ', ($winner ?? 'player' !! 'computer'), ' wins with £',
            $amount, ".\n";
    }
}

(Full code on Github.)

My conclusion is that whoever goes second will win with £3.06

This is the perl version. Perl doesn't have [+] so I implemented sum() to do the job.

sub sum {
    my $total = 0;
    for my $elem (@{ $_[0] }) {
        $total += $elem;
    }

    return $total;
}

sub minmax {
    my @coins = @{ $_[0] };

    return sum(\@coins[1 .. -1]) > sum(\@coins[0 .. -2]);
}

sub run {
    my ($playerTurn) = @_;
    my @coins = (100, 50, 1, 10, 5, 20, 200, 2);
    my $playerAmount = 0;
    my $computerAmount = 0;

    while (scalar @coins) {
        my $amount = minmax(\@coins) ? shift @coins : pop @coins;

        if ($playerTurn) {
            $playerAmount += $amount;
            $playerTurn = undef;
        } else {
            $computerAmount += $amount;
            $playerTurn = 1;
        }
    }

    if ($playerAmount > $computerAmount) {
        return (1, $playerAmount / 100);
    } else {
        return (undef, $computerAmount / 100);
    }
}

say 'Assuming both take the best coin...';
for my $playerTurn (1, undef) {
    print 'If the ', ($playerTurn ? 'player' : 'computer'), ' goes first, ';
    my ($winner, $amount) = run($playerTurn);
    print 'the ', ($winner ? 'player' : 'computer'), ' wins with £',
        $amount, ".\n";
}

(Full code on Github.)