These are some answers to the Week 171 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 July 3, 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: Abundant Numbers

Write a script to generate first 20 Abundant Odd Numbers.

According to wikipedia,

A number n for which the sum of divisors σ(n) > 2n, or, equivalently, the sum of proper divisors (or aliquot sum) s(n) > n.

For example, 945 is the first Abundant Odd Number.

Sum of divisors:
1 + 3 + 5 + 7 + 9 + 15 + 21 + 27 + 35 + 45 + 63 + 105 + 135 + 189 + 315 = 975

Reading that the first odd abundant number is 975, I was a bit afraid that we would have to dig into very large numbers to find the first 20 ones, but this turned out not to be the case.

Abundant Numbers in Raku

The is-abundant subroutine lists all the proper divisors of the input parameter and checks whether their sum is larger than the input integer. Then, we just loop over each odd integer (using the 1, 3 ... Inf lazy sequence operator) and display it if it in abundant. And we stop when we reach 20 of them.

sub is-abundant (Int $n where * > 0) {
    my @divisors = grep {$n %% $_}, 1..$n/2;
    return @divisors.sum > $n ?? True !! False;
}
my $count = 0;
for 1, 3 ... Inf -> $n {
    if is-abundant $n {
        say $n;
        last if ++$count >= 20;
    }
}

This program displays the following output:

$ raku ./abundant.raku
945
1575
2205
2835
3465
4095
4725
5355
5775
5985
6435
6615
6825
7245
7425
7875
8085
8415
8505
8925

Abundant Numbers in Perl

This is essentially a port to Perl of the above Raku program. The only significant differences is that we implement our own sum subroutine and iterate manually over odd integers.

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

sub sum {
    my $sum = 0;
    $sum += $_ for @_;
    return $sum;
}
sub is_abundant {
    my $n = shift;
    my @divisors = grep {$n % $_ == 0} 1..$n/2;
    return sum(@divisors) > $n ? 1 : 0;
}
my $n = 1;
my $count = 0;
while ($count < 20) {
    if (is_abundant $n) {
        say $n;
        $count++;
    }
    $n += 2;
}

This program displays the following output:

$ perl  ./abundant.pl
945
1575
2205
2835
3465
4095
4725
5355
5775
5985
6435
6615
6825
7245
7425
7875
8085
8415
8505
8925

Abundant Numbers in 17 Other Programming Languages

Update on July 1, 2022: added this section with other programming languages

I thought it would be an interesting and perhaps even useful exercise to try an implementation in a number of other programming languages. All of the implementations in this section have essentially the same structure, with the same function names (when possible) and variable names, to make language comparisons easier. They also all display the same output (space-separated values on one single line):

945 1575 2205 2835 3465 4095 4725 5355 5775 5985 6435 6615 6825 7245 7425 7875 8085 8415 8505 8925

Therefore, I won’t provide the output for each language, as this would repeat the line above each time.

To help reference, languages are listed in alphabetic order.

In Awk

function is_abundant(n) {
    sum = 0
    for (i = 2; i <= n/2; i++) {
        if (n % i == 0) {
            sum += i
            if (sum > n) {
                return 1
            }
        }
    }
    return 0
}   

BEGIN {
    n = 1
    count = 0
    while (count < 20) {
        if (is_abundant(n)) {
            printf("%d ", n)
            count++
        }
        n += 2
    }
}

In Bc

define is_abundant (n) {
    sum = 0
    for (i = 2; i < n/2; i++) {
        if (n % i == 0) {
            sum += i;
            if (sum > n) {
                return 1
            }
        }
    }
    return 0
}
n = 1
count = 0
while (count < 20) {
    if (is_abundant(n)) {
        print n, " "
        count += 1   
    }
    n += 2
}   
quit

In C

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

