December 2021 Archives

Perl Weekly Challenge 145: Palindromes

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

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on January 2, 2022 at 24:00). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Task 1: Dot Product

This first task of this week’s challenge was covered in this blog post.

Task 2: Palindromic Tree

You are given a string $s.

Write a script to create a Palindromic Tree for the given string.

I found this blog explaining Palindromic Tree in detail.

Example 1:

Input: $s = 'redivider'
Output: r redivider e edivide d divid i ivi v

Example 2:

Input: $s = 'deific'
Output: d e i ifi f c

Example 3:

Input: $s = 'rotors'
Output: r rotor o oto t s

Example 4:

Input: $s = 'challenge'
Output: c h a l ll e n g

Example 5:

Input: $s = 'champion'
Output: c h a m p i o n

Example 6:

Input: $s = 'christmas'
Output: c h r i s t m a

The blog explaining palindromic trees is in my humble opinion somewhat unclear and quite difficult to follow.

If we look at the examples provided, the aim is to find all palindromes that can be formed from fragments of a word. For example, for the word redivider, the palindromic fragments are: r redivider e edivide d divid i ivi v. Note that a single letter is considered to be a palindrome, even though it is sort of a trivial solution. Also note that each palindrome appears only once in the output, so the algorithm somehow removes any duplicates. Finally, the palindromes are ordered by their place of occurrence in the input string.

With these properties in mind, we can write a much simpler algorithm to find all palindromes and generate exactly the requested output.

The point about the palindromic tree algorithm is that it is supposed to be efficient. Well, I’m not even sure that a proper palindromic tree implementation would run faster than my implementations below with the input examples provided. As Donald Knuth wrote in The Art of Computer Programming, “premature optimization is the root of all evil (or at least most of it) in programming.” So, before spending a lot of time and energy on implementing a fairly complicated algorithm, let’s see how a much simpler naive implementation behaves.

Well, with the six input words provided in the task specification, the Perl program below is timed as follows on my laptop (a relatively good computer, but certainly not a racing horse):

real    0m0,048s
user    0m0,015s
sys     0m0,030s

In other words, it runs in less than 50 milliseconds (compile time included). This is fairly good, isn’t it? Why, for heaven’s sake, would you want to optimize this? I certainly don’t want to spend hours on a complicated algorithm just to possibly scrap a few milliseconds.

Admittedly, for very long input strings, the palindromic tree algorithm may perform faster, but palindromes are normally used on actual words, which rarely have more than a dozen letters.

And, as we shall see, our output is exactly what is requested from us in the task specification. So, why bother?

Palindromes in Raku

We just use two nested loops to generate all fragments of the input words. Then we filter out fragments that are not palindromes and palindromes that have already been seen previously for the same input (to avoid duplicates).

use v6;

sub is-palindrome (Str $in) { return $in eq $in.flip; }

sub find-all-palindromes ($input) {
    print "$input: ";
    my BagHash $seen;
    for 0..$input.chars -> $start {
        for 1..$input.chars - $start -> $length {
            my $candidate = substr $input, $start, $length;
            next unless is-palindrome $candidate.Str;
            next if $seen{$candidate};
            $seen{$candidate}++;
            print "$candidate ";
        }
    }
    say " ";
}

for <redivider deific rotors challenge
    champion christmas> ->  $test {
        find-all-palindromes $test;
}

This program displays the following output:

$ raku ./palindromes.raku
redivider: r redivider e edivide d divid i ivi v
deific: d e i ifi f c
rotors: r rotor o oto t s
challenge: c h a l ll e n g
champion: c h a m p i o n
christmas: c h r i s t m a

Palindromes in Perl

This is a port to Perl of the above Raku program. Please refer to the explanations above if needed.

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

sub is_palindrome { return $_[0] eq reverse $_[0]; }

sub find_all_palindromes {
    my $input = shift;
    print "$input: ";
    my %seen;
    my $str_length = length $input;
    for my $start (0..$str_length) {
        for my $length (1.. $str_length - $start) {
            my $candidate = substr $input, $start, $length;
            next unless is_palindrome $candidate;
            next if $seen{$candidate};
            $seen{$candidate} = 1;
            print "$candidate ";
        }
    }
    say " ";
}

for my $test (qw <redivider deific rotors 
              challenge champion christmas>) {
        find_all_palindromes $test;
}

This program displays the following output:

$ perl palindromes.pl
redivider: r redivider e edivide d divid i ivi v
deific: d e i ifi f c
rotors: r rotor o oto t s
challenge: c h a l ll e n g
champion: c h a m p i o n
christmas: c h r i s t m a

Update (Jan 2, 2022): Added the new section below with 6 languages.

Palindromes in 6 Other Programming languages

In Python

def is_palindrome (str):
    return str == str[::-1]

def find_all_palindromes (input):
    seen = {}
    result = f'{input} : '
    for start in range (0, len(input)):
        for endstr in range(1, (len(input) + 1)):
            candidate = input[start : endstr]
            if is_palindrome(candidate) and not candidate in seen:
                result = result + " " + candidate
                seen[candidate] = 1
    print(result)

for test in ("redivider", "deific", "rotors", "challenge"): 
    find_all_palindromes(test);

Output:

$ python3 ./palindromes.py
redivider :  r redivider  e edivide d divid i ivi v
deific :  d  e i ifi f c
rotors :  r rotor  o oto t s
challenge :  c h a l ll e n g

In Julia

function is_palin(instr)
    return instr == reverse(instr)
end

function find_all_palindromes(input)
    print("$input: ")
    seen = Dict()
    for startstr in 1:length(input)
        for endstr in startstr:length(input)
            cand = input[startstr:endstr]  # candidate
            if is_palin(cand) && cand ∉ keys(seen)
                print("$cand ")
                seen[cand] = 1
            end
        end
    end
    print("\n")
