laurent_r

These are some answers to the Week 122 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days, on July 25, 2021 at 24:00. This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

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

This is often called a moving average or a running average, or, more precisely in this case, a cumulative moving average, since we want to compute the mean of all data received so far.

It is of course possible to keep track of all data seen so far and, each time, to recompute the average from the whole dataset using standard formulas. However, if we have the current average and the number of values from which it was computed, it is quite easy to compute the new average with a new value. Suppose that the average of the first five values of a series is 8. This means that the sum s of the first five values was s = 5 x 8 = 40. As a new value, say 2, is taken into account, then the new sum is 42, and the new average is 42 / 6 = 7. So the rule it to multiply the current average by the current number of values, to add the new value and to divide this new sum by the new number of values, i.e. the current number of values plus 1.

Average of Stream in Raku

Implementing the rule described above is fairly straight forward. For our test, we use an infinite (lazy) arithmetic sequence with a common difference of 10 between two consecutive terms.

use v6;

my @n = 10, 20 ... Inf;
my @cum_moving_avg = @n[0];
for 1..^10 -> $i {
    @cum_moving_avg[$i] = (@cum_moving_avg[$i-1] * $i + @n[$i]) / ($i + 1);
}
say ~@cum_moving_avg;

This program displays the following output:

raku ./mvg_avg.raku
10 15 20 25 30 35 40 45 50 55

Note that, with an arithmetic sequence as input, the output sequence of moving average values is also an arithmetic sequence.

Average of Stream in Perl

This is an implementation of the same rule in Perl. We cannot use an infinite sequence in Perl, so we simply use an arithmetic sequence of 10 terms.

use strict;
use warnings;
use feature "say";

my @n = (10, 20, 30, 40, 50, 60, 70, 80, 90, 100);
my @mvg_avg = ($n[0]);
for my $i (1..9) {
    $mvg_avg[$i] = ($mvg_avg[$i-1] * $i + $n[$i]) / ($i + 1);
}
say "@mvg_avg";

This program displays the following output:

$ perl ./mvg_mean.pl
10 15 20 25 30 35 40 45 50 55

Average of Stream in Scala

This is a port to Scala of the Raku and PPerl implementations above:

object root extends App {
  val n = Array.range(10, 101, 10) // (10, 20, ... 100)
  val mvg_avg = new Array[Int](10)
  mvg_avg(0) = n(0)
  for (i <- 1 to 9) {
    mvg_avg(i) = (mvg_avg(i - 1) * i + n(i)) / (i + 1)
  }
  println(mvg_avg.mkString(" "))
}

This program yields the following result:

10 15 20 25 30 35 40 45 50 55

Average of Stream in Python

A port to Python of the Raku and Perl versions above:

n = list(range(10, 100, 10)) # [10, 20 ... 90]
mvg = [n[0]]
for i in range(1, 9):
    mvg.append((mvg[i-1] * i + n[i])  / (i + 1))
print(mvg)

Output:

$ python3 mvg_mean.py
[10, 15.0, 20.0, 25.0, 30.0, 35.0, 40.0, 45.0, 50.0]

Average of Stream in C

Implementation of essentially the same algorithm in the C programming language. There is a slight change in the management of indices because the arguments passed to a C program start with argv[1} (since argv[0] contains the program name). Another slight change is that this program doesn’t populate an array of mean values, but prints out the average value as soon as it is found. This should lead to a smaller memory footprint (which may be useful if the stream is very large).

#include <stdio.h>
#include <stdlib.h>

int main(int argc, char *argv[]) {
    int avg = atoi(argv[1]);
    printf("%5i  ", avg);
    for (int i = 1; i < argc - 1; i++) {
        avg = (avg * i + atoi(argv[i+1])) / (i + 1);
        printf("%3i ", avg);
    };
    printf("\n");
}

Output:

$ ./a.out 10 20 30 40 50 60 70 80 90 100
10   15  20  25  30  35  40  45  50  55

Average of Stream in Awk

Again some tweaks on the management of indices because of the specific properties and behavior of arrays in awk, but essentially the same algorithm.

{ 
    avg[0] = $1;
    print $1;
    for (i = 1; i < NF; i++) { 
         avg[i] = (avg[i-1] * i + $(i+1)) / (i+1)
         print avg[i]
    }
}

Output:

$ echo '10 20 30 40 50 60 70 80 90 100
    ' | awk -f mvg_mean.awk
10
15
20
25
30
35
40
45
50
55

Average of Stream in D

The D programming language is similar to C or C°°, except that it is supposed to be more secure.

import std.stdio;
import std.math;
import std.conv;

void main(string[] args) {
    int avg = std.conv.to!int(args[1]);
    printf ("%d ", avg);
    for (int i = 1; i < args.length - 1; i++) {
        avg = (avg * i + std.conv.to!int(args[i+1])) / (i + 1);
        printf("%3d ", avg);
    }
    printf("\n");
}

Output:

$ mvg-mean.amx 10 20 30 40 50 60 70 80 90 100
10  15  20  25  30  35  40  45  5

Task 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

Basketball Points in Raku

I initially tried to use the | and X operators and the combinations, unique and some other method invocations to try to generate the values with a single expression, but turned out to be more difficult than I expected. So, I gave up and decided to use a good old recursive subroutine (find-dist) to generate all possible solutions leading to the target value:

use v6;

my $target = @*ARGS[0] // 5;
my @vals = 1, 2, 3;

sub find-dist ($sum, @seq) {
    for @vals -> $i {
        my $new-sum = $sum + $i;
        # if $new-sum > $target, then we don't 
        # need to test other values of @vals and
        # can use return directly instead of next 
        # since these values are in ascending order
        return if $new-sum > $target;
        my @new-seq = |@seq, $i;
        if $new-sum == $target {
            say ~@new-seq;
            return;
        } else {
            find-dist($new-sum, @new-seq);
        }
    }
}
find-dist 0, ();

This displays the following output:

$ raku ./score-dist.raku
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

$ raku ./score-dist.raku 4
1 1 1 1
1 1 2
1 2 1
1 3
2 1 1
2 2
3 1

Basketball Points in Perl

This a port to Perl of the Raku solution using a recursive subroutine:

use strict;
use warnings;
use feature "say";

my $target = shift // 5;
my @vals = (1, 2, 3);

sub find_dist  {
    my ($sum, @seq) = @_;
    for my $i (@vals) {
        my $new_sum = $sum + $i;
        # if $new_sum > $target, then we don't 
        # need to test other values of @vals and
        # can use return instead of next 
        # since these values are in ascending order
        return if $new_sum > $target;
        my @new_seq = (@seq, $i);
        if ($new_sum == $target) {
            say ""@new_seq";
            return;
        } else {
            find_dist($new_sum, @new_seq);
        }
    }
}
find_dist 0, ();

This program generates the following output:

$ perl score-dist.pl
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

$ perl score-dist.pl 4
1 1 1 1
1 1 2
1 2 1
1 3
2 1 1
2 2
3 1

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on August 1, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.