These are some answers to the Week 175 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 31, 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: Last Sunday

Write a script to list Last Sunday of every month in the given year.

For example, for year 2022, we should get the following:

2022-01-30
2022-02-27
2022-03-27
2022-04-24
2022-05-29
2022-06-26
2022-07-31
2022-08-28
2022-09-25
2022-10-30
2022-11-27
2022-12-25

Last Sunday in Raku

In Raku, the Date classmethodday-of-month) provides all the methods needed to properly manage dates.

The MAIN subroutine takes one parameter, the year that we want to process, and will default to 2022 if no parameter is passed.

First, we compute the last date in the month, find on which day of the week it falls (day of week is an integer between 1 and 7, where 1 stands for Monday and 7 for Sunday).

To get the date in month of the last Sunday in the month, we simply subtract the day of the week from the day in the month, except that this would not work properly when the last day of the month is a Sunday (we would obtain the previous Sunday), so we subtract the week day modulo 7.

sub MAIN (Int $yr = 2022) {
    for ('01'..'09', 10 .. 12).flat -> $month {
        my $month-end = Date.new("$yr-$month-01").last-date-in-month;
        my $week_day = $month-end.day-of-week;
        my $day-in-month = $month-end.day-of-month;
        # Note: Sunday is weekday 7
        my $sunday = $day-in-month - ($week_day % 7);
        say Date.new("$yr-$month-$sunday");
    }
}

This program displays the following output:

$ raku ./last-sunday.raku
2022-01-30
2022-02-27
2022-03-27
2022-04-24
2022-05-29
2022-06-26
2022-07-31
2022-08-28
2022-09-25
2022-10-30
2022-11-27
2022-12-25

~
$ raku ./last-sunday.raku 2023
2023-01-29
2023-02-26
2023-03-26
2023-04-30
2023-05-28
2023-06-25
2023-07-30
2023-08-27
2023-09-24
2023-10-29
2023-11-26
2023-12-31

Last Sunday in Perl

This Perl program essentially follows the same idea as the Raku program above, except that we need to compute manually the last day in the month, which leads us to implement an is_leap subroutine to be sure of the last day of February.

#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;
use Time::Local;