end

for test in ("redivider", "rotors", "deific", "challenge")
    find_all_palindromes(test)
end

Output:

redivider: r redivider e edivide d divid i ivi v 
rotors: r rotor o oto t s 
deific: d e i ifi f c 
challenge: c h a l ll e n g

In Rust

use std::collections::HashSet;

fn is_palindrome (instr : &str) -> bool {
    return instr == instr.chars().rev().collect::<String>()
}

fn find_palindromes (input : &str) {
    print!("{}: ", input);
    let mut seen = HashSet::new();
    for start in 0..input.len() {
        for endstr in start+1..=input.len() {
            let cand = &input[start .. endstr];
            if is_palindrome(&cand) && !seen.contains(&cand) {
                print!("{} ", cand);
                seen.insert(cand);
            }
        }
    }
    println!(" ");
}

fn main () {
    let tests = vec!["redivider", "rotors", "challenge"];
    for test in tests.into_iter() {
        find_palindromes(test);
    }
}

Output:

redivider: r redivider e edivide d divid i ivi v  
rotors: r rotor o oto t s  
challenge: c h a l ll e n g

In Ruby

def is_palindrome (instr)
    return instr == instr.reverse
end

def find_palindromes (input)
    print input, ": "
    seen = {}
    for start in 0 .. input.length - 1 do
        for endstr in start .. input.length - 1 do
            cand = input[start .. endstr]
            if is_palindrome(cand) and not seen[cand] then
                print cand, " "
                seen[cand] = 1
            end
        end
    end
    puts " "
end

for test in ["redivider", "rotors", "challenge"] do
    find_palindromes(test)
end

Output:

$ ruby palindrome.rb
redivider: r redivider e edivide d divid i ivi v  
rotors: r rotor o oto t s  
challenge: c h a l ll e n g

In Lua

local function is_palindrome (instr)
    return instr == string.reverse(instr)
end

local function find_palindromes (input) 
    io.write (input, ": ")
    local seen = {}
    for startstr = 1, #input do
        for endstr = startstr, #input do
            local cand = string.sub (input, startstr, endstr)
            if is_palindrome(cand) and not seen[cand] then
                io.write(cand, " ")
                seen[cand] = 1
            end
        end
    end
print(" ")
end

local tests = {"redivider", "rotors", "challenge"}
for _, test in pairs(tests) do
    find_palindromes(test)
end

Output:

$ lua ./dot-product.lua
redivider: r redivider e edivide d divid i ivi v  
rotors: r rotor o oto t s  
challenge: c h a l ll e n g

In Ring

Ring is a new programming language. Well, it is at least completely new to me (I had never heard about it until this morning of Jan 2, 2022), but it was released for the first time in January 2016. Its documentation states:

The Ring is an Innovative and practical general-purpose multi-paradigm scripting language that can be embedded in C/C++ projects, extended using C/C++ code and/or used as standalone language. The supported programming paradigms are Imperative, Procedural, Object-Oriented, Functional, Meta programming, Declarative programming using nested structures, and Natural programming.

I thought it would be interesting to get a gist of it by using it as a guest language in the Perl Weekly Challenge. Here we go.

tests = ["redivider", "rotors", "challenge"]
for test in tests
    find_palindromes(test)
next

func find_palindromes input
    see input + " : " 
    seen = []
    for start = 1 to len(input)
        for length = 1 to len(input) - start
            cand = substr(input, start, length)
            if is_palindrome(cand) and not seen[cand]
                see cand + " "
                add(seen, cand)
            ok
        next
    next
    see " " + nl

func is_palindrome instr
    reverse = ""
    for i = len(instr) to 1 step -1
        reverse = reverse + instr[i]
    next
    return reverse = instr

Using the Ring online compiler, I obtain the following output:

redivider : r e edivide d divid i ivi v i d e
rotors : r rotor o oto t o r
challenge : c h a l ll l e n g

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

Perl Weekly Challenge 145: Dot Product

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

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on January 2, 2022 at 24:00). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Task 1: Dot Product

You are given 2 arrays of same size, @a and @b.

Write a script to implement Dot Product.

Example:

@a = (1, 2, 3);
@b = (4, 5, 6);

$dot_product = (1 * 4) + (2 * 5) + (3 * 6) => 4 + 10 + 18 => 32

An important point is that we are told that the arrays have the same size. Thus, we don’t need to check that. We’ll also assume that they contain only numbers.

Dot Product in Raku

Raku is particularly well-suited to solve this task.

Assuming we have the two arrays presented in the task description (@a = (1, 2, 3); and @b = (4, 5, 6);), the infix Z zip operator will interleave the values from the two arrays like a zipper, taking index-corresponding elements from each operand:

say @a Z @b;  # prints: ((1 4) (2 5) (3 6))

That’s already quite good, but Z is also a metaoperator) that can be combined with another infix operator that will be applied to each pair of the above result. Thus, using Z*, we obtain directly the individual products:

say @a Z* @b; # prints: (4 10 18)

Finally, we only need to add these partial results (with the built-in sum function or method, or with another metaoperator combination, [+]) to fulfill the task in just one very short code-line:

use v6;

my @a = 1, 2, 3;
my @b = 4, 5, 6;

say sum @a Z* @b;  # Could also be: say [+] @a Z* @b;

This script displays the following output:

$ raku ./dot-product.raku
32

Dot Product in Perl

Since Perl doesn’t have the Zip operator and metaoperator, we cannot port the Raku solution to Perl. But, using a map, we can nevertheless implement a fairly concise solution:

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

my @a = (1, 2, 3);
my @b = (4, 5, 6);

