Merge pull request #6515 from drbaggy/master

Finally got round to writing the blog!

4 files changed, 155 insertions, 33 deletions

diff --git a/challenge-175/james-smith/README.md b/challenge-175/james-smith/README.md
index d80b07f8a0..b1aad3d2c1 100644
--- a/challenge-175/james-smith/README.md
+++ b/challenge-175/james-smith/README.md
@@ -1,7 +1,7 @@
-[< Previous 173](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-173/james-smith) |
-[Next 175 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-175/james-smith)
+[< Previous 174](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-174/james-smith) |
+[Next 176 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-176/james-smith)
 
-# The Weekly Challenge 174
+# The Weekly Challenge 175
 
 You can find more information about this weeks, and previous weeks challenges at:
 
@@ -13,56 +13,94 @@ submit solutions in whichever language you feel comfortable with.
 
 You can find the solutions here on github at:
 
-https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-174/james-smith
+https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-175/james-smith
 
-# Task 1 - Disarium Numbers
+# Task 1 - Last Sunday
 
-***Write a script to generate first 19 Disarium Numbers. A disarium number is an integer where the sum of each digit raised to the power of its position in the number, is equal to the number.***
+***Write a script to list Last Sunday of every month in the given year.**
 
 ## Solution
 
 ```perl
-my $n = -1;
-for(1..19) {
-  my($c,$t) = (0,++$n);
-  $t-= $_ ** ++ $c for split //,$n;
-  $t ? (redo) : say $n;
+my @L = (31,31,28,31,30,31,30,31,31,30,31,30,31);
+
+sub last_day_of_months {
+  my $yr = shift;
+  $L[2] = (my $ly  = !( $yr%400 && ( ($yr%4) || !($yr%100) ) )) ? 29 : 28;
+  my $last = 31 - ( int(($yr%100)/4) - $ly + 2 * (int(3 - $yr/100)%4) + $yr%100 ) % 7;
+  map { ( ($last += 35 - $L[$_-1]) > $L[$_] ) && ($last-=7);
+        sprintf '%04d-%02d-%02d', $yr, $_, $last
+      } 1..12;
 }
 ```
+### Notes
 
-### Complex map
+The algorithm works by finding the last Sunday in December of the previous year (`$last`) and then walks forward a month at a time to find the last sunday in each month of the your.
 
-```perl
-$n = -1;
-say for map { while(1) { my($c,$t)=(0,++$n); $t-=$_**++$c for split//,$n; $t || last }; $n } 1..19;
+We note the last Sunday in the month is either 4 or 5 weeks away so we can get the date by adding 35 days to the current last Sunday and seeing if that happens to be in the next month (if it isn't we subtract 7 days to get back into the correct month. We make adjustments for the length of the previous month, and repeat.
+
+The computation is broken into two parts - we first work out if the year is a leap year {divisible by 4 but not 100 unless divisible by 400}
+
+We use this value twice - once to modify the length of february - and once in the calulation for end of the previous year.
+
+To get the last Sunday of December of the previous year we work out the day of the `0th` of January in our year of interest. This gives the day of the week of December 31st - we subtract this from 31 to get the last Sunday.
+
+# Task 2 - Perfect Totient Numbers
+
+***Write a script to generate first 20 Perfect Totient Numbers. In number theory, a perfect totient number is an integer that is equal to the sum of its iterated totients. Take n, compute it's totient, then compute it's totient and repeat. Then add values. The toient of a number is the count of numbers smaller than it that are co-prime.***
+
+## Notes
+
+**Sum of totients**
+
+First thing we note is that the "sum of totients" (`S(n)`) for `n` is equal to the sum of the totient (`t(n)`) for `n` & the Sum of totients of that value.
 
 ```
+   S(n) = t(n) + S( t(n) );
+```
 
-# Task 2 - Permutation Ranking
+This reduces the problem to a recursive solution. So naturally we use a memoized (caching function) to store `S(n)` - State variables are useful here to store those values - each time you call the function they remember values before.. In this case the cache of `S(n)` values. We pre-populate 1 value in the cache when `n` is `1` the totient is `0` and so is the sum of `totients`. The first `0` is a pad so arrays are `0` based.
 
-***You are given a list of integers with no duplicates, e.g. [0, 1, 2]. Write two functions, permutation2rank() which will take the list and determine its rank (starting at 0) in the set of possible permutations arranged in lexicographic order, and rank2permutation() which will take the list and a rank number and produce just that permutation.***
+**Totient number**
 
-## Solution
+Computing the `gcd(n,m)` for all `m` less than `n` gets hard to compute. So is there a way to avoid this - well yes there is!
 
-The one obvious thing we don't want to do is generate a complete list of permutations and display that - so we have to work out an algoritm to convert rank to values!
+If we generate a prime factorization of `n` then we can use this to quickly compute the totient.
+
+If `n` = `p1^k1 . p2^k2 . ...` then we can simplify the calculation. For to be co-prime with `n` and number must be co-prime to `p1`, `p2`, .... For each `p` the number of co-primes in `p^k` numbers is `p^k - p^(k-1)` or `p^(k-1) . (p-1)`.
+
+Furthermore we note that these are "orthogonal" and so the totient is the product of this value for all primes.
+
+We use our favourite prime library and `factor_exp` to get this factorization and compute the product.
+
+## Solution
 
 ```perl
