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.