my $yr = shift // 2022;
my @months = (0, 31, is_leap($yr) ? 29 : 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

for my $month (1..12) {
    my $month_last_day = timegm( 0, 0, 0, $months[$month], $month - 1, $yr - 1900 );
    my $day_in_week = (gmtime $month_last_day)[6];
    my $sunday = $months[$month] - ($day_in_week % 7);
    printf "%04d/%02d/%02d\n", $yr, $month, $sunday;
}

sub is_leap {
    my $yr = shift;
    return 0 if $yr % 4;    # no if not divisible by 4
    return 1 if $yr % 100;  # yes if divisible by 4 but not by 100
    return 0 if $yr % 400;  # no if divisible by 100 and not by 400
    return 1;               # yes if divisibe by 400
}

This program displays the following output:

$ perl ./last-sunday.pl
2022/01/30
2022/02/27
2022/03/27
2022/04/24
2022/05/29
2022/06/26
2022/07/31
2022/08/28
2022/09/25
2022/10/30
2022/11/27
2022/12/25

~
$ perl ./last-sunday.pl 2023
2023/01/29
2023/02/26
2023/03/26
2023/04/30
2023/05/28
2023/06/25
2023/07/30
2023/08/27
2023/09/24
2023/10/29
2023/11/26
2023/12/31

Last Sunday in Julia

The Julia Dates module provides everything we need, including a lastdayofmonth method.

using Dates

function sundays(year, month)
    month_end = Dates.lastdayofmonth(Dates.Date(year, month, 1))
    weekday = Dates.dayofweek(month_end)
    println(month_end - Dates.Day(weekday % 7))
end

year = parse( Int, ARGS[1])
for month in 1:12
    sundays(year, month)
end

Output:

$ julia ./last-sunday.jl 2022
2022-01-30
2022-02-27
2022-03-27
2022-04-24
2022-05-29
2022-06-26
2022-07-31
2022-08-28
2022-09-25
2022-10-30
2022-11-27
2022-12-25

Last Sunday in Python

Python’s datetime module doesn’t have a lastdayofmonth method, but we can use the timedelta(days = 1) method to subtract one day from the first day of the next month. We only need a bit of simple arithmetic to find the next month.

from datetime import date,timedelta
import sys

def lastsundays (y):
  for m in range(1,13):
    if m == 12:
      year = y + 1
      month = 1
    else:
      year = y
      month = m + 1

    mthEnd = date(year, month, 1) - timedelta(days = 1)
    weekDay = mthEnd.weekday()
    lastSun = mthEnd - timedelta(days = (weekDay + 1) % 7)
    print(lastSun)

if len(sys.argv) == 2:
  year = int(sys.argv[1])
else:
  year = 2022

lastsundays(year)

Output:

$ python3 ./last-sunday.py
2022-01-30
2022-02-27
2022-03-27
2022-04-24
2022-05-29
2022-06-26
2022-07-31
2022-08-28
2022-09-25
2022-10-30
2022-11-27
2022-12-25

Last Sunday in Ruby

The Ruby date class provides a next_month and a prev_day methods that we can chain to get the last day of the month (lmd) in just one code line. Thus, the Ruby solution is particularly concise.

require 'date'

year = ARGV.shift.to_i.nil? || 2022

for month in 1..12 
    lmd = Date.new(year, month, 1).next_month.prev_day
    weekday = lmd.wday
    puts lmd - (weekday % 7)
end

Output:

2022-01-30
2022-02-27
2022-03-27
2022-04-24
2022-05-29
2022-06-26
2022-07-31
2022-08-28
2022-09-25
2022-10-30
2022-11-27
2022-12-25

Task 2: Perfect Totient Numbers

Write a script to generate first 20 Perfect Totient Numbers. Please checkout [wikipedia page](https://en.wikipedia.org/wiki/Perfect_totient_number] for more informations.

Output:

3, 9, 15, 27, 39, 81, 111, 183, 243, 255, 327, 363, 471, 729, 2187, 2199, 3063, 4359, 4375, 5571

Wikipedia explains us that, in number theory, Euler’s totient function counts the positive integers up to a given integer n that are relatively prime to n. In other words, it is the number of integers k in the range 1 ≤ k ≤ n for which the greatest common divisor gcd(n, k) is equal to 1. For example, there are 4 integers less than 10 that are prime relatively prime to 10: 1, 3, 7, 9. So, the totient of 10 is 4.

A perfect totient number is an integer that is equal to the sum of its iterated totients. That is, we apply the totient function to a number n, apply it again to the resulting totient, and so on, until the number 1 is reached, and add together the resulting sequence of numbers; if the sum equals n, then n is a perfect totient number.

For example, there are six positive integers less than 9 and relatively prime to it (1, 2, 4, 5, 7, 8), so the totient of 9 is 6; there are two numbers less than 6 and relatively prime to it (1, 5), so the totient of 6 is 2; and there is one number less than 2 and relatively prime to it (1), so the totient of 2 is 1; and 9 = 6 + 2 + 1, so 9 is a perfect totient number.

Once we’ve understood what a perfect totient number, it is quite easy to program a is_perfect_totient function that determines whether an input integer is a perfect totient. We need a gcd function to find out whether an integer is relatively prime to another. Some programming languages provide a built-in gcd function; for other languages, we’ll need to implement our own gcd function (see for example the Perl implementation below).

Perfect Totient Numbers in Raku

Raku has a built-in infix gcd operator. So it is quite easy: in the is-perfect-totient subroutine, we simply compute the totient of the input number n (i.e. count the number positive integers up to n that are relatively prime to n), then iteratively compute the totient of the totient, and so on, until we reach 1. Finally, we compare the sum of all totients to the original input number.

Raw Unoptimized Version

This is our first Raku version.

# Unoptimized version, don't use it
my $count = 0;
for 2..Inf -> $n {
    print "$n " and $count++ if is-perfect-totient $n;
    last if $count >= 20;
}
say "";
sub is-perfect-totient ($num) {
    my $n = $num;
    my $sum = 0;
    while $n >= 1 {
        $n = (grep { $n gcd $_ == 1 }, 1..^$n).elems;
        $sum += $n;
    }
    return $num == $sum;
}

This program displays the following output:

$ raku ./perfect-totient.raku
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

The program becomes quite slow for the last perfect totient values (about 25 seconds to run). I tried some micro-optimizations, but without any significant improvement.

Caching the Totient Sums (Naive Version)

If you think about it, the above program computes the sum of the totients many times for the same number. We could store these values to avoid recomputing them. This strategy is called caching (or sometimes memoizing). We use the @tot array as a cache (or memo) to store the totient sums. When we want to compute the totient of a number, we first check if it is in the cache and use this value if such is the case, and we do the computation the hard way (with gcd) only if it is not in the cache.

This could lead to this program:

# Naive caching strategy
my $count = 0;
my @tot = 0, 0;
for 2..Inf -> $n {
    print "$n " and $count++ if is-perfect-totient $n;
    last if $count >= 20;
}
say "";
say "Time spent: ", now - INIT now;

sub is-perfect-totient ($num) {
    my $n = $num;
    my $sum = 0;
    while $n >= 1 {
        if (defined @tot[$n]) {
            $sum += @tot[$n];
            last;
        } else {
            $n = (grep { $n gcd $_ == 1 }, 1..^$n).elems;
            $sum += $n;
        }
    }
    @tot[$num] = $sum;
    return $num == $sum;
}

This program displays the following output:

$ ./raku perfect-totient_cached_1.raku
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571
Time spent: 15.32900533

So we are now at 15 seconds. This is a significant improvement (although less than what I hoped).

Caching the Totient Sums (Improved Version)

We are testing every integer in ascending order. When we are testing one such new integer we know for sure that we haven’t computed its totient sum so far and need to compute it, and we also know for sure that we have already done the calculation for its totient number (provided we supply a first value). In other words, we no longer need the while loop, we can just compute the totient for the new input integer, and add to that the totient sum of the totient, which we are guaranteed to have in the cache. This leads to a significant code simplification of the is-perfect-totient subroutine:

# Improved caching strategy
my $count = 0;
my @tot = 0, 0;
for 2..Inf -> $n {
    print "$n " and $count++ if is-perfect-totient $n;
    last if $count >= 20;
}
say "";
say "Time spent: ", now - INIT now;

sub is-perfect-totient ($num) {
    my $sum = (grep { $num gcd $_ == 1 }, 1..^$num).elems;
    $sum += @tot[$sum];
    @tot[$num] = $sum;
    return $num == $sum;
}

This program displays the following output:

$ raku ./perfect-totient_cached_2.raku
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571
Time spent: 12.34103864

The code simplification has also led to an additional performance improvement of about 20%.

Perfect Totient Numbers in Perl

Our Perl implementation is really a port to Perl of the first Raku program above, with the only difference that we need to implement our own gcd subroutine, since two numbers are relatively prime (or coprime) if their greatest common divisor equals 1. For this, our gcd subroutine will use the so-called Euclidean algorithm, which is an improved variant of Euclid’s original method.

Raw Unoptimized Version

This is our first Perl version.

# Unoptimized version, don't use it
use strict;
use warnings;
use feature qw/say/;

sub gcd {
    my ($i, $j) = sort { $a <=> $b } @_;
    while ($j) {
        ($i, $j) = ($j, $i % $j);
    }
    return $i;
}
sub is_perfect_totient {
    my $num = shift;
    my $n = $num;
    my $sum = 0;
    while ($n >= 1) {
        $n = scalar grep { gcd( $n, $_) == 1 } 1..$n-1;
        $sum += $n;
    }
    return $num == $sum;
}
my $count = 0;
my $n = 1;
while ($count < 20) {
    print "$n " and $count++ if is_perfect_totient $n;
    $n++;
}
say "";

This program displays the following output:

$ perl  ./perfect-totient.pl
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

This program is even slower (39 seconds) than the first Raku version (25 seconds), presumably because of the pure Perl implementation of the gcd function. So, we will also use the caching strategy previously tested in Raku

Caching the Totient Sums

Here, we will go directly to the improved caching strategy used in the third Raku program because it makes the code simpler (and slightly faster).

# Optimized cached version
use strict;
use warnings;
use feature qw/say/;

my @tot = (0, 0);

sub gcd {
    my ($i, $j) = sort { $a <=> $b } @_;
    while ($j) {
        ($i, $j) = ($j, $i % $j);
    }
    return $i;
}

sub is_perfect_totient {
    my $num = shift;
    my $sum = scalar grep { gcd( $num, $_) == 1 } 1..$num-1;
    $sum += $tot[$sum];
    $tot[$num] = $sum;
    return $num == $sum;
}

my $count = 0;
my $n = 1;
while ($count < 20) {
    print "$n " and $count++ if is_perfect_totient $n;
    $n++;
}
say "";

Output:

$ time perl perfect-totient_cached.pl
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

real    0m20,371s
user    0m20,281s
sys     0m0,046s

So, our caching program runs almost twice faster than our original Perl program.

Perfect Totient Numbers in Julia

This is port to Julia of the Raku program above. Julia has a built-in gcd function that we put for good use.

function is_perfect_totient(num)
    n = num
    sum = 0
    while n >= 1
        n = length( filter((x) -> gcd(x, n) == 1, 1:n-1))
        sum += n
    end
    return num == sum
end

count = 0
n = 1
while count < 20 
    if is_perfect_totient(n)
        print("$n ")
        global count += 1
    end
    global n += 1;
end

Output:

$ julia ./perfect-totient.jl
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

This Julia implementation runs much faster (less than 4 seconds) than the Raku and Perl versions. There is probably no urgent need to try to use the caching strategy used for Raku and Perl, but let’s try. The cached version below runs about twice faster (less than 2 seconds):

cache = zeros(Int64, 1, 10000)

function is_perfect_totient(num)
    tot = length( filter((x) -> gcd(x, n) == 1, 1:n-1))
    sum = tot + cache[tot] 
    cache[num] = sum
    return num == sum
end

count = 0
n = 2
while count < 20 
    if is_perfect_totient(n)
        print("$n ")
        global count += 1
    end
    global n += 1;
end

From now on, for other guest-languages, we will go directly for the improved cache strategy (faster and simpler code).

Perfect Totient Numbers in C

C doesn’t have a built-in gcd function, so we implement our own.

#include <stdio.h>
#define MAX_VAL 50000

int cache[MAX_VAL];

int gcd(int i, int j) {
    while (j != 0) {
        int temp = i % j;
        i = j;
        j = temp;
    }
    return i;
}

int is_perfect_totient (int num) {
    int tot = 0;
    for (int i = 1; i < num; i++) {
        if (gcd(num, i) == 1) {
            tot++;
        }
    }
    int sum = tot + cache[tot];
    cache[num] = sum;
    return num == sum;
}

int main() {
    int j = 1;
    int count = 0;
    while (count < 20) {
        if (is_perfect_totient(j)) {
            printf("%d ", j);
            count++;
        }
        j++;
    }
    printf("%s\n", " "); 
}

Output:

$ time ./a.exe
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

real    0m1,441s
user    0m1,374s
sys     0m0,015s

Perfect Totient Numbers in bc

In bc, which is really an arbitrary precision basic calculator with some programming features, we also need to implement our own gcd function.

define gcd (i, j) {
    while(j != 0) {
        k = j
        j = i % j
        i = k
    }
    return i
}

define is_perfect_totient (num) {
    tot = 0
    for (i = 1; i < num; i++) {
        if (gcd(num, i) == 1) {
            tot += 1
        }
    }
    sum = tot + cache[tot] 
    cache[num] = sum
    return num == sum
}

j = 1
count = 0
# we only go to 15 (not 20) because bc is very slow
while (count <= 15) {
    if (is_perfect_totient(j)) {
        print j, " "
        count += 1
    }
    j += 1
}
print "\n"
quit

Since bc is really slow, we display only the first 16 perfect totient numbers:

$ time bc -q perfect-totient.bc
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199

real    0m35,553s
user    0m35,437s
sys     0m0,030s

Perfect Totient Numbers in awk

In awk also we need to implement our own `gcd` function.

function gcd (i, j) {
    while(j != 0) {
        k = j
        j = i % j
        i = k
    }
    return i
}
function is_perfect_totient (num) {
    tot = 0
    for (i = 1; i < num; i++) {
        if (gcd(num, i) == 1) {
            tot += 1
        }
    }
    sum = tot + cache[tot] 
    cache[num] = sum
    return num == sum
}
BEGIN {
    j = 1
    count = 0
    while (count < 20) {
        if (is_perfect_totient(j)) {
            printf "%d ", j
            count += 1
        }
        j += 1
    }
    print " "
}

Output:

$ time awk -f perfect-totient.awk
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 557

real    0m48,899s
user    0m48,656s
sys     0m0,046s

Perfect Totient Numbers in D

D has a built-in gcd function in the std.numeric module.

import std.stdio;
import std.numeric;

int[10000] cache;

bool is_perfect_totient(int num) {
    int tot = 0;
    for (int i = 1; i < num; i++) {
        if (gcd(num, i) == 1) {
            tot++;
        }
    }
    int sum = tot + cache[tot];
    cache[num] = sum;
    return num == sum;
}

void main() {
    int j = 1;
    int count = 0;
    while (count < 20) {
        if (is_perfect_totient(j)) {
            printf("%d ", j);
            count++;
        }
        j++;
    }
    writeln(" "); 
}

Output:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

This ran in 1.34 seconds (but not the same hardware, so don’t compare with other timings).

Perfect Totient Numbers in Ring

t_start = clock()
j = 1
count = 0
cache = list(10000)
while count < 14
    if is_perfect_totient(j)
        see "" + j + " "
        count++
    ok
    j++
end
see nl
duration = (clock() - t_start)/clockspersecond()
see "" + duration + nl

func gcd (i, j) 
    while j != 0 
        k = i % j
        i = j
        j = k
    end
    return i

func is_perfect_totient (num)
    tot = 0
    for i = 1 to (num-1)
        if gcd(num, i) = 1
            tot++
        ok
    next
    sum = tot + cache[tot+1] 
    cache[num+1] = sum
    return num = sum

Output:

$ ring ./perfect-totient.ring
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571
207.40

This program ran in 207.40 seconds, so it isn’t fast. However, it is possible to compile Ring source code into binary executable files (apparently with an intermediate C file). This should presumably be much faster, but I wasn’t able to do this so far because of various environment problems.

Perfect Totient Numbers in Python

Python has a gcd function in the math module.

import math

cache = [0] * 10000

def is_perfect_totient (n):
    tot = 0
    for i in range(1, n):
        if (math.gcd(n, i) == 1):
            tot += 1

​ sum = tot + cache[tot] ​ cache[n] = sum ​ return n == sum
​
i = 1 ​ count = 0 ​ while count < 20: ​ if isperfecttotient(i): ​ print(i, end = ” “) ​ count += 1 ​ i += 1 ​ print(” “)

Output:

$ time python3 ./perfect-totient.py
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

real    0m4,832s
user    0m4,718s
sys     0m0,076s

Perfect Totient Numbers in Kotlin

In Kotlin, we had to implement our own gcd function.

val cache = Array(10000, {i-> 0})

fun gcd (m: Int, n: Int): Int {
    var i = m
    var j = n
    while(j != 0) {
        val k = j
        j = i % j
        i = k
    }
    return i
}

fun is_perfect_totient(n: Int): Boolean {
    var tot = 0
    for (i in 1..n-1) {
        if (gcd(n, i) == 1) {
            tot++
        }
    }
    val sum = tot + cache[tot] 
    cache[n] = sum
    return n == sum
}

fun main() {
    var i = 0
    var count = 0
    while (count <= 20) {
        if (is_perfect_totient(i)) {
            print("$i ")
            count++
        }
        i++
    }
    println(" ")
}

Output:

0 3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

This program ran in 2.5 seconds.

Perfect Totient Numbers in Rust

The Rustnum::integer library provides a gcd function. In my humble opinion, Rust is nevertheless a pain in the neck to use because of its ultra-strict type system. As an example, I could not use a simple integer (i32) as an array subscript, because Rust wants a usize type. That’s why I had to use expressions like CACHE[n as usize]. Similarly, Rust forced me to have my global cache array in uppercase. And, since it is a global variable, I had to wrap accesses to the cache in a unsafe{] block. I personally don’t think a programming language should get in the way of developers to such an extent. I really wasted quite a bit of time working around this straitjacket.

use num::integer::gcd;

static mut CACHE:[i32;10000] = [0; 10000];

fn is_perfect_totient(n: i32) -> bool {
    let mut  tot = 0;
    for i in 1..n {
        if gcd(n, i) == 1 {
            tot += 1
        }
    }
    unsafe {
        let sum = tot + CACHE[tot as usize];
        CACHE[n as usize] = sum;
        return n == sum;
    }
}    

fn main() {
    let mut i = 1;
    let mut count = 0;
    while count < 20 {
        if is_perfect_totient(i) {
            print!("{} ", i);
            count += 1;
        }
        i += 1;
    }
    println!("{}", " ")
}

Ouput:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

Perfect Totient Numbers in Java

Java has a gcd function bizarrely sitting in the java.math.BigInteger class. For a program performing heavy number crunching, I did not think it was reasonable to accept the performance penalty associated with big integers. So, I wrote my own gcd function.

public class PerfectTotient {

    static int[] cache = new int[10000];

    public static int gcd(int i, int j) {
        while (j != 0) {
            int temp = i % j;
            i = j;
            j = temp;
        }
        return i;
    }
    public static boolean isPerfectTotient(int n) {
        int tot = 0;
        for (int i = 1; i < n; i++) {
            if (gcd(n, i) == 1) {
                tot++;
            }
        }
        int sum = tot + cache[tot];
        cache[n] = sum;
        return n == sum;
    }

    public static void main(String[] args) {
        int i = 0;
        int count = 0;
        while (count < 20) {
            if (isPerfectTotient(i)) {
                System.out.printf("%d ", i);
                count++;
            }
            i++;
        }
        System.out.printf("%s", "\n");
    }
}

Ouput:

0 3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

The compiled program ran in 1,23 second (not on the same hardware as most timings in this post).

Perfect Totient Numbers in Nim

Nim has a gcd function in its math library.

import math

var cache: array[0..10000, int]

proc is_perfect_totient (n: int): bool =
  var tot = 0
  for i in 1..n-1:
    if (gcd(n, i) == 1):
      tot += 1
  let sum = tot + cache[tot]
  cache[n] = sum
  return sum == n

var i = 1
var count = 0
while count < 20:
  if is_perfect_totient(i):
    stdout.write i, " "
    count += 1
  i += 1
echo ""

Output:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

This program ran in 13 seconds.

Perfect Totient Numbers in Go

No gcd in plementation in go, so we rolled out our own.

import "fmt"

var cache [10000]int

func gcd(i int, j int) int {
    for j != 0 {
        temp := i % j
        i = j
        j = temp
    }
    return i
}

func is_perfect_totient(n int) bool {
    tot := 0
    for i := 1; i < n; i++ {
        if gcd(n, i) == 1 {
            tot++
        }
    }
    sum := tot + cache[tot]
    cache[n] = sum
    return n == sum
}

func main() {
    i := 0
    count := 0
    for count <= 20 {
        if is_perfect_totient(i) {
            fmt.Printf("%d ", i)
            count++
        }
        i++
    }
    fmt.Println("")
}

Output:

0 3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

Perfect Totient Numbers in JavaScript

var cache = new Array(10000)
cache[0] = 0

function gcd (i, j) {
    while(j != 0) {
        k = j
        j = i % j
        i = k
    }
    return i
}

function is_perfect_totient (n) {
    let tot = 0
    for (var i = 1; i < n; i++) {
          if (gcd(n, i) == 1) {
            tot++
        }
    }
    sum = tot + cache[tot]
    cache[n] = sum
    return n == sum
}

let count = 0
let i = 1
while (count < 20) {
    if (is_perfect_totient(i)) {
        process.stdout.write(i + " ")

        count++
    }
    i++
}
process.stdout.write("\n")

Output:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

Perfect Totient Numbers in Dart

Dart has a gcd method, which we will use.

import "dart:io";

var cache = List<int>.filled(10000, 0, growable: true);

void main() {
    cache[0] = 0;
    var count = 0;
    var i = 1;
    while (count < 20) {
        if (is_perfect_totient(i)) {
            stdout.write("$i ");
            count++;
        }
        i++;
    }
    print(" ");
}

bool is_perfect_totient(n) {
    var tot = 0;
    for (int i = 1; i < n; i++ ) {
       if (i.gcd(n) == 1) {
            tot++;
        }
    }
    int sum = tot + cache[tot];
    cache[n] = sum;
    return n == sum;
}

Output:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

Perfect Totient Numbers in Ruby

Ruby has a gcd mehod, so we’ll use it.

$cache = Array.new(10000, 0) # global variables require $

def is_perfect_totient(n)
    tot = 0
    for i in 1..(n - 1)
        if n.gcd(i) == 1
            tot += 1
        end
    end
    sum = tot + $cache[tot]
    $cache[n] = sum;
    return sum == n
end

i = 1
count = 0
while count < 20
    if is_perfect_totient(i)
        printf("%d ", i)
        count += 1
    end
    i += 1
end
print("\n")

Output:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

Perfect Totient Numbers in Scala

Scala has a gcd function, but only for big integers (probably because Scala relies on Java, which has the same property). For a program performing heavy number crunching, I did not think it was reasonable to accept the performance penalty associated with big integers. So, I wrote my own gcd function for plain integers.

object PerfectTotient extends App {

  var cache = new Array[Int](10000)

  def gcd(a: Int, b: Int): Int = {
    var (i, j) = (a, b)
    while (j > 0) {
      var t = i
      i = j
      j = t % j
    }
    return i
  }

  def is_perfect_totient(n: Int): Boolean = {
    var tot = 0
    for (i <- 1 to (n - 1)) {
      if (gcd(n, i) == 1) {
        tot += 1
      }
    }
    val sum = tot + cache(tot)
    cache(n) = sum
    return n == sum
  }

  var i = 1
  var count = 0
  while (count < 20) {
    if (is_perfect_totient(i)) {
      count += 1
      printf("%d ", i)
    }
    i += 1
  }
  println("")
}

Output:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

Perfect Totient Numbers in Tcl

Tcl doesn’t have a built-in gcd function, so I wrote one.

array set cache {}

set cache(0) 0

proc gcd {i j} {
   while {$j != 0} {
      set t [expr {$i % $j}]
      set i $j
      set j $t
   }
   return $i
}

proc is_perfect_totient {n} {
    global cache
    set tot 0
    for {set i 1} {$i < $n} {incr i} {
        if [ expr [gcd $i $n] == 1 ] {
            incr tot
        }
    }
    set sum [expr $tot + $cache($tot)]
    set cache($n) $sum
    return [ expr $n == $sum ? 1 : 0]
}

set i 1
set count 0
while { $count < 20 } {
    if [ is_perfect_totient $i ] {
        puts -nonewline  "${i} "
        incr count
    }
    incr i
}
puts ""

As a fully interpreted language, Tcl is quite slow, as it can be seen in the following output:

$ time tclsh ./perfect-totient.tcl
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

real    1m18,058s
user    1m17,593s
sys     0m0,046s

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

This blog is an answer to the first task (Disarium Numbers) of the Week 174 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Originally, the Perl Weekly Challenge called for solutions in Perl and Raku (also known as Perl 6 at the time). But, very soon, people started to provide solutions in other “guest” languages. See for example my blog post providing solutions to the task described below in about 18 different guest languages.

One of the languages I tried for the first time last week with Sylvester’s sequence is dc, and it turned out to be much more difficult and challenging than I initially thought. One of the problems is that there is only very limited documentation on this old programming language. So I thought it might be useful to describe in some details how I solved it. I provided detailed explanations in this other blog post. I’ll now do the same with the disarium number task of this week, which is a bit more complicated.

The Disarium Number Task of Perl Weekly Challenge 174

Write a script to generate first 19 Disarium Numbers.

A disarium number is an integer where the sum of each digit raised to the power of its position in the number, is equal to the number.

For example,

518 is a disarium number as (5 ** 1) + (1 ** 2) + (8 ** 3) => 5 + 1 + 512 => 518

Disarium Numbers in Some Other Languages

The dc language is difficult and poorly documented. Before we get to it, I want to illustrate the algorithm I’ll implement with some other more traditional languages.

You can find solutions to this problem in 17 programming languages in this other blog post. I’ll show two of them below.

Disarium Numbers in Raku

sub is-disarium($num) {
    my @digits = $num.comb;
    my $sum = [+] map { $^b ** ($^a + 1) }, @digits.kv;
    return $num == $sum;
}
my $count = 0;
my $i = 0;
while $count < 19 {
    ++$count and say $i if is-disarium($i);
    $i++;
    # say "i: $i";
}

This program displays the following output:

0
1
2
3
4
5
6
7
8
9
89
135
175
518
598
1306
1676
2427
2646798

Disarium Numbers in Perl

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

sub is_disarium {
    my $num = shift;
    my @digits = split '', $num;
    my $i = 1;
    my $sum = 0;
    $sum += $_ for map {  $_ ** $i++ } @digits;
    return $num == $sum;
}
my $i = 0;
my $count = 0;
while ($count < 19) {
    say $i and $count++ if is_disarium $i;
    $i++;
}

This Perl program displays the same output as the Raku program above.

Disarium program in awk

The dc language doesn’t have the powerful string functions of Raku, Perl, or Julia. Let me provide here an awk implementation, because awk also doesn’t have these string functions. In the while loop of the is_disarium function, we use the integer division and modulo operators to get each digit of the input integer in turn. We’ll have to do something similar in dc.

function is_disarium(num) {
    n = num
    sum = 0
    len = length(n)
    while (n > 0) {
        sum += (n % 10) ^ len
        n = int(n/10)
        len--
    }
    return (sum == num)
}

BEGIN {
    count = 0
    i = 0
    while (count < 19) {
        if (is_disarium(i)) {
            printf("%d\n", i)
            count++
        }
        i++
    }
}

This awk program displays the same output as the Raku program above.

Introducing dc

According to Wikipedia), dc (desk calculator) is a cross-platform reverse-Polish calculator which supports arbitrary-precision arithmetic. Written by Lorinda Cherry and Robert Morris at Bell Labs, it is one of the oldest Unix utilities, preceding even the invention of the C programming language. dc is docucumented in section 2 of the first ediion of Bell Labs’s Unix Programmer’s Manual published on Nov 3, 1971, so dc was probably written in 1970 or latest in 1971. Like other utilities of that vintage, it has a powerful set of features but terse syntax. Traditionally, the bc calculator program (with infix notation) was implemented on top of dc.

dc is the oldest surviving Unix language program. When its home Bell Labs received a PDP-11, dc—written in B—was the first language to run on the new computer, even before an assembler.

It uses reverse Polish notation (RPN) which was also used around the same time by Hewlett-Packard pocket calculators. Actually, the main reason I am interested with dc (despite its awful worse-than-assembler syntax) is that this is essentially the type of language with which I first learned to program back in the mid-1970s with a programmable pocket calculator.

RPN is a postfix notation in which you first specify the operands and then the operator.

$ echo '5 6 + p' | dc
11

As you can see, we first input the two operands (5 and 6), and then the + operator, and finally the p operator to print out the result of the addition. Prefix your number with an underscore if you want to specify a negative number (e.g. _5 for -5)

The spaces are not needed (except between 5 and 6) but improve readability. We could have written it this way:

$ echo '5 6+p' | dc
11

dc can also be used in interactive mode:

$ dc
5 6
+
p
11
q

or:

$ dc
5 6 + p q
11

This can be quite convenient to test chunks of code and we will use that feature.

We can also use the -e (or --expression) command-line option to specify a simple program between single quotes:

$ dc -e '5 6 + p'
11

dc uses a stack to perform its operations. Stacks are very commonly used data structure in computer science. A stack is a last in / first out data structure. Think of piled-up plates. When you put a clean plate on the stack, you usually put it on top; when you take one out, you also take it from the top. So, the first plate that you take out is the last one that you added. The dc stack implements the same idea: the first piece of data you take out is the last one you added. Adding a new piece of data onto the stack is usually called a push operation, and taking out one piece of data from the stack is called a pop operation.

The various commands above can be understood as follows:

$ dc
5   # push 5 to stack
6   # push 6 to stack
f   # display stack (displays 6 and 5). Useful for debugging
6
5
+   # pop two items from stack, add them and push result to stack
p   # print top item of the stack (prints 11)
11
q   # quit

Note that the # sign indicates the beginning of a comment (the rest of the line is ignored).

For full details on the dc syntax, please consult the dc GNU manual. We will describe here only the most common commands, those that we are likely to use for our program. The best tutorial I have found on dc is the Wikipedia dc page).

