Perl Weekly Challenge 175.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 173.
Task 1: Last Sunday
Submitted by: Mohammad S Anwar
Write a script to list Last Sunday of every month in the given
year.
For example, for year 2022, we should get the following:
2022-01-30
2022-02-27
2022-03-27
2022-04-24
2022-05-29
2022-06-26
2022-07-31
2022-08-28
2022-09-25
2022-10-30
2022-11-27
2022-12-25
This task is easy using the module DateTime, as it provides
methods to get the last day of a month, the corresponding day
of the week, and facilities for doing date math. This allows a
simple oneliner:
perl -MDateTime -E '$y=shift; say $_->subtract(days=>$_->day_of_week%7)->ymd for
map {DateTime->last_day_of_month(year=>$y, month=>$_)} (1..12)' 2022
Results:
2022-01-30
2022-02-27
2022-03-27
2022-04-24
2022-05-29
2022-06-26
2022-07-31
2022-08-28
2022-09-25
2022-10-30
2022-11-27
2022-12-25
The results correspond to the proleptic Gregorian calendar, so they may be historically wrong for remote dates for which the transition to the Gregorian calendar had not ocurred yet. Furthermore, the transition was at different dates in different places.
The full code is
1 # Perl weekly challenge 175
2 # Task 1: Last Sunday
3 #
4 # See https://wlmb.github.io/2022/07/25/PWC175/#task-1-last-sunday
5 use v5.36;
6 use DateTime;
7 die "Usage: $0 Y1 [Y2...]\nto print the last Sundays of years Y1, Y2...\n"
8 unless @ARGV;
9 foreach my $year(@ARGV){
10 say "\nLast Sundays of year $year:";
11 say $_->subtract(days=>$_->day_of_week%7)->ymd for
12 map {DateTime->last_day_of_month(year=>$year, month=>$_)} (1..12)
13 }
Example:
./ch-1.pl 2022 2023 2024
Results:
Last Sundays of year 2022:
2022-01-30
2022-02-27
2022-03-27
2022-04-24
2022-05-29
2022-06-26
2022-07-31
2022-08-28
2022-09-25
2022-10-30
2022-11-27
2022-12-25
Last Sundays of year 2023:
2023-01-29
2023-02-26
2023-03-26
2023-04-30
2023-05-28
2023-06-25
2023-07-30
2023-08-27
2023-09-24
2023-10-29
2023-11-26
2023-12-31
Last Sundays of year 2024:
2024-01-28
2024-02-25
2024-03-31
2024-04-28
2024-05-26
2024-06-30
2024-07-28
2024-08-25
2024-09-29
2024-10-27
2024-11-24
2024-12-29
Task 2: Perfect Totient Numbers
Submitted by: Mohammad S Anwar
Write a script to generate first 20 Perfect Totient
Numbers. Please checkout wikipedia page for more informations.
Output
3, 9, 15, 27, 39, 81, 111, 183, 243, 255, 327, 363, 471, 729,
2187, 2199, 3063, 4359, 4375, 5571
I need a sub to calculate the totient of a number, a
function to make a list of recursive totients, and then I just
sum them up and compare the result to the original number. It
all fits into a 3-liner.
perl -MList::Util=sum -E 'say $n=nt() for(1..shift); sub nt{state $n=1; ++$n; ++$n
until $n==sum ts($n);$n} sub ts($m){my $t=t1($m);$m==2?($t):(ts($t), $t)} sub t1($m){
scalar(@d=grep {gcd($m,$_)==1}(1..$m-1))}sub gcd($a,$b){$b==0?$a:gcd($b, $a%$b)}
' 20
Results:
3
9
15
27
39
81
111
183
243
255
327
363
471
729
2187
2199
3063
4359
4375
5571
It’s not too fast (took 45s in my laptop) but it works.
It may be made much faster and shorter by using the euler_phi fuction from
Math::Prime::Util instead of calculating my own totients:
perl -MMath::Prime::Util=euler_phi -MList::Util=sum -E 'say $n=nt() for(1..shift);
sub nt{state $n=1; ++$n; ++$n until $n==sum ts($n);$n} sub ts($m){my $t=euler_phi($m);
$m==2?($t):(ts($t), $t)}
' 20
gives the same results and took only 0.035s.
The full version is
# Perl weekly challenge 175
# Task 2: Perfect totient numbers
#
# See https://wlmb.github.io/2022/07/25/PWC175/#task-2-perfect-totient-numbers
use v5.36;
use List::Util qw(sum);
use Math::Prime::Util qw(euler_phi);
die "Usage: $0 N\nto print the first N perfect totient numbers\n"
unless @ARGV;
say "$_: ", next_perfect_totient() for(1..shift);
sub next_perfect_totient{
state $current=1;
++$current;
++$current until $current==sum recursive_totients($current);
$current
}
sub recursive_totients($m){ #(totient(m), totient(totient($m))...)
my $t=euler_phi($m);
$m==2?($t):(recursive_totients($t), $t)
}
./ch-2.pl 20