November 2021 Archives

Perl Weekly Challenge 140: Multiplication Tables

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

You are given 3 positive integers, `\$i`, `\$j` and `\$k`.

Write a script to print the `\$kth` element in the sorted multiplication table of `\$i` and `\$j`.

Example 1:

``````Input: \$i = 2; \$j = 3; \$k = 4
Output: 3

Since the multiplication of 2 x 3 is as below:

1 2 3
2 4 6

The sorted multiplication table:

1 2 2 3 4 6

Now the 4th element in the table is "3".
``````

Example 2:

``````Input: \$i = 3; \$j = 3; \$k = 6
Output: 4

Since the multiplication of 3 x 3 is as below:

1 2 3
2 4 6
3 6 9

The sorted multiplication table:

1 2 2 3 3 4 6 6 9

Now the 6th element in the table is "4".
``````

Multiplication Table in Raku

We use the built-in infix `X` cross-product operator to create all combinations from each range, and combine it with the `*` multiplication operators to obtain all the products of the multiplication table. Then, we simply sort the values obtained and pick the right one (at index `\$k - 1`). In Raku, we can chain all these operations in just one code-line:

``````use v6;

sub mult-table (UInt \$i, UInt \$j, UInt \$k) {
say (sort 1..\$i X* 1..\$j)[\$k - 1]
}
for (2, 3, 4), (3, 3, 6) -> \$a, \$b, \$c {
mult-table \$a, \$b, \$c;
}
``````

This script displays the following output:

``````raku ./mult-table.raku
3
4
``````

Multiplication Table in Perl

Since we don’t have the cross-product operator in Perl, we will simply use two nested `for` loops to compute the products and store them in the `@products` array. Then, we sort the values obtained and pick the right one (at index `\$k - 1`).

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

sub mult_table {
my (\$c, \$d, \$k) = @{\$_[0]};
my @products;
for my \$i (1..\$c) {
for my \$j (1..\$d) {
push @products, \$i * \$j;
}
}
say +(sort {\$a <=> \$b} @products)[\$k - 1];

}
for my \$test ([2, 3, 4], [3, 3, 6]) {
mult_table \$test;
}
``````

This script displays the following output:

``````\$ perl mult-table.pl
3
4
``````

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

Perl Weekly Challenge 140: Add Binary

These are some answers to the Week 140 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 November 28, 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 two decimal-coded binary numbers, `\$a` and `\$b`.

Write a script to simulate the addition of the given binary numbers.

The script should simulate something like `\$a + \$b`. (operator overloading)

Example 1:

``````Input: \$a = 11; \$b = 1;
Output: 100
``````

Example 2:

``````Input: \$a = 101; \$b = 1;
Output: 110
``````

Example 3:

``````Input: \$a = 100; \$b = 11;
Output: 111
``````

In Raku, we simply convert the binary strings to regular integers, using the parse-base method, add these integers with normal addition, and convert the result back to a binary string with the base built-in method.

``````use v6;

(\$a.Str.parse-base(2) + \$b.Str.parse-base(2)).base(2);
}
for (11, 1), (101, 1), (100, 11), (1011,11) -> \$test {
say "\$test\t=> ", add-bin \$test[0], \$test[1];
}
``````

This scipt displays the following output:

``````\$ raku ./add-binary.raku
11 1    => 100
101 1   => 110
100 11  => 111
``````

In Perl, we implemented manually an `add_bin` subroutine to perform direct addition of decimal-coded binary numbers.

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

my (\$c, \$d) = @_;
(\$d, \$c) = (\$c, \$d) if \$d > \$c;
my \$result = "";
my @c = reverse split //, \$c;
my @d = reverse split //, \$d;
my \$carry = 0;   # carry over
for my \$i (0 .. \$#c){
my \$e = \$d[\$i] // 0;
my \$t = \$c[\$i] + \$e + \$carry;
\$result .= \$t and \$carry = 0 if \$t <= 1;
if (\$t == 2) {
\$result .= 0;
\$carry = 1;
} elsif (\$t == 3) {
\$result .= 1;
\$carry = 1;
}
}
\$result .= (\$carry == 0 ? '' : \$carry == 1 ? 1 : '01');
return scalar reverse \$result;
}
for my \$test ( [11, 1], [101, 1], [100, 11], [100, 100], [1011, 11]) {
}
``````

