Perl Weekly Challenge 171.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 171.
Task 1: Abundant Number
Submitted by: Mohammad S Anwar
Write a script to generate first 20 Abundant Odd Numbers.
According to wikipedia,
A number n for which the sum of divisors σ(n) > 2n, or,
equivalently, the sum of proper divisors (or aliquot sum) s(n)
> n.
For example, 945 is the first Abundant Odd Number.
Sum of divisors:
1 + 3 + 5 + 7 + 9 + 15 + 21 + 27 + 35 + 45 + 63 + 105 + 135 + 189 + 315 = 975
A straightforward solution is to check all odd numbers from 3 upwards, find all their proper divisors, and check if their sum is larger than the number, until enough abundant numbers are found. Using the Perl Data Language (PDL) yields a oneliner:
perl -MPDL -E '$n=1; $N=shift; while($N){$n+=2; $s=1+sequence($n/2); $d=$s->where($n%$s==0);
$a=$d->sum; $N--, say "$n: Divisors: $d. Sum: $a" if $a>$n; }' 20|fmt -w 62 -t
Results:
945: Divisors: [1 3 5 7 9 15 21 27 35 45 63 105 135 189
315]. Sum: 975
1575: Divisors: [1 3 5 7 9 15 21 25 35 45 63 75 105 175
225 315 525]. Sum: 1649
2205: Divisors: [1 3 5 7 9 15 21 35 45 49 63 105 147 245
315 441 735]. Sum: 2241
2835: Divisors: [1 3 5 7 9 15 21 27 35 45 63 81 105 135
189 315 405 567 945]. Sum: 2973
3465: Divisors: [1 3 5 7 9 11 15 21 33 35 45 55 63 77 99
105 165 231 315 385 495 693 1155]. Sum: 4023
4095: Divisors: [1 3 5 7 9 13 15 21 35 39 45 63 65 91 105
117 195 273 315 455 585 819 1365]. Sum: 4641
4725: Divisors: [1 3 5 7 9 15 21 25 27 35 45 63 75 105 135
175 189 225 315 525 675 945 1575]. Sum: 5195
5355: Divisors: [1 3 5 7 9 15 17 21 35 45 51 63 85 105 119
153 255 315 357 595 765 1071 1785]. Sum: 5877
5775: Divisors: [1 3 5 7 11 15 21 25 33 35 55 75 77 105
165 175 231 275 385 525 825 1155 1925]. Sum: 6129
5985: Divisors: [1 3 5 7 9 15 19 21 35 45 57 63 95 105 133
171 285 315 399 665 855 1197 1995]. Sum: 6495
6435: Divisors: [1 3 5 9 11 13 15 33 39 45 55 65 99 117
143 165 195 429 495 585 715 1287 2145]. Sum: 6669
6615: Divisors: [1 3 5 7 9 15 21 27 35 45 49 63 105 135
147 189 245 315 441 735 945 1323 2205]. Sum: 7065
6825: Divisors: [1 3 5 7 13 15 21 25 35 39 65 75 91 105
175 195 273 325 455 525 975 1365 2275]. Sum: 7063
7245: Divisors: [1 3 5 7 9 15 21 23 35 45 63 69 105 115
161 207 315 345 483 805 1035 1449 2415]. Sum: 7731
7425: Divisors: [1 3 5 9 11 15 25 27 33 45 55 75 99 135
165 225 275 297 495 675 825 1485 2475]. Sum: 7455
7875: Divisors: [1 3 5 7 9 15 21 25 35 45 63 75 105 125
175 225 315 375 525 875 1125 1575 2625]. Sum: 8349
8085: Divisors: [1 3 5 7 11 15 21 33 35 49 55 77 105 147
165 231 245 385 539 735 1155 1617 2695]. Sum: 8331
8415: Divisors: [1 3 5 9 11 15 17 33 45 51 55 85 99 153
165 187 255 495 561 765 935 1683 2805]. Sum: 8433
8505: Divisors: [1 3 5 7 9 15 21 27 35 45 63 81 105 135
189 243 315 405 567 945 1215 1701 2835]. Sum: 8967
8925: Divisors: [1 3 5 7 15 17 21 25 35 51 75 85 105 119
175 255 357 425 525 595 1275 1785 2975]. Sum: 8931
The full code is:
1 # Perl weekly challenge 171
2 # Task 1: Abundant number
3 #
4 # See https://wlmb.github.io/2022/06/27/PWC171/#task-1-abundant-number
5 use v5.12;
6 use warnings;
7 use PDL;
8 die "Usage ./ch-1.pl N\nto obtain the first N abundant odd numbers" unless @ARGV;
9 my $count=shift; # How many abundants are desired
10 my $candidate=1;
11 while($count){
12 $candidate+=2; # only test odd numbers
13 my $potential_divisors=1+sequence($candidate/2);
14 my $divisors=$potential_divisors->where($candidate%$potential_divisors==0);
15 my $sum=$divisors->sumover;
16 $count--, say "$candidate: Divisors: $divisors. Sum: $sum." if $sum>$candidate;
17 }
Example:
./ch-1.pl 20|fmt -w 62 -t
Results:
945: Divisors: [1 3 5 7 9 15 21 27 35 45 63 105 135 189
315]. Sum: 975.
1575: Divisors: [1 3 5 7 9 15 21 25 35 45 63 75 105 175
225 315 525]. Sum: 1649.
2205: Divisors: [1 3 5 7 9 15 21 35 45 49 63 105 147 245
315 441 735]. Sum: 2241.
2835: Divisors: [1 3 5 7 9 15 21 27 35 45 63 81 105 135
189 315 405 567 945]. Sum: 2973.
3465: Divisors: [1 3 5 7 9 11 15 21 33 35 45 55 63 77 99
105 165 231 315 385 495 693 1155]. Sum: 4023.
4095: Divisors: [1 3 5 7 9 13 15 21 35 39 45 63 65 91 105
117 195 273 315 455 585 819 1365]. Sum: 4641.
4725: Divisors: [1 3 5 7 9 15 21 25 27 35 45 63 75 105 135
175 189 225 315 525 675 945 1575]. Sum: 5195.
5355: Divisors: [1 3 5 7 9 15 17 21 35 45 51 63 85 105 119
153 255 315 357 595 765 1071 1785]. Sum: 5877.
5775: Divisors: [1 3 5 7 11 15 21 25 33 35 55 75 77 105
165 175 231 275 385 525 825 1155 1925]. Sum: 6129.
5985: Divisors: [1 3 5 7 9 15 19 21 35 45 57 63 95 105 133
171 285 315 399 665 855 1197 1995]. Sum: 6495.
6435: Divisors: [1 3 5 9 11 13 15 33 39 45 55 65 99 117
143 165 195 429 495 585 715 1287 2145]. Sum: 6669.
6615: Divisors: [1 3 5 7 9 15 21 27 35 45 49 63 105 135
147 189 245 315 441 735 945 1323 2205]. Sum: 7065.
6825: Divisors: [1 3 5 7 13 15 21 25 35 39 65 75 91 105
175 195 273 325 455 525 975 1365 2275]. Sum: 7063.
7245: Divisors: [1 3 5 7 9 15 21 23 35 45 63 69 105 115
161 207 315 345 483 805 1035 1449 2415]. Sum: 7731.
7425: Divisors: [1 3 5 9 11 15 25 27 33 45 55 75 99 135
165 225 275 297 495 675 825 1485 2475]. Sum: 7455.
7875: Divisors: [1 3 5 7 9 15 21 25 35 45 63 75 105 125
175 225 315 375 525 875 1125 1575 2625]. Sum: 8349.
8085: Divisors: [1 3 5 7 11 15 21 33 35 49 55 77 105 147
165 231 245 385 539 735 1155 1617 2695]. Sum: 8331.
8415: Divisors: [1 3 5 9 11 15 17 33 45 51 55 85 99 153
165 187 255 495 561 765 935 1683 2805]. Sum: 8433.
8505: Divisors: [1 3 5 7 9 15 21 27 35 45 63 81 105 135
189 243 315 405 567 945 1215 1701 2835]. Sum: 8967.
8925: Divisors: [1 3 5 7 15 17 21 25 35 51 75 85 105 119
175 255 357 425 525 595 1275 1785 2975]. Sum: 8931.
Task 2: First-class Function
Submitted by: Mohammad S Anwar
Create sub compose($f, $g) which takes in two parameters $f
and $g as subroutine refs and returns subroutine ref
i.e. compose($f, $g)->($x) = $f->($g->($x))
e.g.
$f = (one or more parameters function)
$g = (one or more parameters function)
$h = compose($f, $g)
$f->($g->($x,$y, ..)) == $h->($x, $y, ..) for any $x, $y, ...
I assume that @ARGV has the code for the two functions f and g as strings (i.e., “sub{…}”) to be (unsafely) eval’ed, followed by the arguments to feed g, whose output feeds f. This yields a oneliner solution:
perl -E '$f=eval shift or die $@; $g=eval shift or die $@; $h=sub{$f->($g->(@_))}; say $h->(@ARGV)
' 'sub($x){log($x)/log(10)}' 'sub($x){$x**2}' 10
perl -E '$f=eval shift or die $@; $g=eval shift or die $@; $h=sub{$f->($g->(@_))}; say $h->(@ARGV)
' 'sub($x, $y){sqrt($x**2+$y**2)}' 'sub($x1, $y1, $x2, $y2){($x1+$x2, $y1+$y2)}' 1 1 2 3
perl -E '$f=eval shift or die $@; $g=eval shift or die $@; $h=sub{$f->($g->(@_))}; say $h->(@ARGV)
' 'sub($x){sin($x)}' 'sub($x, $y){atan2($y, $x)}' 1 1
Results:
2
5
0.707106781186547
In the first example f calculates the log10 of its argument and g squares the argument. Thus, f∘g(10)=log10(102)=2. In the second example f calculates the euclidean size of a 2D vector while g adds two 2D vectors. Thus f∘g(1,1,2,3)=f(1+2,1+3)=f(3,4)=sqrt(9+16)=5. In the third example f calculates the sine of an angle while g calculates the direction of a 2D vector x,y with respect to the x-axis, thus f∘g(1,1)=sin(π/4)=1/√2=0.707…. I’m using Perl 5.36, so that -E enables signatures.
I didn’t write a compose function above, for brevity, but I do so in the full code is below:
1 # Perl weekly challenge 171
2 # Task 2: First class function
3 #
4 # See https://wlmb.github.io/2022/06/27/PWC171/#task-2-first-class-function
5 use v5.36;
6 die <<END unless @ARGV>=2;
7 Usage: .ch-2.pl "sub{...}" "sub{...}" arg1 arg2...
8 to compose two functions and apply them to the given arguments
9 END
10 my ($f, $g)=map {eval $_ or die $@} my ($fs, $gs)=(shift, shift);
11 my $h=compose($f, $g);
12 say "$fs ∘ $gs : ", join(", ", @ARGV), " ↦ ", $h->(@ARGV);
13
14 sub compose($f, $g){
15 sub {$f->($g->(@_))};
16 }
Examples:
./ch-2.pl 'sub($x){log($x)/log(10)}' 'sub($x){$x**2}' 10
./ch-2.pl 'sub($x, $y){sqrt($x**2+$y**2)}' 'sub($x1, $y1, $x2, $y2){($x1+$x2, $y1+$y2)}' 1 1 2 3
./ch-2.pl 'sub($x){sin($x)}' 'sub($x, $y){atan2($y, $x)}' 1 1
Results:
sub($x){log($x)/log(10)} ∘ sub($x){$x**2} : 10 ↦ 2
sub($x, $y){sqrt($x**2+$y**2)} ∘ sub($x1, $y1, $x2, $y2){($x1+$x2, $y1+$y2)} : 1, 1, 2, 3 ↦ 5
sub($x){sin($x)} ∘ sub($x, $y){atan2($y, $x)} : 1, 1 ↦ 0.707106781186547
Here, I used the compose ∘ and the yields ↦ symbols.