Merge pull request #5147 from drbaggy/master

First commit

4 files changed, 146 insertions, 39 deletions

diff --git a/challenge-137/james-smith/README.md b/challenge-137/james-smith/README.md
index b0b3dc8889..e2aaf64e38 100644
--- a/challenge-137/james-smith/README.md
+++ b/challenge-137/james-smith/README.md
@@ -1,4 +1,4 @@
-# Perl Weekly Challenge #136
+# Perl Weekly Challenge #137
 
 You can find more information about this weeks, and previous weeks challenges at:
 
@@ -10,64 +10,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-136/james-smith/perl
+https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-137/james-smith/perl
 
-# Task 1 -  Two friendly
+# Task 1 -  Long year
 
-***You are given 2 positive numbers, `$m` and `$n`. Write a script to find out if the given two numbers are "Two friendly".***
+***Write a script to find all the years between 1900 and 2100 which is a Long Year.***
 
-*Two positive numbers, `m` and `n` are two friendly when `gcd(m, n) = 2 ^ p` where `p > 0`. The greatest common divisor (gcd) of a set of numbers is the largest positive number that divides all the numbers in the set without remainder.*
+*Long years are those years with 53 weeks, they either start on a Thursday OR on a Wednesday in a Leap Year*
 
 ## The solution
 
-The logic of our solution is (1) find the GCD; (2) check they are not co-prime (GCD = 1); (3) The GCD is a power of 2
+We will do this without using Perl modules or date functions, the only "input" we need is that January 1st 1900 was in fact a Monday.
+We encode days of the week with Sunday = 0, Monday = 1, *etc*.
 
-We can test the last case by converting the GCD into binary - and checking to see if it has the form `10+`. Alternatively we can use `&` and `>>=` to remove trailing zeros.
+For each year the first thing we have to find out if the year is infact a leap year. That is achieved with the formulae
 
-All that gives us the simple function....
+```perl
+! $year % 4 && ( $year % 100 || ! $year % 400 );
+```
+
+We then check to see if the year is a long year, *i.e.* if starts on a Thursday (day 4) or Wednesday (day 3) in a leap year
 
 ```perl
-sub friendly {
-  my($a,$b) = @_;
-  ($a,$b) = ($b,$a%$b) while $b; ## Compute GCD
-  return 0 if $a == 1;           ## Co-prime not friendly
-  $a>>=1 until $a&1;             ## Remove trailing 0s
-  return $a == 1 ? 1 : 0;        ## Friendly iff
-}
+$start_day == 4 || $start_day == 3 && $is_leap_year;
+```
 
+Finally we increment the start day - by two days in a leap year or one in a non-leap year.
+```perl
+$start_day = ( $start_day + 1 + $is_leap_year ) % 7;
 ```
 
-# Task 2 - Fibonacci Sequence
+Bringing this altogether gives us the following code:
+
+```perl
+my $start_day = 1;
 
-***You are given a positive number `$n`. Write a script to find how many different sequences you can create using Fibonacci numbers where the sum of unique numbers in each sequence are the same as the given number. ***
+foreach my $year ( 1900 .. 2100 ) {
+  my $is_leap_year = ! $year % 4 && ( $year % 100 || ! $year % 400 );
+  say $year if $start_day == 4 || $start_day == 3 && $is_leap_year;
+  $start_day = ( $start_day + 1 + $is_leap_year ) % 7;
+}
+```
 
-## Solution
+# Task 2 - Lychrel Number
 
-There are two bits to this:
- * get a list of fibonacci numbers `<= $n`. Easier to find list up to the first fibonnaci number `> $n`.
-   * We have a cache of the fibonnaci numbers - we just need to extend it to include all those fibonnaci numbers below `$n` (if required).
- * get a list of sums of these numbers which equal `$n`
-   * We call a generic "get-sum" method where we pass in our target number and array of fibonacci numbers
-   * this get-sum method is then call recursively to count the number of totals
+***You are given a number, `10 <= $n <= 1000`. Write a script to find out if the given number is Lychrel number.***
  
-```perl
+*To keep the task simple, we impose the following rules: a. Stop if the number of iterations reached 500; b. Stop if you end up with number >= 10_000_000.*
 
-my @fib;
+*Note we don't know which numbers are Lychrel numbers, but we do know which aren't! Brute force will only get us so far - but leaves open the question of a palindrome further down the line than we stop computing and reversing sums.*
 
-sub fib_sum {
-  my $n = shift;
-  push @fib, $fib[-1] + $fib[-2] while $n > $fib[-1];
-  return sum( $n, grep { $_ <= $n }  @fib );
-}
+## Solution
 
-sub sum {
-  local $_;
-  my ( $t, @n ) = @_;
-  return 1 unless $t;
-  return 0 if $t < 0;
-  my $c = 0;
-  $c += sum( $t - $_, @n ) while $_ = shift @n;
-  return $c;
+The solution is suprisingly simple. Check to see if the number is a palindrome - if so return 0. If not add the reverse of the number to itself and repeat until the count or size limits in the question apply.
+
+```perl
+sub lychrel {
+  my($n,$c) = (shift,$COUNT);
+  ($n eq reverse $n) ? (return 0) : ($n+= reverse $n) while $c-- && $n <= $MAX;
+  1;
 }
