RabbitFarm

2022-07-30

Sunday Was Perfectly Totient

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

Write a script to list the last sunday of every month in the given year.

Solution


use strict;
use warnings;
use Time::Piece; 

sub last_sunday_month{
    my($month, $year) = @_;
    $month = "0$month" if $month < 10;
    my $sunday;
    my $t = Time::Piece->strptime("$month", "%m");   
    for my $day (20 .. $t->month_last_day()){
        $t = Time::Piece->strptime("$day $month $year", "%d %m %Y");
        $sunday = "$year-$month-$day" if $t->wday == 1;
    }  
    return $sunday;  
}

sub last_sunday{
    my($year) = @_;
    my @sundays; 
    for my $month (1 .. 12){
        push @sundays, last_sunday_month($month, $year);  
    }
    return @sundays;   
}

MAIN:{
    print join("\n", last_sunday(2022)) . "\n"; 
} 

Sample Run


$ perl perl/ch-1.pl
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

Notes

When dealing with dates in Perl you have a ton of options, including implementing everything on your own. I usually use the Time::Piece module. Here you can see why I find it so convenient. With strptime you can create a new object from any conceivable date string, for setting the upper bounds on iterating over the days of a month we can use month_last_day, and there are many other convenient functions like this.

Part 2

Write a script to generate the first 20 Perfect Totient Numbers.

Solution


use strict;
use warnings;
use constant EPSILON => 1e-7;   

sub distinct_prime_factors{
    my $x = shift(@_); 
    my %factors;    
    for(my $y = 2; $y <= $x; $y++){
        next if $x % $y;
        $x /= $y;
        $factors{$y} = undef;
        redo;
    }
    return keys %factors;  
}

sub n_perfect_totients{
    my($n) = @_; 
    my $x = 1;
    my @perfect_totients;
    {
        $x++;
        my $totient = $x;
        my @totients;
        map {$totient *= (1 - (1 / $_))} distinct_prime_factors($x);   
        push @totients, $totient; 
        while(abs($totient - 1) > EPSILON){
            map {$totient *= (1 - (1 / $_))} distinct_prime_factors($totient);   
            push @totients, $totient; 
        }  
        push @perfect_totients, $x if unpack("%32I*", pack("I*", @totients)) == $x;
        redo if @perfect_totients < $n;
    }
    return @perfect_totients;
}

MAIN:{
    print join(", ", n_perfect_totients(20)) . "\n";
}

Sample Run


$ perl perl/ch-2.pl
3, 9, 15, 27, 39, 81, 111, 183, 243, 255, 327, 363, 471, 729, 2187, 2199, 3063, 4359, 4375, 5571

Notes

This code may look deceptively simple. In writing it I ended up hitting a few blockers that weren't obvious at first. The simplest one was my own misreading of how to compute totients using prime factors. We must use unique prime factors. To handle this I modified my prime factorization code to use a hash and by returning the keys we can get only the unique values. Next, while Perl is usually pretty good about floating point issues, in this case it was necessary to implement a standard epsilon comparison to check that the computed totient was equal to 1.

Actually, maybe I should say that such an epsilon comparison is always advised but in many cases Perl can let you get away without one. Convenient for simple calculations but not a best practice!

For doing serious numerical computing in Perl the best choice is of course to use PDL!

References

Time::Piece

Perfect Totient Number

Challenge 175

posted at: 12:08 by: Adam Russell | path: /perl | permanent link to this entry