# January 2022 Archives

## Perl Weekly Challenge 149: Fibonacci Digit Sum and Largest Square

These are some answers to the Week 149 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 30, 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: Fibonacci Digit Sum

Given an input `\$N`, generate the first `\$N` numbers for which the sum of their digits is a Fibonacci number.

Example:

``````f(20)=[0, 1, 2, 3, 5, 8, 10, 11, 12, 14, 17, 20, 21, 23, 26, 30, 32, 35, 41, 44]
``````

### Fibonacci Digit Sum in Raku

We first populate a Set (for fast look-up) with the Fibonacci numbers up to 1000. Note that we could choose a much smaller maximum value, but it doesn’t cost much and it will work with very large sequences.

To generate the Fibonacci numbers, we use the sequence operator, in which we provide the first two numbers of the Fibonacci sequence and a formula (`* + *`) to compute a Fibonacci number from the two previous ones. The last part of the code line is the stopping condition. This idiomatic construction makes the code very concise and fast. This is an example in a Raku one-liner:

``````\$ raku -e 'say 0, 1, * + * ...^  * > 100'
(0 1 1 2 3 5 8 13 21 34 55 89)
``````

Then, we use the gather / take construct to loop over successive integers and store those satisfying the criteria, and we stop when we reach the limit.

``````sub MAIN (Int \$max = 20) {       # 20: default input value
my \$fibo = set(0, 1, * + * ...^  * > 1000);
my \$count = 0;
my @numbers = gather {
for 0 .. Inf -> \$num {
if \$num.comb.sum (elem) \$fibo {
take \$num;
\$count++;
last if \$count >= \$max;
}
}
}
say @numbers;
}
``````

This script displays the following output:

``````\$ raku ./fib_digit_sum.raku
[0 1 2 3 5 8 10 11 12 14 17 20 21 23 26 30 32 35 41 44]

\$ raku ./fib_digit_sum.raku 25
[0 1 2 3 5 8 10 11 12 14 17 20 21 23 26 30 32 35 41 44 49 50 53 58 62]
``````

### Fibonacci Digit Sum in Perl

The Perl solution follows essentially the same ideas as the Raku implementation, except that we use a plain `while` loop (instead of a sequence) to generate the Fibonacci numbers and we store them in a hash instead of a set for fast look-up.

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

sub fib_digit_sum {
my \$max = shift;
my @fib = (0, 1);
my \$count = 1;
while (\$count < 100) {
push @fib, \$fib[-1] + \$fib[-2];
\$count ++;
}
my %fibo = map { \$_ => 1 } @fib;
my @numbers;
my \$count_result = 0;
my \$i = 0;
while (\$count_result < \$max) {
my \$sum = 0;
\$sum += \$_ for split //, \$i;
if (exists \$fibo{\$sum}) {
push @numbers, \$i;
\$count_result++;
}
\$i++
}
say "@numbers";
}

fib_digit_sum(shift);
``````

This program displays the following output:

``````\$ perl ./fib_digit_sum.pl 20
0 1 2 3 5 8 10 11 12 14 17 20 21 23 26 30 32 35 41 44

\$ perl ./fib_digit_sum.pl 50
0 1 2 3 5 8 10 11 12 14 17 20 21 23 26 30 32 35 41 44 49 50 53 58 62 67 71 76 80 85 94 100 101 102 104 107 110 111 113 116 120 122 125 131 134 139 140 143 148 152
``````

Given a number base, derive the largest perfect square with no repeated digits and return it as a string. (For base>10, use ‘A’..‘Z’.)

Example:

``````f(2)="1"
f(4)="3201"
f(10)="9814072356"
f(12)="B8750A649321"
``````

Note that any program that I can think of for solving this task is bound to become very slow for large bases (especially some of them such as 13 in the case of the programs below).

### Largest Square in Raku

We start with the largest number that can be expressed in `\$base` digits in the given `\$base`. We compute `largest_root`, the integer part of the root of that number. Then we iterate down one by one from `largest_root` and check whether the square of each such number has no duplicate digit when expressed in the input base.

``````sub largest (\$base) {
my \$largest_num = \$base ** \$base - 1;
my \$largest_root = \$largest_num.sqrt.Int;
for (1..\$largest_root).reverse -> \$i {
my \$sq = \$i².base(\$base);
next if \$sq.chars != \$sq.comb.Set;
say "f(\$base) = \$sq" and last;
}
}
for 1..14 -> \$test { largest \$test }
``````

This program displays the following output:

``````\$ raku ./largest_sq.raku
f(2) = 1
f(3) = 1
f(4) = 3201
f(5) = 4301
f(6) = 452013
f(7) = 6250341
f(8) = 47302651
f(9) = 823146570
f(10) = 9814072356
f(11) = A8701245369
f(12) = B8750A649321
f(13) = CBA504216873
f(14) = DC71B30685A924
``````

