Merge pull request #6532 from mattneleigh/pwc175

	new file:   challenge-175/mattneleigh/perl/ch-1.pl

2 files changed, 308 insertions, 0 deletions

diff --git a/challenge-175/mattneleigh/perl/ch-1.pl b/challenge-175/mattneleigh/perl/ch-1.pl
new file mode 100755
index 0000000000..5094bfcaee
--- /dev/null
+++ b/challenge-175/mattneleigh/perl/ch-1.pl
@@ -0,0 +1,96 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my $year = 2022;
+
+print("\n");
+printf(
+    "In the year %04d, the last Sundays of the month are:\n%s\n\n",
+    $year,
+    join("\n", last_sundays_in_year($year))
+);
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Determine the dates of the last Sundays of each month in a specified year
+# after 1000
+# Takes one argument:
+# Returns on success:
+# * A list of dates of the last Sundays of the month in the specified year, in
+#   ISO 8601 format (i.e. YYYY-MM-DD)
+# Returns on error:
+# * undef if the specified year is less than 1000
+################################################################################
+sub last_sundays_in_year{
+    use Time::Local;
+    use constant SECONDS_PER_DAY  => 86400;
+    use constant SECONDS_PER_WEEK => 604800;
+
+    my $year = int(shift());
+
+    # Not dealing with anything earlier than 1000
+    # due to the vagaries of timegm();
+    # timegm_modern() doesn't seem to be available
+    # on most of my systems, so eh...
+    return(undef)
+        if($year < 1000);
+
+    my $time;
+    my @time_fields;
+    my @dates;
+
+    # Seconds since the start of the epoch at
+    # 00:01:00 GMT on January 1 in the specified
+    # year
+    $time = timegm(0, 1, 0, 1, 0, $year);
+    @time_fields = gmtime($time);
+
+    # Advance $time to the first Sunday AFTER
+    # New Year's Day (even if NYD is itself a
+    # Sunday)
+    $time += (7 - $time_fields[6]) * SECONDS_PER_DAY;
+
+    # Loop until we've passed the end of the
+    # specified year
+    $year -= 1900;
+    while($time_fields[5] == $year){
+        my @prev_time_fields = @time_fields;
+
+        # Advance the time by a week
+        $time += SECONDS_PER_WEEK;
+        @time_fields = gmtime($time);
+
+        if($time_fields[4] != $prev_time_fields[4]){
+            # We changed months... store the previous
+            # Sunday
+            push(
+                @dates,
+                sprintf(
+                    "%04d-%02d-%02d",
+                    $prev_time_fields[5] + 1900,
+                    $prev_time_fields[4] + 1,
+                    $prev_time_fields[3],
+                )
+            );
+        }
+    }
+
+    return(@dates);
+
+}
+
+
+
diff --git a/challenge-175/mattneleigh/perl/ch-2.pl b/challenge-175/mattneleigh/perl/ch-2.pl
new file mode 100755
index 0000000000..705ec0269b
--- /dev/null
+++ b/challenge-175/mattneleigh/perl/ch-2.pl
@@ -0,0 +1,212 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my $n = 20;
+my $i = 1;
+my @perfect_totients;
+
+while(scalar(@perfect_totients) < $n){
+    push(@perfect_totients, $i)
+        if(is_perfect_totient($i));
+    $i++;
+}
+
+printf(
+    "\nThe first %d perfect totient numbers are:\n\n%s\n\n",
+    $n,
+    join(", ", @perfect_totients)
+);
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Determine whether a positive integer N is a perfect totient number
+# Takes one argument:
+# * The positive integer N to examine
+# Returns:
+# * 1 if N is a perfect totient number
+# * 0 if N is not a perfect totient number
+# See https://en.wikipedia.org/wiki/Perfect_totient_number for more information
+# about this type of number
+################################################################################
+sub is_perfect_totient{
+    my $n = int(shift());
+
+    my $totient = $n;
+    my $totient_sum = 0;
+
+    while($totient != 1){
+        $totient = totient($totient);
+        $totient_sum += $totient;
+    }
+
+    return(
+        $totient_sum == $n ? 1 : 0
+    );
+
+}
+
+
+
+################################################################################
+# Calculate the number of positive integers that are relatively prime to a
+# positive integer N by way of Euler's totient function
+# Takes one argument:
+# * The positive integer N to examine
+# Returns:
+# * The number of positive integers that are relatively prime to N
+# See https://en.wikipedia.org/wiki/Euler%27s_totient_function for more
+# information about this type of number
+# NOTE: This function maintains a persistent store of computed totients so
+# repeated calls on the same value will not require repeated calculations
+################################################################################
+sub totient{
+    use v5.10;
+
+    my $n = int(shift());
+
+    # Special case: 1
+    return(1)
+        if($n == 1);
+
+    # This will persist across calls
+    state @totients;
+
+    # No totient will be zero, so we can check for
+    # undef (no totient) this way
+    unless($totients[$n]){
+        # We haven't seen this number before; calculate its
+        # totient and store it
+        my $totient = $n;
+        my @prime_factors;
+
+        prime_factorize_distinct($n, \@prime_factors);
+
+        foreach my $factor (@prime_factors){
+            $totient *= 1 - (1 / $factor);
+        }
+
+        # In case of round-off error...
+        $totients[$n] = sprintf("%d", $totient) + 0;
+    }
+
+    return($totients[$n]);
+
+}
+
+
+
+################################################################################
+# Find the distinct prime factors of a given positive integer N
+# Takes two arguments:
+# * The positive integer N to examine and factor (e.g. 50)
+# * A ref to a list that will be populated with prime factors in ascending
+#   order (e.g. [ 2, 5 ]; note that 5 would appear twice in a simple prime
+#   factorization of 50); any previous contents will be deleted
+# Returns no meaningful value
+################################################################################
+sub prime_factorize_distinct{
+    use POSIX;
+
+    my $n = int(shift());
+    my $factors = shift();
+
+    my $i = 2;
+
+    # Clobber existing list contents if any
+    @{$factors} = ();
+
+    # Loop until $n is prime
+    until(is_prime($n)){
+        # $n is not prime; set an upper bound on
+        # our factor search
+        my $max = ceil(sqrt($n));
+
+        # Loop until we find prime $i that
+        # divides evenly into $n
+        while($i <= $max){
+            unless(is_prime($i)){
+                $i++;
+                next;
+            }
+            last unless($n % $i);
+            $i++;
+        }
+
+        # Store the new prime factor $i if it is
+        # distinct
+        if(
+            # Always store if the list is empty
+            !scalar(@{$factors})
+            ||
+            ($i != $factors->[$#$factors])
+        ){
+            push(@{$factors}, $i);
+        }
+
+        # ...then divide $n by it
+        $n /= $i;
+
+    }
+
+    # Store $n, which by now is the last prime
+    # factor of the originally-supplied argument,
+    # if it is distinct
+    if(
+        # Always store if the list is empty
+        !scalar(@{$factors})
+        ||
+        ($n != $factors->[$#$factors])
+    ){
+        push(@{$factors}, $n);
+    }
+
+} 
+
+
+
+################################################################################
+# Determine whether a given integer N is prime
+# Takes one argument:
+# * The integer N
+# Returns on success:
+# * 1 if N is prime
+# * 0 if N is not prime
+# NOTE: If N is less than zero, it will always be considered nonprime
+################################################################################
+sub is_prime{
+    my $n = int(shift());
+
+    my $i;
+
+    # Take care of a few easy cases
+    return(1)
+        if(($n == 2) || ($n == 3));
+    return(0)
+        if(($n <= 1) || !($n % 2) || !($n % 3));
+
+    # See if certain factors divide evenly
+    for($i = 5; $i * $i <= $n; $i += 6){
+        if(!($n % $i) || !($n % ($i + 2))){
+            return(0);
+        }
+    }
+
+    return(1);
+
+}
+
+
+