Printing Commands

p   Prints the value on the top of the stack, not altering the stack. 
n   Prints the value on the top of the stack, popping it off
f   Prints the entire contents of the stack without altering anything.

Stack Control

c   Clears the stack, rendering it empty
d   duplicate the value on top of the stack
r   Reverses the order of (swaps) the top two values on the stack.

Registers

dc provides at least 256 memory registers, each named by a single character. You can store a number in a register and retrieve it later.

sr  Pops the value off the top of the stack, stores it in register r. 
lr  Copies the value in register r, and pushes it onto the stack.
    This does not alter the contents of r.

Each register also contains its own stack. The current register value is the top of the register’s stack. If you want to use a register r as a stack, use Sr (with uppercase S) to push the top of stack value to r, and Lr (with uppercase L) to pop a value from r and push it on the main stack. We will not use the stack features of registers in this blog post.

Arithmetic

+   Pops two values off the stack, adds them, and pushes the result.
-   Pops two values, subtracts the first one popped from the second 
    one popped, and pushes the result. 
*   Pops two values, multiplies them, and pushes the result.
/   Pops two values, divides the second one popped from the first 
    one popped, and pushes the result. The number of fraction digits 
    is specified by the precision value. Default is integer division.
%   Pops two values, computes the remainder of the division that 
    the `/` command would do, and pushes that.
^   Pops two values and exponentiates, using the first value popped 
    as the exponent and the second popped as the base.

Strings

dc can operate on strings as well as on numbers. The only things you can do with strings are print them and execute them as macros (which means that the contents of the string are processed as dc commands).

For example, to print twice a string in the interactive mode:

$ dc
[Hello wolrd!]p
Hello wolrd!
p
Hello wolrd

or:

$ dc
[Hello wolrd!]pp
Hello wolrd!
Hello wolrd!

Now, let’s try to write a simple string containing dc statements to increment by 2 the value on the stack, and to run it as a macro (using the x command):

$ dc
20          # pushes 20 to stack
[2 + p] x   # [2 + p] is a string that means "push 2 to stack,
            # add the two top items of the stack and print result.
            # x runs the [2 + p] sting as a macro
22
q

Both registers and the stack can hold strings, and dc always knows whether any given object is a string or a number.

[ch] Makes a string containing "ch" and pushes it on the stack.
x   Pops the value from the top of the stack and executes it as a macro
>r  Pops two values off the stack and compares them assuming they are 
    numbers, executing the contents of register r as a macro if the 
    original top-of-stack is greater
<r  Similar but invokes the macro if the original top-of-stack is less
=r  Similar but invokes the macro if the original top-of-stack is equal

Macros

Macros are then implemented by allowing registers and stack entries to be strings as well as numbers. A string can be printed, but it can also be executed (i.e. processed as a sequence of dc commands). For instance, we can store a macro to add 3 and then multiply by 2 into register m:

[3 + 2 *] sm

and then (using the x command which executes the top of the stack) we can use it like this:

3 lm x p

This displays the following:

$ dc -e '[3 + 2 *] sm 3 lm x p'
12

For better understanding, this is a detailed account of what’s going on:

[    # start of macro definition
  3  # push 3 to stack
  +  # pop 2 values off the stack, add them and store result on stack
  2  # push 2 on stack
  *  # pop 2 values off the stack, multiply them, store result on stack
]    # end of macro definition
sm   # store the macro just defined in register m
3    # push 3 on stack
lm   # copy value in register m (the macro) onto the stack
x    # run the macro
p    # print the result (top of the stack)

Conditionals and Loops in dc

The =, >, !>, <, !<, != conditionals execute the subsequent macro when the two top values of the stack are equal, larger than, not larger than, etc. For example, in:

$ dc -e '[[smaller than]p] sm 6 5 <m'
smaller than

the macro stored in m runs (and prints “smaller than”) because 5 is smaller than 6. The < pops 5 and then 6 from the stack and runs the macro in register m because the first popped value (5) is smaller than the second popped value.

Let’s look at a simple countdown in this page in the Bash Hackers Wiki:

dc << EOF
[ li       # put our index i on the stack 
  p        # print it, to see what's going on
  1 -      # we decrement the index by one
  si       # store decremented index (i=i-1)
 0 li >L   # if i > 0 then execute recursively L
] sL       # store our macro with the name L
10 si      # let's give to our index the value 10
lLx        # and start our loop
EOF 

10
9
8
[ Lines omitted for brevity]
2
1

Basically, the macro is called a first time, and then calls itself recursively so long as the condition is satisfied.

Disarium Numbers in dc

Remember that we want to write something similar to the is_disarium function of our above-described awk program:

function is_disarium(num) {
    n = num
    sum = 0
    len = length(n)
    while (n > 0) {
        sum += (n % 10) ^ len
        n = int(n/10)
        len--
    }
    return (sum == num)
}

Our program will be composed essentially of four macros calling themselves or each other, and just a few additional code lines to start the whole process.

The Length Macro

The above is_disarium function uses the awk built-in length() function. There is no such built-in function in dc. So our first task will be to write our own length macro.

The way this macro will work is that we’re going to repeatedly divide (integer division) the input number by 10, until we get to 0. At each step through the process, we increment the length (register l) by one.

The length macro itself is stored in the L register, and the length “variable” in register l.

[10      # pushes 10 to stack
 /       # divides input by 10 and stores result on stack
 ll      # pushes length on stack
 1+      # adds one to stack (length)
 # p     # prints intermediate length (for debugging)
 sl      # saves length to register l
 d       # duplicates value (number) on top of stack
 0       # pushes 0 to stack
 <Lx     # executes recursively length macro (L) if number > 0
] sL     # end of macro, stores it in L

889 sn   # stores some input number in n
ln       # pushes number to stack
0sl      # stores 0 in register l (length)
lLx      # runs the macro once to start the loop
llp      # prints length final value

The last five lines in the code above (after the blank line) are not part of the macro, they are just some code to set up the environment before calling the macro: start with an input number (889 in the above example), initialize the length (register l) to 0, invokes the macro (stored in register L), and prints the length.

With an input number of 889, this program correctly prints out 3.

The Disarium Macro

This macro is more or less equivalent to the is_disarium function’s while loop of the awk program:

while (n > 0) {
    sum += (n % 10) ^ len
    n = int(n/10)
    len--
}

The disarium macro computes the number modulo 10, then computes the result to the length power, adds the obtained value to the sum so far; it also divides the number by 10 (integer division) and decrements the length by 1. At the end, it calls itself recursively if the resulting number is larger than 0.

The disarium macro is stored in register D. The sum is stored in register s, the length in register l, and the input number in register n.

[d      # duplicates value (number) on top of stack
10      # pushes 10 to stack
%       # pushes (number % 10) to stack
ll      # pushes length to stack
^       # computes (n % 10) ^ len
ls      # pushes sum to stack
+ss     # computes new sum and stores it in s
10/     # integer division number / 10
ll      # pushes length on stack
1-      # subtract 1 froml length
sl      # stores new length in l
d       # duplicates value (number) on top of stack
0       # pushes 0 to stack
<Dx     # executes recursively disarium macro (D) if number > 0
] sD    # stores disarium macro in D

88 sn   # stores number in n
ln      # pushes number to stack
0sl     # stores 0 in register l (length)
lLx     # runs the length macro
0ss     # initializes sum to 0
cln     # clear stack and pushes number onto it
lDx     # runs the Disarium macro
lsln    # pushes sum and number
f       # display stack (sum and number)

The 10 last code lines (after the blank line) are not part of the macro, but are needed to make a full dc program that can be tested independently (well you’ll also need the length macro described above). They initialize the input number to 88, the sum to 0, and the length to 0. Then we run the length macro (stored in L) and the disarium macro. At the end, we push the sum and the input number to the stack and can verify whether they are equal (in which case the input number is a disarium number) or not. With the input value of 88, the program displays:

88
72
0

The input number (88) and the sum (72 = 8 * 8 + 8) are not equal, so 88 is not a disarium number.

If we change the input number to 89, we get the following output:

89
89
0

The input number (89) and the sum (89 = 9 * 9 + 8) are equal, so 89 is a disarium number.

The Iteration Macro

We need to iterate over the subsequent integers and, for each of them, call the length macro and then the disarium macro to find out whether it is a disarium number.

The macro stores the current iteration variable into the number register (this is the number we will test), initializes length to 0, runs the length macro, initialize sum to 0 and runs the disarium macro once. Then it pushes sum and number to stack and compares them. If they are equal (input number is a disarium number), it runs the printing macro (see below). Finally, it compares the disarium number with 18, and calls itself recursively if the counter is smaller than 18.

The iteration macro is stored in the I (capital i) register. The sum is stored in register s, the length in register l, the input number in register n, the iteration variable in register i, and the disarium number counter in register c.

[li sn  # Stores iteration variable in number register
ln      # pushes number to stack
0sl     # stores 0 in register l (length)
lLx     # runs the length macro
0ss     # inititialize sum to 0
cln     # clear stack and pushes number onto it
lDx     # runs the Disarium macro once
lsln    # pushes sum and number
=P      # runs the printing macro if numbers are equal
li      # loads iteration variable
1+si    # increments iteration variable
lc18    # pushes counter and 18 on stack
>Ix     # runs recursively iteration macro if counter < 18
] sI    # end of iteration macro, stores it in I

We cannot run this macro at this point, because we need a small additional macro, the printing macro.

The Printing and Counting Macro

I’ve previously called it “printing macro” for the sake of brevity, but it is really a printing and counting macro. This macro runs only when input number and the computed sum are equal (i.e. when we have a disarium number). In that case, we need to do two things: print out the disarium number and increment by 1 the disarium number counter (so that we know when to stop the iteration macro).

The printing and counting macro is stored in the P register. The disarium number counter is stored in the c register, and the input number in register n.

[lc1+sc # increments disarium number counter
lnp     # print number
]sP     # Stores printing macro in P

The Final Disarium Number Program in dc

We can now put together all the pieces seen so far.

The macros are stored in upper-case letter registers:

• L: length of input number macro

• D: Disarium macro

• I: Iteration macro

• P: Printing and counting macro

The “variables” are stored in lower-case letter registers:

• n: Input number

• c: Disarium number counter

• l: Length of input number

• s: Sum

• i: Iteration variable

This is the full dc program:

# Macro for computing the input number length
[10      # pushes 10 to stack
 /       # divides input by 10 and stores result on stack
 ll      # push length on stack
 1+      # add one to stack (length)
 sl      # saves length to register l
 d       # duplicates value (number) on top of stack
 0       # pushes 0 to stack
 <Lx     # executes recursively length macro (L) if number > 0
] sL     # end of macro, store it in L

# Disarium macro
[d      # duplicates value (number) on top of stack
10      # pushes 10 to stack
%       # pushes (number % 10) to stack
ll      # pushes length to stack
^       # computes (n % 10) ^ len
ls      # pushes sum to stack
+ss     # computes new sum and stores it in s
10/     # integer division number / 10
ll      # pushes length on stack
1-      # subtract 1 froml length
sl      # stores new length in l
d       # duplicates value (number) on top of stack
0       # pushes 0 to stack
<Dx     # executes recursively disarium macro (D) if number > 0
] sD    # stores disarium macro in D

# Printing and counting macro
[lc1+sc # increments disarium number counter
lnp     # print number
]sP     # Stores printing macro in P

# Iteration macro
[li sn  # Stores iteration variable in number register
ln      # pushes number to stack
0sl     # stores 0 in register l (length)
lLx     # runs the length macro
0ss     # inititialize sum to 0
cln     # clear stack and pushes number onto it
lDx     # runs the Disarium macro once
lsln    # pushes sum and number
=P      # runs the printing macro if numbers are equal
li      # loads iteration variable
1+si    # increments iteration variable
lc18    # pushes counter and 18 on stack
>Ix     # runs recursively iteration macro counter < 18
] sI    # end of iteration macro, stores it in I

# Main
0si     # Initialize iteration variable
0sc     # Initialize disarium numbers counter
lIx     # running iteration macro the first time

As you can see, the program consists of the four macros defined previously, plus just 3 code lines (the “Main” part) to initialize the iteration variable, initialize the disarium number counter and launch the iteration macro.

This program displays the following output:

$ dc ./disarium.dc
0
1
2
3
4
5
6
7
8
9
89
135
175
518
598
1306
1676
2427

But, of course, formatting the program with abundant spaces and comments as above is way too easy. Real programmers will prefer this one-liner version (spread over two lines for formatting reasons):