### Largest Square in Perl

This is essentially the same idea in Perl. We use two helper subroutines: `has_unique_digits` to discard squares having duplicate digits (using a hash), and `base_to_b` to convert a number into a string representing that number in the given base.

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

sub base_to_b {
my (\$n, \$b) = @_;
my \$s = "";
while (\$n) {
\$s .= ('0'..'9','A'..'Z')[\$n % \$b];
\$n = int(\$n / \$b);
}
scalar(reverse(\$s));
}

sub has_unique_digits {
my \$in = shift;
my %seen = map { \$_ => 1 } split //,  \$in;
return length \$in == scalar keys %seen;
}

sub largest {
my \$base = shift;
my \$largest_num = \$base ** \$base - 1;
my \$largest_root = int sqrt \$largest_num;
for my \$i ( reverse 1..\$largest_root) {
my \$sq = base_to_b (\$i*\$i, \$base);
next unless has_unique_digits \$sq;
say "f(\$base) = \$sq" and last;
}
}

largest \$_ for 1..14;
``````

This script displays the following output:

``````\$ perl ./largest_sq.pl
f(2) = 1
f(3) = 1
f(4) = 3201
f(5) = 4301
f(6) = 452013
f(7) = 6250341
f(8) = 47302651
f(9) = 823146570
f(10) = 9814072356
f(11) = A8701245369
f(12) = B8750A649321
f(13) = CBA504216873
f(14) = DC71B30685A924
``````

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

## Perl Weekly Challenge 148: Eban Numbers and Cardano Triplets

These are some answers to the Week 148 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 23, 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.

Write a script to generate all Eban Numbers <= 100.

*An Eban number is a number that has no letter ‘e’ in it when the number is spelled in English (American or British).

Example:

``````2, 4, 6, 30, 32 are the first 5 Eban numbers.
``````

The task asks us to list the Eban integers smaller than or equal to 100. To start with, 100 (“one hundred”) has two ‘e’, so it is not an Eban number. So we can limit our search to all Eban Numbers < 100, so that we can limit our search to integers with one or two digits.

For the single-digit integers and for the second digit of integers with two digits, we need to exclude: 1,3,5,7,8,and 9. For the first digit of two-digit integers (pronounced eleven, twelve, xxxxteen, twenty, thirty, etc. in English), wee need to exclude: 1x, 2x, 7x, 8x, 9x.

### Eban Numbers in Raku

Implementing the exclusion rules detailed above is fairly easy with two regexes:

``````my @ebans = grep { ! /<>\$/ and ! /<>\d/ }, 1..99;
say @ebans;
``````

This script displays the following output:

``````\$ raku ./eban.raku
[2 4 6 30 32 34 36 40 42 44 46 50 52 54 56 60 62 64 66]
``````

This script is so simple that we can make it a Raku one-liner:

``````raku -e 'say grep { ! /<>\$/ and ! /<>\d/ }, 1..99;'
(2 4 6 30 32 34 36 40 42 44 46 50 52 54 56 60 62 64 66)
``````

### Eban Numbers in Perl

We can implement the same exclusion rules in Perl:

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

my @ebans = grep { ! /\$/ and ! /\d/ } 1..99;
say "@ebans";
``````

This script displays the following output:

``````\$ perl ./eban.pl
2 4 6 30 32 34 36 40 42 44 46 50 52 54 56 60 62 64 66
``````

This can also be a Perl one-liner:

``````\$ perl -E 'say join " ", grep { ! /\$/ and ! /\d/ } 1..99;'
2 4 6 30 32 34 36 40 42 44 46 50 52 54 56 60 62 64 66
``````

Write a script to generate first 5 Cardano Triplets.

A triplet of positive integers (a,b,c) is called a Cardano Triplet if it satisfies the below condition. Example:

``````(2,1,5) is the first Cardano Triplets.
``````

In order to be able to generate the 5 first Cardano triplets, we would need to clarify what first means. In other words, we would need to establish an order relation on the Cardano triplets. Such order could be any of many things: order the triplets in accordance with the first integer of the triplet (a), or the second (b), or the third (c). It could also be the sum of the 3 triplets. Or some weighted average. Whatever. I will simply list the 5 first triplets that I find, which is as valid an order as any other.

### Cardano Triplets in Raku

We implement a subroutine, `is-cardano-triplet`, to find whether a triplet of integers satisfies the criteria for Cardano triplets. Here we encountered an unexpected difficulty: the exponentiation operator (`**`) returns “Not a number” (`NaN`) when the base is negative and the power a (non-integer) rational number:

``````say (-2) ** (1/3);    # NaN
``````

I don’t understand why, as I believe that this is a perfectly valid mathematical operation. I would definitely understand such a result for the square root of a negative number, but I don’t for the cubic root. The scientific calculator on my mobile phone and Excel both return proper values with such input.