+```
 
+You will note there is a limit on the size of `$n` in the question, and one of the reasons for this is that when `$n` gets large Perl reverts to floating point representation and the code here fails. Instead we can replace our representation of `$n` as a digit array, we can do the same calculations and checks on the elements of the array, but this allows us to deal with arbitrary sized values.
+ 
+```perl
+sub lychrel_large {
+  my ( $c, @n ) = ( $COUNT, split //, $_[0] );
+  while( $c-- ) {
+    return 0 if (join '', my @r = reverse @n ) eq (join '', @n);
+    ( $n[$_] += $r[$_] ) > 9  && ($n[$_] -= 10, $_ ? ($n[$_-1]++) : (unshift @n, 1) ) for reverse 0 .. @n-1;
+  }
+  1;
+}
+```
+The interesting line I suppose is:
 ```
+( $n[$_] += $r[$_] ) > 9  && ($n[$_] -= 10, $_ ? ($n[$_-1]++) : (unshift @n, 1) ) for reverse 0 .. @n-1;
+```
+This adds the reverse of the number represented in `@n` to itself, ready for the next iteration. If `$n[] = $r[]` is greater than 9 we have to carry one to the left.
+
+If this is not the first digit on `@n` we just carry to the next column `$n[$_-1]`, but if it is the first digit we can't do this so need to add an additional element (containing 1) as the new first digit....
+
+Doing this removes a number of "non Lychrel" numbers that are calculated by the previous function.
+
+### Lychrel numbers computed
+
+The first method found the following candidate Lychrel numbers between 1 and 1000:
+
+89 98 177 187 **196** 276 286 **295** 375 385 **394** **493** 573 583 **592** 672 682 **689** **691** 739 771 781 **788** **790** 849 869 870 **879** 880 **887** 899 937 948 968 **978** **986** 998
+
+The ones highlighted in bold are the candidate Lychrel numbers which are not ruled out by the second function.
diff --git a/challenge-137/james-smith/blog.txt b/challenge-137/james-smith/blog.txt
new file mode 100644
index 0000000000..65a139c4d0
--- /dev/null
+++ b/challenge-137/james-smith/blog.txt
@@ -0,0 +1 @@
+https://github.com/drbaggy/perlweeklychallenge-club/new/master/challenge-137/james-smith
diff --git a/challenge-137/james-smith/perl/ch-1.pl b/challenge-137/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..4ab92a0091
--- /dev/null
+++ b/challenge-137/james-smith/perl/ch-1.pl
@@ -0,0 +1,22 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Test::More;
+use Benchmark qw(cmpthese timethis);
+use Data::Dumper qw(Dumper);
+
+my $start_day = 1; ## Jan 1st 1900 was a Monday.
+
+foreach my $year ( 1900 .. 2100 ) {
+  my $is_leap_year = ! $year % 4 && ( $year % 100 || ! $year % 400 );
+  say $year if $start_day == 4 || $start_day == 3 && $is_leap_year;
+  $start_day = ( $start_day + 1 + $is_leap_year ) % 7;
+}
+
+## Compute if leap year?
+## Long year if starts on Thursday (day 4) or Wednesday (day 3) in a leap year
+## Next year starts on the next day of the week Mon->Tues ....
+##   except in a leap year when it moves 2 Mon->Wed
diff --git a/challenge-137/james-smith/perl/ch-2.pl b/challenge-137/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..8951d7c972
--- /dev/null
+++ b/challenge-137/james-smith/perl/ch-2.pl
@@ -0,0 +1,54 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Test::More;
+use Benchmark qw(cmpthese timethis);
+use Data::Dumper qw(Dumper);
+
+my $MAX         = 1e9;
+my $MAX_LARGE   = 40;
+my $COUNT = 500;
+my @TESTS = (
+  [ 56, 0 ],
+  [ 57, 0 ],
+  [ 59, 0 ],
+  [196, 1 ],
+);
+
+is( lychrel(      $_->[0]), $_->[1] ) foreach @TESTS;
+is( lychrel_large($_->[0]), $_->[1] ) foreach @TESTS;
+
+done_testing();
+
+sub lychrel {
+  my($n,$c) = (shift,$COUNT);
+  ($n eq reverse $n) ? (return 0) : ($n+= reverse $n) while $c-- && $n <= $MAX;
+  1;
+}
+
+sub lychrel_large {
+  my($n,$c) = (shift,$COUNT);
+  my @n = split //, $n;
+  while( $c-- && @n <= $MAX_LARGE ) {
+    my @r = reverse @n;
+    return 0 if (join '', @r) eq (join '', @n);
+    foreach ( reverse 0 .. @n-1 ) {
+      $n[$_] += $r[$_];
+      next if $n[$_] < 10;
+      $n[$_]-=10;
+      $_ ? ($n[$_-1]++) : (unshift @n,1);
+    }
+  }
+  1;
+}
+
+
+print "Simple:";
+print " $_" foreach grep { lychrel $_ } 10..1000;
+print "\nLarge: ";
+print " $_" foreach grep { lychrel_large $_ } 10..1000;
+print "\n\n";
+