my $result = 0;
$result += $_ for map { $a[$_] * $b[$_] } 0..$#a;
say $result;

This script displays the following output:

$ perl ./dot-product.pl
32

Update (Jan 2, 2022): Added the new section below with 16 languages.

Dot Product in 16 Other Programming Languages

All these implementations basically implement the same idea, with some minor differences due to syntactic differences.

In Julia

#!/usr/bin/julia

function dot_product(a1, a2)
    res = 0
    for i in eachindex(a1)
        res = res + a1[i] * a2[i]
    end
    return res
end

print( "Dot product: ", dot_product([1, 2, 3], [4, 5, 6]))

Output:

$ julia ./dot-product.jl
Dot product: 32

In Python

def dot_product (a1, a2):
    res = 0
    for i in range(0, len(a1)):
        res += a1[i] * a2[i]
    return res

product = dot_product([1, 2, 3], [4, 5, 6])
print(product)

Output:

$ python3 ./dot-product.py
32

In Scala

object dot_product extends App {
  val a1 = Array(1, 2, 3)
  val a2 = Array(4, 5, 6)
  var res = 0
  for (i <- a1.indices) {
    res = res + a1(i) * a2(i)
  }
  println("Dot product: " + res)
}

Output:

Dot product: 32

In Lua

#!/usr/bin/lua

local function dot_product(a1, a2)
    res = 0
    for i, v in next, a1 do
        res = res + v * a2[i]
    end
    return res
end

print(dot_product({1, 2, 3}, {4, 5, 6}))

Output:

$ lua ./dot-product.lua
32

In Kotlin

fun dot_product(a1: List<Int>, a2: List<Int>): Int {
    var res = 0
    for (i in a1.indices) {
        res += a1[i] * a2[i]
    }
    return res
}
fun main() {
    println (dot_product(listOf<Int>(1, 2, 3), listOf<Int>(4, 5, 6)))
}

Output:

32

In Ruby

def dot_product(a1, a2)
    res = 0
    a1.each_with_index do |v, i|
        res += v * a2[i]
    end
    return res
end
print dot_product([1, 2, 3], [4, 5, 6]), "\n"

Output:

bundle exec ruby dot-product.rb
32

In Rust

fn dot_product(a1: Vec<i32>, a2: Vec<i32>) -> i32 {
    let mut res = 0;
    a1.iter().enumerate().for_each(|(i, v)| {
        res += v * a2[i];
    });
    return res
}
fn main() {
    println!("{} ", dot_product(vec![1, 2, 3],vec![4, 5, 6]));
}

Output:

32

In Awk

$ echo '1 2 3
4 5 6 '  | awk -e '{
    for (i = 1; i <= NF; i ++) {
        if (NR == 1) {
             col[i] = $i
        }
        else {
            result += col[i] * $i
        }
    }
}
END {
    print result
}
'
32

In C

#include <stdio.h>

int main() {
    int a1[] = {1, 2, 3};
    int a2[] = {4, 5, 6};
    int res = 0;
    int size = sizeof(a1)/sizeof(a1[0]);
    for (int i = 0; i < size; i++) {
        res += a1[i] * a2[i];
    }
    printf("%d\n", res);
}

Output:

$ ./a.out
32

In Pascal

program dot_product;
const
    SIZE = 2;
var
    a1: array[0..SIZE] of integer = (1, 2, 3);
    a2: array[0..SIZE] of integer = (4, 5, 6);
    result, i : integer;
begin
    result := 0;
    for i := 0 to SIZE do
        result += a1[i] * a2[i];
    writeln(result);
end.

Output:

32

In D

import std.stdio;

int a1[] = [1, 2, 3];
int a2[] = [4, 5, 6];
int main() {
    int result = 0;
    for (int i = 0; i < 3; i++) {
        result += a1[i] * a2[i];
    }
    writeln(result);
    return 0;
}

Output:

32

In Bash