In order for the above equation to hold, the second term has to be negative, as the first term will always be a positive number larger than 1. So, the subroutine returns false if the second term is positive. Then we can compute the cubic root of the absolute value of the second term, and change the addition of the two terms with a subtraction. In addition, we need to use the `=~=` approximately-equal operator to compare floating point numbers with an integer as 1.

``````use v6;
constant MAX = 5;

sub is-cardano-triplet (\a, \b, \c) {
return False if a - b * c.sqrt > 0;
my \$val = ((a + b * c.sqrt) ** (1/3)) - ((- a + b * c.sqrt) ** (1/3));
return \$val =~= 1
}

my @values = 1..100;
my \$count = 0;
OUT: for @values -> \$i {
for @values -> \$j {
for @values -> \$k {
if is-cardano-triplet \$i, \$j, \$k {
say "\$i \$j \$k";
\$count++;
last OUT if \$count >= MAX;
}
}
}
}
say "Duration: ", now - INIT now;
``````

This program displays the following output:

``````\$ raku ./cardano.raku
2 1 5
5 1 52
5 2 13
8 3 21
11 4 29
Duration: 6.621876
``````

We have here used the first 100 integers as input. If we use integers between 1 and 200, we find another triplet with 8 as the first integer: `8, 1, 189`. But again, we have no special order, we just take the first triplets that we find.

### Cardano Triplets in Perl

This is essentially a port to Perl of the Raku program above. Just like in Raku, the exponentiation operator (`**`) returns “Not a number” (`NaN`) when the base if negative and the power a (non-integer) rational number. So we use the same method to work around this limitation. Also, since Perl does not have an approximately-equal (`=~=`) operator, we implement it manually: we check that the absolute value of the difference between the equation result and 1 is less than a given very small value (set here to 0.000001).

``````use strict;
use warnings;
use feature "say";
use constant MAX => 5;

sub is_cardano_triplet {
my (\$a, \$b, \$c) = @_;
return 0 if \$a - \$b * sqrt(\$c) > 0;
my \$val = ((\$a + \$b * sqrt(\$c)) ** (1/3)) - ((- \$a + \$b * sqrt(\$c)) ** (1/3));
# say \$val;
return abs(\$val - 1) < 0.000001;
}

my @values = 1..100;
my \$count = 0;
OUT: for my \$i (@values) {
for my \$j (@values) {
for my \$k (@values) {
if (is_cardano_triplet \$i, \$j, \$k) {
say "\$i \$j \$k";
\$count++;
last OUT if \$count >= MAX;
}
}
}
}
``````

This program displays the following output:

``````\$ time perl cardano.pl
2 1 5
5 1 52
5 2 13
8 3 21
11 4 29

real    0m0,175s
user    0m0,108s
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 January 30, 2022. And, please, also spread the word about the Perl Weekly Challenge if you can.

## Perl Weekly Challenge 147: Truncatable Primes and Pentagon Numbers

These are some answers to the Week 147 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 16, 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.

Write a script to generate first 20 left-truncatable prime numbers in base 10.

In number theory, a left-truncatable prime is a prime number which, in a given base, contains no 0, and if the leading left digit is successively removed, then all resulting numbers are primes.

Example:

``````9137 is one such left-truncatable prime since 9137, 137, 37 and 7 are all prime numbers.
``````

### Truncatable Prime in Raku

We first build an infinite lazy list (`@el-primes`) of primes with no 0 digit. For each integer in the list, we then try to truncate the left-most digit and check whether the truncated number is prime, and so one until we get to the last digit. The process stops when 20 such primes have been generated.

``````my @truncatables;
my \$count = 0;
my @el-primes = grep {.is-prime and not /0/}, 2..Inf;
for @el-primes -> \$candidate {
my \$length = \$candidate.chars;
my \$is-truncatable = True;
for 1..\$length -> \$i {
my \$truncated = substr \$candidate, \$length - \$i;
\$is-truncatable = False, last unless \$truncated.is-prime;
}
if \$is-truncatable {
push @truncatables, \$candidate;
\$count++;
}
last if \$count >= 20;
}
say @truncatables;
``````

This program displays the following output:

``````raku ./truncatable.raku
[2 3 5 7 13 17 23 37 43 47 53 67 73 83 97 113 137 167 173 197]
``````

### Truncatable Prime in Perl

This Perl program is based on essentially the same idea as the Raku implementation, except that we build a hash of primes along the way. We need to check primality only when we meet a new number the first time: for the truncated numbers, we simply check their primality by looking up into the hash.

``````use strict;
use warnings;
use feature "say";
use constant MAX => 20;

