Of Points
with Raku and Perl

by Arne Sommer

Of Points with Raku and Perl

[138] Published 24. July 2021.

This is my response to the Perl Weekly Challenge #122.

Challenge #122.1: Average of Stream

You are given a stream of numbers, @N.

Write a script to print the average of the stream at every point.

Example: 
Input: @N = (10, 20, 30, 40, 50, 60, 70, 80, 90, ...)
Output:      10, 15, 20, 25, 30, 35, 40, 45, 50, ...

Average of first number is 10.
Average of first 2 numbers (10+20)/2 = 15
Average of first 3 numbers (10+20+30)/3 = 20
Average of first 4 numbers (10+20+30+40)/4 = 25 and so on.
File: average-of-stream 
#! /usr/bin/env raku

unit sub MAIN (*@N where all(@N) ~~ Numeric, :v(:$verbose));  # [1]

my $sum   = 0;                # [5a]
my $count = 0;                # [2]

my @result;                   # [6a]

for @N -> $current            # [3]
{
  $sum += $current;           # [4]

  my $avg = $sum / ++$count;  # [5]
  @result.push: $avg;         # [6]

  say "Average of first { $count == 1 ?? "number" !! "$count numbers" } \
    ({ @N[^$count].join("+")  })/$count = $avg" if $verbose;
}

say @result.join(", ");       # [7]

[1] Not a stream of numbers (as requested), but a list of numeric values on the command line. We ensure that they are numeric by smartmatching them (all of them, with an all junction) against the Numeric type.

[2] The number of values calculated so far.

[3] For each value,

[4] • add it to the sum.

[5] • get the average so far.

[6] • add the (new) average to the result list.

[7] Print the list of average values.

See docs.raku.org/routine/all for more information about all, and docs.raku.org/type/Junction for more information about Junctions.

Running it: 

$ ./average-of-stream 10 20 30 40 50 60 70 80 90
10, 15, 20, 25, 30, 35, 40, 45, 50

Verbose mode mimics the explanation given in the example in the challenge: 

$ ./average-of-stream -v 10 20 30 40 50 60 70 80 90
Average of first number (10)/1 = 10
Average of first 2 numbers (10+20)/2 = 15
Average of first 3 numbers (10+20+30)/3 = 20
Average of first 4 numbers (10+20+30+40)/4 = 25
Average of first 5 numbers (10+20+30+40+50)/5 = 30
Average of first 6 numbers (10+20+30+40+50+60)/6 = 35
Average of first 7 numbers (10+20+30+40+50+60+70)/7 = 40
Average of first 8 numbers (10+20+30+40+50+60+70+80)/8 = 45
Average of first 9 numbers (10+20+30+40+50+60+70+80+90)/9 = 50
10, 15, 20, 25, 30, 35, 40, 45, 50

Looking good.

A Perl Version

This is a straight forward translation of the Raku version.

File: average-of-stream-perl 
#! /usr/bin/env perl

use strict;
use warnings;
use feature 'say';
use Getopt::Long;

my $verbose = 0;

GetOptions("verbose" => \$verbose);

die "Please specify a list of numbers" unless @ARGV;  # [1]

my $sum   = 0;
my $count = 0;

my @result;

for my $current (@ARGV)                               # [1]
{
  $sum += $current;

  my $avg = $sum / ++$count;
  push(@result, $avg);

  say "Average of first " .
      ( $count == 1 ? "number" : "$count numbers" ) .
      " (" . join("+", @ARGV[0 .. $count -1]) . ")/$count = $avg" if $verbose;
}

say join(", ", @result);

[1] I have chosen to keep the numbers in @ARGV.

Running it gives the same result as the Raku version: 

$ ./average-of-stream-perl 10 20 30 40 50 60 70 80 90
10, 15, 20, 25, 30, 35, 40, 45, 50