$ echo '1 2 3
4 5 6 '  | bash -c '
    read -a a1
    read -a a2
    for ((i = 0; i < ${#a1[@]}; i ++))
        do  ((result += a1[i] * a2[i]))
    done
    echo $result
'
32

In Dart

var a1 = [1, 2, 3];
var a2 = [4, 5, 6];

void main() {
    int result = 0;
    for (int i = 0; i < 3; i++ ) {
        result += a1[i] * a2[i];
    }
    print(result);
}

Output:

32

In Go

package main
import "fmt"

func main() {
    a1 := [3]int{1, 2, 3}
    a2 := [3]int{4, 5, 6}
    var result int = 0
    for i := 0; i < 3; i++ {
        result += a1[i] * a2[i]
    }
    fmt.Printf("Dot product: %d\n", result)
}

Output:

Dot product: 32

In Nim

Remember that Nim uses Python-like code indentation.

proc dot_product (a1, a2: array[0..2, int]) : int =
    result = 0
    for i in 0..2:
        result += a1[i] * a2[i]
    return result

let a1 = [1, 2, 3]
let a2 = [4, 5, 6]
let res = dot_product(a1, a2)
echo "dot product: ", res

Output:

dot product: 32

In Ring

Ring is a new programming language. Well, it is at least completely new to me (I had never heard about it until this morning of Jan 2, 2022), but it was released for the first time in January 2016. Its documentation states:

The Ring is an Innovative and practical general-purpose multi-paradigm scripting language that can be embedded in C/C++ projects, extended using C/C++ code and/or used as standalone language. The supported programming paradigms are Imperative, Procedural, Object-Oriented, Functional, Meta programming, Declarative programming using nested structures, and Natural programming.

I thought it would be interesting to use is as a guest language in the Perl Weekly Challenge to get a gist of it. Here we go.

see "Dot product: " + dot_product([1, 2, 3], [4, 5, 6]) + nl

func dot_product a1, a2
    res = 0
    for i = 1 to len(a1)
        res = res +  a1[i] * a2[i]
    next
    return res

Using the Ring online compiler, I obtain the following output:

Dot product = 32

Task 2: Palindromic Tree

This task requests us to implement a fairly complicated algorithm. I’ll try to come back to that later, if I have time and if I succeed to understand the requirement.

Update (Dec. 29): Finally, I have completed this second task here.

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

Perl Weekly Challenge 144: Semiprimes and Ulam Sequence

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

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

Task 1: Semiprimes

Write a script to generate all Semiprime number <= 100.

For more information about Semiprime, please checkout the Wikipedia page.

In mathematics, a semiprime is a natural number that is the product of exactly two prime numbers. The two primes in the product may equal each other, so the semiprimes include the squares of prime numbers.

Example:

10 is Semiprime as 10 = 2 x 5
15 is Semiprime as 15 = 3 x 5

Semiprimes might look like a somewhat useless curiosity, but they are in fact extremely important in the field of public key cryptography. For example, generating the public and private keys for a RSA cipher involves generating two very large prime numbers (with several dozens of digits) and computing their product. Raku has built-in features to quickly create RSA keys (and also to encode messages and decode cryptograms): arbitrary precision integers, an efficient is-prime primality test (using the fast Miller-Rabin test) and modular arithmetic. See this for further details. But that’s another subject.

Semiprimes in Raku

We start by generating a list of prime numbers between 1 and 50. Then we want to generate all pairs of such primes. Since we also want square semiprimes (i.e. numbers that are squares of prime numbers), we cannot use the combinations method. We will use instead the X cross product operator between the array of primes and itself, multiply the pair items, filter out those which are too large, sort them and remove duplicates.

use v6;

constant \MAX = 100;
my @primes = grep { .is-prime }, 1..MAX/2;
my @nums = grep { $_ <= MAX }, map { [*] $_[0,1] }, 
    (@primes X @primes);
say @nums.sort.squish;
# say now - INIT now;

This program displays the following output:

$ raku ./semi-primes.raku
(4 6 9 10 14 15 21 22 25 26 33 34 35 38 39 46 49 51 55 57 58 62 65 69 74 77 82 85 86 87 91 93 94 95)

Semiprimes in Perl

Our Perl implementation is essentially a port of the Raku implementation, except that we had to roll out our primessubroutine for generating a list of prime integers, and to use two nested loops for generating the pairs of primes.

use strict;
use warnings;
use feature "say";
use constant MAX => 100;

sub primes {
    my $max = shift;
    my @primes = (2, 3, 5);
    PRIMES: for my $c (7..$max/2) {
        for my $i (2..$c/2) {
            next PRIMES unless $c % $i;
        }
        push @primes, $c;
    }
    return @primes;
}

my @p = primes MAX;
my @semi_primes;
# Generating pairs of primes and their product 
for my $i (0..$#p) {
    for my $j (0..$i) {
        my $product = $p[$i] * $p[$j];
        push @semi_primes, $product if $product <= MAX;
    }
}
my @result;
my $j = -1;
# Removing duplicate products
for my $i (sort {$a <=> $b} @semi_primes) {
    push @result, $i if $i != $j;
    $j = $i;
}
say "@result";

This program displays the following output:

$ perl semi-primes.pl
4 6 9 10 14 15 21 22 25 26 33 34 35 38 39 46 49 51 55 57 58 62 65 69 74 77 82 85 86 87 91 93 94 95

Task 2: Ulam Sequence

You are given two positive numbers, $u and $v.

Write a script to generate Ulam Sequence having at least 10 Ulam numbers where $u and $v are the first 2 Ulam numbers.

For more information about Ulam Sequence, please checkout this website.

The standard Ulam sequence (the (1, 2)-Ulam sequence) starts with U1 = 1 and U2 = 2. Then for n > 2, Un is defined to be the smallest integer that is the sum of two distinct earlier terms in exactly one way and larger than all earlier terms.

Example 1:

Input: $u = 1, $v = 2
Output: 1, 2, 3, 4, 6, 8, 11, 13, 16, 18

Example 2:

Input: $u = 2, $v = 3
Output: 2, 3, 5, 7, 8, 9, 13, 14, 18, 19

Example 3:

Input: $u = 2, $v = 5
Output: 2, 5, 7, 9, 11, 12, 13, 15, 19, 23

The fact that a member of the sequence has to be “the smallest integer that is the sum of two distinct earlier terms in exactly one way” makes it quite difficult to construct the number directly from the previous ones. For example, suppose we have so far 1, 2, 3, 4. It would probably possible to find the next one. But the fact that it has to be the sum “in exactly one way” excludes 5 from the sequence, because it can be reached in two ways (1 + 4 and 2 + 3). But to be able to find that, we basically need to build all possibilities. In other words, we basically need a brute force approach: find all pairs of previous terms, perform the sums and find the smallest unique sum that is larger than the largest previous term. In the process, we can possibly improve the process by pruning values that are too small or too large, to reduce the number of values to examine, but it is still basically a brute force approach.

Note that the task specification asks us to find “at least 10 Ulam numbers”. I’ve decided to generate 12 Ulam numbers, i.e. 10 numbers in addition to the two seeds. This wasn’t requested, but it is still in line the the requirement of providing at least 10 Ulam numbers.

Ulam Sequence in Raku

For a given existing sequence of numbers, we use the combinations method to generate all possible pairs, sum each of them, compute the sums, filter out the sums that are too small and sort them. Then we loop on the resulting list, remove the duplicates and insert in the sequencearray the first valid candidate. And we start again with the new sequence and do it ten times in total.

uses v6;

sub ulam ($first, $second) {
    my @sequence = $first, $second;
    for 1..10 {
        my @sums = sort grep { $_ > @sequence[*-1] }, 
            map { [+] $_[0, 1] }, @sequence.combinations: 2;
        my $last = 0;
        for 0..@sums.end -> \i {
            next if @sums[i] == $last;
            push @sequence, @sums[i] and last if i >= @sums.end;
            $last = @sums[i] and next if @sums[i] == @sums[i+1];
            push @sequence, @sums[i] and last;
        }
    }
    return @sequence;
}
for (1,2), (2,3), (2,5) -> $test {
  say "$test => ", ulam |$test;

}

This program displays the following output:

$ raku ./ulam_seq.raku
1 2 => [1 2 3 4 6 8 11 13 16 18 26 28]
2 3 => [2 3 5 7 8 9 13 14 18 19 24 25]
2 5 => [2 5 7 9 11 12 13 15 19 23 27 29]

Ulam Sequence in Perl

This is essentially a port to Perl of the Raku solution above, except that we had to implement our own combine subroutine to replace the Raku built-in combination method.

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

sub combine {
    my @seq = @_;
    my $min = $seq[-1];
    my @comb_sums;
    for my $i (0..$#seq) {
        for my $j (0..$i-1) {
            my $sum =  $seq[$i] + $seq[$j];
            next if $sum <= $min;
            push @comb_sums, $sum;
        }
    }
    return sort { $a <=> $b } @comb_sums;
}

sub ulam {
    my @sequence = @{$_[0]};
    for (1..10) {
        my @sums = combine @sequence;
        my $last = 0;
        for my $i (0..$#sums) {
            next if $sums[$i] == $last;
            push @sequence, $sums[$i] and last if $i >= $#sums;
            $last = $sums[$i] and next if $sums[$i] == $sums[$i+1];
            push @sequence, $sums[$i] and last;
        }
    }
    return @sequence;
}
for my $test ([1,2], [2,3], [2,5]) {
    say "@$test => ", join " ", ulam $test;
}

This program displays the following output:

1 2 => 1 2 3 4 6 8 11 13 16 18 26 28
2 3 => 2 3 5 7 8 9 13 14 18 19 24 25
2 5 => 2 5 7 9 11 12 13 15 19 23 27 29

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

Perl Weekly Challenge 143: Calculator and Stealthy Numbers

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

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

Task 1: Calculator

You are given a string, $s, containing mathematical expression.

Write a script to print the result of the mathematical expression. To keep it simple, please only accept + - * ().

Example 1:

Input: $s = "10 + 20 - 5"
Output: 25

Example 2:

Input: $s = "(10 + 20 - 5) * 2"
Output: 50

Calculator in Raku

This is a perfect case where we could showcase the use of grammars in Raku. However, we have a much simpler solution: the EVAL routine will evaluate (i.e. compile and execute) an input string as a piece of Raku code and return the result. So we will use here this simpler solution (but will provide below an example of implementation with a grammar). There is, however, a big caveat: the EVAL routine is dangerous because its input string may contain malicious code. For that reason, you need to use the MONKEY-SEE-NO-EVAL pragma. If we try to use EVAL without turning on first the MONKEY-SEE-NO-EVAL (or MONKEY) pragma, we get the following error message:

EVAL is a very dangerous function!!! (use the MONKEY-SEE-NO-EVAL pragma to override this error but only if you’re VERY sure your data contains no injection attacks).

The EVAL routine is particularly dangerous if its input string comes from outside the program (for example as an input parameter, user input, or input file). A typical example would be a malicious user entering a string calling the operating system to execute a shell command such as rm -rf /* (don’t try this command), which may wipe out the entire file system (at least if you have root privileges). In our case, the strings to be EVALed come from within our program, so, assuming we know what we’re doing, we can be reasonably confident that nothing bad should happen. However, to make our calc subroutine completely innocuous, we use a regular expression to detect and reject any input string which doesn’t consist only of digits, spaces, arithmetic operators + - *, and parentheses.

use v6;
use MONKEY-SEE-NO-EVAL;

sub calc (Str $expr) {
    return "Not a valid arithmetic expression" unless 
        $expr ~~ /^<[-\d \s +*()]>+$/;
    return EVAL $expr;
}
for "10 + 20 - 5", "(10 + 20 - 5) * 2", "7 + a", "6 * 7" -> $test {
    say calc $test;
}

This program displays the following output:

$ raku ./calculator.raku
25
50
Not a valid arithmetic expression
42

Calculator in Perl

In Perl, we will use the eval built-in subroutine, in a way that is similar to the use of EVAL in the Raku solution above. The Perl eval has similar risks: it is dangerous because its input string may contain malicious code. This is particularly risky if the input string comes from outside the program (input parameter, user input, input file, etc.). In our case, the string to be evaled are hard-coded in our program so that the risk is reasonably small if we know what we’re doing. However, to make our calc subroutine completely innocuous, we use a regular expression to detect and reject any input string which doesn’t consist only of digits, spaces, arithmetic operators (+ - *), and parentheses.

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

sub calc {
    my $expr = shift;
    return "Not a valid arithmetic expression" unless 
        $expr =~ /^[-\d\s+*()]+$/;
    return eval $expr;
}
for my $test ("10 + 20 - 5", "(10 + 20 - 5) * 2", "7 + a", "6 * 7") {
    say calc $test;
}

This program displays the following output:

$ perl ./calculator.pl
25
50
Not a valid arithmetic expression
42

Task 2: Stealthy Number

You are given a positive number, $n.

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

A positive integer N is stealthy, if there exist positive integers a, b, c, d such that a * b = c * d = N and a + b = c + d + 1.

Example 1:

Input: $n = 36
Output: 1

Since 36 = 4 (a) * 9 (b) = 6 (c) * 6 (d) and 4 (a) + 9 (b) = 6 (c) + 6 (d) + 1.

Example 2:

Input: $n = 12
Output: 1

Since 2 * 6 = 3 * 4 and 2 + 6 = 3 + 4 + 1

Example 3:

Input: $n = 6
Output: 0

Since 2 * 3 = 1 * 6 but 2 + 3 != 1 + 6 + 1

I had never heard before about stealthy numbers, but the description provided is pretty clear.

Stealthy Number in Raku

We basically need to find all divisors of the input number and look at every combination of them to see if it matches the specified criteria.

After having generated all divisors of the input number (in the @divisors array), I thought about using the combinations method to generate all pairs of divisors. But that doesn’t work properly for perfect squares because the square root of the input number appears only once in the divisors list, and therefore cannot be used twice in the same pair of divisor. For example, if the input integer is 36, we would need to have (6, 6) in the list of divisor pairs. The combinations method cannot do that (unless we manually add a second instance of 6 in the divisor list. Rather than adding code for handling such edge case, I found it easier to use the X cross product operator between the @divisors array and itself and to filter out all those pairs of divisors whose product is not equal to the input integer. The result of this operation goes into the @div-pairs array.

Then, we can use the combinations method to generate pairs of pairs and check wheter they satisfy the second condition (a + b = c + d + 1). Since (a, b) and (c, d) are interchangeable, we actually check whether a + b - c - d is equal to either 1 or -1 (we do it here with a junction because it’s fun, but we could also compare the absolute value of that expression with 1, as we do below in our Perl implementation).

use v6;

sub stealthy-nums (UInt $n) {
    my @divisors = grep {$n %% $_}, 1..$n;
    my @div-pairs = grep { $_[0] * $_[1] == $n }, (@divisors X @divisors);
    # say @div-pairs;
    for @div-pairs.combinations: 2 -> $c {
        return $c if $c[0][0] + $c[0][1] - $c[1][0] - $c[1][1] == any(1, -1)
    }
    return False
}

for <36 12 6> -> $test {
    my $result = stealthy-nums $test;
    say "$test \t", 
    $result ?? "1 -> $result" !! 0;
}

This script display the following output:

$ raku ./stealthy-numbers.raku
36  1 -> 4 9 6 6
12  1 -> 2 6 3 4
6   0

I thought it would interesting to find more stealthy numbers. So I changed the final for block to this:

for (1..100) -> $test {
    my $result = stealthy-nums $test;
    say "$test \t $result" if $result;
}

and found 8 stealthy numbers below 100:

raku ./main.raku
4    1 4 2 2
12   2 6 3 4
24   3 8 4 6
36   4 9 6 6
40   4 10 5 8
60   5 12 6 10
72   6 12 8 9
84   6 14 7 12

Increasing the range to 1..1000, we find that there are 39 stealthy numbers below 1000, and that they are all even. And, by the way, there are 2851 stealthy integers below 1,000,000.

Stealthy Number in Perl

The Perl solution is essentially a port of the Raku solution, except that I had to write my own simple cross subroutine, since the cross product operator doesn’t exist in Perl.

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

sub cross {
    my @nums = @_;
    my @num_pairs;
    for my $i (@nums) {
        for my $j (@nums) {
            next if $j > $i; # filter out duplicates such as [12, 3] and [3, 12]
            push @num_pairs, [$i, $j];
        }
    }
    return @num_pairs;
}

sub stealthy_nums  {
    my $n = shift;
    my @divisors = grep {$n % $_ == 0} 1..$n;
    my @div_pairs = grep { $_->[0] * $_->[1] == $n } cross @divisors;
    for my $c (@div_pairs) {
        for my $d (@div_pairs) {
            return "@$c and @$d" if abs($c->[0] + $c->[1] - $d->[0] - $d->[1]) == 1;
        }
    }
    return 0;
}

for my $test (qw <36 12 6>) {
    my $result = stealthy_nums $test;
    say "$test \t", 
    $result ? "1 -> $result" : 0;
}

This program displays the following output:

$ perl stealthy-numbers.pl
36      1 -> 6 6 and 9 4
12      1 -> 4 3 and 6 2
6       0

A Raku Grammar for a Calculator

For implementing a calculator in Raku, we used the built-in EVAL routine, as this a a very simple solution. I can’t resist, however, to the desire and fun of presenting a full-fledged Raku grammar. This is derived in large part from a solution to the exercises that I provided in my Raku book.

The Calculator Grammar

Here’s one way to write the grammar itself:

my grammar Calculator {
    rule TOP            { <expr> }
    rule expr           { <term> + % <plus-minus-op> }
    token plus-minus-op { [< + - >] }
    rule term           { <atom> + % <mult-div-op> }
    token mult-div-op   { [< * / >] }
    rule atom {
        | <num> { make +$<num> }
        | <paren-expr> { make $<paren-expr>.made}
    }
    rule num            { <sign> ? [\d+ | \d+\.\d+ | \.\d+ ] }
    rule paren-expr     { '(' <expr> ')' }
    token sign          { [< + - >] }
}

This solution is quite simple.

An expression (expr) is made of one or several terms separated by + or - operators. A term is made of one or several atoms separated by * or / operators. An atom may be a bare number or a parenthesized expression.

This guarantees that precedence rules are satisfied. Multiplications and divisions will be evaluated before additions and subtractions, since, when parsing an expression, you need to evaluate the individual terms before you can complete the expression evaluation. Similarly, since a parenthesized expression is an atom, it will have to be evaluated before the term in which it appears can be fully evaluated. Note that, in the case of a parenthesized expression, the expr rule is called recursively.

The Actions Class

Notice that we have included two actions in the grammar (in the atom rule). One reason was for convenience: since the atom rule covers two very different named sub-rules, it is a bit easier to include the action just in the context of the sub-rules. If an action had been attached to the atom rule, it would have required finding out which sub-rule had been matched to know which action to perform. Nothing difficult, but doing so would have made the code slightly more complex. The other reason was for pedagogical purposes: although it often makes sense to create an actions class, it is useful to know that actions may be inserted in the grammar part. For a very simple grammar, it might be over-engineering to create an actions class with just one or two actions.

The actions class might look like this:

class CalcActions {
    method TOP ($/) {
        make $<expr>.made
    }
    method expr ($/) {
        $.calculate($/, $<term>, $<plus-minus-op>)
    }
    method term ($/) {
        $.calculate($/, $<atom>, $<mult-div-op>)
    }
    method paren-expr ($/) {
         make $<expr>.made;
    }
    method calculate ($/, $operands, $operators) {
        my $result = (shift $operands).made;
        while my $op = shift $operators {
            my $num = (shift $operands).made;
            given $op {
                when '+' { $result += $num; }
                when '-' { $result -= $num; }
                when '*' { $result *= $num; }
                when '/' { $result /= $num; }
                default  { die "unknown operator "}
            }
        }
        make $result;
    }
}

The calculate method computes expressions (terms separated by addition or subtraction operators) and terms atoms separated by multiplication or division operators) from left to right, since these operators are left associative.

Testing the Grammar and Actions Class

This grammar for a calculator and its associated actions class may be unit tested with the following code:

for |< 3*4 5/6 3+5 74-32 5+7/3 5*3*2 (4*5) (3*2)+5 4+3-1/5 4+(3-1)/4 >,
    "12 + 6 * 5", " 7 + 12 + 23", " 2 + (10 * 4) ", "3 * (7 + 7)" { 
    my $result = Calculator.parse($_, :actions(CalcActions));
    # say $result;
    printf "%-15s %.3f\n", $/,  $result.made if $result;
}

which will display the following results:

3*4             12.000
5/6             0.833
3+5             8.000
74-32           42.000
5+7/3           7.333
5*3*2           30.000
(4*5)           20.000
(3*2)+5         11.000
4+3-1/5         6.800
4+(3-1)/4       4.500
12 + 6 * 5      42.000
 7 + 12 + 23    42.000
 2 + (10 * 4)   42.000
3 * (7 + 7)     42.000

So, these limited tests yield the desired results.

You might wonder whether this code works correctly with nested parenthesized expressions. I originally thought, when I wrote this code, that it might malfunction and that I might have to change or add something to get nested parenthesized expressions right and properly balanced. It turns out that it works fine out of the box. For example, consider the following test code with relatively deeply nested parenthesized expressions:

for "(((2+3)*(5-2))-1)*3", "2 * ((4-1)*((3*7) - (5+2)))"  { 
    my $result = Calculator.parse($_, :actions(CalcActions));
    printf "%-30s %.3f\n", $/,  $result.made if $result;
}

The result is correct:

(((2+3)*(5-2))-1)*3            42.000
2 * ((4-1)*((3*7) - (5+2)))    84.000

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

Perl Weekly Challenge 142: Divisor Last Digit and Sleep Sort

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

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

Task 1: Divisor Last Digit

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

Write a script to find total count of divisors of $m having last digit $n.

Example 1:

Input: $m = 24, $n = 2
Output: 2

The divisors of 24 are 1, 2, 3, 4, 6, 8 and 12.
There are only 2 divisors having last digit 2 are 2 and 12.

Example 2:

Input: $m = 30, $n = 5
Output: 2

The divisors of 30 are 1, 2, 3, 5, 6, 10 and 15.
There are only 2 divisors having last digit 5 are 5 and 15.

Divisor Last Digit in Raku

We first generate all divisors of the input integer (including 1 and the input number itself, as these may end-up with the right digit), using a grep testing the divisibility of each number less than or equal to the input integer, and then use another grep to keep all divisors ending with the same digit as the other input integer.

use v6;

sub count_divisors (UInt $m, UInt $n) {
    my @divisors = grep {$m %% $_}, 1..$m;
    my $last-digit = substr $n, *-1;
    my @eligible-divisors = grep { $last-digit == substr $_, *-1 }, @divisors;
    return @eligible-divisors.elems;
}

for (24, 34), (24, 12), (30, 45) {
  say "$_ -> ", count_divisors $_[0], $_[1];
}

This program displays the following output:

$ raku ./div_last_digit.raku
24 34 -> 2
24 12 -> 2
30 45 -> 2

Divisor Last Digit in Perl

This is essentially a Perl port of the Raku program just above:

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

sub count_divisors {
    my ($m, $n) = @_;
    my @divisors = grep {$m % $_ == 0} 1..$m;
    my $last_digit = substr $n, -1, 1;
    my @eligible_divisors = grep { $last_digit == substr $_, -1, 1 } @divisors;
    return scalar @eligible_divisors;
}
for ([24, 34], [24, 12], [30, 45]) {
  say "@$_ -> ", count_divisors $_->[0], $_->[1];
}

This program displays the following output:

$ perl ./div_last_digit.pl
24 34 -> 2
24 12 -> 2
30 45 -> 2

Task 2: Sleep Sort

Another joke sort similar to JortSort suggested by champion Adam Russell.

You are given a list of numbers.

Write a script to implement Sleep Sort. For more information, please checkout this post.

The basic idea of the sleep sort is that you launch a thread (or a process) for each item in the array to be sorted. Each thread then waits (or “sleeps”) for an amount of time proportional to the value of the element for which it was created and finally prints this value. If things go right, the array item with the smallest value is printed first, then the next higher value, and so on until lastly the item with largest value, so that you eventually get the array items in ascending sorted order.

Sleep Sort in Raku

For each value in the input array, we start a promise. In the code for each promise, the thread is made to sleep for an amount of time proportional to the value (here, half the value) and then prints the value:

use v6;

await <6 8 1 12 2 14 5 2 1 0>.map: { start {sleep $_/2; .say} };

This scripts prints out the following output:

$ raku ./sleep-sort.raku
0
1
1
2
2
5
6
8
12
14

This nice post by Andrew Shitov provides a somewhat similar solution also using promises, together with quite a bit of further explanations.

Sleep Sort in Perl

The Perl solution is similar, but spawns processes using fork. The solution looks simple, but since I had not used fork for ages, it took me quite a while to get it to work properly.

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

while ($_ = shift and @ARGV >= 1) {
    last unless fork;
}
sleep $_;
say;
wait;

This script displays the following output:

$ perl sleep-sort.pl 5 7 3 4 1 2 9
1
2
3
4
5
7
9

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

Perl Weekly Challenge 141: Number Divisors and Like Numbers

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

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

Task 1: Number Divisors

Write a script to find lowest 10 positive integers having exactly 8 divisors.

Example:

24 is the first such number having exactly 8 divisors.
1, 2, 3, 4, 6, 8, 12 and 24.

This is quite straight forward. We can look at consecutive integers, count their factors, and stop when we reach ten integers having 8 divisors.

Number Divisors in Raku

We create an infinite list of integers (from 8 to infinity), and, for each such integer, call the has_8_divisors subroutine, which computes all factors of the input integer and returns True if it has eight divisors. This subroutine checks every integer between 1 and the input integer and filters out those that do not divide evenly the input number (using the Raku built-in infix %% divisibility operator).

use v6;

sub has_8_divisors (UInt $n) {
    my @divisors = grep {$n %% $_}, 1..$n;
    return @divisors.elems == 8;
}

my $count = 0;
for 8..Inf -> $m {
    say $m and $count++ if has_8_divisors $m;
    last if $count >= 10;
}

This script displays the following output:

$ raku ./eight-div.raku
24
30
40
42
54
56
66
70
78
88

It is interesting to notice that the first 10 integers having exactly eight divisors are all even. With a small change to the above program (changing the maximal value of $count), you could find out that the first odd such integer is the 13th one, 105.

Number Divisors in Perl

This is essentially a port to Perl of the above program:

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

sub has_8_divisors {
    my $n = shift;
    my @divisors = grep {$n % $_ == 0} 1..$n;
    return @divisors == 8;
}

my $count = 0;
for my $m (8..1_000_000) {
    say $m and $count++ if has_8_divisors $m;
    last if $count >= 10;
}

This script displays the following output:

$ perl ./eight-div.pl
24
30
40
42
54
56
66
70
78
88

Task 2: Like Numbers

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

Write a script to find total count of integers created using the digits of $m which is also divisible by $n.

Repeating of digits are not allowed. Order/Sequence of digits can’t be altered. You are only allowed to use (n-1) digits at the most. For example, 432 is not acceptable integer created using the digits of 1234. Also for 1234, you can only have integers having no more than three digits.

Example 1:

Input: $m = 1234, $n = 2
Output: 9

Possible integers created using the digits of 1234 are:
1, 2, 3, 4, 12, 13, 14, 23, 24, 34, 123, 124, 134 and 234.

There are 9 integers divisible by 2 such as:
2, 4, 12, 14, 24, 34, 124, 134 and 234.

Example 2:

Input: $m = 768, $n = 4
Output: 3

Possible integers created using the digits of 768 are:
7, 6, 8, 76, 78 and 68.

There are 3 integers divisible by 4 such as:
8, 76 and 68.

Like Numbers in Raku

In Raku, we use the built-in combinations method to generate all numbers with at most one digit less than the input integer that can be derived from the input number. We then filter out those which are not evenly divided by the other input integer. And finally print out the number of such integers.

use v6;

sub like_numbers (UInt $m, UInt $n) {
    my @digits = $m.comb;
    return grep { $_ %% $n }, 
        (@digits.combinations: 1..$m.chars-1)>>.join(''); 
}
for (1234, 2), (768, 4) -> $test {
    my @vals = like_numbers $test[0], $test[1];
    # say @vals; # -> [2 4 12 14 24 34 124 134 234]
    say "$test => ", @vals.elems;
}

This script displays the following output:

raku ./like-nums.raku
1234 2 => 9
768 4 => 3

Like Numbers in Perl

This is essentially a port to Perl of the above Raku program. The main difference is that we need to roll out our own combine recursive subroutine.

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

my @result;

sub combine {
    my $part_comb = shift;
    my @digits = @{$_[0]};
    my $max_size = $_[1];
    push @result, $part_comb unless $part_comb eq "";
    return if length $part_comb >= $max_size;
    for my $i (0..$#digits) {
        my $new_comb = $part_comb . $digits[$i];
        combine($new_comb, [ @digits[$i+1..$#digits]], $max_size);
    }
}
sub like_numbers {
    my $n = shift;
    my @digits = split //, shift;
    combine ("", [@digits], @digits - 1);
    return grep { $_ % $n == 0 } @result;
}
for my $test ( [2, 1234], [4, 768] ) {
    @result = ();
    my @vals = like_numbers $test->[0], $test->[1];
    # say "@vals"; # -> 12 124 134 14 2 234 24 34 4
    say "@$test => ", scalar @vals;
}

This script displays the following output:

$ perl  ./like-nums.pl
2 1234 => 9
4 768 4 => 3

Wrapping up

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

About laurent_r

user-pic I am the author of the "Think Perl 6" book (O'Reilly, 2017) and I blog about the Perl 5 and Raku programming languages.