my @primes = (2, 3, 5);
my %primes_h = map {\$_ => 1} @primes;
my @truncatables = @primes;;
my \$candidate = \$primes[-1];
my \$count = scalar @truncatables;;
while (\$count < MAX) {
\$candidate += 2;
my \$not_prime = 0;
next if \$candidate =~ /0/;
my \$sq_cand = sqrt \$candidate;
for my \$i (@primes) {
\$not_prime = 1, last unless \$candidate % \$i;
last if \$i > \$sq_cand;
}
next if \$not_prime;
push @primes, \$candidate;
\$primes_h{\$candidate} = 1;
# now check if truncatable prime
my \$length = length \$candidate;
my \$is_truncatable = 1;
for my \$i (1..\$length) {
my \$truncated = substr \$candidate, \$length - \$i;
\$is_truncatable = 0, last unless exists \$primes_h{\$truncated};
}
if (\$is_truncatable) {
push @truncatables, \$candidate;
\$count++;
}
}
say "@truncatables";
``````

This program displays the following output:

``````\$ perl  ./truncatable.pl
2 3 5 7 13 17 23 37 43 47 53 67 73 83 97 113 137 167 173 197
``````

### Truncatable Prime in Ring

I continue here my exploration of Ring, a quite recent programming language. The program below is a port to Ring of the Perl program above.

``````max = 20
primes = [2, 3, 5]
primes_h = []
count = len(primes)
for i = 1 to count
primes_h[string(primes[i])] = i
next
truncatables = primes
candidate = primes[count]
while count < max
candidate += 2
not_prime = false
pos = substr(string(candidate), "0")
if pos > 0 loop ok
sq_cand = floor(sqrt(candidate))
for i in primes
if candidate % i = 0
not_prime = true
exit
ok
if i > sq_cand exit ok
next
if not_prime loop ok
primes_h[string(candidate)] = 1
// We've found a prime, now check if truncatable prime
length = len(string(candidate))
is_truncatable = true
for i = 1 to length
truncated = right(string(candidate), i)
if isnull(primes_h[truncated])
is_truncatable = false
exit
ok
next
if is_truncatable
count += 1
ok

end
for val in truncatables see "" + val + " " next
see " " + nl
``````

Output:

``````\$ ring ./truncatable.ring
2 3 5 7 13 17 23 37 43 47 53 67 73 83 97 113 137 167 173 197
``````

Write a script to find the first pair of Pentagon Numbers whose sum and difference are also a Pentagon Number.

Pentagon numbers can be defined as P(n) = n(3n - 1)/2.

Example:

The first 10 Pentagon Numbers are: 1, 5, 12, 22, 35, 51, 70, 92, 117 and 145.

``````P(4) + P(7) = 22 + 70 = 92 = P(8)
but
P(4) - P(7) = |22 - 70| = 48 is not a Pentagon Number.
``````

### Pentagon Numbers in Raku

We’ve decided to use the built-in combinations method to generate the pairs of pentagon numbers. Note that we cannot use an infinite list of pentagon numbers because the `combinations` routine cannot operate on an infinite list. So I just tried various increasing values for the `\$max` variable until I obtained a result satisfying the criteria. Note that I use a `%penta` hash to store the pentagon values, so the verifying whether and sum and the difference values are pentagon number is just a matter of a fast hash lookup.

``````my \$max = 4000;
my @pentanums = map { (3 * \$_² - \$_)/2 }, 1..\$max;
my %penta = map {@pentanums[\$_] => \$_+1}, 0..\$max-1;
for @pentanums.combinations(2) -> \$comb {
next unless %penta{\$comb.sum}:exists;
next unless %penta{\$comb-\$comb}:exists;
say \$comb, " = Pentagon numbers N° %penta{\$comb} and %penta{\$comb}";
say "Sum is ", \$comb.sum, " (Pentagon number ", %penta{\$comb.sum}, ")";
say "Difference is ", \$comb-\$comb, " (Pentagon number ", %penta{\$comb-\$comb}, ")";
last;
}
say now - INIT now, " seconds";
``````

This script displays the following output:

``````raku ./pentanums.raku
(1560090 7042750) = Pentagon numbers N° 1020 and 2167
Sum is 8602840 (Pentagon number 2395)
Difference is 5482660 (Pentagon number 1912)
101.7166579 seconds
``````

This program is relatively slow (101 seconds execution time). I found that using two nested loops (as in the Perl program below) rather than the `combinations` routine make the program at least 20 times faster (only a few seconds). So it seems that the `combinations` routine is quite slow. This is a bit unfortunate as `combinations` is really useful and makes the code simpler and cleaner. I still prefer to present this version, but if you need better performance, then use two nested loops as in the Perl implementation below.

### Pentagon Numbers in Perl

This is essentially the same idea as the Raku program above. However, as mentioned above, we don’t have `combinations` routine in Perl, so we use two nested loops to generate all the combinations. The advantage is that this runs much faster.

``````use strict;
use warnings;
use feature "say";
use constant MAX => 4000;

my @pentanums = map { \$_ * (3 * \$_ - 1)/2 } 1..MAX;
my %penta_h = map {\$pentanums[\$_] => \$_+1 } 0..MAX-1;
# say Dumper \%penta_h;