int is_abundant(int n) {
    int sum = 0;
    for (int i = 2; i <= n/2; i++) {
        if (n % i == 0) {
            sum += i;
            if (sum > n) {
                return 1;
            }
        }
    }
    return 0;
}

int main() {
    int n = 1;
    int count = 0;
    while (count < 20) {
        if (is_abundant(n)) {
            printf("%d ", n);
            count ++;
        }
        n += 2;
    }
}

In D

import std.stdio;

int is_abundant(int n) {
    int sum = 0;
    for (int i = 2; i <= n/2; i++) {
        if (n % i == 0) {
            sum += i;
            if (sum > n) {
                return 1;
            }
        }
    }
    return 0;
}

void main() {
    int n = 1;
    int count = 0;
    while (count < 20) {
        if (is_abundant(n)) {
            printf("%d ", n);
            count ++;
        }
        n += 2;
    }
}

In Dart

import "dart:io";
void main() {
    var count = 0;
    var j = 1;
    while (count < 20) {
        if (is_abundant(j)) {
            stdout.write("$j ");
            count++;
        }
        j += 2;
    }
}

bool is_abundant(n) {
    var sum = 0;
    for (int i = 1; i <= n/2; i++) {
        if (n % i == 0) {
            sum += i;
            if (sum > n) {
                return true;
            }
        }
    }
    return false;
}

In Go

package main

import "fmt"

func main() {
    var count = 0
    var j = 1
    for count < 20 {
        if is_abundant(j) {
            fmt.Printf("%d ", j)
            count++
        }
        j += 2
    }
}

func is_abundant(n int) bool {
    var sum = 0
    for i := 1; i < n/2; i++ {
        if n%i == 0 {
            sum += i
            if sum > n {
                return true
            }
        }
    }
    return false
}

In Javascript

function is_abundant(n) {
    let sum = 0;
    for (let i = 1; i < (n/2 + 1); i++) {
        if (n % i == 0) {
            sum += i;
            if (sum > n) {
                return true;
            }
        }
    }
    return false;
}
let count = 0
let j = 1
while (count < 20) {
    if (is_abundant(j)) {
        process.stdout.write(j + " ")
        count++
    }
    j += 2
}

In Julia

function is_abundant(n)
    sum = 0
    for i in 1:n/2
        if n % i == 0 
            sum += i
            if sum > n
                return true
            end
        end
    end
    return false
end

j = 1
count = 0
while count < 20
    if is_abundant(j)
      print(j, " ")
      global count += 1
    end
    global j += 2
end

In Kotlin

fun is_abundant(n: Int): Boolean {
    var sum = 0
    for (i in 2..(n/2 + 1).toInt()) {
        if (n % i == 0) {
            sum += i
            if (sum > n) {
                return true
            }
        }
    }
    return false
}
fun main() {
    val max = 20
    var count = 0
    var j = 1
    while (count < max) {
        if (is_abundant(j)) {
            print ("$j ")
            count++;
        }
        j += 2
    }
}

In Lua

local function is_abundant(n)
    sum = 0
    for i = 1, n/2 do
        if n % i == 0 then
            sum = sum + i
            if sum > n then
                return true
            end
        end
    end
    return false
end

max = 20
count = 0
j = 1
while count < max do
    if is_abundant(j) then
        io.write(j, " ")
        count = count + 1
    end
    j = j + 2
end

In Nim

In Nim, control flow control is using indentation (like Python).

proc is_abundant(n: int): bool =
  var sum = 0
  for i in 2..int(n/2):
    if n mod i == 0:
      sum += i
      if sum > n:
        return true
  return false;

var count = 0
var j = 1
while count < 20:
  if is_abundant(j):
    stdout.write j, " "
    count += 1
  j += 2

In Pascal

program abundant;
const
    max = 20;
var
    count, j: integer;

function is_abundant(n: integer): boolean;
var
    sum, i: integer;