$ dc -e '[10/ll1+sld0<Lx]sL[d10%ll^ls+ss10/ll1-sld0<Dx]sD[lc1+sc
lnp]sP[lisnln0sllLx0ssclnlDxlsln=Pli1+silc18>Ix]sI0si0sclIx'
0
1
2
3
[Lines omitted for brevity
598
1306
1676
2427

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

These are some answers to the Week 174 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 24, 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: Disarium Numbers

Write a script to generate first 19 Disarium Numbers.

A disarium number is an integer where the sum of each digit raised to the power of its position in the number, is equal to the number.

For example,

518 is a disarium number as (5 ** 1) + (1 ** 2) + (8 ** 3) => 5 + 1 + 512 => 518

In Raku and Perl, we’ll implicitly convert the input number into a string of characters (@digits), split it into an array of characters, and then implicitly convert each character into a digit. In some other languages such as awk, bc, or C, such implicit conversion don’t happen or are tedious, and we will use mathematical computations to get the individual digits.

Disarium Numbers in Raku

This is quite straight forward. We have a is-disarium subroutine which returns a True value is the described sum is equal to the input value, and False otherwise. Then we use it to test each subsequent integer from 0 on and print out the number if it is a disarium number. We stop when we reach 19 disarium numbers.

sub is-disarium($num) {
    my @digits = $num.comb;
    my $sum = [+] map { $^b ** ($^a + 1) }, @digits.kv;
    return $num == $sum;
}
my $count = 0;
my $i = 0;
while $count < 19 {
    ++$count and say $i if is-disarium($i);
    $i++;
    # say "i: $i";
}

This program displays the following output:

0
1
2
3
4
5
6
7
8
9
89
135
175
518
598
1306
1676
2427
2646798

This program took 0.4 second to find the first 18 disarium numbers, and then more than 4 minutes to find the 19th one. I have to confess that, for years, I have been too lazy to upgrade my Rakudo installation, which dates from 2019. This time, I decided it was high time to upgrade it and installed version 2022.06 to see what happens.

The good news is that, with this new version, the program ran in about 45 seconds. More than five times faster, that’s a rather impressive improvement. The bad news, though, is that it’s still very slow. The equivalent Perl and Python programs (see below) both took slightly less than 10 seconds, the Julia implementation ran in 3 seconds, and the C program completed in less than half a second. There is definitely a large opportunity for performance improvement. I love Raku, but I must admit that, in terms or performance, it is currently not good at intensive number crunching.

Disarium Numbers in Perl

This is a port to Perl of the Raku program just above, with a is_disarium subroutine to find is the input integer is a disarium number.

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

sub is_disarium {
    my $num = shift;
    my @digits = split '', $num;
    my $i = 1;
    my $sum = 0;
    $sum += $_ for map {  $_ ** $i++ } @digits;
    return $num == $sum;
}
my $i = 0;
my $count = 0;
while ($count < 19) {
    say $i and $count++ if is_disarium $i;
    $i++;
}

This program displays the following output:

$ time perl ./disarium.pl

0
1
2
3
[Lines omitted for brevity]
1676
2427
2646798

real    0m9,781s
user    0m9,625s
sys     0m0,046s

Disarium Numbers in Julia

Julia has the built-in digits function, which produces a list of digits of the input number (in the wrong order for our purpose), and enumerate iterator, which yields a list of indexes and values. These functions make the is_disarium function very simple (it could easily be written in one single code line).

function is_disarium(n)
    s = sum(i ^ p for (p, i) in enumerate(reverse(digits(n))))
    return s == n
end

count = 0
i = 0
while count < 19
    if is_disarium(i)
        println(i)
        global count += 1
    end
    global i += 1
end

Output:

julia ./disarium.jl
0
1
2
3
[Lines omitted for brevity]
1676
2427
2646798

Disarium Numbers in awk

The awk language doesn’t have the powerful string functions of Raku, Perl, or Julia. In the while loop of the is_disarium function, we use the integer division and modulo operators to get each digit of the input integer in turn.

function is_disarium(num) {
    n = num
    sum = 0
    len = length(n)
    while (n > 0) {
        sum += (n % 10) ^ len
        n = int(n/10)
        len--
    }
    return (sum == num)
}

BEGIN {
    count = 0
    i = 0
    while (count < 19) {
        if (is_disarium(i)) {
            printf("%d\n", i)
            count++
        }
        i++
    }
}

Output:

$ awk -f ./disarium.awk
0
1
2
3
[Lines omitted for brevity]
1676
2427
2646798

Disarium Numbers in bc

This program is very similar to the awk program just above, with the same method to access the individual digits.

define is_disarium (num) {
    n = num
    sum = 0
    len = length(n)
    while (n > 0) {
        sum += (n % 10) ^ len
        n = n/10
        len -= 1
    }
    return (sum == num)
}

count = 0
i = 0
while (count < 19) {
    if (is_disarium(i)) {
        print i, "\n"
        count += 1
    }
    i += 1
}
quit

Output:

$ bc  ./disarium.bc
bc 1.06.95
Copyright 1991-1994, 1997, 1998, 2000, 2004, 2006 Free Software Foundation, Inc.
This is free software with ABSOLUTELY NO WARRANTY.
For details type `warranty'.
0
1
2
3
[Lines omitted for brevity]
1676
2427
2646798

Disarium Numbers in dc

The problem can be solved with a dc one-liner (spread over two lines for formatting reasons):

$ dc -e '[10/ll1+sld0<Lx] sL [d10%ll^ls+ss10/ll1-sld0<Dx] sD [lc1+sc
lnp] sP [lisnln0sllLx0ssclnlDxlsln=Pli1+silc18>Ix] sI0si0sclIx'
0
1
2
3
4
5
6
7
8
9
89
135
175
518
598
1306
1676
2427

Note that I only printed 18 numbers because this is getting really slow.

This is not a golf attempt: I could have removed a few spaces if I had wanted to golf it.

But I must admit dc scripts are not easy to read. This is now a much more readable version of the same solution:

# Macro for computing the input number length
[10      # pushes 10 to stack
 /       # divides input by 10 and stores result on stack
 ll      # push length on stack
 1+      # add one to stack (length)
 # p     # prints intermediate length (for debugging)
 sl      # saves length to register l
 d       # duplicates value (number) on top of stack
 0       # pushes 0 to stack
 <Lx     # executes length macro (L) if number > 0
] sL     # end of length macro, store it in L

# is Disarium macro
[d      # duplicates value (number) on top of stack
10      # pushes 10 to stack
%       # pushes (number % 10) to stack
ll      # pushes length to stack
^       # computes (n % 10) ^ len
ls      # pushes sum to stack
+ss     # computes new sum and stores it in s
10/     # integer division number / 10
ll      # pushes length on stack
1-      # subtract 1 froml length
sl      # stores new length in l
d       # duplicates value (number) on top of stack
0       # pushes 0 to stack
<Dx     # executes recursively disarium macro (D) if number > 0
] sD    # stores disarium macro in D

# Printing and counting macro
[lc1+sc # increments disarium number counter
lnp     # print number
]sP # Stores printing macro in P

# Iteration macro
[li sn  # Stores iteration variable in number register
ln      # pushes number to stack
0sl     # stores 0 in register l (length)
lLx     # runs the length macro
0ss     # inititialize sum to 0
cln     # clear stack and pushes number onto it
# llp   # print the length
lDx     # runs the Disarium macro once
lsln    # pushes sum and number
=P      # runs the printing macro if numbers are equal
li      # loads iteration variable
1+si    # increments iteration variable
lc18    # pushes counter and 18 on stack
>Ix     # runs recursively iteration macro if counter < 18
] sI    # end of iteration macro, stores it in I 

# Main
0si     # Initiate iteration variable
0sc     # Initiate disarium numbers counter
lIx     # running iteration macro the first time

Output:

$ dc disarium.dc
0
1
2
3
[Lines omitted for brevity]
1306
1676
2427

Understanding the solution in details would require a lot more explanations than what I can provide here. If you want to understand better how this program works and, more broadly, how the dc syntax works, you are kindly invited to read this other blog post where I describe the solution in detail.

Disarium Numbers in C

The C programming language doesn’t have a standard exponentiation operator. So I wrote a power function to perform exponentiation of individual digits. There is also no direct way to find the number of digits of an integer. So, I used floor(log10(n)) + 1 to find the size of an integer n, except that it would fail for an input of 0, so I used this method only for integers larger than 9.

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

int power (int base, int exponent) {
    int result = 1;
    for (int i = 1; i <= exponent; i++) {
        result *= base;
    }
    return result;
}

int is_disarium (int num) {
    int n = num;
    int sum = 0;
    int len = n <= 9 ? 1 : floor(log10(n)) + 1;
    while (n > 0) {
        sum += power(n % 10, len);
        n /= 10;
        len--;
    }

    return num == sum;
}

int main() {
    int count = 0;
    int i = 0;
    while (count < 19) {
        if (is_disarium(i)) {
            printf("%d\n", i);
            count++;
        }
        i++;
    }
}

Output:

$ time ./a.out
0
1
2
3
[Lines omitted for brevity]
1676
2427
2646798

real    0m0,475s
user    0m0,280s
sys     0m0,015s

Disarium Numbers in Python

Also using the integer division and modulo operators to get each digit of the input integer.

def is_disarium(num):
    n = num
    size = len(str(n))
    sum = 0
    while n > 0:
        sum += (n % 10) ** size
        n //= 10
        size -= 1
    return sum == num

i = 0
count = 0
while count < 19:
    if is_disarium(i):
        print(i)
        count += 1
    i += 1

Output:

$ python3 disarium.py
0
1
2
3
[Lines omitted for brevity]
1306
1676
2427
2646798

Disarium Numbers in Ruby

def is_disarium(num)
    n = num.to_s
    sum = 0
    for i in 1..(n.length)
        sum += n[i-1].to_i**i
    end
    return sum == num
end

i = 0
count = 0
while count < 19
    if is_disarium(i)
        printf("%d ", i)
        count += 1
    end
    i += 1
end
print("\n")

From now on, our programs will display the disarium numbers on one line to save space:

0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798

Disarium Numbers in Kotlin

Kotlin has a pow function for exponentiation, but it works with Double and Float leading to numerous time-consuming difficulties. I ended up writing my own power functions for integers.

fun power(n: Int, exp: Int): Int {
    return when {
        exp > 1 -> n * power(n, exp-1)
        exp == 1 -> n
        else -> 1
    }
}
fun is_disarium(num: Int): Boolean {
    val n = num.toString()
    var sum = 0
    for (i in 1..n.length) {
        sum += power (n[i-1] - '0', i)
    }
    return sum == num
}
fun main() {
    var i = 0
    var count = 0
    while (count < 19) {
        if (is_disarium(i)) {
            print("$i ")
            count++
        }
        i++
    }
    println("")
}

Output:

0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798

Disarium Numbers in Rust

I don’t really like Rust because, in my humble opinion, its type system is really an obstructive straitjacket and gets in the way of doing simple things. Just like in Kotlin, I ended up writing my own power functions for exponentiating integers.

fn power(n: i32, exp: i32) -> i32 {
    let mut result = 1;
    for _i in 0..exp {
        result *= n;
    }
    return result;
}
fn is_disarium(num: i32) -> bool {
    let mut n = num;
    let mut sum = 0;
    let mut i = 1;
    let len = num.to_string().len();
    while n > 0 {
        sum += power(n % 10, len as i32 - i + 1);
        n /= 10;
        i += 1
    }
    return sum == num;
}
fn main() {
    let mut i = 0;
    let mut count = 0;
    while count <= 18 {
        if is_disarium(i) {
            print!("{} ", i);
            count += 1;
        }
        i += 1;
    }
    println!("{}", " ")
}

Output:

0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798

Disarium Numbers in Java

import java.lang.Math;

public class DisariumNumbers {
    public static boolean is_disarium(int num) {
        int n = num;
        int len = Integer.toString(n).length();
        int sum = 0;
        int i = 1;
        while (n > 0) {
            sum += Math.pow(n % 10, len - i + 1);
            n /= 10;
            i ++;
        }
        return sum  == num;
    }

    public static void main(String[] args) {
        int i = 0;
        int count = 0;
        while (count <= 18) {
            if (is_disarium(i)) {
                System.out.printf("%d ", i);
                count++;
            }
            i++;
        }
        System.out.printf("%s", "\n");
    }
}

Output:

0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798

Disarium Numbers in Scala

object Disarium extends App {
  def power(base: Int, exp: Int): Int = {
    var result = 1
    for (i <- 1 to exp) {
      result *= base
    }
    return result
  }
  def is_disarium(num: Int): Boolean = {
    val digits = num.toString.split("")
    var sum = 0
    for (i <- 0 to (digits.size - 1)) {
      sum += power(digits(i).toInt, i + 1)
    }
    return num == sum
  }
  var i = 0
  var count = 0
  while (count < 19) {
    if (is_disarium(i)) {
      count += 1
      printf("%d ", i)
    }
    i += 1
  }
  println("")
}

Output:

0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798

Disarium Numbers in Ring

i = 0
count = 0
while count < 19
    if is_disarium(i)
        see "" + i + " "
        count++
    ok
    i++
end    
see nl

func pow (base, exp)
    result = 1
    for i = 0 to exp - 1
        result *= base
    next
    return result

func is_disarium (num)
    n = "" + num
    sum = 0
    for i = 1 to len(n)
        sum += pow (n[i] % 10, i)
    next
    return sum = num

Output:

$ ring ./disarium.ring
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798

Disarium Numbers in Nim

import strutils
import math

proc is_disarium(num: int): bool =
  let n = intToStr(num)
  var sum = 0
  for i in 0..len(n)-1:
    sum += int((int(n[i])-48) ^ (i+1))
  return sum == num

var i = 0
var count = 0
while count < 19:
  if is_disarium(i):
    stdout.write i, " "
    count += 1
  i += 1
echo ""

Output:

0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798

Disarium Numbers in Go

package main

import (
    "fmt"
    "math"
    "strconv"
)

func is_disarium(num int) bool {
    n := num
    i := 0
    sum := 0
    l := len(strconv.Itoa(n))
    for n > 0 {
        sum += int(math.Pow(float64(n%10), float64(l-i)))
        n /= 10
        i++
    }
    return sum == num
}
func main() {
    i := 0
    count := 0
    for count < 19 {
        if is_disarium(i) {
            fmt.Printf("%d ", i)
            count++
        }
        i++
    }
    fmt.Println("")
}

Output:

0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798

Disarium Numbers in Tcl

I used to be a fan of Tcl some 25 to 30 years ago, not that I really loved Tcl itself, but because it came usually bundled with the Tk graphical toolkit, and I really loved Tk, which made fairly easy the design and implementation of graphical interfaces. But I wasn’t really impressed at the time by its shell-looking syntax and, often, I wasn’t quite sure whether I should add a $ sign before a variable name or not, or whether I should use [...], (...), or {...}. Now, more than a quarter of century later, I have forgotten most if not all the details about the syntax, and I find it quite difficult to use and somewhat awkward (but perhaps it is my own prejudice). Still, I’m posting this Tcl implementation as a kind of tribute to John Ousterhout, the blessed creator of Tcl-Tk.

proc is_disarium {num} {
    set n num
    set sum 0
    set i 1
    set ch 1
    foreach char [split $num {}] {
        scan $char %d ch
        set sum [ expr ($sum + $ch ** $i)]
        incr i
    }
    return [ expr $num == $sum ? 1 : 0]
}
set i 0
set count 0
while { $count < 19 } {
    if [ is_disarium $i ] {
        puts -nonewline  "${i} "
        incr count
    }
    incr i
}
puts ""

Output:

$ tclsh ./disarium.tcl
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798

Disarium Numbers in D

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

bool is_disarium(int num) {
    int n = num;
    int sum = 0;
    ulong len = to!string(num, 10).length;
    while (n > 0) {
        sum += pow(n % 10, len);
        n /= 10;
        len--;
    }
    return num == sum;
}
void main() {
    int i = 0;
    int count = 0;
    while (count < 19) {
        if (is_disarium(i)) {
            printf("%d ", i);
            count++;
        }
        i++;
    }
    writeln(" ");
}

Output:

0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798

Disarium Numbers in Dart

import "dart:math";
import "dart:io";
void main() {
    var count = 0;
    var i = 0;
    while (count < 19) {
        if (is_disarium(i)) {
            stdout.write("$i ");
            count++;
        }
        i++;
    }
}

bool is_disarium(numb) {
    var n = numb;
    var len = n.toString().length;
    var sum = 0;
    while (n > 0) {
        sum += (pow(n % 10, len)).toInt();
        n = (n / 10).toInt();
        len--;
    }
    return numb == sum;
}

Output:

0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798

Disarium Numbers in JavaScript

function is_disarium (num) {
    let n = num
    let len = n.toString().length
    let sum = 0
    while (n > 0) {
        sum += (n % 10) ** len
        n = parseInt(n / 10, 10)
        len--
    }
    return num == sum
}
let count = 0
let i = 1
while (count < 18) {
    if (is_disarium(i)) {
        process.stdout.write(i + " ")
        count++
    }
    i++
}

Output:

1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798

Task 2: Permutation Ranking

You are given a list of integers with no duplicates, e.g. [0, 1, 2].

Write two functions, permutation2rank() which will take the list and determine its rank (starting at 0) in the set of possible permutations arranged in lexicographic order, and rank2permutation() which will take the list and a rank number and produce just that permutation.

Please checkout this post for more informations and algorithm.

Given the list [0, 1, 2] the ordered permutations are:

0: [0, 1, 2]
1: [0, 2, 1]
2: [1, 0, 2]
3: [1, 2, 0]
4: [2, 0, 1]
5: [2, 1, 0]

and therefore:

permutation2rank([1, 0, 2]) = 2

rank2permutation([0, 1, 2], 1) = [0, 2, 1]

Given that dealing with integers, I do not understand why permutations should be arranged in lexicographic order. I would expect permutation [9, 11] to be before permutation [11, 9], but lexicographic order would arrange them the other way around: [11, 9], [9, 11]. Well, it doesn’t really matter and we will use in our tests only single digit integers to avoid bizarre results. I’ll even use a test with single letters to show that my implementation also works with letters.

The second thing is that since my implementation of permutation2rank creates an ordered array of permutations, we don’t really need the rank2permutation subroutine to find the permutation with rank n, since I only need to lookup the array. I’ll create the rank2permutation subroutine nonetheless, just to abide with the specification.

Permutation Ranking in Raku

In Raku, the permutations method will create permutations in the proper order provided the input permutation is itself in the right order. So we only need to sort the input permutation at the beginning.

my @permut_str;

sub permutation2rank(@in) {
    # if the input list is sorted, then permutations will be sorted
    # Forcing a lexicographic order (although not really needed here)
    my @sorted = sort { $^a leg $^b }, @in;
    my @permutations = @sorted.permutations;
    @permut_str = map {[join " ", $_]}, @permutations;
    my %ranks = map { $^b => $^a }, @permut_str.kv;
}
sub rank2permutations ($rank) {
    return @permut_str[$rank];
}

my @tests = (1, 0, 2), (6, 3, 4), <a c d b>;
for @tests -> @test {
    my %ranks = permutation2rank(@test);
    say @permut_str;
    my $test = join " ", @test;
    say "[$test] has rank %ranks{$test}";
    say "Rank %ranks{$test} is ", rank2permutations(%ranks{$test});
    say "Rank {%ranks{$test} - 1} is ", rank2permutations(%ranks{$test} - 1);
    say "";
}

Note that we are also printing the sorted permutations to enable easy verification of the results.

This program displays the following output:

$ raku ./permute_ranks.raku
[[0 1 2] [0 2 1] [1 0 2] [1 2 0] [2 0 1] [2 1 0]]
[1 0 2] has rank 2
Rank 2 is [1 0 2]
Rank 1 is [0 2 1]

[[3 4 6] [3 6 4] [4 3 6] [4 6 3] [6 3 4] [6 4 3]]
[6 3 4] has rank 4
Rank 4 is [6 3 4]
Rank 3 is [4 6 3]

[[a b c d] [a b d c] [a c b d] [a c d b] [a d b c] [a d c b] [b a c d] [b a d c] [b c a d] [b c d a] [b d a c] [b d c a] [c a b d] [c a d b] [c b a d] [c b d a] [c d a b] [c d b a] [d a b c] [d a c b] [d b a c] [d b c a] [d c a b] [d c b a]]
[a c d b] has rank 3
Rank 3 is [a c d b]
Rank 2 is [a c b d]

Permutation Ranking in Perl

Perl has no built-in function to create permutations, so we implement the recursive permute subroutine to do that. Note that we designed it in such a way as to create the permutations in the right order, provided the input permutation is itself in the proper order.

use strict;
use warnings;
use feature "say";
use Data::Dumper;

my @permutations;

sub permute {
    my ($done, $left) = @_;
    if (scalar @$left == 0) {
        push @permutations, $done;
        return;
    }
    my @left = @$left;
    permute([ @$done, $left[$_]], [@left[0..$_-1], @left[$_+1..$#left]]) for 0..$#left;
}

sub permutation2rank {
    # if the input list is sorted, then permutations will be sorted
    # This will be in lexicographic order, even for numbers
    my @sorted = sort @_;
    permute([], [@sorted]);
    my @permut_str = map {join " ", @$_} @permutations;
    my $count = 0;
    my %ranks = map { $_ => $count++ } @permut_str;
}

sub rank2permutations {
    return (map {join " ", @$_} @permutations)[$_[0]];
}

my @tests = ( [1, 0, 2], [6, 3, 4], [<a d c b>]);
for my $test (@tests) {
    @permutations = ();
    my %ranks = permutation2rank (@$test);
    my $test_str = join " ", @$test;
    say "Rank of [$test_str] is: $ranks{$test_str}";
    for my $i (2, 4, 5) {
        say "Rank $i is [", rank2permutations ($i), "]";
    }
    say " ";
}

This program displays the following output:

$ perl ./permute_ranks.pl
Rank of [1 0 2] is: 2
Rank 2 is [1 0 2]
Rank 4 is [2 0 1]
Rank 5 is [2 1 0]

Rank of [6 3 4] is: 4
Rank 2 is [4 3 6]
Rank 4 is [6 3 4]
Rank 5 is [6 4 3]

Rank of [a d c b] is: 5
Rank 2 is [a c b d]
Rank 4 is [a d b c]
Rank 5 is [a d c b]

Permutation Ranking in Julia

Note that Julia array subscripts start at 1, not 0. Therefore, the ranks are shifted by 1 compared to other languages and the output differs accordingly. It would be easy to fix that, but I preferred to keep the Julia semantic.

# Note: Julia array subscripts start at 1, not 0
using Combinatorics

function permute(in_list)
    return collect(permutations(sort(in_list), length(in_list)))
end

function permutation2rank(perms, input)
    for i in 1:length(perms)
        if perms[i] == input
            return i
        end
    end
end

function rank2permutation(perm_list, index)
    return perm_list[index]
end

perm_in = [3, 1, 2]
perms = permute(perm_in)
println("Permutations: ", perms)
println("Permutation ", perm_in, " -> rank ", permutation2rank(perms, perm_in))
for i in 1:length(perms)
    println("Rank: ", i, " -> permutation ", rank2permutation(perms, i))
end

Output:

$ julia ./permute_ranks.jl
Permutations: [[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]]
Permutation [3, 1, 2] -> rank 5
Rank: 1 -> permutation [1, 2, 3]
Rank: 2 -> permutation [1, 3, 2]
Rank: 3 -> permutation [2, 1, 3]
Rank: 4 -> permutation [2, 3, 1]
Rank: 5 -> permutation [3, 1, 2]
Rank: 6 -> permutation [3, 2, 1]

Permutation Ranking in Python

Comparing two arrays with the == operator doesn’t seem to work in Python. There may be a better way to compare arrays, but I decided to stringify the arrays and to compare the resulting strings.

def stringify(input):
  return " ".join(map(str, input))

def permute(input):
  temp = input.copy() # avoid modifying input perm with the sort
  temp.sort()
  return list(itertools.permutations(temp))

def permutation2rank(perms, input):
  perms_str = map(stringify, perms)
  input_str = stringify(input)
  for index, value in enumerate(perms_str):
    if value == input_str:
      return index 

def rank2permutation(permutation, rank):
  return permutation[rank]

perm = [3, 1, 2]
perms = permute(perm)
print("Permutations: ", str(perms))
rank = permutation2rank(perms, perm)
print("Permutation ", perm, " -> rank ", rank)
for i in range(0, len(perms)):
  print("Rank: ", i, " -> permutation ", rank2permutation(perms, i))

Output:

$ python3 ./permute_ranks.py
Permutations:  [(1, 2, 3), (1, 3, 2), (2, 1, 3), (2, 3, 1), (3, 1, 2), (3, 2, 1)]
Permutation  [3, 1, 2]  -> rank  4
Rank:  0  -> permutation  (1, 2, 3)
Rank:  1  -> permutation  (1, 3, 2)
Rank:  2  -> permutation  (2, 1, 3)
Rank:  3  -> permutation  (2, 3, 1)
Rank:  4  -> permutation  (3, 1, 2)
Rank:  5  -> permutation  (3, 2, 1)

Permutation Ranking in Ruby

def permute(in_list)
    return in_list.sort.permutation(in_list.length).to_a
end

def permutation2rank(perms, input)
    for i in 0..perms.length - 1
        if perms[i] == input
            return i
        end
    end
end

def rank2permutation(perms, index)
    return perms[index]
end

perm_in = [3, 1, 2]
perms = permute(perm_in)
puts("Permutations: #{perms} \n")
print("Permutation #{perm_in} -> rank  #{permutation2rank(perms, perm_in)} \n")
for i in 1..perms.length - 1
    print("Rank:  #{i} -> permutation  #{rank2permutation(perms, i)} \n")
end

Output:

Permutations: [[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]] 
Permutation [3, 1, 2] -> rank 4
Rank: 1 -> permutation [1, 3, 2]
Rank: 2 -> permutation [2, 1, 3]
Rank: 3 -> permutation [2, 3, 1]
Rank: 4 -> permutation [3, 1, 2]
Rank: 5 -> permutation [3, 2, 1]

Permutation Ranking in Javascript

JavaScript doesn’t seem to have a built-in permutation function. The permute function in the program below is derived from this Stack Overflow page. I liked it because of its functional style. When I used JavaScript around 2003-04 for Web page development, I did not like too much its somewhat clunky syntax. Taking a fresh look at it nowadays really changes my perception, it appears that the language has really improved in the meantime. I’ll try to look deeper into it as soon as I get some free time.

function permute(inputArray) {
    let inAry = [...inputArray].sort(); //copy and sort input
    return inAry.reduce(function permute(res, item, key, arr) {
        return res.concat(arr.length > 1 && arr.slice(0, key)
            .concat(arr.slice(key + 1))
            .reduce(permute, [])
            .map(function (perm) {
                 return [item].concat(perm);
            }) || item);
    }, []);
}

function permutation2rank(perms, in_perm) {
    let input = JSON.stringify(in_perm)
    for (var i = 0; i < perms.length; i++) {  
        // stringify permutations to enable comparison
        if (JSON.stringify(perms[i]) == input) {
            return i
        }
    }
}

function rank2permutation(perm_list, index) {
    return perm_list[index]
}

let perm_in = [3, 1, 2];
let perms = permute(perm_in)
console.log(perms)
let rank = permutation2rank(perms, perm_in)
console.log("Permutation", perm_in, "has rank", rank)
for (var i = 0; i < perms.length; i++) {
    console.log("Rank: ", i, " -> permutation ", rank2permutation(perms, i))
}

Output:

node /tmp/CUuyiMw4x0.js
[ [ 1, 2, 3 ],
[ 1, 3, 2 ],
[ 2, 1, 3 ],
[ 2, 3, 1 ],
[ 3, 1, 2 ],
[ 3, 2, 1 ] ]
Permutation [ 3, 1, 2 ] has rank 4
Rank:  0  -> permutation  [ 1, 2, 3 ]
Rank:  1  -> permutation  [ 1, 3, 2 ]
Rank:  2  -> permutation  [ 2, 1, 3 ]
Rank:  3  -> permutation  [ 2, 3, 1 ]
Rank:  4  -> permutation  [ 3, 1, 2 ]
Rank:  5  -> permutation  [ 3, 2, 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 July 31, 2022. And, please, also spread the word about the Perl Weekly Challenge if you can.

This blog is an answer to the second task of the Week 173 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Originally, the Perl Weekly Challenge called for solutions in Perl and Raku (also known as Perl 6 at the time). But, very soon, people started to provide solutions in other “guest” languages. See for example my blog post providing solutions to the Sylvester’s Sequence task described below in about 15 different guest languages.

One of the languages I tried is dc, and it turned out to be much more difficult and challenging than I initially thought. I actually spent far more time on it than I would wish to admit, at least 5 to 6 hours (not counting the time to write this blog post). One of the problems is that there is only very limited documentation on this old programming language. So I thought it might be useful to describe in some details how I solved it.

The Task

Write a script to generate first 10 members of Sylvester’s sequence. For more informations, please refer to the wikipedia page.

Output:

2
3
7
43
1807
3263443
10650056950807
113423713055421844361000443
12864938683278671740537145998360961546653259485195807
165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

Each number in the sequence is the product of all previous numbers of the sequence plus 1.

A potential difficulty with this problem is that we’re dealing with very large integers, so that, for some programming languages at least, we may encounter an integer overflow error (or values may be converted to floats, with a resulting loss of precision).

Sylvester’s Sequence in Some Other Languages

The dc language is difficult and poorly documented. Before we get to it, I want to illustrate the algorithm I’ll implement with some other more traditional languages.

Sylvester’s Sequence in Raku

Raku’s integers support arbitrary precision, so we don’t have to worry about dealing with very large integers.

Our first implementation reflects directly the definition: we store the Sylvester’s sequence in the @s array. To get a new number, we simply compute the product of all items of the @s array (using the [*] meta-operator) and add it to the array.

my @s = 2;
while @s.elems < 10 {
    push @s, 1 + [*] @s;
}
.say for @s;

This program displays the following output:

$ raku ./sylvester.raku
2
3
7
43
1807
3263443
10650056950807
113423713055421844361000443
12864938683278671740537145998360961546653259485195807
165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

But recomputing the full product each time is inefficient. At any time through the process, the current Sylvester number is one more than the product of all previous numbers of the sequence. For example, in the output displayed above, we can compute the number of the 4th row (43) by multiplying the number of the third row (7) by it minus 1 (7 - 1) and adding 1 to the product: 7 * (7 - 1) + 1 = 43. Using this recursive definition, we can write this:

my $n = 2;
say $n;
$n = $n * ($n - 1) + 1 and say $n for 1..^10;

This produces the same output:

$ ./raku sylvester3.raku
2
3
7
43
1807
3263443
[ Lines omitted for brevity ]

This second implementation reflects the algorithm that we will use from now on, as it has the advantage of not using arrays to store the sequence numbers.

Sylvester’s Sequence in Perl

Perl doesn’t natively support large integer, but we can use the use BigInt; pragma to convert all numeric literals to Math::BigInt objects, which can store arbitrarily large integers. This Perl program is essentially identical to the second Raku implementation above:

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

my $n = 2;
say $n;
$n = $n * ($n - 1) + 1 and say $n for 1..9;

This displays the same output as before:

 $ perl sylvester3.pl
 2
 3
 7
 43
 1807
 [ Lines omitted for brevity]
 165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

Sylvester’s Sequence in bc

The bc) utility, for basic calculator, is “an arbitrary-precision calculator language” with syntax similar to the C programming language. It first appeared in Version 6 Unix in 1975. It is still included nowadays in most (if not all) Linux distributions. We chose to use it because of its arbitrary precision feature.

n = 2
print n, "\n"
count = 1
while (count < 10) {
    n = (n - 1) * n + 1
    print n, "\n"
    count += 1
}
quit

This displays the same output as before:

$ BC_LINE_LENGTH=0 bc sylvester.bc
bc 1.06.95
Copyright 1991-1994, 1997, 1998, 2000, 2004, 2006 Free Software Foundation, Inc.
This is free software with ABSOLUTELY NO WARRANTY.
For details type `warranty'.
2
3
7
43
1807
[ Lines omitted fr brevity ]
165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

Note that we set the BC_LINE_LENGTH environment variable to 0 before calling bc to prevent bc from cutting the last line into two chunks after 70 characters. Otherwise, it would be displayed as:

16550664732451996419846819544443918001751315270637749784185138876653\
5868639572406808911988131737645185443

We will see that we’ll need to do something similar with dc.

bc was initially written as a font-end to dc. As we will see, dc performs arbitrary-precision computations specified in reverse Polish notation. At the time, bc provided a conventional programming-language interface to the same capability via a simple compiler (a single yacc source file comprising a few hundred lines of code), which converted a C-like syntax into dc notation and piped the results through dc. This is in part the reason I got interested with dc.

Introducing dc

According to Wikipedia), dc (desk calculator) is a cross-platform reverse-Polish calculator which supports arbitrary-precision arithmetic. Written by Lorinda Cherry and Robert Morris at Bell Labs, it is one of the oldest Unix utilities, preceding even the invention of the C programming language. Like other utilities of that vintage, it has a powerful set of features but terse syntax. Traditionally, the bc calculator program (with infix notation) was implemented on top of dc.