OUTER: for my \$i (0..MAX-1) {
for my \$j (\$i+1..MAX-1) {
my \$sum = \$pentanums[\$i] + \$pentanums[\$j];
next unless exists \$penta_h{\$sum};
my \$diff = \$pentanums[\$j] - \$pentanums[\$i];
next unless exists \$penta_h{\$diff};
say "First pair of pentagon numbers is \$pentanums[\$i] (rank ", \$i+1, ") and \$pentanums[\$j] (rank ", \$j+1, ")";
say "Sum is \$sum (rank \$penta_h{\$sum}) and difference is \$diff (rank \$penta_h{\$diff})";
last OUTER;
}
}
``````

This program displays the following output:

``````\$ time perl  ./pentanums.pl
First pair of pentagon numbers is 1560090 (rank 1020) and 7042750 (rank 2167)
Sum is 8602840 (rank 2395) and difference is 5482660 (rank 1912)

real    0m2,043s
user    0m1,703s
sys     0m0,108s
``````

### Pentagon Numbers in Ring

Again a port to Ring of the Perl implementation:

``````max = 3000
pentanums = []
for i = 1 to max
add (pentanums,  i * (3 * i - 1) / 2)
next
// see pentanums + nl
penta_h = []
for i = 1 to max
penta_h[ string(pentanums[i])] = i
next
for i = 1 to max
for j = i+1 to max
diff = pentanums[j] - pentanums[i]
diff_s = string(diff)
if isnull(penta_h[diff_s]) loop ok
sum = pentanums[i] + pentanums[j]
sum_s = string(sum)
if isnull(penta_h[sum_s]) loop ok
see "" + diff + " " + sum + " " + pentanums[i] + " " + pentanums[j] + nl
next
next
``````

Output:

``````\$ ring ./pentanums.ring
5482660 8602840 1560090 7042750
``````

### Pentagon Numbers in Julia

``````max = 4000
pentanums = map((x) -> Int(x * (3 * x -1)/2), 1:max)
penta_h = Dict(map((x) -> Int(x * (3 * x -1)/2) => x, 1:max))
for i in 1:4000-1
for j in (i + 1):4000-1
sum = pentanums[i] + pentanums[j]
continue
end
diff = pentanums[i] - pentanums[j]
# if (haskey(penta_h, Int(diff)) == 0)
#    continue
# end
println(i, " ", j, " ", pentanums[i], " ", pentanums[j], " ", sum)
end
end
``````

Output:

``````\$ julia pentanums.jl
Indices 1020 and 2167 ; Pentanums: 1560090 7042750; Sum: 8602840; Diff: 5482660
1020 2167
``````

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

## Perl Weekly Challenge 146: Prime Numbers and Fraction Tree

These are some answers to the Week 146 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 9, 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: 10001st Prime Number

Write a script to generate the 10001st prime number.

### 10001st Prime Number in Raku

Raku has a fast is-prime subroutine or method, using the Miller-Rabin algorithm, to test whether a integer is prime. We can just generate an infinite (lazy) list of prime numbers and look for the 10000st one.

``````use v6;

my @primes = grep { .is-prime }, (1, 2, 3, -> \$a { \$a + 2} ...Inf);
say @primes[10001 - 1];  # Subtract 1 because the array starts at 0
``````

This script displays the following output:

``````\$ raku ./10001prime.raku
104743
``````

The Raku script is so simple that it can be implemented as a short Raku one-liner:

``````\$ ./raku -e 'say (grep { .is-prime }, 1..Inf)'
104743
``````

### 10001st Prime Number in Perl

Since Perl doesn’t have a built-in `is-prime` subroutine, we implement our own. As finding the first 10001 primes is an intensive computation, we implement three performance optimizations compared to the naive brute-force solution: first, with the exception of 2, we only check odd integers. Second, we limit the tested divisors to the square root of the integer being checked. Finally, rather than testing all possible divisors, we test only the primes that we have already found. With these three optimizations, the script runs in less than 0.2 second, much faster than I expected.

``````use strict;
use warnings;
use feature "say";
use constant MAX => 10_001;

sub primes {
my \$max = shift;
my @primes = (2, 3, 5);
my \$count = 3;
my \$candidate = \$primes[-1];
while (\$count <= \$max) {
\$candidate += 2;
my \$not_prime = 0;
my \$sq_cand = sqrt \$candidate;
for my \$i (@primes) {
\$not_prime = 1, last unless \$candidate % \$i;
last if \$i > \$sq_cand;
}
next if \$not_prime;
push @primes, \$candidate;
\$count ++;
}
return \$primes[\$max-1];
}
my \$p = primes(MAX);
say "\$p";
``````

This script displays the following output:

``````\$ time perl ./10001prime.pl
104743

real    0m0,192s
user    0m0,124s
sys     0m0,077s
``````