begin
    sum := 0;
    for  i := 2 to round(n/2) do
    begin
        if ( n mod i = 0) then
            sum := sum + i;
            if (sum > n) then
                exit(true);
    end;
    exit(false);
end;

begin
    count := 0;
    j := 1;
    while ( count < max ) do
    begin
        if (is_abundant(j)) then
        begin
             write(j, ' ');
             count := count + 1;
        end;
        j := j + 2;
    end;
end.

In Python

def is_abundant(n):
  sum = 0
  for i in range(2,int(n/2 + 1)):
    if n % i == 0:
      sum += i
      if sum > n:
        return True
  return False

n = 1
count = 0
while count < 20:
  if is_abundant(n):
    print(n, end=' ')
    count += 1
  n += 2

In Ring

count = 0
for j = 1 to 10001 step 2
    if is_abundant(j)
        see " " + j 
        count += 1
        if count > 10 exit 1 ok
    ok
    j += 2
next

func is_abundant n
    sum = 0
    for i = 2 to n/2
        if n % i = 0
            sum += i
            if sum > n 
                return 1
            ok
        ok
    next
    return 0;

In Ruby

def is_abundant(n)
    sum = 0
    for i in 1.upto(n/2) 
        if n % i == 0 then
            sum += i
            if sum > n then
                return true
            end
        end
    end
    return false
end

j = 1
count = 0
while count < 20
    if is_abundant(j) then
        print("#{j} ")
        count += 1
    end
    j += 2
end

In Rust

fn is_abundant(n: usize) -> bool {
    let mut sum = 0;
    for i in 2..n/2 {
        if n % i == 0 {
            sum += i;
            if sum > n {
                return true;
            }
        }
    }
    return false
}

fn main() {
    let mut n = 1;
    let mut count = 0;
    while count < 20 {
        if is_abundant(n) {
            print!("{} ", n);
            count += 1;
        }
        n += 2;
    }
}

In Scala

object abundant extends App {
  def is_abundant(n: Int): Boolean = {
    var sum = 0
    for (i <- 1 to n/2) {
      if (n % i == 0) {
        sum += i
        if (sum > n) {
          return true
        }
      }
    }
    return false;
  }
  var count = 0
  var j = 1
  while (count < 20) {
    if (is_abundant(j)) {
      print(s"$j ")
      count += 1
    }
    j += 2
  }
}

Task 2: First-class Function

Create sub compose($f, $g) which takes in two parameters $f and $g as subroutine refs and returns subroutine ref i.e. compose($f, $g)->($x) = $f->($g->($x))

e.g.

$f = (one or more parameters function)
$g = (one or more parameters function)

$h = compose($f, $g)
$f->($g->($x,$y, ..)) == $h->($x, $y, ..) for any $x, $y, ...

There are some problems with this task specification. First, it doesn’t say what we should do, but more or less how it should (probably) be done in Perl. I usually do my first implementation of a challenge task in Raku, and it would make little sense to implement the provided pseudo-code in Raku.

The second problem is that, when composing functions, you can’t have just any random number of parameters. The arity (number of parameters) of the second function must usually match the number of values returned by the first one. I’ll deal primarily with examples of functions taking one parameter, but will also show an example with variadic functions.

First-Class Function in Raku

Raku has the infix:<∘> (ring) or infix:<o> function composition operator, which combines two functions, so that the left function is called with the return value of the right function.

We could use this operator directly, but since we are asked to write a compose subroutine, we’ll carry out the extra step of creating such a subroutine.

sub f($n) { $n / 2 + 1}
sub g($n) { $n * 2 }
sub compose (&h1, &h2) {
    &h1 ∘ &h2; # h1 will be called with the return value of h2
    # could also be written: &h1 o &h2;
}
my &composed = compose(&f, &g);
say composed 2;

This script displays the following output:

$ raku ./first-class.raku
3

