# October 2021 Archives

## Perl Weekly Challenge 136: Two Friendly and Fibonacci Sequence

These are some answers to the Week 136 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 October 31, 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.

You are given 2 positive numbers, `\$m` and `\$n`.

Write a script to find out if the given two numbers are Two Friendly.

Two positive numbers, m and n are two friendly when gcd(m, n) = 2 ^ p where p > 0. The greatest common divisor (gcd) of a set of numbers is the largest positive number that divides all the numbers in the set without remainder.

Example 1:

``````Input: \$m = 8, \$n = 24
Output: 1

Reason: gcd(8,24) = 8 => 2 ^ 3
``````

Example 2:

``````Input: \$m = 26, \$n = 39
Output: 0

Reason: gcd(26,39) = 13
``````

Example 3:

``````Input: \$m = 4, \$n = 10
Output: 1

Reason: gcd(4,10) = 2 => 2 ^ 1
``````

In other words, the greatest common divisor of two friendly numbers needs to be a power of two. Or, there must be a power of two for which, when both integers are divided by this power of two, the results are co-primes.

### Two Friendly Numbers in Raku

Raku has a built-in gcd infix operator. So we just need to compute the GCD if the two input integers. If the GCD is 1 (numbers are co-primes) or less (one of the input integers was 0), then we return 0, as the integers are not two friendly numbers. (Note that it may be argued that 1 is a power of 2, i.e. 2 ^ 0, but I considered this to be a degenerate case, and that co-primes are not two-friendly; anyway, the task description is clear on the subject and specifies that “gcd(m, n) = 2 ^ p where p > 0”). Otherwise, we divide the GCD by two as long as the result is even. When we can no longer divide by two, the two input integers were two friendly numbers if the result of the final division is 1 (as the GCD was a power of two).

``````use v6;

sub is-friendly (Int \$i, Int \$j) {
my \$gcd = \$i gcd \$j;
return 0 if \$gcd <= 1;
\$gcd /= 2 while \$gcd %% 2;
return \$gcd == 1 ?? 1 !! 0;
}
for 8, 24, 26, 39, 4, 10, 7, 5, 18, 0 {
say "\$^a, \$^b => ", is-friendly \$^a, \$^b;
}
``````

Note that Raku can take two numbers at a time from the input list in the `for` loop at the bottom, because the loop uses two parameters, which is quite convenient. In this case, we used placeholder variables aka self-declared positional parameters (`\$^a` and `\$^b`), but it would also work just as well with formal declared loop parameters, such as:

``````for 8, 24, 26, 39, 4, 10, 7, 5, 18, 0 -> \$a, \$b {
say "\$a, \$b => ", is-friendly \$a, \$b;
}
``````

This program yields the following results for the built-in input test integers:

``````\$ raku ./friendly.raku
8, 24 => 1
26, 39 => 0
4, 10 => 1
7, 5 => 0
18, 0 => 0
``````

### Two Friendly Numbers in Perl

Just like in Raku, we divide the GCD by two as long as the result is even. When we can no longer divide by two, the two input integers were two friendly numbers is the result of the final division is 1. The main difference with Raku, though, is that Perl doesn’t have a built-in GCD function or operator. So we implement the `gcd` subroutine for that purpose, implementing a well-known method derived from the famous Euclidean algorithm.

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

sub gcd {
my (\$i, \$j) = @_;
return 0 if \$i < 1 or \$j < 1;
while (\$j) {
(\$i, \$j) = (\$j, \$i % \$j);
}
return \$i;
}
sub is_friendly {
my \$gcd = gcd \$_, \$_;
return 0 if \$gcd <= 1;
\$gcd /= 2 while \$gcd % 2 == 0;
return \$gcd == 1 ? 1 : 0;
}
for my \$pair ([8, 24], [26, 39], [4, 10], [7, 5], [18, 0]) {
say "@\$pair => ", is_friendly @\$pair;
}
``````

This program displays the following output:

``````\$ perl ./friendly.pl
8 24 => 1
26 39 => 0
4 10 => 1
7 5 => 0
18 0 => 0
``````

You are given a positive number `\$n`.

Write a script to find how many different sequences you can create using Fibonacci numbers where the sum of unique numbers in each sequence are the same as the given number.

Fibonacci Numbers: 1,2,3,5,8,13,21,34,55,89, …

Example 1:

``````Input:  \$n = 16
Output: 4

Reason: There are 4 possible sequences that can be created using Fibonacci numbers
i.e. (3 + 13), (1 + 2 + 13), (3 + 5 + 8) and (1 + 2 + 5 + 8).
``````

Example 2:

``````Input:  \$n = 9
Output: 2

Reason: There are 2 possible sequences that can be created using Fibonacci numbers
i.e. (1 + 3 + 5) and (1 + 8).
``````

Example 3:

``````Input:  \$n = 15
Output: 2

Reason: There are 2 possible sequences that can be created using Fibonacci numbers
i.e. (2 + 5 + 8) and (2 + 13).
``````

### Fibonacci Sequence in Raku

I do not see any way to solve this problem other than listing all possible sequences of Fibonacci numbers less than or equal to the target number and counting those sequence whose sum is equal to the target number. We first initialize a list (a global variable) of the first 16 Fibonacci numbers using the sequence `...` operator. The reason for doing this is that we don’t want to recompute the Fibonacci numbers for every input test integer. Of course, we would have to change this for input integers larger than 1597, but that’s good enough for our testing purpose.