### 10001st Prime Number in Ring

I continue my exploration of Ring, a recent programming language (the first version was issued in 2016). The Ring implementation below is essentially a port of the Perl program above (with same performance optimizations):

``````p = primes(10001)
see p + nl

func primes max
primes = [2, 3, 5]
count = len(primes)
candidate = primes[count]
while count < max
candidate += 2
is_prime = True
sqrt_cand = sqrt(candidate)
for i in primes
if candidate % i = 0
is_prime = False
exit
ok
if i > sqrt_cand exit ok
next
if is_prime
count ++
ok
end
return primes[max]
``````

This program displays the following output:

``````\$ ring ./10001prime.ring
104743
``````

Note that Ring lists start with subscript 1, so we use index 10001 for finding the 10001 ptime number.

### 10001st Prime Number in Julia

``````function getprimes(max)
primes = [2, 3, 5]
count = 3
candidate = 5
while (count <= max)
candidate += 2
not_prime = false
sq_cand = sqrt(candidate)
for i in primes
if (candidate % i == 0)
not_prime = true
break
end
i > max && break
end
not_prime && continue
push!(primes, candidate)
count += 1
end
end

p = getprimes(10001)
println(p)
``````

This program displays the following output:

``````\$ julia 10001prime.jl
104743
``````

## Task 2: Curious Fraction Tree

Consider the following Curious Fraction Tree: You are given a fraction, member of the tree created similar to the above sample.

Write a script to find out the parent and grandparent of the given member.

Example 1:

``````Input: \$member = '3/5';
Output: parent = '3/2' and grandparent = '1/2'
``````

Example 2:

``````Input: \$member = '4/3';
Output: parent = '1/3' and grandparent = '1/2'
``````

The first problem is to understand how this tree is constructed.

Each fraction has two children. It is easy to see that the left child is always a number smaller than 1 and the right child is always a number larger than 1. But how are the values generated?

Well, it is probably not so difficult to find out, but I must confess that I did not try very hard to find the constructing rules, but found them on the Curious Fraction Tree Web page. They are explained in this diagram: In other words, we have the following rules:

• For any node, the left child is less than 1 et the right child larger than 1;
• For node `a/b`, left child is `a/(a+b)` and right node is `(a+b)/b`.

From these two rules, it is easy to derive the reciprocal rules for finding the parent of a node:

• For a node `x/y` with a fraction less than 1, the parent is `x/(y-x)`;
• For a node `x/y` with a fraction larger than 1, the parent is `(x-y)/x`.

It is now very easy to implement these rules in various programming languages.

There is, however, one little last problem. The task specifications do not tell us what to do about invalid input. For example, if the input is `(1, 1)` (the root to the tree), we will not be able to find a parent. Similarly, if we are given `(1/2)` as input, we will find `(1, 1)` as the parent, and will not be able to the grand-parent. We would have a problem if one of the values is 0. It is fairly easy to detect these problems, but I still wouldn’t know what to do about it. In many of the implementations below, I have decided that we must be given a valid input and will not try to validate the input. In some others, I have decided to detect some of these invalid input problems and tried to do something reasonable about them.

### Curious Fraction Tree in Raku

We’re just implementing the rules above. Here, I do not try to validate the input.

Note that I was first tempted to implement the fraction as a `Rat` type of value, since it implements it as a numerator/denominator pair. I finally decided not to do that (because there may be some cases where the fraction might be reduced to their simplest form, division by 0 errors, and other such problems). So I decided to implement the fractions as integer pairs.

``````use v6;

# for a node x/y less than 1, parent is x/(y-x)
# for a node x/y larger than 1, parent is (x-y)/x

sub parent (\num, \denom) {
return num < denom ?? (num, denom - num) !! (num - denom, denom);
}
for (5, 2), (2, 5), (3, 4), (3, 5) -> \$fraction {
my \$parent = parent |\$fraction[0,1];
my \$gd-parent = parent |\$parent[0,1];
say "for child \$fraction, parent is \$parent and gd-parent is \$gd-parent";
}
``````

With the test fractions provided in the code, this program displays the following output:

``````raku ./fraction-tree.raku
for child 5 2, parent is 3 2 and gd-parent is 1 2
for child 2 5, parent is 2 3 and gd-parent is 2 1
for child 3 4, parent is 3 1 and gd-parent is 2 1
for child 3 5, parent is 3 2 and gd-parent is 1 2
``````

### Curious Fraction Tree in Perl

This program implements the rules described above. Here, we have made some effort to validate the input, just as an example: we write an error value if we get pas the root node.

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

# for a node x/y less than 1, parent is x/(y-x)
# for a node x/y larger than 1, parent is (x-y)/x

sub parent {
my (\$num, \$denom) = @{\$_};
return ["Error"] if \$num == \$denom;
return \$num < \$denom ? [\$num, \$denom - \$num] : [\$num - \$denom, \$denom];
}