dc is the oldest surviving Unix language program. When its home Bell Labs received a PDP-11, dc—written in B—was the first language to run on the new computer, even before an assembler.

It uses reverse Polish notation (RPN) which was also used around the same time by Hewlett-Packard hand calculators. RPN is a postfix notation in which you first specify the operands and then the operator.

$ echo '5 6 + p' | dc
11

As you can see, we first input the two operands (5 and 6), and then the + operator, and finally the p operator to print out the result of the addition. Prefix your number with an underscore if you want to specify a negative number (e.g. _5 for -5)

The spaces are not needed (except between 5 and 6) but improve readability. We could have written it this way:

$ echo '5 6+p' | dc
11

dc can also be used in interactive mode:

$ dc
5 6
+
p
11
q

or:

$ dc
5 6 + p q
11

This can be quite convenient to test chunks of code and we will use that feature.

We can also use the -e command-line option to specify a simple program between single quotes:

$ dc -e '5 6 + p'
11

dc uses a stack to perform its operations. The various commands above can be understood as follows:

$ dc
5   # push 5 to stack
6   # push 6 to stack
f   # display stack (displays 6 and 5). Useful for debugging
6
5
+   # pop two items from stack, add them and push result to stack
p   # print top item of the stack (prints 11)
11
q   # quit

