laurent_r

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

Spoiler Alert: This weekly challenge deadline is due in a few of days from now (on June 26, 2022 at 23:59). 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: Primorial Numbers

Write a script to generate first 10 Primorial Numbers.

Primorial numbers are those formed by multiplying successive prime numbers.

For example,

P(0) = 1    (1)
P(1) = 2    (1x2)
P(2) = 6    (1x2×3)
P(3) = 30   (1x2×3×5)
P(4) = 210  (1x2×3×5×7)

If we use the strict definition provided in the task specification, the list of primorial numbers should start with 2, since 0 and 1 are not considered to be prime. However, definitions of primorial numbers often start with 1. I’ll stick with the definition provided in the task, but it would be very easy to add 1 at the beginning of the list if we wished to do so.

Primorial Numbers in Raku

Using the [] reduction meta-operator together with the * multiplication operator, as well as the is-prime built-in routine, make the task very easy in Raku, so that we can express it as a Raku one-liner:

say [\*] (1..Inf).grep({.is-prime})[0..9];

We start with an infinite list of prime numbers and then find the partial sums of the first ten prime numbers with the [\*] meta-operator.

This script displays the following output:

$ raku ./primorials.raku
(2 6 30 210 2310 30030 510510 9699690 223092870 6469693230)

Primorial Numbers in Perl

This is essentially the same idea as above except that we have to implement our own is_prime subroutine as well as our loop to compute the partial sums.

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


sub is_prime {
   my $n = shift;
   return 1 if $n == 2;
   return 0 if $n % 2 == 0;
   return 0 if $n == 1;

   my $p = 3;
   my $sqrt = sqrt $n;
   while ($p <= $sqrt) {
       return 0 if $n % $p == 0;
       $p += 2;
   }
   return 1;
}

my ($i, $count, $product) = (1, 0, 1);
my @result;
while (1) {
    $i++;
    next unless is_prime $i;
    $count++;
    $product = $product * $i;
    push @result, $product;
    last if $count >= 10;
}
say "@result";

This program displays the following output:

$ perl ./primorials.pl
2 6 30 210 2310 30030 510510 9699690 223092870 6469693230

Task 2: Kronecker Product

You are given 2 matrices.

Write a script to implement Kronecker Product on the given 2 matrices.

For more information, please refer wikipedia page.

For example:

A = [ 1 2 ]
    [ 3 4 ]

B = [ 5 6 ]
    [ 7 8 ]

A x B = [ 1 x [ 5 6 ]   2 x [ 5 6 ] ]
        [     [ 7 8 ]       [ 7 8 ] ]
        [ 3 x [ 5 6 ]   4 x [ 5 6 ] ]
        [     [ 7 8 ]       [ 7 8 ] ]

      = [ 1x5 1x6 2x5 2x6 ]
        [ 1x7 1x8 2x7 2x8 ]
        [ 3x5 3x6 4x5 4x6 ]
        [ 3x7 3x8 4x7 4x8 ]

      = [  5  6 10 12 ]
        [  7  8 14 16 ]
        [ 15 18 20 24 ]
        [ 21 24 28 32 ]

Kronecker Product in Raku

First, before we get to the real task, we implement a print_matrix subroutine to pretty print a matrix in a human-friendly format. This type of auxiliary subroutine is often very useful when dealing with aggregate or composite data structures. This is useful not only to display the result at the end (as in the code below), but also as a development tool to check that the input is correct and also for debugging purpose (this use does not appear in the program below, but I employed it at development time).

In most programming languages, the Kronecker Product task would require four nested loops (loop over the rows of the first matrix, loop over the rows of the second matrix, and loop over the individual items of each of the rows). With Raku, the X cross product operator makes it possible to avoid an explicit coding of the two last (inner) loops, so that we can simply iterate over the rows of each matrix and take the cross product of these rows.

Note that we use three test cases: a simple case with two 2 x 2 square matrices, another one with one 3 x 2 and one 2 x 3 matrices, and finally one with one 2 x 3 and one 3 x 2 matrices.

sub print_matrix (@m) {
    for @m -> @row {
        .fmt(" %3d ").print for @row;
        say "";
    }
}
sub kroneck_prod (@a, @b) {
    my @result;
    for @a -> @row_a {
        for @b -> @row_b  {
            push @result, [@row_a  X* @row_b];
        }
    }
    print_matrix @result;
}

say "test 1:";
my @a = (1, 2; 3, 4);
my @b = [5, 6; 7, 8];
kroneck_prod @a, @b;
say "\ntest 2:";
my @c = (1, 2, 3; 2, 3, 4);
my @d = (5, 6; 7, 8; 9, 10);
kroneck_prod @c, @d;
say "\nTest 3:";
kroneck_prod @d, @c;

This program displays the following output for the 3 test cases:

$ raku ./kronecker_prod.raku
test 1:
   5    6   10   12
   7    8   14   16
  15   18   20   24
  21   24   28   32

test 2:
   5    6   10   12   15   18
   7    8   14   16   21   24
   9   10   18   20   27   30
  10   12   15   18   20   24
  14   16   21   24   28   32
  18   20   27   30   36   40

Test 3:
   5   10   15    6   12   18
  10   15   20   12   18   24
   7   14   21    8   16   24
  14   21   28   16   24   32
   9   18   27   10   20   30
  18   27   36   20   30   40

Kronecker Product in Perl

This is essentially a port to Perl of the Raku program above, except that, since Perl doesn’t have the X cross product operator, we implement our own cross_prod subroutine to handle matrices’ rows. I tend to think that separating the handling of the matrices from the handling of the individual rows (and thus avoiding four explicitly nested loops) makes the code slightly easier to understand.

Note that we use again three test cases: a simple case with two 2 x 2 square matrices, another one with one 3 x 2 and one 2 x 3 matrices, and finally one with one 2 x 3 and one 3 x 2 matrices.

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

sub print_matrix {
    for my $row (@_) {
        print map sprintf(" %3d ", $_), @$row;
        say "";
    }
}
sub cross_prod {
    my @c = @{$_[0]};
    my @d = @{$_[1]};
    my @cross_res;
    for my $i (@c) {
        push @cross_res, $i * $_ for @d;
    }
    return [ @cross_res ]
}  
sub kroneck_prod {
    my @a = @{$_[0]};
    my @b = @{$_[1]};
    my @result;
    for my $row_a (@a) {
        for my $row_b (@b) {
            push @result, cross_prod $row_a, $row_b;
        }
    }
    print_matrix @result;
}
say "Test 1:";
my @a = ([1, 2], [3, 4]);
my @b = ([5, 6], [7, 8]);
kroneck_prod \@a, \@b;
say "\nTest 2:";
my @c = ([1, 2, 3], [2, 3, 4]);
my @d = ([5, 6], [7, 8], [9, 10]);
kroneck_prod \@c, \@d;
say "\nTest 3:";
kroneck_prod \@d, \@c;

This program displays the following output for the 3 test cases:

$ perl ./kronecker_prod.pl
Test 1:
   5    6   10   12
   7    8   14   16
  15   18   20   24
  21   24   28   32

Test 2:
   5    6   10   12   15   18
   7    8   14   16   21   24
   9   10   18   20   27   30
  10   12   15   18   20   24
  14   16   21   24   28   32
  18   20   27   30   36   40

Test 3:
   5   10   15    6   12   18
  10   15   20   12   18   24
   7   14   21    8   16   24
  14   21   28   16   24   32
   9   18   27   10   20   30
  18   27   36   20   30   40

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 July 3, 2022. And, please, also spread the word about the Perl Weekly Challenge if you can.