This script displays the following output:

``````\$ perl  ./add-binary.pl
11 1    => 100
101 1   => 110
100 11  => 111
100 100 => 1000
1011 11 => 1110
``````

I have no time now to complete this task and will be busy most of the weekend. I might be able to complete it on Sunday evening and will post accordingly if I do.

Update: I manage to complete Task 2 in time. Please find below a link to my new blog post providing Raku and Perl solutions to task 2 of PWC 140:

https://blogs.perl.org/users/laurent_r/2021/11/perl-weekly-challenge-140-multiplication-tables.html

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

Perl Weekly Challenge 139: JortSort and Long Primes

These are some answers to the Week 139 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 November 21, 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 a list of numbers.

Write a script to implement JortSort. It should return true/false depending if the given list of numbers are already sorted.

Example 1:

``````Input: @n = (1,2,3,4,5)
Output: 1

Since the array is sorted, it prints 1.
``````

Example 2:

``````Input: @n = (1,3,2,4,5)
Output: 0

Since the array is NOT sorted, it prints 0.
``````

I had never heard about JortSort before. It seems to be a sorting toolkit, which, assuming I understood correctly, appears to be rather inefficient. To check whether an array of values is correctly sorted, it appears to sort the array and to compare the sorted result with the original array. Sorting an array usually has an algorithmic complexity of at least `O(n x log n)` (where n is the size of the array), whereas comparing each item with the preceding (or next) one in a simple loop has a linear complexity of `O(n)` and can thus be significantly faster. We will use the later solution.

JortSort in Raku

The built-in Raku `[]` reduction metaoperator makes it possible to apply an operator to each pair of elements of a list. In our case, using it with the `<=` operator, it will return `True` if each element is smaller than or equal to the next element. Since this operator returns a Boolean value (True or False), and since the task is to print 0 or 1, we simply numify the Boolean value by applying the unary `+` operator to the result. This is quite simple:

``````use v6;

sub jortsort (@in) {
+ [<=] @in;  # + numifies the Boolean result
}

for (1,2,3,4,5), (1,3,2,4,5) -> @test {
say "@test[] -> ", jortsort @test;
}
``````

This script displays the following output:

``````\$ raku ./jortsort.raku
1 2 3 4 5 -> 1
1 3 2 4 5 -> 0
``````

Actually, this is so simple that we can easily make a very small Raku one-liner:

``````\$ raku -e 'say + [<=] @*ARGS' 1 2 3 4 5
1

\$ raku -e 'say + [<=] @*ARGS' 1 2 4 3 5
0
``````

JortSort in Perl

Perl doesn’t have a reduction meta-operator, but it is almost as simple to use a `for` loop and compare each element with the previous one. We return 0 if any pair of elements fails the comparison test, and return 1 if the loop reaches the array last item:

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

sub jortsort {
my @in = @_;
for my \$i (1..\$#in) {
return 0 if \$in[\$i - 1] > \$in[\$i];
}
return 1;
}

for my \$a ([1,2,3,4,5], [1,3,2,4,5]) {
say "@\$a -> ", jortsort @\$a;
}
``````

This script displays the following output:

``````\$ perl jortsort.pl
1 2 3 4 5 -> 1
1 3 2 4 5 -> 0
``````

Write a script to generate first 5 Long Primes.

A prime number (p) is called Long Prime if (1/p) has an infinite decimal expansion repeating every (p-1) digits.

Example:

``````7 is a long prime since 1/7 = 0.142857142857...
The repeating part (142857) size is 6 i.e. one less than the prime number 7.

Also 17 is a long prime since 1/17 = 0.05882352941176470588235294117647...
The repeating part (0588235294117647) size is 16 i.e. one less than the prime number 17.

Another example, 2 is not a long prime as 1/2 = 0.5.
There is no repeating part in this case.
``````

Long Primes in Raku

Raku has a built-in method, base-repeating, provided by the role `Rational`, that splits a Rational into a base and a repeating pattern part. So we simply loop through an infinite lazy list of prime integers and return True is the repeating part is one less than the input prime, and we stop the loop when we have enough long primes.