Our compose subroutine will also work with variadic input functions (taking a variable number of arguments). For example, here, we use a triple subroutine multiplying by 3 the items of a list of integers and a concat subroutine concatenating the resulting integers into a string (with a _ separator):

sub concat { join "_", @_}
sub triple { map {$_ * 3}, @_ }
sub compose (&h1, &h2) {
    &h1 ∘ &h2; # h1 will be called with the return value of h2
}
my &composed = compose(&concat, &triple);
say composed <2 4 6 8>;

This generates the following output:

$ ./raku first-class_2.raku
6_12_18_24

First-Class Function in Perl

Here, the compose subroutine is a function factory that takes two subroutine references as input parameters and returns an anonymous subroutine reference combining the two input subroutines.

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

sub f { shift() / 2 + 1}
sub g { shift() * 2 }


sub compose {
    my ($f, $g) = @_;
    sub {
        $f -> ($g -> (@_))
    };
}
my $composed = compose( \&f, \&g);
say $composed->(2);

This script displays the following output:

$ perl ./first-class.pl
3

Our compose subroutine will also work with variadic input functions (taking a variable number of arguments). For example, here, we use a triple subroutine multiplying by 3 the items of a list of integers and a concat subroutine concatenating the resulting integers into a string (with a _ separator):

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

sub concat { join "_", @_}
sub triple { map $_ * 3, @_ }

sub compose {
    my ($f, $g) = @_;
    sub {
        $f -> ($g -> (@_))
    };
}
my $composed = compose(\&concat, \&triple);
say $composed->(qw/2 4 6 8/);

This script displays the following output:

$ perl  first-class_2.pl
6_12_18_24

First-Class Function in Other Programming Languages

Update on July 2, 2022: added this section with other programming languages

Using first-class functions is usually a relatively advanced topic. I can do it quite easily in Perl and Raku, but I’m only kind of a novice in several of the programming languages presented below in this section. So, in some cases, I had to look it up in the Internet and some of the solutions are copied in part from others. Thus, I do not claim full authorship on these code snippets, but, so what? After all, writing a computer program is very often about taking an existing solution and modifying it to meet new requirements.

In all cases, we will compose a function returning twice the input parameter and a function that, for an input parameter p, returns p/2 + 1. And we display the result for input integers between 1 and 6. In some cases, we also display the result of actually chaining calls of the two functions. The result might be something like that:

2.0  2.0
3.0  3.0
4.0  4.0
5.0  5.0
6.0  6.0
7.0  7.0

We will not repeat the output for each programming language.

In D

In D, a delegate is a kind of pointer to a function.

import std.stdio;

T delegate(S) compose(T, U, S)(in T delegate(U) f,
                               in U delegate(S) g) {
    return s => f(g(s));
}

void main() {
    auto h = compose((int x) => x / 2 + 1, (int x) => x * 2);
    for (int i = 1; i <= 6; i++) {
        writeln(i);
    }
}

In Julia

Like Raku, Julia has the ∘ function compose operator, making the solution pretty straight forward.

function f(p)
    return p / 2 + 1
end
function g(p)
    return p * 2
end
function compose(h1, h2)
    return h1 ∘ h2;
end
h = compose(f, g)
for i in 1:5
    println(h(i), "  ", f(g(i)))
end

In Kotlin

fun f(x: Int): Int = x/2 + 1

fun g(x: Int): Int = x * 2

fun compose(f: (Int) -> Int,  g: (Int) -> Int): (Int) -> Int  = { f(g(it)) }

fun main() {
    for (i in 2..6) {
        println(compose(::f, ::g)(i))
    }
}

In Nim

import sugar

proc compose[A,B,C](h1: A -> B, h2: B -> C): A -> C = (x: A) => h1(h2(x))

proc f(x: int): int = int(x / 2) + 1
proc g(x: int): int = x * 2

var h = compose(f, g)
for i in 1..6:
  echo (h(i), f(g(i)))

In Python

def compose(f1, f2):
    return lambda x: f1(f2(x))