$ ./average-of-stream-perl -v 10 20 30 40 50 60 70 80 90
Average of first number (10)/1 = 10
Average of first 2 numbers (10+20)/2 = 15
Average of first 3 numbers (10+20+30)/3 = 20
Average of first 4 numbers (10+20+30+40)/4 = 25
Average of first 5 numbers (10+20+30+40+50)/5 = 30
Average of first 6 numbers (10+20+30+40+50+60)/6 = 35
Average of first 7 numbers (10+20+30+40+50+60+70)/7 = 40
Average of first 8 numbers (10+20+30+40+50+60+70+80)/8 = 45
Average of first 9 numbers (10+20+30+40+50+60+70+80+90)/9 = 50
10, 15, 20, 25, 30, 35, 40, 45, 50

But non-numeric values will trip up the program, as I have dropped the type check. (See [1] in the Raku program, above.) 

$ ./average-of-stream-perl 10 20 30 40 50 60 70 80 90 lk
Argument "lk" isn't numeric in addition (+) at …
10, 15, 20, 25, 30, 35, 40, 45, 50, 45

We can fix that by adding a check for numeric values, and postphone the printing of the verbose output until we have reached the end of the arguments (and thus ensured that they are all numeric):

File: average-of-stream-2-perl 
#! /usr/bin/env perl

use strict;
use warnings;
use feature 'say';
use Getopt::Long;
use Scalar::Util qw(looks_like_number);                      # [1]

my $verbose = 0;

GetOptions("verbose" => \$verbose);

die "Please specify a list of numbers" unless @ARGV;

my $sum   = 0;
my $count = 0;

my @result;
my @verbose;                                                 # [2]

for my $current (@ARGV)
{
  die "$current: Not a numeric value"
    unless looks_like_number($current);                      # [1a]

  $sum += $current;
  
  my $avg = $sum / ++$count;
  push(@result, $avg);

  push(@verbose, "Average of first " .                       # [2a]
      ( $count == 1 ? "number" : "$count numbers" ) .
      " (" . join("+", @ARGV[0 .. $count -1]) . ")/$count = $avg")
        if $verbose;
}

$verbose && say $_ for @verbose;                             # [2b]

say join(", ", @result);

[1] Use this module/procedure combo to ensure that the value is numeric. Die if not [1a].

[2] Collect the verbose output in an array [2a], and print them when we have finished parsing the values (and not died). Note the crative way of combining a conditional (if) and a loop (for) in a single line (with &&) [2b].

Running it: 

$ ./average-of-stream-perl -v 10 20
10, 15

$ ./average-of-stream-2-perl -v 10 20
Average of first number (10)/1 = 10
Average of first 2 numbers (10+20)/2 = 15
10, 15

$ ./average-of-stream-2-perl -v 10 20 a12
a12: Not a numeric value at ./average-of-stream-2-perl line 23.

$ ./average-of-stream-2-perl 10 20 a12
a12: Not a numeric value at ./average-of-stream-2-perl line 23.

Challenge #122.2: Basketball Points

You are given a score $S.

You can win basketball points e.g. 1 point, 2 points and 3 points.

Write a script to find out the different ways you can score $S.

Example: 
Input: $S = 4
Output: 1 1 1 1
        1 1 2
        1 2 1
        1 3
        2 1 1
        2 2
        3 1

Input: $S = 5
Output: 1 1 1 1 1
        1 1 1 2
        1 1 2 1
        1 1 3
        1 2 1 1
        1 2 2
        1 3 1
        2 1 1 1
        2 1 2
        2 2 1
        2 3
        3 1 1
        3 2

Recursion is suitable here:

File: basketball-points-ifs 
#! /usr/bin/env raku

unit sub MAIN (UInt $S, :v(:$verbose));  # [1]

recurse( (), $S);                        # [2]

sub recurse (@points, $left)             # [3]
{
  if $left == 0                          # [4]
  {
    say @points.join(" ");
    return;
  }

  if $left >= 1                          # [5]
  {
    my @p = @points.clone;
    @p.push: 1;
    recurse(@p, $left -1);
  }

  if $left >= 2                          # [6]
  {
    my @p = @points.clone;
    @p.push: 2;
    recurse(@p, $left -2);
  }

  if $left >= 3                          # [7]
  {
    my @p = @points.clone;
    @p.push: 3;
    recurse(@p, $left -3);
  }
}