Then, the `fib-seq` subroutine uses the built-in combinations method to generate all sequences of Fibonacci numbers and uses the builin `grep` and `sum` functions to keep the sequences whose sum is equal to the target input integer. And it returns the number of sequences matching this criterion.

Note that, although the task specification did not request that, I’ve decided to print out the matching sequences as this makes it much easier to check the result.

``````use v6;

my @fib = 1, 2, * + * ... * > 1000; # 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597

sub fib-seq (UInt \$n) {
my \$count = 0;
++\$count and .say for grep { \$_.sum == \$n }, @fib.grep({\$_ <= \$n }).combinations;
return \$count;
}
for 16, 9, 15, 89, 100 {
say "Number of sequences for \$_: ", fib-seq(\$_), "\n";
}
``````

This programs prints out the following output:

``````\$ raku ./main.raku
(3 13)
(1 2 13)
(3 5 8)
(1 2 5 8)
Number of sequences for 16: 4

(1 8)
(1 3 5)
Number of sequences for 9: 2

(2 13)
(2 5 8)
Number of sequences for 15: 2

(89)
(34 55)
(13 21 55)
(5 8 21 55)
(2 3 8 21 55)
Number of sequences for 89: 5

(3 8 89)
(1 2 8 89)
(3 8 34 55)
(1 2 3 5 89)
(1 2 8 34 55)
(3 8 13 21 55)
(1 2 3 5 34 55)
(1 2 8 13 21 55)
(1 2 3 5 13 21 55)
Number of sequences for 100: 9
``````

### Fibonacci Sequence in Perl

The Perl implementation is very similar to the Raku implementation, except that we need to code our own `sum` and `combine` subroutines to replace the equivalent Raku built-in methods.

Note that, as in Raku and although the task specification did not request that, I’ve decided to print out the matching sequences as this makes it much easier to check the result. Just comment out the penultimate code line of the `fib_seq` subroutine to avoid printing the sequences.

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

my @comb;
my @fib = qw /1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597/;

sub sum {
my \$sum = 0;
\$sum += \$_ for @_;
return \$sum;
}