``````my @primes = grep { .is-prime }, 1..Inf;
my \$count = 0;

sub is-long-prime ( UInt \$den) {
my (\$non-rep, \$repeating) = (1 / \$den).base-repeating;
return True if \$repeating.chars == \$den - 1;
}
for @primes -> \$candidate {
say \$candidate and ++\$count if is-long-prime \$candidate;
last if \$count >= 5
}
``````

This script displays the following output:

``````\$ raku ./long-primes.raku
7
17
19
23
29
``````

Long Primes in Perl

In Perl, we implement a `generate_primes` subroutine to generate a list of prime numbers. We also implement an `invert` subroutine to compute the inverse `1/n` of the input integer `n`; we do this because we need this inverse to have a relatively large number of significant decimal digits (more than what Perl arithmetic division can provide). Then we use a regular expression to find possible repeating sequences smaller than the input prime. The first 3 primes (2, 3, and 5) behave somewhat differently from the subsequent primes and are not long primes so, rather than implementing another test specifically for them, we really start our search at the fourth prime, 7. Frankly, I’m really not sure that my regex works correctly for moderately or very large input values, but it does work fine for values much larger than just the first five long primes.

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

my \$count = 0;

sub generate_primes {
my @primes = (2, 3, 5, 7);
my \$current = 9;
while (1) {
my \$prime = 1;   # True
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;
}
return @primes;
}

sub invert {
my \$n = shift;
my \$dividend = 1;
my \$result;
my \$max = 2 * \$n;
while (1) {
\$dividend *= 10;
\$result .= int(\$dividend / \$n);
return \$result if length \$result >= \$n;
my \$remainder = \$dividend % \$n;
\$dividend = \$remainder;
}
return \$result;
}

my @primes = generate_primes;
for my \$candidate (@primes[3..30]) {

my \$decimals = invert \$candidate;
my \$len = length \$decimals;
++\$count and say "\$candidate  \$decimals " unless \$decimals =~  /(\d{3,\$len})\1/;
last if \$count >= 5;
}
``````

In this implementation, the program displays the long primes detected, as well as the decimal digit sequences for those primes, to help checking the results. The changes to be made to remove the decimal digit sequences should be obvious. As it is, this program displays the following output:

``````\$ perl long-primes.pl
7  1428571
17  05882352941176470
19  0526315789473684210
23  04347826086956521739130
29  03448275862068965517241379310
``````

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

Perl Weekly Challenge 138: Workdays and Split Number

These are some answers to the Week 138 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 November 14, 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 a year, `\$year` in 4-digits form.

Write a script to calculate the total number of workdays in the given year.

For the task, we consider, Monday - Friday as workdays.

Example 1:

``````Input: \$year = 2021
Output: 261
``````

Example 2:

``````Input: \$year = 2020
Output: 262
``````

A year has 52 weeks, plus one or two days (when the year is leap). So, we will have `5 * 52 = 260` work days, plus 0, 1, or 2 days. So we basically start with 260 work days and add one if Dec. 31 falls on a week day, plus another work day if the year is leap and if Dec. 30 falls on a week day.

Workdays in Raku

In Raku, we start with Jan. 1 of the input year and add 52 weeks to it. The later of the Dateish role will happily compute the date 52 weeks after Jan. 1 and accurately take care of leap years, so that it will return Dec. 30 on leap years and Dec. 31 on other years. It is then only a matter to find out is these dates fall on week days.

``````sub work-days (UInt \$y) {
my \$new-year-day = Date.new("\$y-01-01");
my \$fifty-two-weeks-later = \$new-year-day.later(:52weeks);
my \$count = 52 * 5;
\$count++ if 1 <= \$fifty-two-weeks-later.day-of-week < 6;
return \$count if \$fifty-two-weeks-later.day == 31;
\$count++ if 1 <= \$fifty-two-weeks-later.later(:1days).day-of-week < 6;
return \$count;
}
say "\$_ -> ", work-days \$_ for 2000..2021;
``````

This program displays the following output:

``````\$ raku ./working-days.raku
2000 -> 260
2001 -> 261
2002 -> 261
2003 -> 261
2004 -> 262
2005 -> 260
2006 -> 260
2007 -> 261
2008 -> 262
2009 -> 261
2010 -> 261
2011 -> 260
2012 -> 261
2013 -> 261
2014 -> 261
2015 -> 261
2016 -> 261
2017 -> 260
2018 -> 261
2019 -> 261
2020 -> 262
2021 -> 261
``````

Workdays in Perl

In Perl, we’ll use the core Time::Piece module. We’ll use a slightly different strategy: we start with `5 * 52 = 260` work days, add one if Dec. 31 is a week day, and add one more if the year is leap and if Dec. 30 is a week day.

``````use warnings;
use feature qw/say/;
use Time::Piece;

sub work_days {
my \$y = shift;
my \$count = 52 * 5;
my \$t = Time::Piece->strptime("\$y Dec 31", '%Y %b %e');
my \$last_d = \$t->day_of_week;
\$count++ if \$last_d > 0 and \$last_d < 6;
if (\$t->is_leap_year) {
my \$thirtieth = (\$last_d - 1) % 7;
\$count++ if \$thirtieth > 0 and \$thirtieth < 6;
}
return \$count;
}
say "\$_ -> ", work_days \$_ for 2000..2021;
``````

This script displays the following output:

``````\$ perl ./working-days.pl
2000 -> 260
2001 -> 261
2002 -> 261
2003 -> 261
2004 -> 262
2005 -> 260
2006 -> 260
2007 -> 261
2008 -> 262
2009 -> 261
2010 -> 261
2011 -> 260
2012 -> 261
2013 -> 261
2014 -> 261
2015 -> 261
2016 -> 261
2017 -> 260
2018 -> 261
2019 -> 261
2020 -> 262
2021 -> 261
``````

You are given a perfect square.

Write a script to figure out if the square root the given number is same as sum of 2 or more splits of the given number.

Example 1:

``````Input: \$n = 81
Output: 1

Since, sqrt(81) = 8 + 1
``````

Example 2:

``````Input: \$n = 9801
Output: 1

Since, sqrt(9801) = 98 + 0 + 1
``````

Example 3:

``````Input: \$n = 36
Output: 0

Since, sqrt(36) != 3 + 6
``````

Split Number in Raku

I first thought I could use some combination of the `combinations` and `permutations` methods to solve the problem, but this turned out to be more complicated than expected. So I decided to write a recursive `partition` subroutine to build the various partitions of the input square number and add the various parts. The `split-square` subroutine checks that the input number is a perfect square and calls the `partition` subroutine, passing to it a list of the input number digits. Note that we are using dynamic variables (`\$*found` and `\$*root`) to avoid passing them back and forth in the recursive subroutine calls.

``````use v6;

sub partition (Int \$sum is copy, @in) {
if @in.elems == 0 {
\$*found = 1 if \$sum == \$*root;
return;
}
for 1..@in.elems -> \$i {
my \$new-sum = \$sum + join "", @in[0..(\$i-1)];
last if \$new-sum > \$*root;
partition \$new-sum, @in[\$i..@in.end];
}
}

sub split-square (UInt \$sq) {
my \$*root = sqrt(\$sq).Int;
say "\$sq is not a perfect square\n" and return 0 if \$*root² != \$sq;
my \$*found = 0;
partition(0, \$sq.comb);
return \$*found;
}
for <1 27 81 100 225 1296 6561 9801> -> \$test {
say \$test.fmt("%5d\t") , split-square \$test;
}
``````

This program displays the following output:

raku ./split-squares.raku 1 1 27 is not a perfect square

``````   27   0
81   1
100   1
225   0
1296   1
6561   0
9801   1
``````

Split Number in Perl

This is essentially a Perl port of the Raku solution above. We also implement a recursive `partition` subroutine to build the various partitions of the input square number and add the various parts. The `split_square` subroutine checks that the input number is a perfect square and calls the `partition` subroutine, passing to it a list of the input number digits.

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

my (\$found, \$root);