[1] The UInt type does what it is short for «Unsigned Int». Note that zero is allowed.

[2] Off we go recurively. The argument is a list of (partial) values in the solution (first argument), and the remainder (second argument).

[3] The recursive prosedure.

[4] If the remainder is zero, we are done. Print the (partial) list of values, and exit this recursive call.

[5] Do we have at least «1» as the remainder? If so, add it to the list of (partial) values, substract it from the remainder, and off we go recursively.

[6] As above, but for «2».

[7] As above, but for «3».

See docs.raku.org/type/UInt for more information about the «UInt» type.

Then the Perl version:

File: basketball-points-ifs-perl 
#! /usr/bin/env perl

use strict;
use warnings;
use feature 'say';
use feature 'signatures';

no warnings qw(experimental::signatures);

my $S = $ARGV[0] // die "Please specify a positive integer";

recurse($S);                  # [1]

sub recurse ($left, @points)  # [1a]
{
  if ($left == 0)
  {
    say join(" ", @points);
    return;
  }

  recurse($left - 1, @points, 1) if $left >= 1;  # [1b] [2]
  recurse($left - 2, @points, 2) if $left >= 2;
  recurse($left - 3, @points, 3) if $left >= 3;
}

[1] A list of lists is cumbersome in Perl, so I have moved the «left» value up front of the array. The rest is the path so far.

[2] We can pass a custom array like this, thus avoiding the clone issue in the Raku version.

Running them: 

$ ./basketball-points-ifs 4
1 1 1 1
1 1 2
1 2 1
1 3
2 1 1
2 2
3 1

$ ./basketball-points-ifs-perl 4
1 1 1 1
1 1 2
1 2 1
1 3
2 1 1
2 2
3 1

$ ./basketball-points-ifs 5
1 1 1 1 1
1 1 1 2
1 1 2 1
1 1 3
1 2 1 1
1 2 2
1 3 1
2 1 1 1
2 1 2
2 2 1
2 3
3 1 1
3 2

$ ./basketball-points-ifs-perl 5
1 1 1 1 1
1 1 1 2
1 1 2 1
1 1 3
1 2 1 1
1 2 2
1 3 1
2 1 1 1
2 1 2
2 2 1
2 3
3 1 1
3 2

We can have the compact recursive calls in Raku, by flattening the first argument (i.e. ensureing that it is a single array). And we can turn the if block into a one liner as well:

File: basketball-points-ifs-2 
#! /usr/bin/env raku

unit sub MAIN (UInt $S, :v(:$verbose));

recurse( (), $S);

sub recurse (@points, $left)
{
  $left == 0 && @points.join(" ").say && return;

  recurse((@points, 1).flat, $left -1) if $left >= 1;
  recurse((@points, 2).flat, $left -2) if $left >= 2;
  recurse((@points, 3).flat, $left -3) if $left >= 3;
}

Pretty compact.

We can combine the three recursive calls (and make the upper limit of 3 configurable at the same time):

File: basketball-points-loop 
#! /usr/bin/env raku

unit sub MAIN (UInt $S, :v(:$verbose), UInt :u(:$upper) where $upper > 1 = 3);

recurse( (), $S);

sub recurse (@points, $left)
{
  $left == 0 && @points.join(" ").say && return;

  for 1 .. $upper -> $step
  {
    recurse((@points, $step).flat, $left - $step) if $left >= $step;
  }
}

This version has the same number of lines, but is much harder to read. The custom upper limit is probably worth the hassle.

Then the Perl version:

File: basketball-points-loop-perl 
#! /usr/bin/env perl

use strict;
use warnings;
use feature 'say';
use feature 'signatures';
use Getopt::Long;

no warnings qw(experimental::signatures);