for my \$fraction ([5, 2], [2, 5], [3, 4], [3, 5], [2, 1], [1, 1]) {
die "Invalid input node @\$fraction" if \$\$fraction == \$\$fraction;
my \$parent = parent \$fraction;
my \$gd_parent = parent \$parent;
say "for child @\$fraction, parent is @\$parent and gd-parent is @\$gd_parent";
}
``````

This program displays the following output:

``````\$ perl ./fraction-tree.pl
for child 5 2, parent is 3 2 and gd-parent is 1 2
for child 2 5, parent is 2 3 and gd-parent is 2 1
for child 3 4, parent is 3 1 and gd-parent is 2 1
for child 3 5, parent is 3 2 and gd-parent is 1 2
for child 2 1, parent is 1 1 and gd-parent is Error
Invalid input node 1 1 at fraction-tree.pl line 15.
``````

### Curious Fraction Tree in Some Other Programming Languages

#### In Ring

Again the same rules as before, with an attempt to handle gracefully some of the exceptions:

``````# for a node x/y less than 1, parent is x/(y-x)
# for a node x/y larger than 1, parent is (x-y)/x

for test in [ [5, 2], [2, 5], [3, 4], [3,5], [6, 2], [1, 2] ]
parent = find_parent(test, test)
gd_parent = find_parent(parent, parent)
see "Node " + to_str(test) + " has parent " + to_str(parent) +
" and grand-parent " + to_str(gd_parent) + nl
next

func find_parent num, denom
if num < denom
return [num, denom - num]
but denom < num
return [num - denom, denom]
else
return ["Error", ""]
ok

func to_str input
return "" + input + " " + input
``````

This script displays the following output:

``````\$ ring ./fraction-tree.ring
Node 5 2 has parent 3 2 and grand-parent 1 2
Node 2 5 has parent 2 3 and grand-parent 2 1
Node 3 4 has parent 3 1 and grand-parent 2 1
Node 3 5 has parent 3 2 and grand-parent 1 2
Node 6 2 has parent 4 2 and grand-parent 2 2
Node 1 2 has parent 1 1 and grand-parent Error
``````

#### In Python

No attempt here to validate the input.

``````# for a node x/y less than 1, parent is x/(y-x)
# for a node x/y larger than 1, parent is (x-y)/x

def find_parent(num, denom):
return [num, denom - num] if num < denom else [num - denom, denom]

for test in ([5, 2], [2, 5], [3, 4], [3, 5]):
parent = find_parent(test, test)
gd_parent = find_parent(parent, parent)
print("Node", test, "has parent", parent, "and grand-parent", gd_parent)
``````

Output:

``````\$ python3 ./fraction-tree.py
Node [5, 2] has parent [3, 2] and grand-parent [1, 2]
Node [2, 5] has parent [2, 3] and grand-parent [2, 1]
Node [3, 4] has parent [3, 1] and grand-parent [2, 1]
Node [3, 5] has parent [3, 2] and grand-parent [1, 2]
``````

#### In Julia

Limited attempt to validate the input (catching only some of the exceptions).

``````function find_parent(num, denom)
return num < denom ? [num, denom - num] :
num > denom ? [num - denom, denom] :
("Error on node \$num \$denom");
end

for test in [ [5, 2], [2, 5], [3, 4], [3, 5], [1, 2] ]
parent = find_parent(test, test)
gd_parent = find_parent(parent, parent)
println("Node \$test has parent \$parent and grand-parent \$gd_parent")
end
``````

Output:

``````# Node [5, 2] has parent [3, 2] and grand-parent [1, 2]
# Node [2, 5] has parent [2, 3] and grand-parent [2, 1]
# Node [3, 4] has parent [3, 1] and grand-parent [2, 1]
# Node [3, 5] has parent [3, 2] and grand-parent [1, 2]
# Node [1, 2] has parent [1, 1] and grand-parent Error on node
``````

#### In Awk:

``````# Run for example as:
# echo ' 5/2
# 2/5
# 3/5' | awk -f fraction-tree.awk
function parent()
{
if (a < b) {
b = b - a
} else {
a = a - b
}
}
BEGIN {
a = 0
b = 0
FS = "/"
}
{
a = \$1
b = \$2
printf "Node = %d/%d: ", a, b
parent()
printf "Parent = %d/%d; ", a, b
parent()
printf "Grand-parent = %d/%d\n", a, b
}
``````

Output:

``````\$ echo ' 5/2
2/5
3/4
3/5
6/2 ' | awk -f fraction-tree.awk
Node = 5/2: Parent = 3/2; Grand-parent = 1/2
Node = 2/5: Parent = 2/3; Grand-parent = 2/1
Node = 3/4: Parent = 3/1; Grand-parent = 2/1
Node = 3/5: Parent = 3/2; Grand-parent = 1/2
Node = 6/2: Parent = 4/2; Grand-parent = 2/2
``````