sub partition {
my (\$sum, @in) = @_;
if (scalar @in == 0) {
\$found = 1 if \$sum == \$root;
return;
}
for my \$i (1..(scalar @in)) {
my \$new_sum = \$sum + join "", @in[0..(\$i-1)];
last if \$new_sum > \$root;
partition (\$new_sum, @in[\$i..\$#in]);
}
}

sub split_square {
my \$sq = shift;
\$root = int sqrt(\$sq);
say "\$sq is not a perfect square\n" and return 0 if \$root ** 2 != \$sq;
\$found = 0;
partition(0, split //, \$sq);
return \$found;
}
for my \$test (qw<1 27 81 100 225 1296 6561 9801>) {
printf "%5d\t%d\n", \$test , split_square \$test;
}
``````

This program displays the following output:

``````\$ perl  ./split-squares.pl
1   1
27 is not a perfect square

27   0
81   1
100   1
225   0
1296   1
6561   0
9801   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 November 21, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 137: Long Year and Lychrel Number

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

Write a script to find all the years between 1900 and 2100 which is a Long Year.

A year is Long if it has 53 weeks.

Expected Output:

``````1903, 1908, 1914, 1920, 1925,
1931, 1936, 1942, 1948, 1953,
1959, 1964, 1970, 1976, 1981,
1987, 1992, 1998, 2004, 2009,
2015, 2020, 2026, 2032, 2037,
2043, 2048, 2054, 2060, 2065,
2071, 2076, 2082, 2088, 2093,
2099
``````

All years have 52 weeks, plus 1 day, or 2 days for leap years. How can you have years with 53 weeks? Well, it depends on how you define weeks. The most common convention is the following: all weeks start with Monday and each week belongs in the year in which the Thursday falls. This means that if the year starts on a Thursday or is a leap year and starts on a Wednesday, that particular year will have 53 numbered weeks.

Long Year in Raku

For this task, we use the built-in `DateTime` module, and the `day-of-week` and `is-leap-year` methods provided by the dateish role. We simply loop over the `1900-2100` range and print out the year if it starts on a Thursday, or if it starts on a Wednesday and is a leap year.

``````use v6;

for 1900..2100 -> \$y {
my \$year = DateTime.new(:year(\$y));
my \$new-year-day = Date.new("\$y-01-01").day-of-week;
print "\$y, " if \$new-year-day == 4; # DoW 4 = Thursday
print "\$y, " if \$year.is-leap-year and \$new-year-day == 3;
}
say "";
``````

This program displays the following output (slightly reformatted for the purpose of this blog post):

``````\$ raku ./53-week-year.raku
1903, 1908, 1914, 1920, 1925, 1931, 1936,
1942, 1948, 1953, 1959, 1964, 1970, 1976,
1981, 1987, 1992, 1998, 2004, 2009, 2015,
2020, 2026, 2032, 2037, 2043, 2048, 2054,
2060, 2065, 2071, 2076, 2082, 2088, 2093,
2099,
``````

Update (Nov. 2, 2021): This can be made significantly simpler. Andrew Shitov sent me a message suggesting to use the `week-number` method (which is provided by the dateish role). All we need to do is to check whether the week number of the last day of the year is 53 (no need to check whether the year is leap). This can be done in just one code line, for example:

``````.say if Date.new(\$_, 12, 31).week-number == 53 for 1900..2100;
``````

Long Year in Perl

In Perl, we use the `Time::Local` core module to figure out whether a year starts on a Thursday (or on a Wednesday in the case of leap years). Since Perl doesn’t have a built-in function for finding out whether a year is leap, we roll out our own `is_leap_year` subroutine. A year is leap if it is evenly divisible by 4 and not by 100 (unless it is also divisible by 400), so that 1900 and 2100 are not leap, but 2000 is leap.

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

sub is_leap_year {
my \$year = shift;
return 0 if \$year % 4;   # not divisible by 4
return 1 if \$year % 100; # divisible by 4, not by 100
return 0 if \$year % 400; # divisible by 100, not by 400
return 1;                # divisible by 400
}

for my \$year (1900..2100) {
my \$date = timegm(0, 0, 0, 1, 0, \$year);
my \$day_in_week = (gmtime \$date)[6];
print \$year, ", " if \$day_in_week == 4; # 4 = Thursday
print \$year, ", " if \$day_in_week == 3 and is_leap_year \$year;
}
say "";
``````

This program displays the following output (sligthly reformatted for the purpose of this blog post):

``````\$ perl ./53-week-year.pl
1903, 1908, 1914, 1920, 1925, 1931, 1936,
1942, 1948, 1953, 1959, 1964, 1970, 1976,
1981, 1987, 1992, 1998, 2004, 2009, 2015,
2020, 2026, 2032, 2037, 2043, 2048, 2054,
2060, 2065, 2071, 2076, 2082, 2088, 2093,
2099,
``````

You are given a number, 10 <= \$n <= 1000.

Write a script to find out if the given number is Lychrel number. To keep the task simple, we impose the following rules:

a. Stop if the number of iterations reached 500. b. Stop if you end up with number >= 10_000_000.

According to wikipedia:

A Lychrel number is a natural number that cannot form a palindrome through the iterative process of repeatedly reversing its digits and adding the resulting numbers.

Example 1:

``````Input: \$n = 56
Output: 0

After 1 iteration, we found palindrome number.
56 + 65 = 121
``````

Example 2:

``````Input: \$n = 57
Output: 0

After 2 iterations, we found palindrome number.
57 +  75 = 132
132 + 231 = 363
``````

Example 3:

``````Input: \$n = 59
Output: 0

After 3 iterations, we found a palindrome number.
59 +  95 =  154
154 + 451 =  605
605 + 506 = 1111
``````

It is now known whether there exists any Lychrel number in base ten, but some integers, such as 196, 295, and 394, are conjectured to be Lychrel numbers. They are sometimes called Lichrel candidates.

Note that the (a) stopping condition on the number of iterations is somewhat useless here, as we will reach the condition on the maximum size of the integer much faster. Starting with 1, the smallest positive integer, and applying the reverse and add algorithm will lead to a number larger than 10,000,000 is less than 20 iterations, as shown in the following Perl one-liner:

``````\$ perl -E '\$n = 1; for \$i (1..500) { \$n += reverse \$n; say \$i and last if \$n >= 10_000_000;}'
19
``````

Lychrel Numbers in Raku

We start with a `1..500` loop and break out of it if we’ve found a palindrome or if we’ve reached the 10,000,000 limit. In Raku, the built-in to reverse a word (or a number) is the `flip` method, which we use both for reversing the number and for finding out whether a result is a palindrome.

``````use v6;

sub is-lychrel (UInt \$m) {
my \$n = \$m;
for 1..500 -> \$i {
return "\$m is a Lychrel candidate. Reached the 1e7 limit"
if \$n > 10_000_000;
\$n += \$n.flip;
#`[say \$n and] return 0 if \$n == \$n.flip;
}
return "\$m is a lychrel candidate (made 500 iterations)";
}
for 10...20, 30, 50, 100, 196 -> \$test {
say "\$test -> ", is-lychrel \$test;
}
``````

This program displays the following output:

``````\$ raku ./lychrel.raku

10 -> 0
11 -> 0
12 -> 0
13 -> 0
14 -> 0
15 -> 0
16 -> 0
17 -> 0
18 -> 0
19 -> 0
20 -> 0
30 -> 0
50 -> 0
100 -> 0
196 -> 196 is a Lychrel candidate. Reached the 1e7 limit
``````

Lychrel Numbers in Perl

We’re using essentially the same algorithm as in Raku. In Perl, we use the `reverse` built-in function.

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

sub is_lychrel {
my \$m = shift;
my \$n = \$m;
for my \$i (1..500) {
return "\$m is a Lychrel candidate. Reached the 1e7 limit"
if \$n > 10_000_000;
\$n += reverse \$n;
return 0 if \$n == reverse \$n;
}
return "\$m is a lychrel candidate (made 500 iterations)";
}
for my \$test (10..20, 30, 50, 100, 196) {
say "\$test -> ", is_lychrel \$test;
}
``````

This program displays the following output:

``````\$ perl ./lychrel.pl
10 -> 0
11 -> 0
12 -> 0
13 -> 0
14 -> 0
15 -> 0
16 -> 0
17 -> 0
18 -> 0
19 -> 0
20 -> 0
30 -> 0
50 -> 0
100 -> 0
196 -> 196 is a Lychrel candidate. Reached the 1e7 limit
``````

Lychrel Numbers in Some Other Languages

In Julia

Contrary to Raku and Perl, and as in most other languages we will use below, in Julia, we need to perform some explicit integer to string and string to integer conversions to be able to perform a reverse operation on the digits of an integer. This is quite simple, though:

``````rev = parse(Int64, reverse(string(n)))
``````

Besides that, the program is quite simple:

``````function is_lychrel(n)
m = n
for k = 1:500
if (n > 10_000_000)
return "\$m is a Lychrel candidate. Reached the 1e7 limit"
end
rev = parse(Int64, reverse(string(n)))
if (n == rev) return 0 end
n += rev
end
return "\$m is a lychrel candidate (made 500 iterations)";
end

for test in [10, 20, 30, 50, 100, 196]
println("\$test ->  \$(is_lychrel(test))")
end
``````

Note the use of the `\$` sign in Julia for value interpolations within strings, even (with parentheses) for values returned by code fragments such as function calls

Output:

``````\$ julia ./lychrel.jl
10 -> 0
20 -> 0
30 -> 0
50 -> 0
100 -> 0
196 -> 196 is a Lychrel candidate. Reached the 1e7 limit
``````

In Python

Contrary to Raku and Perl, and as in most other languages we will use, in Python, we need to perform some integer to string and string to integer conversions to be able to perform a reverse operation on the digits of an interger.

``````#!/usr/bin/python3

def is_lychrel(m):
n = m
for i in range(500):
j = int(str(n)[::-1])
if j == n:
return 0
n += j
if n > 10000000:
return "n is a lychrel candidate. Reached the 1e7 limit."
return "n is a lychrel candidate. Made 500 iterations."

for test in range(10, 20):
print(test, " -> ", is_lychrel(test))

for test in 10, 20, 30, 50, 100, 196:
print(test, " -> ", is_lychrel(test))
``````

Note that I wasn’t able to find the right syntax to include in the same test suite a range and a list of integers, so that I needed to use two separate `for` loops for the tests.

Output:

``````\$ python3 lychrel.py
10  ->  0
11  ->  0
12  ->  0
13  ->  0
14  ->  0
15  ->  0
16  ->  0
17  ->  0
18  ->  0
19  ->  0
10  ->  0
20  ->  0
30  ->  0
50  ->  0
100  ->  0
196  ->  n is a lychrel candidate. Reached the 1e7 limit.
``````

In Ruby

``````#! /usr/bin/ruby

def is_lychrel(m)
n = m
for k in 1..500
j = n.to_s.reverse.to_i
if j == n then
return 0
end
n += j
if n > 10000000 then
return "#{m} is  a Lychrel candidate (reached the 1e7 limit)"
end
end
return "#{m} is a lychrel candidate (made 500 iterations)"
end

for test in [10, 20, 30, 50, 100, 196]
print  "#{test} -> ", is_lychrel(test), "\n"
end
``````

Output:

``````10 -> 0
20 -> 0
30 -> 0
50 -> 0
100 -> 0
196 -> 196 is  a Lychrel candidate (reached the 1e7 limit)
``````

In C

``````#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#define MAX_ITER 500
#define MAX_VAL 10000000
#define NB_TESTS 6

void reverse_str(char* str) {
int len, tmp;
len = strlen(str);
for (int i = 0; i < len/2; i++) {
tmp = str[i];
str[i] = str[len - i - 1];
str[len - i - 1] = tmp;
}
}

const char* lychrel (int n) {
char out[20];
for (int k = 1; k <= MAX_ITER; k++) {
if (n > MAX_VAL) {
return "is a Lychrel candidate. Reached the 1e7 limit";
}
char to_str[20];
char rev[20];
sprintf(to_str, "%d", n);
strcpy(rev, to_str);
reverse_str(rev);
if (strcmp(to_str, rev) == 0) {
return "0";
}
n += atoi(rev);
}
return "is a Lychrel candidate. Reached 500 iterations";
}

int main() {
int tests[NB_TESTS] = { 10, 20, 30, 50, 100, 196};
for (int i = 0; i < NB_TESTS; i++) {
printf("%d -> %s\n", tests[i], lychrel(tests[i]));
}
}
``````

Output:

``````\$ lychrel
10 -> 0
20 -> 0
30 -> 0
50 -> 0
100 -> 0
196 -> is a Lychrel candidate. Reached the 1e7 limit
``````

In Lua

``````function is_lychrel(n)
m = n
for k =1, 500 do
if n > 10000000 then
return string.format("%s is a Lychrel candidate. Reached the 1e7 limit", m)
end
rev = tonumber(string.reverse(tostring(n)))
if n == rev then return 0 end
n = n + rev
end
return string.format("%s is a lychrel candidate (made 500 iterations)", m);
end

for key, test in ipairs({10, 20, 30, 50, 100, 196}) do
print(test, " -> ", is_lychrel(test))
end
``````

Output:

``````\$ lua ./lychrel.lua
10   ->     0
20   ->     0
30   ->     0
50   ->     0
100  ->     0
196  ->     196 is a Lychrel candidate. Reached the 1e7 limit
``````

In Rust

In Rust, I wasn’t able to perform the integer to string conversion, reverse operation, and conversion back from string to integer. (Well, to tell the truth, I found a way to do it on the Internet, but I don’t really understand how it works and will therefore not use it.) So, for Rust, I decided to implement a function (`reverse_num`) performing the reverse operation directly on integers, using integer division, modulo, addition and multiplication opetators.

``````fn reverse_num (m: i32) -> i32 {
let mut n = m;
let mut rev = 0;
while n > 0 {
rev *= 10;
rev += n % 10;
n /= 10;
}
return rev;
}

fn is_lychrel(m: i32) -> String {
let mut n = m;
for _k in 1..500 {
let j = reverse_num(n);
if j == n {
return 0.to_string();
}
n += j;
if n > 10000000 {
return "Lychrel candidate (reached the 1e7 limit)".to_string();
}
}
return "Lychrel candidate (500 iterations)".to_string();
}
fn main() {
for test in [10, 20, 30, 100, 196] {
println!("{} -> {}", test, is_lychrel(test));
}
}
``````

Output:

``````10 -> 0
20 -> 0
30 -> 0
100 -> 0
196 -> Lychrel candidate (reached the 1e7 limit)
``````

In awk

``````#!/usr/bin/awk

function reverse (num) {
rev = ""
len = length(num)
for (i = len; i > 0; i--) {
rev = rev substr(num, i, 1);
}
return rev
}
function is_lychrel(n) {
for (i = 1; i <= 5; i++) {
if (n > 10000000) {
return "is a Lychrel candidate. Reached the 1e7 limit"
}
rev = reverse(n)
# print n, rev
if (n == rev) { return 0 }
n += rev
}
return "is a lychrel candidate (made 500 iterations)"
}
/[0-9]+/ { print \$0, " -> ", is_lychrel(\$0) }
``````

To run this awk program we need either to supply a file with the test values, or to pipe such data to the awk program standard input:

``````\$ echo '20
30
40
50
100
196' |  awk -f lychrel.awk
20  ->  0
30  ->  0
40  ->  0
50  ->  0
100  ->  0
196  ->  is a Lychrel candidate. Reached the 1e7 limit
``````

In bc

``````define reverse (n) {
rev = 0
while (n > 0) {
rev *= 10
rev += n % 10
n /= 10
}
return (rev)
}

define is_lychrel(n) {
for (i = 1; i < 500; i++) {
if (n >= 10000000) { return -1}
rev = reverse(n)
/* print n, " ", rev, "\n" */
if (n == rev) {return 0;}
n += rev
}
return -1
}

while (1) {
if (is_lychrel (n) == -1) {
print n, " Lychrel candidate", "\n"
} else {
print n, " ", 0, "\n"
}
}
quit
``````

We need to run this script in a way similar to awk:

``````\$ echo ' 10
15
20
196' | bc lychrel.bc
10 0
15 0
20 0
196 Lychrel candidate
``````

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