sub combine {
my \$target = shift;
my \$count = shift;
my @out = @{\$_};
my @in  = @{\$_};
return if sum @out > \$target;
push @comb, [@out] and return if sum(@out) == \$target;
return if \$count == 0;
for my \$i (0..\$#in) {
combine (\$target, \$count - 1, [@out, \$in[\$i]], [@in[\$i+1..\$#in]]);
}
}

sub fib_seq {
my \$n = shift;
my @short_fib = grep { \$_ <= \$n } @fib;
my \$count =  scalar @short_fib;
@comb = ();
combine \$n, \$count, [], [@short_fib];
say "@\$_" for @comb;
return scalar @comb;
}

say "Number of sequences for \$_: ", fib_seq \$_ for 16, 9, 15, 89, 100;
``````

This program displays the following output:

``````\$ perl ./fib-seq.pl
1 2 5 8
1 2 13
3 5 8
3 13
Number of sequences for 16: 4
1 3 5
1 8
Number of sequences for 9: 2
2 5 8
2 13
Number of sequences for 15: 2
2 3 8 21 55
5 8 21 55
13 21 55
34 55
89
Number of sequences for 89: 5
1 2 3 5 13 21 55
1 2 3 5 34 55
1 2 3 5 89
1 2 8 13 21 55
1 2 8 34 55
1 2 8 89
3 8 13 21 55
3 8 34 55
3 8 89
Number of sequences for 100: 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 November 7, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

## Perl Weekly Challenge 135: Middle 3-Digits and Validate SEDOL

These are some answers to the Week 135 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 October 24, 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.

You are given an integer.

Write a script find out the middle 3-digits of the given integer, if possible otherwise throw sensible error.

Example 1:

``````Input: \$n = 1234567
Output: 345
``````

Example 2:

``````Input: \$n = -123
Output: 123
``````

Example 3:

``````Input: \$n = 1
Output: too short
``````

Example 4:

``````Input: \$n = 10
Output: even number of digits
``````

### Middle 3-Digits in Raku

This is pretty simple. We write a `mid-three` subroutine that returns an error message if the input number has an even number of digits or if it is too small (less than 3 digits). Once this is done, the subroutine finds the mid-point of the sting and returns the substring starting one digit earlier and ending one digit later.

``````sub mid-three (Int \$in is copy) {
\$in = abs(\$in);
my \$length = \$in.chars;
return "Even number of digits" if \$length %% 2;
return "Too short" if \$length < 3;
my \$mid-point = (\$length - 1) /2;
return substr(\$in, \$mid-point - 1, 3);
}
for <1234567 -123 1 10 -54321> -> \$n {
say "\$n -> ", mid-three \$n;
}
``````

This program displays the following output:

``````\$ raku ./mid-three.raku
1234567 -> 345
-123 -> 123
1 -> Too short
10 -> Even number of digits
-54321 -> 432
``````

### Middle 3-Digits in Perl

Again, we have a `mid_three` subroutine that returns an error message if the input number has an even number of digits or if it is too small (less than 3 digits). Once this is done, the subroutine finds the mid-point of the sting and returns the substring starting one digit earlier and ending one digit later.

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

sub mid_three {
my \$in = abs \$_;
my \$length = length \$in;
return "Even number of digits" unless \$length % 2;
return "Too short" if \$length < 3;
my \$mid_point = (\$length - 1) /2;
return substr(\$in, \$mid_point - 1, 3);
}
for my \$n (qw<1234567 -123 1 10 -54321>) {
say "\$n -> ", mid_three \$n;
}
``````

This program displays the following output:

``````\$ perl mid-three.pl
1234567 -> 345
-123 -> 123
1 -> Too short
10 -> Even number of digits
-54321 -> 432
``````

You are given 7-characters alphanumeric SEDOL.

Write a script to validate the given SEDOL. Print 1 if it is a valid SEDOL otherwise 0.

Example 1:

``````Input: \$SEDOL = '2936921'
Output: 1
``````

Example 2:

``````Input: \$SEDOL = '1234567'
Output: 0
``````

Example 3:

``````Input: \$SEDOL = 'B0YBKL9'
Output: 1
``````

### Validate SEDOL in Raku

The `sedol` subroutine returns 0 if the input string contains a vowel or if it not made of 6 alphanumerical characters followed by 1 digit. After these checks, it splits the input string into a sequence of 6 characters and 1 digit (presumably the check digit). It then populates a `%values` hash with the numeric values for the 10 digits and 26 letters. It then computes the weighted sum of the input sequence of 6 characters and then computes the checksum. If the checksum thus calculated is equal to the checksum found in the input string (the last digit), then we have a valid Sedol and the subroutine can return 1. Otherwise the subroutine return 0.

``````sub sedol( Str \$in ) {
return 0 if \$in  ~~ /<[AEIOU]>/;  # Vowels not allowed
return 0 unless \$in ~~ /^ <[0..9B..Z]>**6 <[0..9]> \$/; # 6 alphanumericals + 1 digit
my (\$sedol, \$check) = substr(\$in, 0, 6), substr(\$in, 6, 1);
my %values;
my \$count = 0;
for ( 0..9, 'A'..'Z').flat -> \$val {
%values{\$val} = \$count++;
}
my @weights = 1, 3, 1, 7, 3, 9;
my \$sum = [+] @weights Z* map {%values{\$_}}, \$sedol.comb;
my \$check_digit = (10 - \$sum % 10) % 10;
return 1 if \$check_digit == \$check;
0
}
for <456765 65AR345 2936921 1234567 B0YBKL9> -> \$s {
say "\$s: ", sedol(\$s);
}
``````

This program displays the following output:

``````\$ raku ./sedol.raku
456765: 0
65AR345: 0
2936921: 1
1234567: 0
B0YBKL9: 1
``````

### Validate SEDOL in Perl

This is essentially the same algorithm as in the Raku solution above: the `sedol` subroutine returns 0 if the input string contains a vowel or if it not made of 6 alphanumerical characters followed by 1 digit. After these checks, it splits the input string into a sequence of 6 characters and 1 digit (presumably the check digit). It then populates a `%values` hash with the numeric values for the 10 digits and 26 letters. It then computes the weighted sum of the input sequence of 6 characters and then computes the checksum. If the checksum thus calculated is equal to the checksum found in the input string (the last digit), then we have a valid Sedol and the subroutine can return 1. Otherwise the subroutine return 0.

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

sub sedol {
my \$in = shift;
return 0 if \$in  =~ /[AEIOU]/i;  # Vowels not allowed
return 0 unless \$in =~ /^[A-Z0-9]{6}[0-9]\$/; # 6 alphanumericals + 1 digit
my (\$sedol, \$check) = (substr(\$in, 0, 6), substr(\$in, 6, 1));
my %values;
my \$count = 0;
for my \$val ( 0..9, 'A'..'Z') {
\$values{\$val} = \$count++;
}
my @weights = (1, 3, 1, 7, 3, 9);
my \$sum = 0;
my @chars = split //, \$sedol;
for my \$i (0..5) {
\$sum += \$values{\$chars[\$i]} * \$weights[\$i];
}
my \$check_digit = (10 - \$sum % 10) % 10;
return 1 if \$check_digit == \$check;
0
}
for my \$s (qw<456765 65AR345 2936921 1234567 B0YBKL9>) {
say "\$s: ", sedol(\$s);
}
``````

This program displays the following output:

``````\$ perl  ./sedol.pl
456765: 0
65AR345: 0
2936921: 1
1234567: 0
B0YBKL9: 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 October 31, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

## Perl Weekly Challenge 134: Pandigital Numbers and Distinct Term Count

These are some answers for Week 134 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 October 17, 2021 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.

• Write a script to generate first 5 Pandigital Numbers in base 10.*

As per the https://en.wikipedia.org/wiki/Pandigital_number, it says:

``````A pandigital number is an integer that in a given base has among
its significant digits each digit used in the base at least once.
``````

In base 10, a pandigital number ought to have 10 digits. The first (smallest) pandigital numbers will start with the smallest digits upfront, except that the zero cannot be the first first digit, as it would disappear as non significant. So, to get the first pandigital number we need to start with 1, continue with 0 and then proceed the other digits in increasing order, which leads to 1023456789. The next pandigital number will have its two last digits swapped: 1023456798.

Since we need to find the first five pandigital numbers, they will all start with the sequence 1023456, with the three last digits being the permutations of 7, 8, and 9 in the proper increasing order. There are 6 permutations of three distinct digits, so that will be enough to find the first 5 pandigital numbers.

### Pandigital Numbers in Raku

Based on the explanations above, we can hard-code the first seven digits as `"1023456"` and compute the permutations of the last 3 digits:

``````use v6;

my \$start = "1023456";
my @ends = <7 8 9>.permutations[0..4]>>.join("");
say \$start ~ \$_ for @ends;
``````

This script displays the following output:

``````raku ./pandigital.raku
1023456789
1023456798
1023456879
1023456897
1023456978
``````

This script is so simple that we can easily turn it to a Raku one-liner:

``````\$ raku -e 'say "1023456" ~ \$_ for (7..9).permutations[0..4]>>.join'
1023456789
1023456798
1023456879
1023456897
1023456978
``````

### Pandigital Numbers in Perl

Based on the explanations in the task description section above, we can hard code the first seven digits as `"1023456"` and compute the permutations of the last 3 digits. For this, since we don’t like using external packages for coding challenges, we implement our own recursive `permute` subroutine.

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

my @permutations;

sub permute {
my (\$str, @vals) = @_;
if (scalar @vals == 0) {
push @permutations, \$str;
return;
}
permute("\$str" . \$vals[\$_], @vals[0..\$_-1], @vals[\$_+1..\$#vals]) for 0..\$#vals;
}
permute "", 7, 8, 9;
say "1023456" . \$_ for @permutations[0..4];
``````

This script displays the following output:

``````\$ perl ./pandigital.pl
1023456789
1023456798
1023456879
1023456897
1023456978
``````

## Task 2: Distinct Terms Count

You are given 2 positive numbers, `\$m` and `\$n`.

Write a script to generate multiplication table and display count of distinct terms.

Example 1:

``````Input: \$m = 3, \$n = 3
Output:

x | 1 2 3
--+------
1 | 1 2 3
2 | 2 4 6
3 | 3 6 9

Distinct Terms: 1, 2, 3, 4, 6, 9
Count: 6
``````

Example 2:

``````Input: \$m = 3, \$n = 5
Output:

x | 1  2  3  4  5
--+--------------
1 | 1  2  3  4  5
2 | 2  4  6  8 10
3 | 3  6  9 12 15

Distinct Terms: 1, 2, 3, 4, 5, 6, 8, 9, 10, 12, 15
Count: 11
``````

### Distinct Terms Count in Raku

There is nothing complex about this task. We need to loop over all values between 1 and `\$m` and all values between 1 and `\$n`, perform the multiplications and properly format the output. In addition, we use a SetHash to store the distinct computed terms, display them and count them.

``````use v6;

sub multiplication-table (Int \$m, Int \$n) {
my SetHash \$distinct;
say "x |", join " ", map {.fmt("%3d")}, 1..\$n;
for 1..\$m -> \$i {
my @res = map { \$i * \$_ }, 1..\$n;
\$distinct{\$_} = True for @res;
say "\$i |", join " ", map {.fmt("%3d")}, @res;
}
say "Distinct terms: ", \$distinct.keys.sort.join(" ");
say "Count: ", \$distinct.keys.elems;
}
multiplication-table(7, 5);
``````

This program displays the following output:

``````\$ raku ./distinct-terms.raku
x |  1   2   3   4   5
1 |  1   2   3   4   5
2 |  2   4   6   8  10
3 |  3   6   9  12  15
4 |  4   8  12  16  20
5 |  5  10  15  20  25
6 |  6  12  18  24  30
7 |  7  14  21  28  35
Distinct terms: 1 2 3 4 5 6 7 8 9 10 12 14 15 16 18 20 21 24 25 28 30 35
Count: 22
``````

### Distinct Terms Count in Perl

This is a port to Perl of the Raku program above. In Perl, we use a hash to store the distinct terms.

``````#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;

sub multiplication_table {
my (\$m, \$n) = @_;
my %distinct;
say "x |", join " ", map {sprintf "%3d", \$_} 1..\$n;
for my \$i (1..\$m) {
my @res = map \$i * \$_, 1..\$n;
\$distinct{\$_} = 1 for @res;
say "\$i |", join " ", map {sprintf "%3d", \$_} @res;
}
say "Distinct terms: ", join " ", sort keys %distinct;
say "Count: ", scalar keys %distinct;
}
multiplication_table(7, 5);
``````

Output:

``````\$ perl ./distinct-terms.pl
x |  1   2   3   4   5
1 |  1   2   3   4   5
2 |  2   4   6   8  10
3 |  3   6   9  12  15
4 |  4   8  12  16  20
5 |  5  10  15  20  25
6 |  6  12  18  24  30
7 |  7  14  21  28  35
Distinct terms: 1 10 12 14 15 16 18 2 20 21 24 25 28 3 30 35 4 5 6 7 8 9
Count: 22
``````

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

## Perl Weekly Challenge 133: Integer Square Roots and Smith Numbers

These are some answers for Week 133 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 October 10, 2021 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: Integer Square Root

You are given a positive integer `\$N`.

Write a script to calculate the integer square root of the given number.

Examples:

``````Input: \$N = 10
Output: 3

Input: \$N = 27
Output: 5

Input: \$N = 85
Output: 9

Input: \$N = 101
Output: 10
``````

The standard method for calculating the square root of a number is the Newton method, a.k.a. Newton-Raphson method. For an integer square root, we may use a variation of that method called Heron’s method.

### Integer Square Root in Raku

#### Using a Bisection Method

Before we implement the fairly fast standard method, let’s see what we can do with a bisection method, which is similar to a binary search algorithm on a list of values. If the input number is `\$N`, then we look at the `1..\$N` interval and find the midpoint `\$est` as the first estimate of the square root. If the square of the midpoint is larger than `\$N`, then we continue with the `1..\$est` interval, else we continue with the `\$est..\$N` interval. We continue until the range is smaller than or equal to 1.

This is an implementation of this idea:

``````use v6;

sub sqroot (Int \$a) {
# Bisection approach
my \$start = 1;
my \$end = \$a;
my \$est;
loop {
\$est = (\$start + \$end) div 2;
say "\tIntermediate values: \$start, \$est, and \$end";
my \$est-sq = \$est ** 2;
last if abs(\$end-\$start) <= 1;
if \$est ** 2 > \$a {
\$end = \$est;
} else {
\$start = \$est;
}
}
return \$est;
}
say "\$_\t", sqroot \$_ for 10, 27, 85, 101, 200_000_000;
``````

This program displays the following output:

``````\$ raku ./int_sqrt_bs.raku
Intermediate values: 1, 5, and 10
Intermediate values: 1, 3, and 5
Intermediate values: 3, 4, and 5
Intermediate values: 3, 3, and 4
10  3
Intermediate values: 1, 14, and 27
Intermediate values: 1, 7, and 14
Intermediate values: 1, 4, and 7
Intermediate values: 4, 5, and 7
Intermediate values: 5, 6, and 7
Intermediate values: 5, 5, and 6
27  5
Intermediate values: 1, 43, and 85
Intermediate values: 1, 22, and 43
Intermediate values: 1, 11, and 22
Intermediate values: 1, 6, and 11
Intermediate values: 6, 8, and 11
Intermediate values: 8, 9, and 11
Intermediate values: 9, 10, and 11
Intermediate values: 9, 9, and 10
85  9
Intermediate values: 1, 51, and 101
Intermediate values: 1, 26, and 51
Intermediate values: 1, 13, and 26
Intermediate values: 1, 7, and 13
Intermediate values: 7, 10, and 13
Intermediate values: 10, 11, and 13
Intermediate values: 10, 10, and 11
101 10
Intermediate values: 1, 100000000, and 200000000
Intermediate values: 1, 50000000, and 100000000
Intermediate values: 1, 25000000, and 50000000
Intermediate values: 1, 12500000, and 25000000
Intermediate values: 1, 6250000, and 12500000
Intermediate values: 1, 3125000, and 6250000
Intermediate values: 1, 1562500, and 3125000
Intermediate values: 1, 781250, and 1562500
Intermediate values: 1, 390625, and 781250
Intermediate values: 1, 195313, and 390625
Intermediate values: 1, 97657, and 195313
Intermediate values: 1, 48829, and 97657
Intermediate values: 1, 24415, and 48829
Intermediate values: 1, 12208, and 24415
Intermediate values: 12208, 18311, and 24415
Intermediate values: 12208, 15259, and 18311
Intermediate values: 12208, 13733, and 15259
Intermediate values: 13733, 14496, and 15259
Intermediate values: 13733, 14114, and 14496
Intermediate values: 14114, 14305, and 14496
Intermediate values: 14114, 14209, and 14305
Intermediate values: 14114, 14161, and 14209
Intermediate values: 14114, 14137, and 14161
Intermediate values: 14137, 14149, and 14161
Intermediate values: 14137, 14143, and 14149
Intermediate values: 14137, 14140, and 14143
Intermediate values: 14140, 14141, and 14143
Intermediate values: 14141, 14142, and 14143
Intermediate values: 14142, 14142, and 14143
200000000   14142
``````

This works well, but isn’t very efficient because our first estimates of the square root are quite far away from the actual root. We can improve the process significantly by starting the process with an estimate which is much closer to the target. For example, we can use `2 ** (((log2 N)/2).Int + 1)`, which is the least power of 2 larger than the square root of `N`, as our first estimate. This improved version may look like this:

``````sub sqroot (Int \$a) {
# Bisection approach
my \$start = 1;
my \$end = \$a;
my \$est = 2 ** (((log2 \$a)/2).Int + 1);
loop {
say "\tIntermediate values: \$start, \$est, and \$end";
last if abs(\$end-\$start) <= 1;
if \$est ** 2 > \$a {
\$end = \$est;
} else {
\$start = \$est;
}
\$est = (\$end + \$start) div 2;
}
return \$est;
}
say "\$_\t", sqroot \$_ for 85, 101, 200_000_000;
``````

This improved version displays the following output:

``````\$ raku ./int_sqrt_bs2.raku
Intermediate values: 1, 16, and 85
Intermediate values: 1, 8, and 16
Intermediate values: 8, 12, and 16
Intermediate values: 8, 10, and 12
Intermediate values: 8, 9, and 10
Intermediate values: 9, 9, and 10
85  9
Intermediate values: 1, 16, and 101
Intermediate values: 1, 8, and 16
Intermediate values: 8, 12, and 16
Intermediate values: 8, 10, and 12
Intermediate values: 10, 11, and 12
Intermediate values: 10, 10, and 11
101 10
Intermediate values: 1, 16384, and 200000000
Intermediate values: 1, 8192, and 16384
Intermediate values: 8192, 12288, and 16384
Intermediate values: 12288, 14336, and 16384
Intermediate values: 12288, 13312, and 14336
Intermediate values: 13312, 13824, and 14336
Intermediate values: 13824, 14080, and 14336
Intermediate values: 14080, 14208, and 14336
Intermediate values: 14080, 14144, and 14208
Intermediate values: 14080, 14112, and 14144
Intermediate values: 14112, 14128, and 14144
Intermediate values: 14128, 14136, and 14144
Intermediate values: 14136, 14140, and 14144
Intermediate values: 14140, 14142, and 14144
Intermediate values: 14142, 14143, and 14144
Intermediate values: 14142, 14142, and 14143
200000000   14142
``````

#### Using Heron’s Method

This method looks iteratively for a solution to the `x² - N = 0` equation. With Newton’s method which applies to general numbers (not only integers), if you start with almost any estimate, `p`, you can compute a better estimate `q` with the following formula: `q = (p + a / x) / 2`. Geometrically, this is like drawing a tangent to the curve at the point where the abscissa is the first estimate, and take the point where the tangent meets the `x` axis as the new estimate. As it can be seen, we quickly get closer to the searched value (the square root), which is where the curve intersects the x-axis. For integer square roots, we essentially need to replace standard rational division by Euclidean division (or integer division).

We use again `2 ** (((log2 N)/2).Int + 1)` as our first estimate (see above).

``````use v6;

sub sqroot (Int \$a) {
my \$x = 2 ** (((log2 \$a)/2).Int + 1);
my \$y;
loop {
say "\tIntermediate value: \$x";
\$y = (\$x + \$a div \$x) div 2;
last if abs(\$x - \$y) < 1;
\$x = \$y;
}
return \$y;
}
say "\$_\t", sqroot \$_ for 10, 27, 85, 101, 200_000_000;
``````

This program displays the following output:

``````\$ raku ./int_sqrt.raku
Intermediate value: 4
Intermediate value: 3
10  3
Intermediate value: 8
Intermediate value: 5
27  5
Intermediate value: 16
Intermediate value: 10
Intermediate value: 9
85  9
Intermediate value: 16
Intermediate value: 11
Intermediate value: 10
101 10
Intermediate value: 16384
Intermediate value: 14295
Intermediate value: 14142
200000000   14142
``````

As it can be seen, this method converges toward the root much faster than the bisection method.

### Integer Square Root in Perl

#### Using a Bisection Method

We again start with a bisection method. Please refer to the Bisection Method sub-section in the Raku section above for further explanations.

Perl doesn’t have a `div` Euclidean division operator, but it is easy to replace it with a combination of the standard division operator `/` and the `int` built-in function. Similarly, there is no built-in `log2` binary logarithm function in Perl, but we can easily do without it, since we have the following mathematical property: `log2 x = log x / log 2` (where `log` is the logarithm in any base, including the natural or the decimal logarithm).

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

sub sqroot {
# Bisection method
my \$c = shift;
my \$start = 1;
my \$end = \$c;
my \$est = 2 ** (int((log(\$c)/log(2))/2) + 1);
while (1) {
say "\tIntermediate values: \$start, \$est, and \$end";
last if abs(\$end-\$start) <= 1;
if (\$est ** 2 > \$c) {
\$end = \$est;
} else {
\$start = \$est;
}
\$est = int ((\$end + \$start) / 2);
}
return \$est;
}
say "\$_\t", sqroot \$_ for 85, 101, 200_000_000;
``````

This script displays the same output as the equivalent Raku script above, so, for brevity, we only show the beginning of the output:

``````\$ perl int_sqrt_BS.pl
Intermediate values: 1, 16, and 85
Intermediate values: 1, 8, and 16
Intermediate values: 8, 12, and 16
Intermediate values: 8, 10, and 12
Intermediate values: 8, 9, and 10
Intermediate values: 9, 9, and 10
85      9
Intermediate values: 1, 16, and 101
Intermediate values: 1, 8, and 16
Intermediate values: 8, 12, and 16
Intermediate values: 8, 10, and 12
Intermediate values: 10, 11, and 12
Intermediate values: 10, 10, and 11
101     10
...
``````

#### Using Heron’s Method

This is essentially a port to Perl of the Raku program above (please look there for further explanations):

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

sub sqroot {
my \$c = shift;  # my \$x = 2 ** (int((log(\$c)/log(2))/2) + 1);
my \$x = 2 ** (int((log(\$c)/log(2))/2) + 1);
my \$y;
while (1) {
say "\tIntermediate value: \$x";
\$y = int((\$x + \$c / \$x) / 2);
last if abs(\$x - \$y) < 1;
\$x = \$y;
}
return \$y;
}
say "\$_ -> ", sqroot \$_ for 10, 27, 85, 101, 200_000_000;
``````

Output:

``````\$ perl int_sqrt.pl
Intermediate value: 2
Intermediate value: 3
10 -> 3
Intermediate value: 4
Intermediate value: 5
27 -> 5
Intermediate value: 8
Intermediate value: 9
85 -> 9
Intermediate value: 8
Intermediate value: 10
101 -> 10
Intermediate value: 8192
Intermediate value: 16303
Intermediate value: 14285
Intermediate value: 14142
200000000 -> 14142
``````

Write a script to generate first 10 Smith Numbers in base 10.

According to https://en.wikipedia.org/wiki/Smith_number, in number theory, a Smith number is a composite number for which, in a given number base, the sum of its digits is equal to the sum of the digits in its prime factorization in the given number base.

### Smith Numbers in Raku

For this task, we use a `prime-factors` subroutine that performs a prime factorization of the input parameter. We then iterates over successive integers (except those that are prime) and push the integer on a `@result` array if the sum of its digits is equal to the sum of the digits of its prime factors

``````use v6;

my @primes = grep {.is-prime}, 1..*;

sub prime-factors (UInt \$num-in) {
my @factors;
my \$num = \$num-in;
for @primes -> \$div {
while (\$num %% \$div) {
push @factors, \$div;
\$num div= \$div;
}
return @factors if \$num == 1;
}
push @factors, \$num unless \$num == \$num-in;
return @factors;
}

my @result;
my \$count = 0;
for 1..* -> \$i {
next if \$i.is-prime; # we want composite numbers only
my @factors = prime-factors \$i;
push @result, \$i and ++\$count if (|@factors).comb.sum == \$i.comb.sum;
last if \$count >= 10;
}
say @result;
``````

This program displays the following output:

``````\$ raku ./smith_nums.raku
[4 22 27 58 85 94 121 166 202 265]
``````

### Smith Numbers in Perl

This is essentially the same algorithm as in Raku, except that we have to build our own `prime-factors` and `add_digits` subroutines and implement a loop to populate the `@primes` array.

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

my @primes = (2, 3, 5, 7);
my \$current = 9;
while (1) {
my \$prime = 1;
for my \$i (@primes) {
my \$i_sq = \$i * \$i;
last if \$i_sq > \$current;
\$prime = 0, last if \$current % \$i == 0;
}
push @primes, \$current if \$prime;;
\$current += 2;
last if \$current > MAX;
}
my %primes = map { \$_ => 1} @primes;

sub prime_factors {
my \$num = shift;
my \$origin_num = \$num;
my @factors;
for my \$div (@primes) {
while (\$num % \$div == 0) {
push @factors, \$div;
\$num /= \$div;
}
return @factors if \$num == 1;
}
push @factors, \$num unless \$num == \$origin_num;
return @factors;
}

my \$sum = 0;
for my \$i (@_) {
\$sum += \$_ for split //, \$i;
}
return \$sum;
}
# say join " ", prime_factors \$_ for grep {not exists \$primes{\$_}} 2..50;

my @result;
my \$count = 0;
my \$i = 2;
while (1) {
\$i++;
next if exists \$primes{\$i}; # we want composite numbers only
my @factors = prime_factors \$i;
last if \$count >= 10;
}
say "@result";
``````

The program displays the following output:

\$ perl ./smith_nums.pl 4 22 27 58 85 94 121 166 202 265

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

## Perl Weekly Challenge 132: Mirror Dates and Hash Join

These are some answers for Week 133 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 October 3, 2021 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.

You are given a date (yyyy/mm/dd).

Assuming, the given date is your date of birth. Write a script to find the mirror dates of the given date.

Dave Cross has built cool site that does something similar.

Assuming today is 2021/09/22.

Example 1:

``````Input: 2021/09/18
Output: 2021/09/14, 2021/09/26

On the date you were born, someone who was your current age, would have been born on 2021/09/14.
Someone born today will be your current age on 2021/09/26.
``````

Example 2:

``````Input: 1975/10/10
Output: 1929/10/27, 2067/09/05

On the date you were born, someone who was your current age, would have been born on 1929/10/27.
Someone born today will be your current age on 2067/09/05.
``````

Example 3:

``````Input: 1967/02/14
Output: 1912/07/08, 2076/04/30

On the date you were born, someone who was your current age, would have been born on 1912/07/08.
Someone born today will be your current age on 2076/04/30.
``````

Even though I did the task a few days later, I’ll also assume today is 2021/09/22 in order to be able to compare my results with the examples provided in the task description.

### Mirror Dates in Raku

Raku has rich built-in classes and/or roles (types) for dealing with dates. Here we only need to use the `Date` built-in data type. Date subtraction correctly computes the number of days between two dates, leading to very simple code:

``````use v6;

my \$today =  Date.new("2021-09-22");
for "2021-09-18", "1975-10-10", "1967-02-14" -> \$test {
my \$input = Date.new(\$test);
my \$time-diff = \$today - \$input;
say "Mirror dates for \$input are: ",
\$input - \$time-diff, " and ", \$today + \$time-diff;
}
``````

This program displays the following output:

``````\$ raku ./mirror-dates.raku
Mirror dates for 2021-09-18 are: 2021-09-14 and 2021-09-26
Mirror dates for 1975-10-10 are: 1929-10-27 and 2067-09-05
Mirror dates for 1967-02-14 are: 1912-07-08 and 2076-04-30
``````

### Mirror Dates in Perl

As usual, I don’t want, for a programming challenge, to use external modules. So I’ll be using only the core `Time::Local` module. This leads to some complexities compare to the Raku version. In particular, the program has a `compute_time` function to transform a date string into a standard Posix time stamp, and a `convert_date` function to perform the reciprocal conversion (time stamp to string). Besides that, the Perl program works the same way as the Raku program.

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

sub compute_time {
my (\$y, \$mo, \$d) = split /-/, shift;
my (\$h, \$mi, \$s) = (0, 0, 0);
\$mo -= 1; # months are 0-indexed
# \$y -= 1900; # timegm works better with real year
# say \$y;
return timegm(\$h, \$mi, \$s, \$d, \$mo, \$y);
}
sub convert_date {
my \$time_stamp = shift;
my (\$d, \$m, \$y) = (gmtime \$time_stamp)[3, 4, 5];
\$d = sprintf "%02d", \$d;
\$m = sprintf "%02d", \$m+1;
\$y += 1900;
return "\$y-\$m-\$d";
}

my \$today =  compute_time("2021-09-22");  # timestamp for the date arbitrarily chosen as "today"
for my \$test ("2021-09-18", "1975-10-10", "1967-02-14") {
my \$input = compute_time (\$test);
my \$time_diff = \$today - \$input;
my @output = (\$input - \$time_diff, \$today + \$time_diff);
say "Mirror dates for \$test are: ", convert_date(\$output), " and ", convert_date(\$output);
}
``````

This program displays the following output:

``````\$ perl ./mirror-dates.pl
Mirror dates for 2021-09-18 are: 2021-09-14 and 2021-09-26
Mirror dates for 1975-10-10 are: 1929-10-27 and 2067-09-05
Mirror dates for 1967-02-14 are: 1912-07-08 and 2076-04-30
``````

Write a script to implement Hash Join algorithm as suggested by https://en.wikipedia.org/wiki/Hash_join#Classic_hash_join.

1. For each tuple r in the build input R 1.1 Add r to the in-memory hash table 1.2 If the size of the hash table equals the maximum in-memory size: 1.2.1 Scan the probe input S, and add matching join tuples to the output relation 1.2.2 Reset the hash table, and continue scanning the build input R
2. Do a final scan of the probe input S and add the resulting join tuples to the output relation

Example:

``````Input:

@player_ages = (
[20, "Alex"  ],
[28, "Joe"   ],
[38, "Mike"  ],
[18, "Alex"  ],
[25, "David" ],
[18, "Simon" ],
);

@player_names = (
["Alex", "Stewart"],
["Joe",  "Root"   ],
["Mike", "Gatting"],
["Joe",  "Blog"   ],
["Alex", "Jones"  ],
["Simon","Duane"  ],
);

Output:

Based on index = 1 of @players_age and index = 0 of @players_name.

20, "Alex",  "Stewart"
20, "Alex",  "Jones"
18, "Alex",  "Stewart"
18, "Alex",  "Jones"
28, "Joe",   "Root"
28, "Joe",   "Blog"
38, "Mike",  "Gatting"
18, "Simon", "Duane"
``````

I don’t quite understand the relationship between hash join algorithm as described in the Wikipedia article and the example provided. So, I’ll simply try to replicate the behavior described in the example.

### Hash Join in Raku

The input is the two arrays of arrays (AoA), `@player_ages` and `@player_names`, provided in the task description example. We load `@player_names` into the `%names` hash of arrays (HoA). Then we loop over the other input array, `@player_ages` and look up the hash to complete the lines, which we eventually print out.

``````use v6;

my @player_ages =
[20, "Alex"  ],
[28, "Joe"   ],
[38, "Mike"  ],
[18, "Alex"  ],
[25, "David" ],
[18, "Simon" ];

my @player_names =
["Alex", "Stewart"],
["Joe",  "Root"   ],
["Mike", "Gatting"],
["Joe",  "Blog"   ],
["Alex", "Jones"  ],
["Simon","Duane"  ];

my %names;
for @player_names -> \$name {
push %names{\$name}, \$name;
}
for @player_ages -> \$pl_age {
my (\$age, \$first_name) = \$pl_age;
next unless %names{\$first_name}:exists;
# say "\$age  \$first_name";
for %names{\$first_name}[] -> \$name {
say "\$age \$first_name \$name";
}
}
``````

This script displays the following output:

``````raku ./hash-join.raku
20 Alex Stewart
20 Alex Jones
28 Joe Root
28 Joe Blog
38 Mike Gatting
18 Alex Stewart
18 Alex Jones
18 Simon Duane
``````

### Hash Join in Perl

The Perl version is essentially a port to Perl of the Raku version above. Please refer to the explanations above if needed.

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

my @player_names = (
["Alex", "Stewart"],
["Joe",  "Root"   ],
["Mike", "Gatting"],
["Joe",  "Blog"   ],
["Alex", "Jones"  ],
["Simon","Duane"  ],
);

my %names;
for my \$name (@player_names) {
push @{\$names{\$name->}}, \$name->;
}
for my \$pl_age (@player_ages) {
my (\$age, \$first_name) = @\$pl_age;
next unless exists \$names{\$first_name};
for my \$name (@{\$names{\$first_name}}) {
say "\$age \$first_name \$name";
}
}
``````

This program displays the following output:

``````\$ perl  ./hash-join.pl
20 Alex Stewart
20 Alex Jones
28 Joe Root
28 Joe Blog
38 Mike Gatting
18 Alex Stewart
18 Alex Jones
18 Simon Duane
``````

## 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 October 10, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can. I am the author of the "Think Perl 6" book (O'Reilly, 2017) and I blog about the Perl 5 and Raku programming languages.