Note that the # sign indicates the beginning of a comment (the rest of the line is ignored).

For full details on the dc syntax, please consult the dc GNU manual. We will describe here only the command that we are likely to use for our program. The best tutorial I have found on dc is the Wikipedia dc page).

Printing Commands

p   Prints the value on the top of the stack, not altering the stack. 
n   Prints the value on the top of the stack, popping it off
f   Prints the entire contents of the stack without altering anything.

Stack Control

c   Clears the stack, rendering it empty
d   duplicate the value on top of the stack
r   Reverses the order of (swaps) the top two values on the stack.

Registers

dc provides at least 256 memory registers, each named by a single character. You can store a number in a register and retrieve it later.

sr  Pops the value off the top of the stack, stores it in register r. 
lr  Copies the value in register r, and pushes it onto the stack.
    This does not alter the contents of r.

Each register also contains its own stack. The current register value is the top of the register’s stack.

Strings

dc can operate on strings as well as on numbers. The only things you can do with strings are print them and execute them as macros (which means that the contents of the string are processed as dc commands). Both registers and the stack can hold strings, and dc always knows whether any given object is a string or a number.

[ch] Makes a string containing "ch" and pushes it on the stack.
x   Pops the value from the top of the stack and executes it as a macro
>r  Pops two values off the stack and compares them assuming they are 
    numbers, executing the contents of register r as a macro if the 
    original top-of-stack is greater
<r  Similar but invokes the macro if the original top-of-stack is less
=r  Similar but invokes the macro if the original top-of-stack is equal

Macros

Macros are then implemented by allowing registers and stack entries to be strings as well as numbers. A string can be printed, but it can also be executed (i.e. processed as a sequence of dc commands). So for instance we can store a macro to add 3 and then multiply by 2 into register m:

[3 + 2 *] sm

and then (using the x command which executes the top of the stack) we can use it like this:

3 lm x p

This displays the following:

$ dc -e '[3 + 2 *] sm 3 lm x p'
12

For better understanding, this is a detailed account of what’s going on:

[   # start of macro definition
  3 # push 3 to stack
  + # pop 2 values off the stack, add them and store result on stack
  2 # push 2 on stack
  * # pop 2 values off the stack, multiply them, store result on stack
]   # end of macro definition
sm  # store the macro just defined in register m
3   # push 3 on stack
lm  # copy value in register m (the macro) onto the stack
x   # run the macro
p   # print the result (top of the stack)

We will look at conditionals and loops later on.

Sylvester’s Sequence in dc

Let’s now try to implement Sylvester’s sequence in dc.

Implementing the Basic Formula

Remember that we want to do something equivalent to this Raku program:

my $n = 2;
say $n;
$n = $n * ($n - 1) + 1 and say $n for 1..^10;

We will do it mostly in interactive mode.

First, we want to give an initial value of 2 to n and print it.

$ dc
2snlnp
2

This is a detailed description of the cryptic 2snlnp command:

2    # push 2 on stack
sn   # pops 2 from stack and store in register n
ln   # copy register n onto stack
p    # print top of stack

We could make it one character shorter by using the d duplicate command:

$ dc -e '2dsnp'
2

Then, we want to implement and test the $n = $n * ($n - 1) + 1 formula:

2snlnp
2
1-   # subtract 1 from stack
ln   # load n on stack
*1+p # compute product, add 1 and print new value
3    
sn   # pop new value and store it in register n
ln   # copy new value in n to stack

So, n was 2 and is now set to 3. This is the expected result, so it looks promising. Let’s run again that series of commands a couple of times:

$ dc
2snlnp
2
1-   # subtract 1 from stack
ln   # load n on stack
*1+p # compute product, add 1 and print new value
3
sn   # pop new value and store it in register n
ln   # copy new value in n to stack
1-   # subtract 1 from stack
ln   # load n on stack
*1+p # compute product, add 1 and print new value
7
sn   # pop new value and store it in register n
ln   # copy new value in n to stack
1-   # subtract 1 from stack
ln   # load n on stack
*1+p # compute product, add 1 and print new value
43
sn   # pop new value and store it in register n
ln   # copy new value in n to stack
1-   # subtract 1 from stack
ln   # load n on stack
*1+p # compute product, add 1 and print new value
1807

We obtain the proper sequence of Sylvester numbers: 2, 3, 7, 43, 1807. But, of course, it is a pain in the neck to repeatedly enter this series of 5 commands. We can store it in a macro (I used register m, m as the first letter in macro, because it makes it easier to remember, but you could store a macro in any other register) and then execute the macro any number of times:

$ dc
2snlnp                 # initialization of n to 2
2
[1- ln *1+p sn ln]sm   # store the macro in register m
lm x                   # run the macro
3
lm x
7
lm x
43
lm x
1807
lm x
3263443
lm x
10650056950807
...

So, the results are correct, we have the basic actions to compute the Sylvester’s sequence. We still have to implement a loop to automatize macro execution a given number of times.

Conditionals and Loops in dc

The =, >, !>, <, !<, != conditionals execute the subsequent macro when the two top values of the stack are equal, larger than, not larger than, etc. For example, in:

$ dc -e '[[smaller than]p] sm 6 5 <m'
smaller than

the macro stored in m runs (and prints “smaller than”) because 5 is smaller than 6. The < pops 5 and then 6 from the stack and runs the macro in register m because the first popped value (5) is smaller than the second popped value.

The above-mentioned Wikipedia page then states: “Looping is then possible by defining a macro which (conditionally) reinvokes itself. A simple factorial of the top of the stack might be implemented as:

[d1-d1<F*]dsFxp

I must admit that I did not understand it when I first read it. And still not when I read it a second time and then a third time.

Let’s get away from the Sylvester sequence for a brief moment and look at a simple countdown in this page in the Bash Hackers Wiki:

dc << EOF
[ li       # put our index i on the stack 
  p        # print it, to see what's going on
  1 -      # we decrement the index by one
  si       # store decremented index (i=i-1)
 0 li >L   # if i > 0 then execute L
] sL       # store our macro with the name L
10 si      # let's give to our index the value 10
lLx        # and start our loop
EOF 

10
9
8
[ lines omitted for brevity]
2
1

OK, now I understand it (and I suppose you will if you read the detailed comments) and can complete the task. Basically, the macro is called a first time, and then calls itself recursively so long as the condition is satisfied.

The Complete Sylvester Program in dc

This is now the full Sylvester’s sequence program in dc:

2sn     # push 2 on the stack, pop 2 off the top of the stack
        # and store it into register n
lnp     # copy the value back on the stack and print it
9sc     # give counter c an initial value of 9
[       # start of macro
  1-    # subtract 1 from stack (value n-1)
  ln    # load n to stack
  *1+p  # compute product n * n-1, add 1 and print
  sn    # pop new value and store it in register n
  ln    # copy new value in  n to stack
  lc    # copy counter to stack
  1-    # decrement counter (subtract 1 from c)
  sc    # store decremented counter in c
  0 lc  # store 0 and counter on stack
  >m    # compare c to 0 and, if c > 0, run recursively macro in m
]       # end of macro
d       # duplicate macro on stack
sm      # store macro in register m
x       # execute first iteration of macro

To run it and display properly the last line, we need to set the DC_LINE_LENGTH to 0 in a way similar to what we had to do with bc.

$  DC_LINE_LENGTH=0 dc sylvester.dc
2
3
7
43
1807
3263443
10650056950807
113423713055421844361000443
12864938683278671740537145998360961546653259485195807
165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

But, of course, formatting the program with spaces and comments as above is way too easy and good only for wimps and cowards. Real programmers will prefer this one-line version ( ;-)):

2snlnp9sc[1-ln*1+psnlnlc1-sc0lc>m]dsmx

which you can run as follows:

$ echo '2snlnp9sc[1-ln*1+psnlnlc1-sc0lc>m]dsmx
       ' |  DC_LINE_LENGTH=0 dc
2
3
7
43
1807
3263443
10650056950807
113423713055421844361000443
12864938683278671740537145998360961546653259485195807
165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

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

These are some answers to the Week 173 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 17, 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: Esthetic Number

You are given a positive integer, $n.

Write a script to find out if the given number is Esthetic Number.

An esthetic number is a positive integer where every adjacent digit differs from its neighbour by 1.

For example,

5456 is an esthetic number as |5 - 4| = |4 - 5| = |5 - 6| = 1
120 is not an esthetic numner as |1 - 2| != |2 - 0| != 1

Esthetic Number in Raku

We write an is-esthetic subroutine which splits the input number into an array of digits and checks, for each digit, whether the absolute value of its difference with the previous one is equal to 1. The subroutine returns False is this value is not 1. If it loops through the end, it returns True.

sub is-esthetic ($n) {
    my @d = $n.comb;     # get an array of digits
    return False if abs(@d[$_] - @d[$_-1]) != 1 for 1..@d.end;
    return True;
}
for <5456 120 121 23456 2346 7654567 765467> -> $test {
    say $test.fmt("%-9d"), is-esthetic($test) ?? "is esthetic" !! "is not esthetic";
}

This program displays the following output:

$ raku ./esthetic_nums.raku
5456     is esthetic
120      is not esthetic
121      is esthetic
23456    is esthetic
2346     is not esthetic
7654567  is esthetic
765467   is not esthetic

Esthetic Number in Perl

This is a port to Perl of the previous Raku program, with an is_esthetic subroutine returning 0 (false value) if the absolute value of the difference between two adjacent digits is not equal to 1.

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

sub is_esthetic {
    my @d = split //, shift;     # get an array of digits
    for my $i (1..$#d) {
        return 0 if abs($d[$i] - $d[$i -1 ]) != 1;
    }
    return 1;
}
for my $test (qw<5456 120 121 23456 2346 7654567 765467>) {
    say sprintf("%-9d", $test), is_esthetic($test) ? "is esthetic" : "is not esthetic";
}

This program displays the following output:

$ perl ./esthetic_nums.pl
5456     is esthetic
120      is not esthetic
121      is esthetic
23456    is esthetic
2346     is not esthetic
7654567  is esthetic
765467   is not esthetic

Esthetic Number in Julia

In Julia, you can use subscripts to access individual characters of a string:

julia> print("hello World"[5])    # Scala subscripts start at 1
o

You cannot do that in Perl and in Raku. Well, in Raku, you could implement your own postcircumfix [...] operator like this:

multi sub postcircumfix:<[ ]> (Str $s, Int $n) {
    substr-rw $s, $n, 1;
}

but it doesn’t seem to be worth the trouble for such a simple program.

Anyway since subscript can be used for that purpose in Scala, I decided that my program could easily traverse the string representation of the candidate number, without having to split it into an array of individual digits. All we need to do is to coerce the input number into a string.

function is_esthetic(num)
    n = string(num)
    for i in 2:length(n)
        if abs(n[i] - n[i-1]) != 1
            return false
        end
    end
    return true
end

for test in [5456, 120, 121, 23456, 2346, 7654567, 765467]
    println("$test\t", is_esthetic(test) ? "Esthetic" : "Non esthetic")
end

It may not be obvious, but there is quite a bit of magic going on in this line:

if abs(n[i] - n[i-1]) != 1

n[i] and n[i+1] don’t contain digits, but characters representing digits (ASCII representation). For example, if we are processing a '1' character, we are processing ASCII char 49. So, perhaps, we should convert them to integers:

if abs(Int(n[i]) - Int(n[i-1])) != 1

Well, still not quite good. If the number being tested if 12, the line above would compare integers 49 (char ’1’) and 50 (char ’2’), not numbers 1 and 2. To really compare 1 and 2, we would have to subtract Int['0'] (48) from each term:

