Perl Weekly Challenge: Week 175

Challenge 1:

Last Sunday

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

It's been some time since we've had my favorite; a date-related challenge. Raku has all we need built in.

for 1..12 -> $month {

For each month in the designated year...

    my $lastDate = Date.new($year, $month, 1).last-date-in-month;

...we create an object of class Date and initialize it with the year and month. As we also have to provide a day to the constructor, we set that to 1. This object has a method which returns another Date representing the last date in the month. We capture this in the $lastDate variable.

    say $lastDate - $lastDate.day-of-week % 7;

Date also has a method day-of-week() which returns an integer from 1 to 7 where 1 equals Monday and 7 is Sunday. If we take that value modulo 7, we will know how many days to subtract from $lastDate in order to get the last Sunday. We don't need to do anything special to print this out as the default representation for Date is yyyy-mm-dd which is what the spec asks for,

}

(Full code on Github.)

For Perl I used the DateTime CPAN module for the Date arithmetic.

for my $month  (1..12) {

Once again I applied the calculation to each month.

    my $lastDate = DateTime->last_day_of_month(year => $year, month => $month);

The DateTime class has a constructor last_day_of_month() which given a year and month (day is not required unlike Raku.) returns a new DateTime object representing the last day of that month.

    $lastDate ->subtract(days => $lastDate->dow % 7);

The dow() method works the same as Date.day-of-week() in Raku. The result modulo 7 is the number of days to substract from $lastDate (using the subtreact() method) to get the last Sunday.

    say $lastDate->ymd;

In order to get the yyyy-mm-dd format, we need the ymd() method.

}

(Full code on Github.)

Challenge 2:

Perfect Totient Numbers

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

Yet another number series. So my MAIN() function follows the same structure I've used for similar challenges.

    my @perfectTotients;
    my $n = 1;

    while @perfectTotients.elems < 20 {
        if isPerfectTotient($n) {
            @perfectTotients.push($n);
        }
        $n++;
    }

    @perfectTotients.join(q{, }).say;

Starting from 1, we go through consecutive integers collected perfect totient numbers until we have 20 and then printing them out. The isPerfectTotient() function does all the heavy lifting.

Originally the function used recursion but I changed it to this way to make it a little faster and give my laptops fan a break especially on the larger numbers.

sub isPerfectTotient(Int $n) {
    my $total = 0;
    my $current = $n;

    while $current != 0 {
        my $totients = totients($current);
        $total += $totients;
        $current = $totients;
    }

Starting with $n (which is copied to $current because function parameters are immutable by default in Raku) a while loop is run as long as $current is not zero. In it, $current is passed to another function called totients() which returns the number of totients (Am I using this word correctly? They are also known as relative primes or coprimes) it has. This result is stored in a variable called $totients which is not very good software engineering practice though Raku has no issues with a variable and a function having the same name. $totients is added to $total and becomes the next value of $current.

    return $total == $n;

Once the loop is completed, the $total number of totients is compared to $n. If the two are equal, $n is a perfect totient and True is returned otherwise False.

}

As mentioned previously, a function called totients() actually counts the totients.

sub totients(Int $n) {
    my $tots = 0;
    for 1 ..^ $n -> $i {
        if $i gcd $n == 1 {
            $tots++;
        }
    }

It works by going through all positive integers before $n. If such a number and $n have a greatest common divisor of 1, it means it is a totient. Raku has a handy gcd operator we can use.

I notice that atleast here I had the presence of mind to call the result variable something other than $totients.

    return $tots;
}

(Full code on Github.)

Perl doesn't have a gcd operator like Raku so the first order of business was to write a substitute. Or more accurately, to scour through previous challenges to see if I had written one. Which, in fact, I did but this function is recursive which probably helps explain why the Perl version was uncharacteristically slower than the Raku version.

sub gcd {
    my ($a, $b) = @_;

    return 0 == $b ? $a : gcd($b, $a % $b);
}

The rest of the script pretty much looks the same as in Raku.

my @perfectTotients;
my $n = 1;

while (scalar @perfectTotients < 20) {
    if (isPerfectTotient($n)) {
        push @perfectTotients, $n;
    }
    $n++;
}

say join q{, }, @perfectTotients;

sub isPerfectTotient {
    my ($n) = @_;
    my $total = 0;
    my $current = $n;

    while ($current != 0) {
        my $totients = totients($current);
        $total += $totients;
        $current = $totients;
    }

    return $total == $n;
}

sub totients {
    my ($n) = @_;
    my $tots = 0;
    for my $i (1 .. $n - 1) {
        if (gcd($i, $n) == 1) {
            $tots++;
        }
    }

    return $tots;
}

(Full code on Github.)