Perl weekly challenge 104

Here are solutions to this weeks challenges from the Perl Weekly Challenge.

You can find my full code on Github

Task 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)


I will show you 4 versions of the code below - they essentially non-cached/cached versions of recursive (naive) code to get an individual element, and a non-recursive version to compute the whole sequence.

sub fusc {
  my $n = shift;
  return $n<2 ? $n : fusc($n>>1) + ( $n&1 ? fusc(1+$n>>1) : 0 );


  • Rather than using arithmetic operators here - we use binary operators - as we are checking for even (last bit set) or dividing by 2 (right it shift)

    • $n & 1 is faster than $n%2

    • By using bit shift operators here rather than divide by 2 - the code is faster and also avoids the need for adding an additional int as the bit-shift operator drops the last bit anyway!

  • We can split the numbers into one of 3 cases:

    • n < 2 - Then the return value is just n;

    • n is even - this is just the entry at index n/2 - which we can also think of as floor( n/2 );

    • n is odd - this is just the sum of entries at index (n-1)/2 & (n+1)/2- which we can also think of as floor( n/2 ) + 1 + floor( n/2 );

  • We can write this as nested ternary operators - but note we can re-phrase the last two cases as floor(n/2) plus, if n is odd 1+floor(n/2).

To add caching in this case we just use a state variable which contains all the values - as the index is numeric we can use an array here rather than a hash.

sub fusc_cache {
  my $n = shift;
  state @cache;
  return $cache[$n] ||= $n<2 ? $n :
    fusc_cache($n>>1) + ( $n&1 ? fusc_cache(1+$n>>1) : 0 );


In all these cases we wish to avoid the overhead of recursion - even with caching there is a great overhead in the stack management of the function calls - it isn't always possible - but it is in this case.

In this example we store the sequence in an array and push the subsequence fusc numbers on to the end of it.

  • We note we have two ways of extending the list odd and even - so we can right logic to work out which one we are needing - or we can realise that we can push 2 values at a time, one for the next odd element and one for the next even element, this simplifies the code somewhat...
  • Because we push 2 at a time - we only need to run through the loop half the numbers of times - from 1 .. n/2-1
  • We do need to specify and extra seed value (for n=2)
  • When n is even we generate an extra entry - so we just remove it with a pop at the end.
sub fusc_seq {
  my $n = shift;
  return 0..$n-1 if $n<2;
  my   @seq = (0,1,1);
  push @seq, $seq[$_]+$seq[$_+1], $seq[$_+1] foreach 1..$n/2-1;
  pop  @seq unless $n&1;
  return @seq;

The cached version is similar - we just make the variable @seq a state variable and it is remembered between calls, we then only need to start at the top of the cache and add new elements on -- we start at @seq/2 rather than 1 like in the code above.

The cache now may be much larger than the sequence length we want, so we just use an array slice to return the parts we want

sub fusc_seq_cache {
  my $n = shift;
  state  @seq = (0,1,1);
  push   @seq, $seq[$_]+$seq[$_+1], $seq[$_+1] foreach @seq/2..$n/2-1;
  return @seq[0..$n-1];

Task 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:

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

The solution

There is some flexibility in this weeks challenge - as to how to simulate the game. I'm going to write two versions, one where the computer plays randomly - and one where it plays the optimal solution.

Rather than having human interaction - I'm also playing the human player randomly...

sub simulate {
  my($tokens,$player,$n) = (12,1,'');
  while(1) {
    $n = 1 + int rand 3;
    last if $n >= $tokens;
    say "Player $player takes $n token(s) and leaves $tokens token(s)";
    $player = 3-$player;
  say "Player $player takes the last $n token(s) and wins...\n";


  • We use a while(1) loop with last as it simplifies the logic.

  • To flip the player number from 1 to 2 and v.v. then we just subtract it from 3 - a classic coding trick so we don't need the ternary $player = $player==1 ? 2 : 1

Optimal solution (computer always wins!)

In some ways the optimal player 2 solution is easier as it doesn't need to keep track of players.. Basically whatever player 1 (human) does player 2 (computer) takes tokens so that there are a multiple of 4 left. Human takes n computer takes 4-n.

sub simulate_player2 {
  my $tokens = 12;
  while(1) {
    my $n = 1 + int rand 3;
    $tokens -= $n;
    say "Player 1 takes $n token(s) and leaves $tokens token(s)";
    $n = 4-$n;
    print "Player 2 takes $n token(s) and ";
    $tokens -= $n;
    last unless $tokens;
    say "leaves $tokens tokens";
  say "wins...\n";

Leave a comment

About James Curtis-Smith

user-pic Perl developer for nearly 30 years now, mainly in maintenance scripts and web pages, using mod_perl. I also code a lot in PHP (20+yrs), and also extensive experience in HTML (27+yrs), Javascript(25+yrs), CSS (24+yrs) and SASS.