if abs((Int(n[i]) - Int('0')) - (Int(n[i-1] - Int('0'))) != 1

Of course, subtracting Int('0') (48) from both terms of a subtraction is useless, as the result will be unchanged. But, more broadly, we don’t need to go through the trouble of casting the chars to ints, because Julia can easily compute the numerical difference between two characters. It even works with non-numerical characters such as letters:

julia> print('e' - 'c')
2

Output:

$ julia ./esthetic_nums.jl
5456    Esthetic
120     Non esthetic
121     Esthetic
23456   Esthetic
2346    Non esthetic
7654567 Esthetic
765467  Non esthetic

Esthetic Number in Python

In Python, you can also use subscripts to access individual characters of a string, so I chose to also traverse the string representation of the input integer. But it turned out to be a bit more complicated than in Julia. In Python, we need to cast the individual characters into integers to make the subtraction possible.

def is_esthetic(m):
  n = str(m)
  for i in range(1, len(n)):
    if abs(int(n[i]) - int(n[i - 1 ])) != 1:
      return False
  return True

for test in [5456, 120, 121, 23456, 2346, 7654567, 765467]:
  if is_esthetic(test):
    print("{:<9d} is esthetic".format(test))
  else:
    print("{:<9d} is not esthetic".format(test))

Output:

$ python3 ./esthetic_nums.py
5456      is esthetic
120       is not esthetic
121       is esthetic
23456     is esthetic
2346      is not esthetic
7654567   is esthetic
765467    is not esthetic

Esthetic Number in Ruby

Like in Python, we need to cast characters to integers to make the subtraction possible in Ruby:

def is_esthetic(m)
    n = m.to_s
    for i in 1..(n.length - 1)
        if (n[i].to_i - n[i-1].to_i).abs != 1
            return false
        end
    end
    return true
end

for test in [ 5456, 120, 121, 23456, 2346, 7654567, 765467]
    printf "%-9d ", test 
    if is_esthetic(test)
        print("is esthetic\n")
    else
        print("is not esthetic\n")
    end
end

Output:

5456      is esthetic
120       is not esthetic
121       is esthetic
23456     is esthetic
2346      is not esthetic
7654567   is esthetic
765467    is not esthetic

Esthetic Number in Ring

Like in Julia, there is no need to cast characters to integers in Ring:

for test in [5456, 120, 121, 23456, 2346, 7654567, 765467]
    see test
    if is_esthetic(test)
        see " is esthetic" + nl
    else
        see " is not esthetic" + nl
    ok
next

func is_esthetic (num)
    n = "" + num
    for i = 2 to len(n)
        if fabs(n[i] - n[i-1]) != 1
            return false
        ok
    next
    return true

Output:

$ ring ./esthetic_nums.ring
5456 is esthetic
120 is not esthetic
121 is esthetic
23456 is esthetic
2346 is not esthetic
7654567 is esthetic
765467 is not esthetic

Esthetic Number in Kotlin

Note that the subtraction n[i] - n[i-1] in the is_esthetic function works fine here because a subtraction on two Char values in Kotlin returns an Int value, so that the comments made on the Julia implementation essentially also apply to Kotlin.

import kotlin.math.abs

fun is_esthetic(num: Int): Boolean {
    val n = num.toString()
    for (i in 1..n.length - 1) {
        if (abs(n[i] - n[i-1]) != 1) {
            return false
        }
    }
    return true
}
fun main() {
    for (test in arrayOf(5456, 120, 121, 23456, 2346, 7654567, 765467)) {
        if (is_esthetic(test)) {
            println("$test is esthetic")
        } else {
            println("$test is not esthetic")
        }
    }
}

Output:

5456 is esthetic
120 is not esthetic
121 is esthetic
23456 is esthetic
2346 is not esthetic
7654567 is esthetic
765467 is not esthetic

Esthetic Number in Go

package main

import (
    "fmt"
    "strconv"
)

func is_esthetic(n int) bool {
    s := strconv.Itoa(n)
    for i := 1; i < len(s); i++ {
        if s[i]-s[i-1] != 1 && s[i-1]-s[i] != 1 {
            return false
        }
    }
    return true
}
func main() {
    tests := []int{5456, 120, 121, 23456, 2346, 7654567, 765467}
    for _, test := range tests {
        if is_esthetic(test) {
            fmt.Printf("%-9d is esthetic\n", test)
        } else {
            fmt.Printf("%-9d is not esthetic\n", test)
        }
    }
}

Output:

5456      is esthetic
120       is not esthetic
121       is esthetic
23456     is esthetic
2346      is not esthetic
7654567   is esthetic
765467    is not esthetic

Esthetic Number in D

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

bool is_esthetic(int num) {
    auto s = to!string(num, 10);
    foreach (i; 1 .. s.length) {
        if (abs(s[i] - s[i-1]) != 1) return false;
    }
    return true;
}
void main() {
    int[] tests = [ 5456, 120, 121, 23456, 2346, 7654567, 765467 ];
    foreach(test; tests) {
        printf("%-9d ", test);
        if (is_esthetic(test)) {
            writeln("is esthetic");
        } else {
            writeln("is not esthetic");
        }
    }
}

Output:

5456      is esthetic
120       is not esthetic
121       is esthetic
23456     is esthetic
2346      is not esthetic
7654567   is esthetic
765467    is not esthetic

Esthetic Number in Nim

import strutils
import std/strformat

proc is_esthetic(num: int): bool =
  let n = intToStr(num)
  for i in 1..len(n)-1:
    if abs(int(n[i]) - int(n[i-1])) != 1:
      return false
  return true

for test in [5456, 120, 121, 23456, 2346, 7654567, 765467]:
  if is_esthetic(test):
    echo fmt("{test:<9}"), " is esthetic"
  else:
    echo fmt("{test:<9}"), " is not esthetic"

Output:

5456      is esthetic
120       is not esthetic
121       is esthetic
23456     is esthetic
2346      is not esthetic
7654567   is esthetic
765467    is not esthetic

Esthetic Number in Rust

Sometimes, a strict typing system can be a straight jacket. Rust’s typing system seems to be such. I was’t able to find a way to subtract characters and take the absolute value of the result. So I had to use two separate conditions: if n[i] != n[i-1] + 1 && n[i-1] != n[i] + 1 ...

fn is_esthetic(num: i32) -> bool {
    let n = num.to_string();
    for i in 1..n.len() {
        if n.as_bytes()[i] != n.as_bytes()[i-1] + 1 &&
           n.as_bytes()[i-1] != n.as_bytes()[i] + 1 {
            return false
        }
    }
    return true
}

fn main() {
    for test in [5456, 120, 121, 23456, 2346, 7654567, 765467] {
        println!("{} -> {}", test, if is_esthetic (test) { " is esthetic"} else { " is not esthetic"});
    }
}

Output:

5456 ->  is esthetic
120 ->  is not esthetic
121 ->  is esthetic
23456 ->  is esthetic
2346 ->  is not esthetic
7654567 ->  is esthetic
765467 ->  is not esthetic

Esthetic Number in Scala

object esthetic extends App {
  def is_esthetic(num: Int): Boolean = {
    val digits = num.toString.split("")
    for (i <- 1 to (digits.size) - 1) {
      if ((digits(i).toInt - digits(i-1).toInt).abs != 1) {
        return false
      }
    }
    return true
  }
  val tests = List(5456, 120, 121, 23456, 2346, 7654567, 765467)
  for (test <- tests) {
    if (is_esthetic(test)) {
      println(s"$test is esthetic")
    } else {
      println(s"$test is not esthetic")
    }
  }
}

Output:

5456 is esthetic
120 is not esthetic
121 is esthetic
23456 is esthetic
2346 is not esthetic
7654567 is esthetic
765467 is not esthetic

Esthetic Number in Java

I’m not a great fan of Java, because I find it too verbose. But it is good, some times, to take a fresh look at things.

import java.lang.Math;

public class EstheticNumber {
    public static void main(String[] args) {
        Integer[] tests = {5456, 120, 121, 23456, 2346, 7654567, 765467};  
        for (int i = 0; i <= 6; i++) {
            if (is_esthetic(tests[i])) {
                System.out.printf("%-9d is esthetic\n", tests[i]);
            } else {
                System.out.printf("%-9d is not esthetic\n", tests[i]);
            }
        }
    }
    public static boolean is_esthetic(int n) {
        String s = Integer.toString(n);
        for (int i = 1; i < s.length(); i++ ) {
            if (Math.abs((int)(s.charAt(i)) - (int)(s.charAt(i-1))) != 1) {
                return false;
            }
        }
        return true;
    }
}

Output:

5456      is esthetic
120       is not esthetic
121       is esthetic
23456     is esthetic
2346      is not esthetic
7654567   is esthetic
765467    is not esthetic

Task 2: Sylvester’s Sequence

Write a script to generate first 10 members of Sylvester’s sequence. For more informations, please refer to the wikipedia page.

Output:

2
3
7
43
1807
3263443
10650056950807
113423713055421844361000443
12864938683278671740537145998360961546653259485195807
165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

Each number in the sequence is the product of all previous numbers of the sequence plus 1.

The only potential difficulty with this problem is that we’re dealing with very large integers so that, for some programming languages at least, we may encounter an integer overflow error (or values may be converted to floats, with a resulting loss of precision).

Sylvester’s Sequence in Raku

In Raku, Int objects store integral numbers of arbitrary size. So we don’t have to worry about very large integers.

We start with a direct implementation of the definition. We store the sequence in the @s array. To get a new number, we simply compute the product of all items of the @s array (using the [*] meta-operator) and add it to the array.

my @s = 2;
while @s.elems < 10 {
    push @s, 1 + [*] @s;
}
.say for @s;

This program displays the following output:

$ raku ./sylvester.raku
2
3
7
43
1807
3263443
10650056950807
113423713055421844361000443
12864938683278671740537145998360961546653259485195807
165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

The program runs very fast, but is not as efficient as it could be because we are performing some of the multiplications many times. When computing @s[$n+1], we know that @s[$n] contains the product of all values between @s[0] and @s[$n-1] plus 1. Therefore, the n + 1 item of the sequence can be defined recursively as @s[$n] * (@s[$n] - 1) + 1, so that we can perform only one multiplication each time. This can lead to the following modified implementation:

my @n = 2;
push @n, @n[*-1] * (@n[*-1] - 1) + 1 for 1..^10;
.say for @n;

This program displays the same output as above:

$ raku ./sylvester2.raku
2
3
7
43
1807
(lines omitted for brevity)

Sylvester’s Sequence in Perl

In Perl, scalars cannot contain such large integers. But we can use the use BigInt; pragma to convert all numeric literals to Math::BigInt, which can store arbitrarily large integers.

To port the first raku program above to Perl, we implement a prod subroutine that computes the product of all items of its input.

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

sub prod {
    my $prod = 1;
    $prod *= $_ for @_;
    return $prod;
}

my @s = (2);
while (@s < 10) {
    push @s, 1 + prod @s;
}
say for @s;

This program displays the following output:

$ perl ./sylvester.pl
2
3
7
43
1807
3263443
10650056950807
113423713055421844361000443
12864938683278671740537145998360961546653259485195807
165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

We can avoid the prod subroutine if we use the method of the second Raku program above:

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

my @s = (2);
push @s, $s[-1] * ($s[-1] - 1) + 1 for 1..9;
say for @s;

This program displays the same output:

$ perl ./sylvester2.pl
2
3
7
43
1807
(lines omitted for brevity)

Sylvester’s Sequence in bc

The Unix bc utility is an arbitrary precision calculator language, so it is tempting to use it for a problem in which the only potential difficulty is the use of very large integers. However, bc’s arrays lack many of the cool features of more modern languages. We will implement the second method above without using any array (printing the values as we compute them).

n = 2
print n, "\n"
count = 1
while (count < 10) {
    n = (n - 1) * n + 1
    print n, "\n"
    count += 1
}
quit

This script displays the following output:

$ bc ./sylvester.bc
bc 1.06.95
Copyright 1991-1994, 1997, 1998, 2000, 2004, 2006 Free Software Foundation, Inc.
This is free software with ABSOLUTELY NO WARRANTY.
For details type `warranty'.
2
3
7
43
1807
3263443
10650056950807
113423713055421844361000443
12864938683278671740537145998360961546653259485195807
16550664732451996419846819544443918001751315270637749784185138876653\
5868639572406808911988131737645185443

One last little problem here is that bc cannot print numbers larger than 70 digits on the same line, so that the last Sylvester number above is cut over two lines. We can pipe the bc output through a Perl one-line filter (or some other utility) to reformat properly the faulty line:

$ bc sylvester.bc | perl -pe 's/\\\s//'
2
3
7
43
1807
3263443
10650056950807
113423713055421844361000443
12864938683278671740537145998360961546653259485195807
165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

Another way is to set the BC_LINE_LENGTH environment variable to 0:

$ BC_LINE_LENGTH=0 bc sylvester.bc
bc 1.06.95
Copyright 1991-1994, 1997, 1998, 2000, 2004, 2006 Free Software Foundation, Inc.
This is free software with ABSOLUTELY NO WARRANTY.
For details type `warranty'.
2
3
7
43
1807
3263443
10650056950807
113423713055421844361000443
12864938683278671740537145998360961546653259485195807
165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

Sylvester’s Sequence in dc

The Unix dc utility is also an arbitrary precision calculator language, so it is tempting to use it for a problem in which the only potential difficulty is the use of very large integers. In fact, bc used to be a standard infix front-end to the dc reverse Polish notation.

This is a dc program to display the first 10 elements of the Sylvester’s sequence:

2snlnp9sc[1-ln*1+psnlnlc1-sc0lc>m]dsmx

You can run it as follows:

$ echo '2snlnp9sc[1-ln*1+psnlnlc1-sc0lc>m]dsmx
       ' |  DC_LINE_LENGTH=0 dc
2
3
7
43
1807
3263443
10650056950807
113423713055421844361000443
12864938683278671740537145998360961546653259485195807
165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

OK, I must admit that I golfed it. I usually try to use concise syntax, but don’t commonly golf my solutions. Here, I think that I probably deserve an award for the shortest and most obfuscated golf piece for that problem.

This is now a much more readable version of the same solution:

2sn     # push 2 on the stack, pop 2 off the top of the stack and store it into register n
lnp     # copy the value back on the stack and print it
9sc     # give counter c an initial value of 9
[       # start of macro
  1-    # subtract 1 from stack (value n-1)
  ln    # load n to stack
  *1+p  # compute product n * n-1, add 1 and print
  sn    # pop new value and store it in register n
  ln    # copy new value in  n to stack
  lc    # copy counter to stack
  1-    # decrement counter (subtract 1 from c)
  sc    # store decremented counter in c
  0 lc  # store 0 and counter on stack
  >m    # compare counter to 0 and, if c > 0, run recursively macro in m
]       # end of macro
d       # duplicate macro
sm      # store macro in register m
x       # execute first iteration of macro

Understanding the solution in details would require a lot more explanations than what I can provide here. You are kindly invited to read this other blog post where I describe in detail how I solved the problem in dc.

Sylvester’s Sequence in Julia

With regular integers, we obtain totally wrong results, including negative integers and so forth. All we need to do to fix that problem is to declare our initial variable as a BigInt:

s = BigInt(2)
println(s)
for i in 1:9
    s = s * (s - 1) + 1
    println(s)
end

Output:

$ julia ./sylvester.jl
2
3
7
43
1807
3263443
10650056950807
113423713055421844361000443
12864938683278671740537145998360961546653259485195807
165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

Sylvester’s Sequence in Python

Recent versions of Python automatically switch to big integers when needed:

s = [2];
for i in range(9):
  s.append(s[-1] * (s[-1] - 1) + 1)
for j in s:
  print(j)

Output:

$ python3 sylvester.py
2
3
7
43
1807
3263443
10650056950807
113423713055421844361000443
12864938683278671740537145998360961546653259485195807
165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

Sylvester’s Sequence in Ruby

# Ruby automatically switches to Bignum when needed
s = 2
print("#{s}\n")
for i in 1..9
    s = s * (s - 1) + 1
    print("#{s}\n")
end

Output:

2
3
7
43
1807
3263443
10650056950807
113423713055421844361000443
12864938683278671740537145998360961546653259485195807
165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

Sylvester’s Sequence in Ring

As far as I can tell, Ring doesn’t have a BigNum package. But Ring gracefully switches to floating point arithmetics and thus produces fairly decent approximations of the expected result.

s = 2;
see s + nl
for i = 1 to 9
    s = s * (s - 1) + 1
    see s + nl
next

Output:

$ ring ./sylvester.ring
2
3
7
43
1807
3263443
10650056950807
113423713055421845118910464.00
12864938683278672079501004830742670366487445279604736.00
1.655066473245199625930595525909356695752320791312711997146979916612453687017861571473280717e+104

The three last Sylvester numbers above are computed with floating point arithmetics. As you can see if you compare with the results obtained with other languages above, only the first 16th to 17th digits are accurate.

Sylvester Sequence in Scala

Like in Julia, we only need to declare our initial variable as a BigInt to get the correct results in Scala:

object sylvester extends App {
  var n = BigInt(2)
  println(n)
  for (i <- 1 to 9) {
    n = n * (n - 1) + 1
    println(n)
  }
}

Output:

2
3
7
43
1807
3263443
10650056950807
113423713055421844361000443
12864938683278671740537145998360961546653259485195807
165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

Sylvester’s Sequence in Kotlin

In Kotlin, we import the java java.math.BigInteger library. Note that it doesn’t know how to mix BigInteger numbers with standard integers in computations, so we need to create one, a BigInteger for 1.

import java.math.BigInteger

fun main () {
    var n = BigInteger("2")
    val one = BigInteger("1")
    for (i in 1..9) {
        n = n * (n - one) + one
        println(n)
    }
}

Output:

3
7
43
1807
3263443
10650056950807
113423713055421844361000443
12864938683278671740537145998360961546653259485195807
165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

Sylvester’s Sequence in D

import std.stdio;
import std.bigint;

void main() {
    BigInt s = "2";
    writeln(s);
    for (int i = 1; i <= 9; i++) {
        s = s * (s - 1) + 1;
        writeln(s);
    }
}

Output:

2
3
7
43
1807
3263443
10650056950807
113423713055421844361000443
12864938683278671740537145998360961546653259485195807
165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

Sylvester’s Sequence in Lua

I did not succeed to use the library for large integers. Perhaps my Lua installation is faulty, or I missed something else. I still want to show the result to illustrate how wrong a program can go in the event of an integer overflow not properly managed. We’ve seen before that Ring (for example) automatically switches to floats and provides results accurate to the first 16 decimal places. In Lua, this goes horribly wrong, and displays even negative integers.

-- Does not work properly
s = 2
print(s)
for i = 1, 9 do
    s = s * (s - 1) + 1
    print(s)
end

Output:

2
3
7
43
1807
3263443
10650056950807
-3591524960174918149
-8362769992138052065
4108952388197251491

Sylvester’s Sequence in Go

This works properly, but the method-invocation syntax for using big integers in Go is just plainly horrible and very difficult to use. I expected better from one of the world’s largest and wealthiest corporations and some legendary computer scientists, especially when it is claimed that Go was designed to be simple. OK, I must admit that it is still simpler than dc (see above), but dc was designed and written almost half a century ago.

// Go big int syntax really sucks
package main

import (
    "fmt"
    "math/big"
)

func main() {
    s := big.NewInt(2)
    fmt.Println(0, ": ", s)
    one := big.NewInt(1)
    for i := 1; i <= 9; i++ {
        s.Add(new(big.Int).Mul(s, s), new(big.Int).Sub(one, s))
        fmt.Println(i, ": ", s)
    }
}

Output:

0 :  2
1 :  3
2 :  7
3 :  43
4 :  1807
5 :  3263443
6 :  10650056950807
7 :  113423713055421844361000443
8 :  12864938683278671740537145998360961546653259485195807
9 :  165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

Sylvester’s Sequence in Nim

import bigints

var s = 2.initBigInt
echo s
for i in 1..9:
    s = s * (s - 1) + 1
    echo s

Output:

2
3
7
43
1807
3263443
10650056950807
113423713055421844361000443
12864938683278671740537145998360961546653259485195807
165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

Sylvester’s Sequence in Dart

Like in Kotlin, BigInt objects don’t mix in properly with regular integers in Dart. So we need to declare a one BigInt object for integer 1.

void main() { var s = BigInt.from(2); print(s); var one = BigInt.from(1); for (int i = 1; i <= 9; i++) { s = s * (s - one) + one; print(s); } }

Output:

2
3
7
43
1807
3263443
10650056950807
113423713055421844361000443
12864938683278671740537145998360961546653259485195807
165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

Sylvester’s Sequence in JavaScript

Here, again, we need to declare a one BigInt object for integer 1.

let s = BigInt (2)
let one = BigInt (1)
console.log(s + " ");
for (let i = 1; i <= 9; i++) {
    s = s * (s - one) + one
    console.log(s + " ");
}

Output:

2 
3 
7 
43 
1807 
3263443 
10650056950807 
113423713055421844361000443 
12864938683278671740537145998360961546653259485195807 
165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

Sylvester’s Sequence in TCL

TCL natively supports arbitrarily large integers.

set s 2
puts $s
for {set i 1} {$i <= 9} {incr i} {
    set s [expr ($s * ($s - 1) + 1)]
    puts $s
}

Output:

2
3
7
43
1807
3263443
10650056950807
113423713055421844361000443
12864938683278671740537145998360961546653259485195807
165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

Sylvester’s Sequence in Java

I said before that I found Java to be a bit too verbose. If you don’t know what I mean, just compare the Java solution below with the TCL solution above.

import java.math.BigInteger;

public class Sylvester {
    public static void main(String[] args) {
        BigInteger n = BigInteger.valueOf(2);
        System.out.printf("%s\n", n);
        BigInteger one = BigInteger.valueOf(1);
        for (int i = 1; i <= 9; i++) {
            n = (n.multiply(n.subtract(one))).add(one);
            System.out.printf("%s\n", n);
        }
    }
}

Output:

2
3
7
43
1807
3263443
10650056950807
113423713055421844361000443
12864938683278671740537145998360961546653259485195807
165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

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

These are some answers to the Week 172 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 10, 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: Prime Partition

You are given two positive integers, $m and $n.

Write a script to find out the Prime Partition of the given number. No duplicates allowed.

For example,

Input: $m = 18, $n = 2
Output: 5, 13 or 7, 11

Input: $m = 19, $n = 3
Output: 3, 5, 11

The task description doesn’t say what a prime partition is. In mathematics, a partition of a positive integer n is usually a way of writing n as a sum of positive integers. We can assume that a prime partition is a partition made of only prime numbers. This is confirmed by the examples. From the examples, we can also infer that the second integer $n is the number of (prime) integers whose sum should be equal to $m. Also, the first example has two solutions (5, 13 or 7, 11). To me, this means that either solution is valid. So, I won’t bother to display all solutions when there is more than one, but will stop searching as soon as one solution has been found. Finally, since duplicates are not allowed, there will be some input values for which there is no solution. For example, for the input integers (17, 3): 17 could be considered as the sum of 3 primes, 13, 2, 2, but this isn’t a valid solution because of the duplicate 2 values. It is quite easy to check manually that there is no valid solution.

Prime Partition in Raku

We implement a recursive partition subroutine. If the second parameter ($n) is larger than 2, then partition subroutine loops through a list of prime number and calls itself recursively with a second parameter of $n - 1. If the second parameter is 2, then we stop recursion and find the solution (if any).

my @primes = grep { .is-prime }, 1..100;
my %seen;

sub partition (Int $m, Int $n) {
    return if $n < 2;
    if $n == 2 {
        for @primes -> $i {
            last if $i >= $m;
            my $j = $m - $i;
            next if $j == $i;
            next if %seen{$i} or %seen{$j};
            return $i, $j if $j.is-prime;
        }
        return;
    } else {
        for @primes -> $i {
            last if $i >= $m;
            %seen = $i => True;
            my @sub-partition = partition($m - $i, $n-1);
            next if @sub-partition.elems < 2;
            return ($i, @sub-partition).flat;
        }
        return;
    }
}
for <18 2>, <19 3>, <17 3>, <25 2> -> $test {
    my @partition = partition($test[0], $test[1]);
    say @partition.elems < 2 ?? "$test: No solution" !! "Solution for $test: @partition[]";
}

With the four input tests provided, this program displays the following output:

$ raku ./prime-partition.raku
Solution for 18 2: 5 13
Solution for 19 3: 3 5 11
17 3: No solution
Solution for 25 2: 2 23

Update July 05, 2022: Shortly after I published this post earlier today, it occurred to me that there is a simpler way to do it, using the Raku built-in combinations routine:

sub partition(Int $m, Int $n) {
    my $found = False;
    for (2..$m).grep({.is-prime}).combinations($n) -> $comb {
        say "$m $n: ", $comb and $found = True if $comb.sum == $m;
    }
    say "$m $n: no solution " unless $found;
}
for <18 2>, <19 3>, <17 3>, <25 2> -> $test {
    my @partition = partition($test[0], $test[1]);
}

This program displays the following output:

$ ./raku prime-partition2.raku
18 2: (5 13)
18 2: (7 11)
19 3: (3 5 11)
17 3: no solution
25 2: (2 23)

Note that we are now displaying all solutions, not just the first one.

Prime Partition in Perl

This is a port to Perl of the first Raku program above. The only significant difference is that we had to implement our own is_prime subroutine.

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

my @primes = grep { is_prime($_) } 1..100;
my %seen;

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;
}