def f(p):
    return p / 2 + 1
def g(p):
    return p * 2

h = compose(f, g)

for i in range(1, 6):
    print (f(g(i)), " ", h(i))

In Ruby

def compose(h1, h2)
    lambda {|x| h1.call(h2.call(x))}
end
f = lambda { |x| return x / 2 + 1 }
g = lambda { |x| return x * 2 }

h = compose(f, g)
for i in 1.upto(6) 
    print ("#{h[i]}  #{f.call(g.call(i))}\n")
end

In Scala

object first_class extends App {
  def compose[A](h1: A => A, h2: A => A) = { x: A => h1(h2(x)) }

  def f(x: Int) = x / 2 + 1
  def g(x: Int) = x * 2

  val h = compose(f, g)
  for (i <- 1 to 6) {
    println(s"${h(i)}  ${f(g(i))}")
  }
}

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

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.

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

Spoiler Alert: This weekly challenge deadline is due in a couple of days from now (on June 19, 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: Brilliant Numbers

Write a script to generate first 20 Brilliant Numbers.

Brilliant numbers are numbers with two prime factors of the same length.

The number should have exactly two prime factors, i.e. it’s the product of two primes of the same length.

For example:

24287 = 149 x 163
24289 = 107 x 227

Therefore 24287 and 24289 are 2-brilliant numbers.

These two brilliant numbers happen to be consecutive as there are no even brilliant numbers greater than 14.

Output:

4, 6, 9, 10, 14, 15, 21, 25, 35, 49, 121, 143, 169, 187, 209, 221, 247, 253, 289, 299

There are essentially two ways to solve this type of problems: loop through all integers and filter out those that don’t satisfy the condition, and try to construct brilliant numbers from a list of primes. I prefer this second solution, because it requires much less computing resources, but, since brilliant numbers are not created in ascending order and the process can generate duplicates, we have to generate a few more numbers than what we strictly need to make sure that we obtain really the first 20 brilliant numbers.

Brilliant Numbers in Raku

In Raku, we’ll use the cross-product X operator to generate all pairs of primes. More precisely, we will use it as a metaoperator together with the * multiplication operator, X*, to generate directly the prime products. Since the primes have to have the same length, we’ll do it in two steps, one for primes of length 1 and one for primes of length 2. Since we need only a short list of small primes, I’ll simply hard code the list of the first ten primes. Task 2 of this challenge will show code to generate a longer list of primes when needed.

my @small-primes = 2, 3, 5, 7, 11, 13, 17, 19, 23, 29;
my @result = (@small-primes[0..3] X* @small-primes[0..3]).sort.squish;
append @result, (@small-primes[4..9] X* @small-primes[4..9]).sort.squish;
say @result[0..19];

This script displays the following output:

$ raku ./brilliant.raku
(4 6 9 10 14 15 21 25 35 49 121 143 169 187 209 221 247 253 289 299)

Brilliant Numbers in Perl

This is essentially a port to Perl of the Raku program above, except that we need to implement our own combine subroutine to replace the cross-product operator. We store the result in a hash to remove any duplicate.

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

my @small_primes = (2, 3, 5, 7, 11, 13, 17, 19, 23, 29);

sub combine {
    my @primes = @_;
    my %part_result;
    for my $i (0..$#primes) {
        for my $j ($i..$#primes) {
            $part_result{$primes[$i] * $primes[$j]} = 1;
        }
    }
    return sort {$a <=> $b} keys %part_result;
}
my @result = combine @small_primes[0..3];
push @result, combine @small_primes[4..9];
say "@result[0..19]";

This script displays the following output:

$ perl ./brilliant.pl
4 6 9 10 14 15 21 25 35 49 121 143 169 187 209 221 247 253 289 299

Task 2: Achilles Numbers

Write a script to generate first 20 Achilles Numbers. Please checkout wikipedia for more information.

An Achilles number is a number that is powerful but imperfect (not a perfect power). Named after Achilles, a hero of the Trojan war, who was also powerful but imperfect.

A positive integer n is a powerful number if, for every prime factor p of n, p^2 is also a divisor.

A number is a perfect power if it has any integer roots (square root, cube root, etc.).

For example 36 factors to (2, 2, 3, 3) - every prime factor (2, 3) also has its square as a divisor (4, 9). But 36 has an integer square root, 6, so the number is a perfect power.

But 72 factors to (2, 2, 2, 3, 3); it similarly has 4 and 9 as divisors, but it has no integer roots. This is an Achilles number.

Output:

72, 108,  200,  288,  392,  432,  500,  648,  675,  800,  864, 968, 972, 1125, 1152, 1323, 1352, 1372, 1568, 1800

Our first step will be to factorize the input candidates. An Achilles number is a powerful number, which means that every prime appearing in its prime factorization must have a power of at least 2. For a powerful number to be imperfect, the greatest common divisor (GCD) of its powers must be 1.

Achilles Numbers in Raku

The prime-factorssubroutine returns a BagHash containing a list of prime numbers together with their frequency in the prime factorization of the input integer.

Then, we apply the following rules: * Any prime appearing in the factorization must have a power of at last 2; * There must be at least two distinct prime factors; * The greatest common divisor (GCD) of the powers must be 1.

Note that the Raku built-in gcd routine is an infix operator, which can therefore be used only with 2 operands. However, the [] metaoperator makes it possible to use it with a list of more than 2 operands.

my @primes = (2..1000).grep({.is-prime});

sub prime-factors (UInt $num-in) {
    my $factors = BagHash.new;
    my $num = $num-in;
    for @primes -> $div {
        while ($num %% $div) {
            $factors{$div}++;
            $num div= $div;
        }
        return $factors if $num == 1;
    }
    $factors{$num}++ unless $num == $num-in;
    return $factors;
}

my $count = 0;
for 1..Inf -> $n { 
    my @powers = (prime-factors $n).values;
    if @powers.none < 2 and @powers.elems > 1 and ([gcd] @powers) == 1 {
        say $n.fmt("%4d"), " -> ", @powers;
        $count++;
        last if $count >= 20
    }
}

This script displays the following output:

$ raku ./Achilles_nums.raku
  72 -> [3 2]
 108 -> [3 2]
 200 -> [2 3]
 288 -> [5 2]
 392 -> [2 3]
 432 -> [3 4]
 500 -> [2 3]
 648 -> [4 3]
 675 -> [3 2]
 800 -> [5 2]
 864 -> [5 3]
 968 -> [2 3]
 972 -> [2 5]
1125 -> [2 3]
1152 -> [2 7]
1323 -> [3 2]
1352 -> [2 3]
1372 -> [2 3]
1568 -> [2 5]
1800 -> [2 3 2]

Achilles Numbers in Perl

This is a port to Perl of the Raku program above, with the same rules as above. Since there is no built-in gcd function in Perl, we implement our own. When it receives more than two arguments, it calls itself recursively until it ends up with 2 arguments.

#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;
use Data::Dumper;
use constant MAX => 500;

my @primes = (2, 3, 5, 7);

# Greatest common divisor of two or more integers
sub gcd {
    if (@_ > 2) {
        return gcd( gcd($_[0], $_[1]), @_[2..$#_]);
    } else {
        my ($i, $j) = sort { $a <=> $b } @_;
        while ($j) {
            ($i, $j) = ($j, $i % $j);
        }
        return $i;
    }
}

# Creating a hash of prime factors (as keys) with their powers (as values) 
sub prime_factors {
    my $num = shift;
    my $origin_num = $num;
    my %factors;
    for my $div (@primes) {
        while ($num % $div == 0) {
            $factors{$div}++;
            $num /= $div;
        }
        return %factors if $num == 1;
    }
    $factors{$num}++ unless $num == $origin_num;
    return %factors;
}


# Populating an array of primes up to MAX
my $current = 9;
while (1) {
    my $prime = 1;
    for my $i (@primes) {
        my $i_sq = $i * $i;
        last if $i_sq > $current;
        $prime = 0, last if $current % $i == 0;
    }
    push @primes, $current if $prime;;
    $current += 2;
    last if $current > MAX;
}

my $count = 0;
for my $n (1..MAX*MAX) { 
    my %factors =  prime_factors $n;
    my @powers = map $factors{$_}, keys %factors;
    next if grep { $_ < 2} @powers;
    next if scalar @powers < 2;
    if (gcd(@powers) == 1) {
        printf "%4d -> %s\n", $n,  join " ", @powers;
        $count++;
        last if $count >= 20
    }

This script displays the following output:

$ perl  ./Achilles_nums.pl
  72 -> 2 3
 108 -> 2 3
 200 -> 3 2
 288 -> 5 2
 392 -> 3 2
 432 -> 3 4
 500 -> 3 2
 648 -> 4 3
 675 -> 2 3
 800 -> 2 5
 864 -> 3 5
 968 -> 3 2
 972 -> 5 2
1125 -> 2 3
1152 -> 2 7
1323 -> 2 3
1352 -> 2 3
1372 -> 2 3
1568 -> 5 2
1800 -> 2 2 3

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

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

Spoiler Alert: This weekly challenge deadline is due in a couple of days from now (on June 12, 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.

The Perrin sequence is defined to start with [3, 0, 2]; after that, term N is the sum of terms N-2 and N-3. (So it continues 3, 2, 5, 5, 7, ….)

A Perrin prime is a number in the Perrin sequence which is also a prime number.

Calculate the first 13 Perrin Primes.

f(13) = [2, 3, 5, 7, 17, 29, 277, 367, 853, 14197, 43721, 1442968193, 792606555396977]

On my first implementation, I originally obtained the following sequence:

2 3 2 5 5 7 17 29 277 367 853 14197 43721...

There are two major differences with the expected output: the sequence should be ordered (i.e. sorted in ascending order), and duplicates should be removed.

Perrin Primes in Raku

It is quite easy to do it with a Raku one-liner:

say (unique grep {.is-prime}, (3, 0, 2, -> $a, $b, $c { $a + $b } ... ∞))[0..12].sort;

Here, we use the ... sequence operator to build an infinite list of Perrin numbers. Then, we grep the output to retain only primes and use the unique built-in to remove duplicates. We finally take a slice of 13 items of that infinite array and sort the result in ascending order. Note that the order of the operations is important: for example, it is not possible to sort an infinite list, so the sort must occur at the end, after the extraction of the 13 elements.

This script displays the following output:

$ raku ./perrin.raku
(2 3 5 7 17 29 277 367 853 14197 43721 1442968193 792606555396977)

Perrin Primes in Perl

The Perl solution is significantly more complicated for two reasons. First, we don’t have the sequence operator to build directly the Perrin sequence, and need to use a loop. Second, we need to implement our own is_prime subroutine.

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

my @perrin = (3, 0, 2);
my @result = (2, 3);
my %seen = map { $_ => 1 } @result;
while (1) {
    my $new_item = $perrin[-3] + $perrin[-2];
    push @perrin, $new_item;
    if (is_prime($new_item)) {
        push @result, $new_item unless $seen{$new_item};
        $seen{$new_item} = 1;
        last if @result > 12;
    }
}
say join " ", sort { $a <=> $b } @result;

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 1 if $p >= $n;
       return 0 if $n % $p == 0;
       $p += 2;
   }
   return 1;
}

This program displays the following output:

$ perl ./perrin.pl
2 3 5 7 17 29 277 367 853 14197 43721 1442968193 792606555396977

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