my $upper = 3;

GetOptions("upper=i" => \$upper);

die "--upper must be > 0" if $upper < 1;

my $S = $ARGV[0] // die "Please specify a positive integer";

recurse($S);

sub recurse ($left, @points)
{
  $left == 0 && ( say join(" ", @points) ) && return;  # [1]
 
  for my $step (1 .. $upper)
  {
    if ($left >= $step)
    {
      recurse($left - $step, @points, $step) if $left >= $step;
    }
  }
}

[1] The parens around the middle part are required, because of presedence rules. (Try without, and see what happens.) The Raku version has the same presedence issue, but I moved the say to the end of the expression instead - as a method call.

Running them: 

$ ./basketball-points-loop 4
1 1 1 1
1 1 2
1 2 1
1 3
2 1 1
2 2
3 1

$ ./basketball-points-loop-perl 4
1 1 1 1
1 1 2
1 2 1
1 3
2 1 1
2 2
3 1

$ ./basketball-points-loop 5
1 1 1 1 1
1 1 1 2
1 1 2 1
1 1 3
1 2 1 1
1 2 2
1 3 1
2 1 1 1
2 1 2
2 2 1
2 3
3 1 1
3 2

$ ./basketball-points-loop-perl 5
1 1 1 1 1
1 1 1 2
1 1 2 1
1 1 3
1 2 1 1
1 2 2
1 3 1
2 1 1 1
2 1 2
2 2 1
2 3
3 1 1
3 2

With a custom upper limit: 

$ ./basketball-points-loop -u=4 4
1 1 1 1
1 1 2
1 2 1
1 3
2 1 1
2 2
3 1
4

$ ./basketball-points-loop -u=4 5
1 1 1 1 1
1 1 1 2
1 1 2 1
1 1 3
1 2 1 1
1 2 2
1 3 1
1 4
2 1 1 1
2 1 2
2 2 1
2 3
3 1 1
3 2
4 1

We can use a queue instead of recursion:

File: basketball-points-queue 
#! /usr/bin/env raku

unit sub MAIN (UInt $S, :v(:$verbose), UInt :u(:$upper) where $upper > 1 = 3);

my @queue = ( ( (), $S), );                                        # [1]

while @queue                                                       # [1a]
{
  my $curr   = @queue.shift;                                       # [1b]
  my @points = $curr[0];
  my $left   = $curr[1];

  $left == 0 && @points.join(" ").say && next;

  for 1 .. $upper -> $step
  {
    if $left >= $step
    {
      @queue.push:
        ((@points, $step).flat, $left - $step) if $left >= $step;  # [1c]
    }
  }
}

[1] We have a queue (an array), and go on as long as it has something in it. We add items to it (in [1c]), instead of arecursive call.

Then the Perl version:

File: basketball-points-queue-perl 
#! /usr/bin/env perl

use strict;
use warnings;
use feature 'say';
use feature 'signatures';
use Getopt::Long;

no warnings qw(experimental::signatures);

my $upper = 3;

GetOptions("upper=i" => \$upper);

die "--upper must be > 0" if $upper < 1;

my $S = $ARGV[0] // die "Please specify a positive integer";

my @queue;

my @first = ($S);  # [1]

push(@queue, \@first);

while (@queue)
{
  my $curr = shift(@queue);

  my ($left, @points) = @$curr;

  $left == 0 && ( say join(" ", @points) ) && next;

  for my $step (1 .. $upper)
  {
    if ($left >= $step)
    {
      my @p = ($left - $step, @points, $step);
      push(@queue, \@p);  # [1]
    }
  }
}

Running them: 

$ ./basketball-points-queue 4
1 3
2 2
3 1
1 1 2
1 2 1
2 1 1
1 1 1 1

$ ./basketball-points-queue-perl 4
1 3
2 2
3 1
1 1 2
1 2 1
2 1 1
1 1 1 1

