Perl Weekly Challenge: Week 122

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

For my solution, I avoided any clever tricks and just took a straightforward running average in a loop like this:

my $total = 0;
my $count = 1;
my @averages;

for  my $arg (@ARGV) {
    $total += $arg;
    push @averages, $total / $count++;
}

Input is taken from the command line. Each average is stored in an array which is printed delimited by spaces like this.

say join q{ }, @averages;

(Full code on Github.)

(In hindsight I could easily made the output comma delimited which would match the spec better.)

That's the Perl version. Raku is almost exactly the same:

    my $total = 0;
    my $count = 1;
    my @averages;

    for  @ARGS -> $arg {
        $total += $arg;
        @averages.push($total / $count++);
    }

    @averages.join(q{ }).say;

(Full code on Github.)

Challenge 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

This is a variant of a very common computer science problem which is usually expressed as finding out how many combinations of coins (i.e. nickels, dimes, quarters etc.) can add up to a certain monetary value. Indeed, when I described this challenge to my daughter Shailaja, who recently completed her first year as a computer science major at university, she instantly recoginized it. So getting the basic answer was relatively easy. I was suprised to find that displaying the answer in the way the spec suggests actually took more time. Here is my first attempt at a solution in Raku. Note this type of problem can also be solved using recursion and that's what Shailaja suggested but I have not done it that way.

for  0 .. $S div 3 -> $threes {

First we determine the maximum number of three-point shots we can include in our score combination. Because we don't have the concept of fractional shots, we use div the integer division operator here. Our combinations will include anywhere from 0 to this number of 3's.

    my $remainder = $S - $threes * 3;

Then we subtract the number of $threes from the original score so we know how much is left for 2's and 1's/

    for 0 ..  $remainder div 2 -> $twos {

The same process used for $threes is repeated for $twos...

        my $ones = $remainder - $twos * 2;

...with the added bonus that the remainder is the number of $ones in the combination.

Now that we have a combination of $ones, $twos, and $threes, in some variants of the problem we could print this information out and continue to the next combination. But our spec makes two special demands.

}
}

The first is that each shot should be recorded separately. For instance in the first example, one way of making a score of 4 is with 4 one-point shots. Instead of outputting something like:

4 one-point shots, 0 two-point shots, and 0 three-point shots.

...we are supposed to display:

1 1 1 1

I implemented this with a helper function called arrangement() for want of a better name. It looks like this:

sub arrangement(Int $ones, Int $twos, Int $threes) {

As input it takes $ones, $twos, and $threes as previously discovered.

    my @arranged;

    if $ones {
        @arranged.push(| ('1' xx $ones));
    }

If there are any $ones the list repetition operator xx is used to duplicate that many instances of the character '1' and those are added to the @arranged array. Note the | before the call to xx. This flattens the Sequence returned by xx into individual elements before pushing them onto @arranged. I always forget to do this in Raku and get weird results until I remember because Perl flattens by default.

    if $twos {
        @arranged.push(| ('2' xx $twos));
    }

    if $threes {
        @arranged.push(| ('3' xx $threes));
    }

    return @arranged;

'2' and '1' are added in the same way and then @arranged is returned for further processing. }

The second output issue that has to be dealt with is permutations. Again, looking at the first example we see that one possible combination is:

1 1 2

...And our code dutifully gives this answer. But the example output also includes:

1 2 1

...and:

2 1 1

Luckily, Raku lists have a .permutations() method which can be used to generate all these extra combinations. However there is one stumbling block; still using 1 1 2 what .permutations() generates is:

...as it should using the mathematical definition of permutation but you will note there are several duplicates which we do not want. I solved this by adding each permutation as a key in a hash. (A Set would have been even more appropriate but I've always had problems using them in Raku for some reason.) The value of the key is incremented each time it is encountered. Then outside the loop I print the keys of the hash (first sorting them for good measure) which are unique values no matter how many times the combination was encountered. The final version of the code looks like this:

my %scores;

for  0 .. $S div 3 -> $threes {
    my $remainder = $S - $threes * 3;
    for 0 ..  $remainder div 2 -> $twos {
        my $ones = $remainder - $twos * 2;
        for arrangement($ones, $twos, $threes).permutations -> $perm {
            %scores{$perm}++;
        }
    }
}

for %scores.keys.sort -> $score {
    say $score;
}

(Full code on Github.)

As usual, porting Raku code to Perl mainly involves working around missing gaps in functionality. For instance, Perl does not have an xx list repetition operator. But it does have x which does string repetition. And split() can convert a string into a list. Putting these together, my Perl arrange() function looks like this:

sub arrange {
    my ($ones, $twos, $threes) = @_;
    my @arranged;

    if ($ones) {
        push @arranged, (split //, ('1' x $ones));
    }

    if ($twos) {
        push @arranged, (split //, ('2' x $twos));
    }

    if ($threes) {
        push @arranged, (split //, ('3' x $threes));
    }

    return @arranged;
}

Update: Roger Bell-West informed me that you can use x on a list in perl. In that case we can do the much more sensible:

push @arranged, ('1') x $ones;

Perl also lacks the .permutations() method. For this, the solution I have used in many previous challenges is the permute() function given in perlfaq4.

With that my main routine looks like this:

my %scores;

for  my $threes (0 .. $S / 3) {
    my $remainder = $S - $threes * 3;
    for my $twos (0 ..  $remainder / 2) {
        my $ones = $remainder - $twos * 2;

        my @permutations;
        permute { push @permutations, \@_; }
            arrange($ones, $twos, $threes);

        for my $perm (@permutations) {
            $scores{join q{}, @{$perm}}++;
        }
    }
}

for my $score (sort keys %scores) {
    say join q{ }, (split //, $score);
}

(Full code on Github.)

Two things you may notice are that the calculations use plain old /. Perl does integer division by default if both the operands are integers. Also for the keys of the %scores hash, I'm not using the combinations as-is; I don't think you can have lists as hash keys in Perl or atleast I was not able to make it work. Instead I concatenate the combination into a string and use that as a key. In my final loop I use split() to turn it back into a list for display.