sub partition  {
    my ($m, $n) = @_;
    return if $n < 2;
    if ($n == 2) {
        for my $i (@primes) {
            last if $i >= $m;
            my $j = $m - $i;
            next if $j == $i;
            next if $seen{$i} or $seen{$j};
            return $i, $j if is_prime($j);
        }
        return;
    } else {
        for my $i (@primes) {
            last if $i >= $m;
            %seen = ($i => 1);
            my @sub_partition = partition($m - $i, $n-1);
            next if @sub_partition < 2;
            return ($i, @sub_partition);
        }
        return;
    }
}
for my $test ([18, 2], [19, 3], [17, 3], [25, 2]) {
    my @partition = partition(@$test);
    say @partition < 2 ? "@$test: No solution" : "Solution for @$test: @partition";
}

This program displays the following results:

$ perl ./prime-partition.pl
Solution for 18 2: 5 13
Solution for 19 3: 3 5 11
17 3: No solution
Solution for 25 2: 2 23

Prime Partition in Julia

In Julia, the Primes.primes function returns an iterable collection of prime numbers. And the Combinatoric package provides the combinations function, which does exactly what its name implies. With thezse two functions, the solution is very simple:

using Primes
using Combinatorics

function partition(m, n)
    for comb in combinations(primes(m),n)
        sum(comb) == m && println("$m $n: ", comb)
    end
end

partition(18,2)
partition(19, 3)
partition(25, 2)

Output:

$ julia ./prime-partition.jl
18 2: [5, 13]
18 2: [7, 11]## Task 2: Five-number Summary
19 3: [3, 5, 11]
25 2: [2, 23]*You are given an array of integers.*

Prime Partition in Python

Python also has combinations function, provided by the itertools package. We implement our own is_prime function.

import math
from itertools import combinations

def is_prime(n):
  if n == 2:
    return True
  if n == 0 or n == 1 or n % 2 == 0:
    return False
  p = 3
  sqrt_n = math.sqrt(n)
  while (p <= sqrt_n):
    if ((n % p) == 0):
      return False
    p += 2
  return True

def partition(m, n):
  primes = filter(is_prime, range (1, m))
  for combination in combinations(primes, n):
    if sum(combination) == m:
      print(m, n, ": ", combination)

partition(18, 2)
partition(19, 3)
partition(25, 2)

Output:

$ python3 prime-partition.py
18 2 :  (5, 13)
18 2 :  (7, 11)
19 3 :  (3, 5, 11)
25 2 :  (2, 23)

Task 2: Five-number Summary

You are given an array of integers.

Write a script to compute the five-number summary of the given set of integers.

You can find the definition and example in the wikipedia page.

The five-number summary is a set of descriptive statistics that provides information about a dataset. It consists of the five most important sample percentiles:

• the sample minimum (smallest observation)
• the lower quartile or first quartile
• the median (the middle value)
• the upper quartile or third quartile
• the sample maximum (largest observation)

Intuitively, with a sorted data set, the median is the middle value separating the greater and lesser halves of the set. If the input set has an odd number of items, the median is the middle value. With an even number of items, the median is usually computed as the arithmetic mean of the two middle values.

The lower quartile or first quartile is the value such that one quarter (or 25%) of the items are smaller and three quarters (75%) are larger. It is the median of the lower half of the sorted dataset. And the upper or third quartile is the median of the upper half, i.e. a value such that three quarters are larger and one quarter larger. Having said that, I must add that, as often, the devil hides in the details. Depending on whether or not we include the median in the two halves, we might obtain different results, and there is no universal agreement on selecting the quartile values. This Wikipedia page lists four different methods for computing the quartiles (and, for some data sets, they will compute different results). So, it is sort of your draw, you may pick the method you prefer.

Five-number Summary in Raku

We implement a median subroutine to compute the median of a data set. As noted above, there are two formulas to compute the median, depending on whether the number of elements if even or odd. Note that our median subroutine relies on the fact that its input data has been previously sorted in ascending order (in the summary subroutine). Note that the median subroutine is used three times (to compute the median, or course, but also to compute the lower and upper quartiles).

The test data set is the set of observations of the number of moons for each planet in the solar system: 0, 0, 1, 2, 63, 61, 27, 13, as provided in the Wikipedia page on the five-number summary.

sub median (@in) { # input values must have been sorted
    my $count = @in.elems;
    if $count %% 2 {
        return (@in[$count/2 -1] + @in[$count/2])/2;
    } else {
        return @in[($count - 1) / 2];
    }
}
sub summary (@input) {
    my @in = sort @input;
    my $min = @in[0];
    my $max = @in[*-1];
    my $median = median(@in);
    my $first-quart = median( grep { $_ < $median}, @in);
    my $third-quart = median( grep { $_ > $median}, @in);
    return $min, $first-quart, $median, $third-quart, $max;
}
my @moons = 0, 0, 1, 2, 63, 61, 27, 13;
say summary(@moons);

This program displays the following output:

$ raku ./five-nums-summary.raku
(0 0.5 7.5 44 63)

Five-number Summary in Perl

This is a port to Perl of the Raku program just above. Please refer to the previous section for further explanations.

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

sub median {
    my @in = @_; # Input values have been sorted previously
    my $count = scalar @in;
    if ($count % 2) {
        return $in[($count - 1) / 2];
    } else {
        return ($in[$count/2 -1] + $in[$count/2])/2;
    }
}
sub summary {
    my @in = sort { $a <=> $b } @_;
    my $min = $in[0];
    my $max = $in[-1];
    my $median = median(@in);
    my $first_quart = median( grep { $_ < $median} @in);
    my $third_quart = median( grep { $_ > $median} @in);
    return $min, $first_quart, $median, $third_quart, $max;
}
my @moons = (0, 0, 1, 2, 63, 61, 27, 13);
say join " ", summary(@moons);

This program displays the following output:

$ perl ./five-nums-summary.pl
0 0.5 7.5 44 63

Five-number Summary in Julia

The Statistics package provides a number of functions, including quantile that we are using here:

using Statistics

moons = sort([0, 0, 1, 2, 63, 61, 27, 13])

min = moons[1]  # Julia indices start at 1
first_quart = quantile(moons, 0.25)
median = quantile(moons, 0.5)
third_quart = quantile(moons, 0.75)
max = last(moons)

println("Min: $min; First quartile = $first_quart; Median: $median; Third quartile: $third_quart; Max: $max")

Output:

$ julia ./five-nums-summary.jl
Min: 0; First quartile = 0.75; Median: 7.5; Third quartile: 35.5; Max: 63

Five-number Summary in Python

def median(n):
  c = len(n)
  return n[int((c - 1) / 2)] if c % 2 != 0 else (n[int(c/2 -1)] + n[int(c/2)])/2


def summary(input):
  min = input[0]
  max = input[-1]
  med = median(input)
  lower_half = list(filter(lambda p: p < med, input))
  # print(lower_half)
  first_quart = median(lower_half)
  third_quart = median(list(filter(lambda p: p > med, input)))
  return(min, first_quart, med, third_quart, max)

moons = sorted([0, 0, 1, 2, 63, 61, 27, 13])
print(summary(moons));

Output:

$ python3 ./five-nums-summary.py
(0, 0.5, 7.5, 44.0, 63)

Five-number Summary in Ruby

def median(n)
    size = n.length
    if size %2 != 0
        n[(size + 1) / 2] 
    else
        (n[size/2] + n[size/2 + 1]) / 2.0
    end
end

def summary(n)
    min = n[0]
    max = n[-1]
    med = median(n)
    first_q = median( n.select { |i| i < med })
    last_q = median( n.select { |i| i > med })
    return min, first_q, med, last_q, max
end

moons = [0, 0, 1, 2, 63, 61, 27, 13]
print summary(moons.sort), "\n"

Output:

[0, 0.5, 7.5, 44.0, 63]

Five-number Summary in C

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

int compare_int(const void *a,const void *b) {
    int *x = (int *) a;
    int *y = (int *) b;
    return *x - *y;
}

float median (int count, int m[]) {
    if (count % 2) {
        return 1.0 * m[(count -1)/2];
    } else {
        return (m[count/2 -1] + m[count/2])/2.0;
    }
}

int main() {
    int moons[] = {0, 0, 1, 2, 63, 61, 27, 13};
    int size = sizeof(moons)/sizeof(*moons);
    qsort (moons, size, sizeof(*moons), compare_int);
    float min = 1.0 * moons[0];
    float med = median(size, moons);
    int half = (int)size/2;
    float first_q = median(half, moons);
    float last_q = median(half, moons + 4);
    float max = 1.0 * moons[size - 1];
    printf ("%.2f %.2f %.2f %.2f %.2f", min, first_q, med, last_q, max);
    return 0;
}

Output:

0.00 0.50 7.50 44.00 63.00

Five-number Summary in Ring

Ring does not seem to have a filter (or grep) function and also doesn’t seem to have array slices. Or, if it has any of these two features, I did not find them in the documentation. In addition, Ring array indices start with 1. So, I managed manually the various ranges, but I must admit that, being used with array indices starting at 0, it took me quite a while to get the array index computations right.

moons = [0, 0, 1, 2, 63, 61, 27, 13]
see summary(sort(moons))

func summary(n)
    min = n[1]
    max = n[len(n)]
    size = len(n)
    med = median(1, size, n)
    first_q =  median(1, size/2, n)
    last_q = median(size/2 +1, size, n)
    return [min, first_q, med, last_q, max]

func median(low, high, n)
    if (high + low) % 2 = 0 
        return n[low + (high - low + 1)/2]
    else
        return (n[low + (high - low + 1)/2] + n[low + (high - low + 1)/2 - 1]) / 2.0
    ok

Output:

0
0.50
7.50
44
63

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