### In Ruby

``````# For a node `x/y` with a fraction less than 1, the parent is `x/(y-x)`;
# For a node `x/y` with a fraction larger than 1, the parent is `(x-y)/x`.

def get_parent (pair)
num = pair
denom = pair
return num < denom ? [num, denom - num] : [num - denom, denom];
end

tests = [ [5, 2], [2, 5], [3, 4], [3,5] ]
for test in tests
parent = get_parent(test)
gd_parent = get_parent(parent)
print("Node #{test} - Parent: #{parent} - Grand-Parent: #{gd_parent}\n")
end
``````

Output:

``````Node 5,2 - Parent: 3,2 - Grand-Parent: 1,2
Node 2,5 - Parent: 2,3 - Grand-Parent: 2,1
Node 3,4 - Parent: 3,1 - Grand-Parent: 2,1
Node 3,5 - Parent: 3,2 - Grand-Parent: 1,2
``````

#### In Lua

``````-- For a node `x/y` with a fraction less than 1, the parent is `x/(y-x)`;
-- For a node `x/y` with a fraction larger than 1, the parent is `(x-y)/x`.

local function get_parent(pair)
num = pair
denom = pair
-- no ternary operator in Lua, we can simulate it with and / or:
return num < denom and {num, denom - num} or {num - denom, denom}
end

local function to_str(pair)
-- return pair .. "/" .. pair
return table.concat(pair, "/")
end

local tests = { {5, 2}, {2, 5}, {3, 4}, {3,5} }
for _, test in pairs(tests) do
parent = get_parent(test)
gd_parent = get_parent(parent)
print("Node " .. to_str(test) .. " - Parent: " .. to_str(parent)
.. " - Grand-Parent: " .. to_str(gd_parent))
end
``````

Output:

``````\$ lua ./fraction-tree.lua
Node 5/2 - Parent: 3/2 - Grand-Parent: 1/2
Node 2/5 - Parent: 2/3 - Grand-Parent: 2/1
Node 3/4 - Parent: 3/1 - Grand-Parent: 2/1
Node 3/5 - Parent: 3/2 - Grand-Parent: 1/2
``````

#### In Kotlin

``````fun find_parent(pair: IntArray): IntArray {
val num = pair
val denom = pair
return if (num < denom) intArrayOf(num, denom - num) else intArrayOf(num - denom, denom)
}

fun n2str (pair: IntArray): String {
return "\${pair}/\${pair}"
}

fun main() {
val tests  = arrayOf(intArrayOf(5,2), intArrayOf(2,5), intArrayOf(3,4))
for (test in tests) {
val parent = find_parent(test)
val gd_parent = find_parent(parent)
print(n2str(test) + " - Parent: " + n2str(parent))
println(" - Grand-parent: " + n2str(gd_parent))
}
}
``````

Output:

``````5/2 - Parent: 3/2 - Grand-parent: 1/2
2/5 - Parent: 2/3 - Grand-parent: 2/1
3/4 - Parent: 3/1 - Grand-parent: 2/1
``````

#### In C

``````#include <STDIO>
void parent(int *a, int *b) {
if (*a < *b) {
*b -= *a;
} else {
*a -= *b;
}
}

int main (void) {
int num, denom;

while (scanf ("%d/%d", &num, &denom) == 2) {
printf("%d/%d - ", num, denom);
parent(&num, &denom);
printf("Parent: %d/%d - ", num, denom);
parent(&num, &denom);
printf("Grand-parent: %d/%d \n", num, denom);
}
return (0);
}
``````

Output:

``````\$ echo ' 5/2
2/5
3/4
3/5' | ./a.out
5/2 - Parent: 3/2 - Grand-parent: 1/2
2/5 - Parent: 2/3 - Grand-parent: 2/1
3/4 - Parent: 3/1 - Grand-parent: 2/1
3/5 - Parent: 3/2 - Grand-parent: 1/2
``````

#### In Scala

``````object fraction_tree extends App {

def findParent(pair: List[Int]): List[Int] = {
val num = pair(0)
val denom = pair(1)
return if (num < denom) List(num, denom - num) else List(num - denom, denom)
}
def n2str(pair: List[Int]): String = {
return s"\${pair(0)}" + "/" + s"\${pair(1)}"
}

val tests: List[List[Int]] = List(List(5, 2), List(2, 5), List(3, 4))
for (test <- tests) {
val parent = findParent(test)
val gd_parent = findParent(parent)
println(n2str(test) + " - Parent: " + n2str(parent) + " - Grand-parent: " + n2str(gd_parent))
}
}
``````

Output:

``````5/2 - Parent: 3/2 - Grand-parent: 1/2
2/5 - Parent: 2/3 - Grand-parent: 2/1
3/4 - Parent: 3/1 - Grand-parent: 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 January 16, 2022. 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.