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.

Task 1: Add Binary

This task was covered in the following blog post: https://blogs.perl.org/users/laurent_r/2021/11/perl-weekly-challenge-140-add-binary.html.

Task 2: Multiplication Table

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.

Task 1: Add Binary

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

Add Binary in Raku

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;

sub add-bin ($a, $b) {
    ($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

Add Binary in Perl

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

sub add_bin {
    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]) {
    say "@$test\t=> ", add_bin @$test;
}

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

Task 2: Multiplication Table

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.

Task 1: JostSort

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

Task 2: Long Primes

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.

Task 1: Workdays

*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

Task 2: Split Number

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.

Task 1: Long Year

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,

Task 2: Lychrel Number

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) {
    n = read ()
    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.

About laurent_r

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