$ ./basketball-points-queue 5
2 3
3 2
1 1 3
1 2 2
1 3 1
2 1 2
2 2 1
3 1 1
1 1 1 2
1 1 2 1
1 2 1 1
2 1 1 1
1 1 1 1 1

$ ./basketball-points-queue-perl 5
2 3
3 2
1 1 3
1 2 2
1 3 1
2 1 2
2 2 1
3 1 1
1 1 1 2
1 1 2 1
1 2 1 1
2 1 1 1
1 1 1 1 1

Oops. The order has been reversed. Or rather, it has been changed quite a lot. Using a stack instead of a queue will remedy that, with a little care (i.e. a reversion):

File:/basketball-points-stack 
#! /usr/bin/env raku

unit sub MAIN (UInt $S, :v(:$verbose), UInt :u(:$upper) where $upper > 1 = 3);

my @stack = ( ( (), $S), );

while @stack
{
  my $curr   = @stack.shift;
  my @points = $curr[0];
  my $left   = $curr[1];

  $left == 0 && ( say join(" ", @points) ) && next;

  for $upper ... 1 -> $step                 # [2]
  {
    @stack.unshift: ((@points, $step).flat, $left - $step) if $left >= $step;
                                            # [1]
  }
}

[1] unshift adds to the front of the array (whereas push adds at the end).

[2] We have to reverse the order of this loop as well. This is done here by counting down.

Then the Perl version:

File: basketball-points-stack-perl 
#! /usr/bin/env perl

use strict;
use warnings;
use feature 'say';
use feature 'signatures';
use Getopt::Long;

no warnings qw(experimental::signatures);

my $upper = 3;

GetOptions("upper=i" => \$upper);

die "--upper must be > 0" if $upper < 1;

my $S = $ARGV[0] // die "Please specify a positive integer";

my @queue;

my @first = ($S);

push(@queue, \@first);

while (@queue)
{
  my $curr = shift(@queue);

  my ($left, @points) = @$curr;

  $left == 0 && ( say join(" ", @points) ) && next;

  for my $step (reverse (1 .. $upper))  # [1]
  {
    if ($left >= $step)
    {
      my @p = ($left - $step, @points, $step);
      unshift(@queue, \@p);
    }
  }
}

[1] Perl does not support counting down (as Raku with ...), but reversing the list does the trick.

Running them: 

$ ./basketball-points-stack 4
1 1 1 1
1 1 2
1 2 1
1 3
2 1 1
2 2
3 1
  ./basketball-points-stack-perl 4
1 1 1 1
1 1 2
1 2 1
1 3
2 1 1
2 2
3 1

$ ./basketball-points-stack 5
1 1 1 1 1
1 1 1 2
1 1 2 1
1 1 3
1 2 1 1
1 2 2
1 3 1
2 1 1 1
2 1 2
2 2 1
2 3
3 1 1
3 2

$ ./basketball-points-stack-perl 5
1 1 1 1 1
1 1 1 2
1 1 2 1
1 1 3
1 2 1 1
1 2 2
1 3 1
2 1 1 1
2 1 2
2 2 1
2 3
3 1 1
3 2

Looking Good.

Time, and Time Again

That was quite a lot of programs. Let us compare the time usage for the major ones, for selected values of $N:

Program$N=10$N=20$N=25
basketball-points-ifs0.21 sec3.45 sec1 min 22 sec
basketball-points-loop0.22 sec4.5 sec1 min 45 sec
basketball-points-queue0.23 sec6.4 sec3 min 13 sec
basketball-points-ifs-perl0.025 sec0.74 sec20.8 sec
basketball-points-loop-perl0.045 sec0.73 sec21 sec
basketball-points-queue-perl   0.045 sec   0.95 sec   20.9 sec

Using a stack (or queue) stores data on a custom stack. Using recursion uses the system stack, but this is considerable faster than doing it manually. We can but assume that the system stack operatons are heavily optimized.

And that's it.

Links
 About me
 Keyword Index
Raku Courses
 Beginning Raku (book)
 RSS Feed
 Code (zip)
Reddit Comments