Perl Weekly Challenge: Week 104

Challenge 1:

FUSC Sequence

Write a script to generate first 50 members of FUSC Sequence. Please refer to OEIS for more information._

The sequence defined as below:

fusc(0) = 0
fusc(1) = 1
for n > 1:
when n is even: fusc(n) = fusc(n / 2),
when n is odd: fusc(n) = fusc((n-1)/2) + fusc((n+1)/2)

This is a situation where Rakus multimethods are very useful. We can treat each case of the sequence as a separate function which makes the code much more expressive and easy to understand.

multi sub fusc(
    Int $n where { $n == 0 }
) {
    return 0;
}

multi sub fusc(
    Int $n where { $n == 1 }
) {
    return 1;
}

multi sub fusc(
    Int $n where { ($n > 1) && ($n % 2 == 0); }
) {
    return fusc($n div 2);
}

multi sub fusc(
    Int $n where { ($n > 1) && ($n % 2 == 1); }
) {
    return fusc(($n - 1) div 2) + fusc(($n + 1) div 2);
}

sub MAIN () {
    for ^50 -> $n {
        print fusc($n), ' ';
    }

    print "\n";
}

(Full code on Github.)

Not that the Perl version shown below is so bad but it's a little harder to read IMO.

sub fusc {
    my ($n) = @_;

    if ($n < 2) {
        return $n;
    }

    if ($n % 2 == 0) {
        return fusc($n / 2);
    } else {
        return fusc(($n - 1) / 2) + fusc(($n + 1) / 2);
    }
}

for my $n (0 .. 49) {
    print fusc($n), ' ';
}
print "\n";

(Full code on Github.)

Other than those minor inconveniences, the Perl version follows the same pattern as the Raku version.

Challenge 2:

NIM Game

Write a script to simulate the NIM Game.

It is played between 2 players. For the purpose of this task, let assume you play against the machine.

There are 3 simple rules to follow:

a) You have 12 tokens
b) Each player can pick 1, 2 or 3 tokens at a time
c) The player who picks the last token wins the game

With only three rules, NIM is a very easy game to program. This time I'll start with the Perl version.

my $tokens = 12;

Rule a is implemented in 1 line.

while ($tokens) {

Now we have to alternate between the player and computer until all the tokens have been picked.
This is done with a while loop.

    say "There are $tokens ", plural("token", $tokens), ".";

I start each turn by printing how many tokens are left. A pet peeve of mine is incorrect pluralization i.e. "1 tokens". So I have a little function that does the right thing which looks like this:

sub plural {
    my ($word, $count) = @_;
    return $word . ($count == 1 ? q{} : 's');
}

...back to the game:

    my $playerChoice = 0;

    while (1) {
        print "How many tokens will you pick [1, 2 or 3]?";
        my $answer = <>;
        if ($answer =~ /\A \s* (1|2|3) \s* \z/msx) {
            $playerChoice = $1;
            last;
        }
    }

I prompt the player for how many tokens they want to pick. The only valid choices are 1, 2 or 3 so I have to validate their response to allow only those values.

    $tokens -= $playerChoice;
    if ($tokens < 1) {
        say "You win!";
        last;
    }

If they made a valid move, that number of tokens are subtracted from the total. As per rule 3, If there are none left the player has won.

    my $computerChoice = 4 - $playerChoice;
    say "The computer picks $computerChoice ", plural("token", $computerChoice);
    $tokens -= $computerChoice;

    if ($tokens < 1) {
        say "The computer wins.";
        last;
    }

Now for the computer. An interesting fact I learned when researching this game on the web is that player 2 can guarantee a win every time by picking 4 - the number of tokens picked by player 1. So my code does just that. If there are no tokens left at this point, the computer has won.

}

(Full code on Github.)

This is the Raku version.

sub plural(Str $word, Int $count) {
    return $word ~ ($count == 1 ?? q{} !! 's');
}

sub MAIN () {
    my $tokens = 12;

    while ($tokens) {
        say "There are $tokens ", plural("token", $tokens), ".";
        my $playerChoice = 0;

        loop {
            my $answer = prompt("How many tokens will you pick [1, 2 or 3]?");
            if $answer ~~ /^ \s* (1|2|3) \s* $/ {
                $playerChoice = $0;
                last;
            }
        }

The only features really worthy of note are the prompt() function which takes some of the grunt work out of displaying a message and getting a line of input. Also regexp capture variables start from $0 not $1 as in Perl. That tripped me up for a minute.

        $tokens -= $playerChoice;
        if $tokens < 1 {
            say "You win!";
            last;
        }

        my $computerChoice = 4 - $playerChoice;
        say "The computer picks $computerChoice ",
            plural("token", $computerChoice);
        $tokens -= $computerChoice;

        if ($tokens < 1) {
            say "The computer wins.";
            last;
        }
    }
}

(Full code on Github.)