Perl Weekly Challenge 153.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 153.

Task 1: Left Factorials

Submitted by: Mohammad S Anwar
Write a script to compute Left Factorials of 1 to 10. Please
refer OEIS A003422 for more information.

Expected Output:
1, 2, 4, 10, 34, 154, 874, 5914, 46234, 409114

The left factorial is defined as !n=∑k=0n k!, where k! is the ordinary factorial. Notice that !n=n!+!(n-1), and as is well known, k!=k×(k-1)!, so that both may be defined recursively. This yields a oneliner solution:

perl -E 'say join ", ", map {lf($_)} (0..9);
sub lf{my $n=shift; return 1 if $n<=0; return f($n)+lf($n-1)}
sub f{my $n=shift; return 1 if $n<=0; return $n*f($n-1)}'

Results:

1, 2, 4, 10, 34, 154, 874, 5914, 46234, 409114

The full version is

 1  # Perl weekly challenge 153
 2  # Task 1: Left factorials
 3  #
 4  # See https://wlmb.github.io/2022/02/21/PWC153/#task-1-left-factorials
 5  use v5.12;
 6  use warnings;
 7  use Memoize;
 8  use bigint;
 9  use Text::Wrap qw(wrap $columns $break);
10
11  memoize qw(left_factorial factorial);
12  die "Usage: ./ch-1.pl N\nto get the first N left factorials" unless @ARGV;
13  my $N=shift;
14  $columns=62; $break=qr/\s/;
15  say wrap("", "    ", "The first $N left factorials are: ",
16      join ", ", map {left_factorial($_)} (0..$N-1));
17  sub left_factorial{
18      my $n=shift;
19      return factorial(0) if $n<=0;
20      return factorial($n)+left_factorial($n-1);
21  }
22  sub factorial{
23      my $k=shift;
24      return 1 if $k<=0;
25      return $k*factorial($k-1);
26  }

In order to deal with left factorials of large numbers I use the bigint pragma and I memoize the recursive functions, saving a lot of repetitive calculations. Example:

./ch-1.pl 10

Results.

The first 10 left factorials are: 1, 2, 4, 10, 34, 154, 874,
    5914, 46234, 409114

A larger example:

./ch-1.pl 40

Results:

The first 40 left factorials are: 1, 2, 4, 10, 34, 154, 874,
    5914, 46234, 409114, 4037914, 43954714, 522956314,
    6749977114, 93928268314, 1401602636314, 22324392524314,
    378011820620314, 6780385526348314, 128425485935180314,
    2561327494111820314, 53652269665821260314,
    1177652997443428940314, 27029669736328405580314,
    647478071469567844940314, 16158688114800553828940314,
    419450149241406189412940314,
    11308319599659758350180940314,
    316196664211373618851684940314,
    9157958657951075573395300940314,
    274410818470142134209703780940314,
    8497249472648064951935266660940314,
    271628086406341595119153278820940314,
    8954945705218228090637347680100940314,
    304187744744822368938255957323620940314,
    10637335711130967298604907294846820940314,
    382630662501032184766604355445682020940314,
    14146383753727377231082583937026584420940314,
    537169001220328488991089808037100875620940314,
    20935051082417771847631371547939998232420940314

Task 2: Factorions

Submitted by: Mohammad S Anwar
You are given an integer, $n.

Write a script to figure out if the given integer is
factorion.

A factorion is a natural number that equals the sum of the
factorials of its digits.

Example 1:
Input: $n = 145
Output: 1

    Since 1! + 4! + 5! => 1 + 24 + 120 = 145
Example 2:
Input: $n = 125
Output: 0

    Since 1! + 2! + 3! => 1 + 2 + 6 <> 123

The task is straightforward: split, factorial, add, compare, and say result. It fits into the following oneliner:

perl -MList::Util=sum0 -E 'say "$_ is ",
sum0(map{f($_)}split "")==$_?"":"not ","factorion" for(@ARGV);
sub f {my $n=shift; return 1 if $n<=0; $n*f($n-1)}' 145 125 123

Results:

145 is factorion
125 is not factorion
123 is not factorion

The full version is

 1  # Perl weekly challenge 153
 2  # Task 2: Factorions
 3  #
 4  # See https://wlmb.github.io/2022/02/21/PWC153/#task-2-factorions
 5  use v5.12;
 6  use warnings;
 7  use Memoize;
 8  use List::Util qw(sum0);
 9  memoize qw(factorial);
10  die "Usage: ./ch-2.pl N1 N2...\nto test if Ni is factorion" unless @ARGV;
11  foreach(@ARGV){
12      say("Expected a non-negative integer: $_"), next unless $_>=0;
13      my @digits=split '';
14      my @factorials=map {factorial($_)} @digits;
15      my $sum=sum0(@factorials);
16      my $factorion=$sum==$_;
17      say "$_ is", $factorion?"":" not", " factorion as ",
18          join("! + ", @digits), "! = ", join(" + ",@factorials),
19          " = $sum ", $factorion?"== ":"!= ", $_;
20  }
21  sub factorial {
22      my $n=shift;
23      return 1 if $n<=0;
24      return $n*factorial($n-1);
25  }

Example:

./ch-2.pl 145 125 123

Results:

145 is factorion as 1! + 4! + 5! = 1 + 24 + 120 = 145 == 145
125 is not factorion as 1! + 2! + 5! = 1 + 2 + 120 = 123 != 125
123 is not factorion as 1! + 2! + 3! = 1 + 2 + 6 = 9 != 123

(Note there is a small mistake in the problem’s statement.)

Another example:

./ch-2.pl `seq 150000` | grep "is fac"

Results:

1 is factorion as 1! = 1 = 1 == 1
2 is factorion as 2! = 2 = 2 == 2
145 is factorion as 1! + 4! + 5! = 1 + 24 + 120 = 145 == 145
40585 is factorion as 4! + 0! + 5! + 8! + 5! = 24 + 1 + 120 + 40320 + 120 = 40585 == 40585

So, it seems there are not too many factorions!

As the largest digit, base 10, is 9, and 9!=362880, a six digit number, the largest factorion should be not larger than 7×362880=2540160, a seven digit number. This suggest a oneliner to find all factorions:

perl -MMemoize -MList::Util=sum0 -E 'memoize(f);
for(1..shift){say $_ if sum0(map{f($_)}split "")==$_;}
sub f {my $n=shift; return 1 if $n<=0; $n*f($n-1)}' 3000000

Results:

1
2
145
40585

So in base 10, there are no more.

Written on February 21, 2022