-sub permutation2rank {
-  my($r,$f,@l,$c,$x) = (0,1,@{$_[0]}), my @p = @{$_[1]};
-  $f *= $_ for 1 .. @l;
-  O: for ( reverse 1 .. @l ) {
-    $f/=$_, $c = 0, $x = shift @p;
-    ($x-$_) ? $c++ : ( $r+=$c*$f, splice(@l,$c,1), next O ) for @l;
-    return -1;
+sub sum_totients {
+  state @T = (0,0);
+  unless( defined $T[ $_[0] ] ) {
+    my $z = 1;
+    $z *= $_->[0]**($_->[1]-1) * ($_->[0]-1) for factor_exp $_[0];
+    $T[ $_[0] ] = $z + sum_totients( $z );
   }
-  $r;
+  $T[ $_[0] ];
 }
+```
+
+We can rewrite this as a 1-liner using `List::Util`s product function.
+
+Now there is a second nasty trick here - which if you are used to javascript *self-executing closure*. The trick allows us here to
+use the result of the totient calculation and use it to calculate the `t(n) + S( t(n) )` calculation without a *temporary* variable.
 
-sub rank2permutation {
-  my( $r, $f, @index, @res ) = ( $_[1], 1, 0 .. (my $n = my @l = @{$_[0]}) -1 );
-  $f *= $_ for 1 .. $n;
-  return [] if $r >= $f;  ## rank out of range!
-  push @res, $l[ splice @index, ($r%=$f) / ($f/=$_), 1 ] for reverse 1..$n;
-  \@res;
+The code reduces to, watch out for the two difference `$_[]` and the `$_->[]`...:
+
+```perl
+sub st {
+  state @T = (0,0);
+  $T[ $_[0] ] //= sub{$_[0]+st($_[0])}->(
+                    product
+                      map { $_->[0]**($_->[1]-1) * ($_->[0]-1) }
+                      factor_exp $_[0]
+                  );
 }
 ```
diff --git a/challenge-175/james-smith/blog.txt b/challenge-175/james-smith/blog.txt
new file mode 100644
index 0000000000..ff5fffcdb7
--- /dev/null
+++ b/challenge-175/james-smith/blog.txt
@@ -0,0 +1,2 @@
+https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-175/james-smith
+
diff --git a/challenge-175/james-smith/perl/ch-1.pl b/challenge-175/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..369e3ced03
--- /dev/null
+++ b/challenge-175/james-smith/perl/ch-1.pl
@@ -0,0 +1,31 @@
+#!/usr/local/bin/perl
+
+use strict;
+use warnings;
+use feature qw(say state);
+use DateTime;
+
+my @L = (31,31,28,31,30,31,30,31,31,30,31,30,31);
+
+## Note this calculation is based on the Gregorian calendar rather than the Julian one.
+## The year part of the calculation can be adjusted to take into Julian dates. There
+## are issues on what to use as the cut-off, the date of adpoption of the Gregorian
+## calendar ranges from 1582 to 2016. The UK didn't adopt the calendar into 1754,
+## where in large parts of Europe is was adopted from 1582.
+
+foreach my $yr ( @ARGV ) {
+  say join ' ', last_day_of_months( $yr );
+}
+
+sub last_day_of_months {
+  my $yr = shift;
+                        ## Compute if leap year - set the length of feb accordingly.
+  $L[2] = (my $ly  = !( $yr%400 && ( ($yr%4) || !($yr%100) ) )) ? 29 : 28;
+                        ## Compute the last Sunday in december of the previous year
+  my $last = 31 - ( int(($yr%100)/4) - $ly + 2 * (int(3 - $yr/100)%4) + $yr%100 ) % 7;
+                        ## Finally work out the last days of the following 2 months.
+  map { ( ($last += 35 - $L[$_-1]) > $L[$_] ) && ($last-=7);
+        sprintf '%04d-%02d-%02d', $yr, $_, $last
+      } 1..12;
+}
+
diff --git a/challenge-175/james-smith/perl/ch-2.pl b/challenge-175/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..946839b86b
--- /dev/null
+++ b/challenge-175/james-smith/perl/ch-2.pl
@@ -0,0 +1,51 @@
+#!/usr/local/bin/perl
+
+use strict;
+use warnings;
+use feature qw(say state);
+use Math::Prime::Util qw(factor_exp);
+use List::Util qw(product);
+use Time::HiRes qw(time);
+
+my $c = 40;
+
+my $t0 = time;
+my $n = 1;
+st(++$n)           - $n ? redo : say sprintf '%3d %10d %10.3f', $_, $n, time-$t0 for 1..$c;
+my $t1 = time;
+$n = 1;
+sum_totients(++$n) - $n ? redo : say sprintf '%3d %10d %10.3f', $_, $n, time-$t1 for 1..$c;
+my $t2 = time;
+
+say '';
+say sprintf 'One-liner - %10.6f', $t1-$t0;
+say sprintf 'Expanded  - %10.6f %10.6f', $t2-$t1, 100*($t2-$t1)/($t1-$t0);
+
+# If $n > 1 then the count of co-prime values is equal
+# to the product of p^n-p^(n-1) for all prime factors
+#      (where n is the number of times p is a factor)
+# we can re-write this as p^(n-1)(p-1)
+# As factor_exp is fast this removes the need to compute
+# the gcd of every pair of numbers....
+# we also keep track of the perfect totient numbers gone
+# before so that we re-use the previously computed value
+# if we already have it...;
+
+sub st {
+  state @T = (0,0);
+  $T[ $_[0] ] //= sub{$_[0]+st($_[0])}->(
+                  product
+                    map { $_->[0]**($_->[1]-1) * ($_->[0]-1) }
+                    factor_exp $_[0]);
+}
+
+sub sum_totients {
+  state @T = (0,0);
+  unless( defined $T[ $_[0] ] ) {
+    my $z = 1;
+    $z *= $_->[0]**($_->[1]-1) * ($_->[0]-1) for factor_exp $_[0];
+    $T[ $_[0] ] = $z + sum_totients( $z );
+  }
+  $T[ $_[0] ];
+}
+