Merge pull request #5529 from dcw803/master

imported my solutions to this week's tasks

4 files changed, 282 insertions, 24 deletions

diff --git a/challenge-147/duncan-c-white/README b/challenge-147/duncan-c-white/README
index aae0f64482..91d23b989b 100644
--- a/challenge-147/duncan-c-white/README
+++ b/challenge-147/duncan-c-white/README
@@ -1,39 +1,47 @@
-TASK #1 - 10001st Prime Number
+TASK #1 - Truncatable Prime
 
-Write a script to generate the 10001st prime number.
+Write a script to generate first 20 left-truncatable prime numbers in base 10.
 
-(Remember that 2 is the 1st prime number).
+In number theory, a left-truncatable prime is a prime number which, in a
+given base, contains no 0, and if the leading left digit is successively
+removed, then all resulting numbers are primes.
 
+Example
+
+9137 is one such left-truncatable prime since 9137, 137, 37 and 7 are
+all prime numbers.
 
 MY NOTES: Very easy, especially (tada) if you happen to have a prime
 generating module that you've already used several times in these
 challenges..
 
 
-TASK #2 - Curious Fraction Tree
-
-Consider the following Curious Fraction Tree:
-
-[diagram in which the root is 1/1, and for each element N/D
-it's right child is N+D/D, and it's left child is N/N+D]
-
-You are given a N/D member of the tree created similar to the above sample.
-
-Write a script to find out the parent and grandparent of the given member.
+TASK #2 - Pentagon Numbers
 
-Example 1:
+Write a script to find the first pair of Pentagon Numbers whose sum and difference are also a Pentagon Number.
 
-    Input: $member = '3/5';
-    Output: parent = '3/2' and grandparent = '1/2'
+    Pentagon numbers can be defined as P(n) = n(3n - 1)/2.
 
-Example 2:
+Example
 
-    Input: $member = '4/3';
-    Output: parent = '1/3' and grandparent = '1/2'
+	The first 10 Pentagon Numbers are:
+	1, 5, 12, 22, 35, 51, 70, 92, 117 and 145.
 
-MY NOTES: hmm..  having determined the left and right child rules
-above, I worked out that given a child N/D the parent rule is
-"if D>N then (N, D-N) else (N-D, D)"
+	P(4) + P(7) = 22 + 70 = 92 = P(8)
+	but
+	P(4) - P(7) = |22 - 70| = 48 is not a Pentagon Number.
 
-So very easy using that rule twice (and why not go all the way up to
-the root while we're doing it).
+MY NOTES: Ok, reasonably straight forward, calc first N Pentagon numbers,
+form a sethash of them to allow lookups, then iterate over all pairs of
+Pentagon numbers rejecting all pairs where the diff or sum isn't a Pentagon
+number. The diff of any two of the first N Pentagon numbers is obviously
+smaller, so may be looked up directly in the sethash.  The only tricky bit
+concerns the SUM of any two of them, because that sum may be greater than
+the biggest Pentagon number we know as yet, hence not in the sethash because
+we haven't calculated such Pentagon numbers yet - not because it's not a
+Pentagon number.  I can nearly see the structure of an adaptive solution,
+that generates Pentagon numbers incrementally, but it's a bit tricky.
+So instead let's Keep It Simple - just generate the first N Pentagon numbers
+and see if we can find any matching pair of those (where the sum is in the
+first N Pentagon numbers).  If not, run the program again with a bigger value
+of N.  Experimentation reveals that N=2400 finds the solution..
diff --git a/challenge-147/duncan-c-white/perl/MakePrimes.pm b/challenge-147/duncan-c-white/perl/MakePrimes.pm
new file mode 100644
index 0000000000..6b5cd8e9fe
--- /dev/null
+++ b/challenge-147/duncan-c-white/perl/MakePrimes.pm
@@ -0,0 +1,97 @@
+#
+#	mkprimes module (converted from mkprimes.c)
+#
+
+use strict;
+use warnings;
+use Function::Parameters;
+
+
+my $debug = 0;
+my @foundprimes;	# remember all primes we've found..
+
+
+fun prime_debug( $d )
+{
+	$debug = $d;
+}
+
+
+#
+# my @primes = primes_upto( $n );
+#	Find all primes up to N; return a list of all such primes
+#	(note that 1 is not usually considered a prime)
+#
+fun primes_upto( $n )
+{
+	my @isprime;
+
+	for( my $i=1; $i<=$n; $i++ )
+	{
+		$isprime[$i] = 1;		# initially
+	}
+
+	# now sieve the non-primes out..
+	my $upper = int(sqrt($n));
+	printf( "debug: n=%d, upper=%d\n", $n, $upper ) if $debug;
+	for( my $i=2; $i<=$upper; $i++ )
+	{
+		if( $isprime[$i] )
+		{
+			#printf( "debug: crossing out multiples of %d\n", $i );
+			for( my $j=$i*$i; $j<=$n; $j+=$i )
+			{
+				$isprime[$j] = 0;
+			}
+		}
+	}
+
+	# after sieving, extract the primes
+	my @primes = grep { $isprime[$_] } 2..$n;
+
+	# remember them
+	@foundprimes = @primes;
+
+	return @primes;
+}
+
+
+#
+# my @moreprimes = more_primes( $n, $m );
+#	Need more primes!  Have @foundprimes up to $n, but need
+#	to sieve primes from $n+1..$m, so re-sieve, return
+#	a list of all new primes (in the range $n+1..$m) that we find.
+#
+fun more_primes( $n, $m )
+{
+	my %isprime;
+
+	print "finding more primes from ", $n+1, "..$m\n" if $debug;
+
+	for( my $i=$n+1; $i<=$m; $i++ )
+	{
+		$isprime{$i} = 1;	# pre-sieving
+	}
+
+	# now sieve the non-primes out..
+	foreach my $prime (@foundprimes)
+	{
+		# find first multiple of $prime > $n
+		my $mult = $prime * (int($n/$prime)+1);
+
+		#print "debug: xo multiples of $prime from $mult to $m\n";
+
+		for( my $j=$mult; $j<=$m; $j+=$prime )
+		{
+			delete $isprime{$j};
+		}
+	}
+
+	# after sieving, extract the primes
+	my @primes = grep { $isprime{$_} } $n+1..$m;
+	push @foundprimes, @primes;
+	return @primes;
+}
+
+
+1;
diff --git a/challenge-147/duncan-c-white/perl/ch-1.pl b/challenge-147/duncan-c-white/perl/ch-1.pl
new file mode 100755
index 0000000000..4a3263b7be
--- /dev/null
+++ b/challenge-147/duncan-c-white/perl/ch-1.pl
@@ -0,0 +1,81 @@
+#!/usr/bin/perl
+# 
+# TASK #1 - Truncatable Prime
+#
+# Write a script to generate first 20 left-truncatable prime numbers in base 10.
+# 
+# In number theory, a left-truncatable prime is a prime number which, in a
+# given base, contains no 0, and if the leading left digit is successively
+# removed, then all resulting numbers are primes.
+# 
+# Example
+# 
+#	9137 is one such left-truncatable prime since 9137, 137, 37 and 7 are
+#	all prime numbers.
+#
+# MY NOTES: Very easy, especially (tada) if you happen to have a prime
+# enerating module that you've already used several times in these
+# challenges..
+# 
+
+use strict;
+use warnings;
+use feature 'say';
+use Getopt::Long;
+use Data::Dumper;
+
+use lib qw(.);
+use MakePrimes;
+
+
+my %isprime;
+
+
+#
+# my $islt = left_truncatable($p);
+#	Return 1 iff prime $p is a left truncatable prime.
+#
+sub left_truncatable
+{
+	my( $p ) = @_;
+	return 0 if $p =~ /0/;
+	my $origp = $p;
+	while( length($p)>1 )
+	{
+		$p =~ s/^\d//;
+		return 0 unless $isprime{$p};
+	}
+	#say "$origp is lt";
+	return 1;
+}
+
+
+my $debug=0;
+die "Usage: first-n-left-truncatable-primes [--debug] [N, default 20]\n"
+	unless GetOptions( "debug"=>\$debug ) && @ARGV<2;
+
+my $n = shift // 20;
+
+prime_debug( $debug );
+
+my $bandwidth = 10000;
+my $upto = $bandwidth;
+my @primes = primes_upto( $upto );
+#say "last prime up to $upto is $primes[-1]";
+map { $isprime{$_} = 1 } @primes;
+
+my @ltprimes = grep { left_truncatable($_) } @primes;
+my $ltprimesfound = @ltprimes;
+
+while( $ltprimesfound < $n )
+{
+	my $from = $upto;
+	$upto += $bandwidth;
+	my @moreprimes = more_primes( $from, $upto );
+	say "checking primes up to $moreprimes[-1], $ltprimesfound left truncatable primes found";
+	map { $isprime{$_} = 1 } @moreprimes;
+	push @ltprimes, grep { left_truncatable($_) } @moreprimes;
+	$ltprimesfound = @ltprimes;
+}
+
+say join( ', ', @ltprimes[0..$n-1] );
diff --git a/challenge-147/duncan-c-white/perl/ch-2.pl b/challenge-147/duncan-c-white/perl/ch-2.pl
new file mode 100755
index 0000000000..b1ddbe2e36
--- /dev/null
+++ b/challenge-147/duncan-c-white/perl/ch-2.pl
@@ -0,0 +1,72 @@
+#!/usr/bin/perl
+# 
+# TASK #2 - Pentagon Numbers
+# 
+# Write a script to find the first pair of Pentagon Numbers whose sum
+# and difference are also a Pentagon Number.
+# 
+#     Pentagon numbers can be defined as P(n) = n(3n - 1)/2.
+# 
+# Example
+# 
+# 	The first 10 Pentagon Numbers are:
+# 	1, 5, 12, 22, 35, 51, 70, 92, 117 and 145.
+# 
+# 	P(4) + P(7) = 22 + 70 = 92 = P(8)
+# 	but
+# 	P(4) - P(7) = |22 - 70| = 48 is not a Pentagon Number.
+# 
+# MY NOTES: Ok, reasonably straight forward, calc first N Pentagon numbers,
+# form a sethash of them to allow lookups, then iterate over all pairs of
+# Pentagon numbers rejecting all pairs where the diff or sum isn't a Pentagon
+# number. The diff of any two of the first N Pentagon numbers is obviously
+# smaller, so may be looked up directly in the sethash.  The only tricky bit
+# concerns the SUM of any two of them, because that sum may be greater than
+# the biggest Pentagon number we know as yet, hence not in the sethash because
+# we haven't calculated such Pentagon numbers yet - not because it's not a
+# Pentagon number.  I can nearly see the structure of an adaptive solution,
+# that generates Pentagon numbers incrementally, but it's a bit tricky.
+# So instead let's Keep It Simple - just generate the first N Pentagon numbers
+# and see if we can find any matching pair of those (where the sum is in the
+# first N Pentagon numbers).  If not, run the program again with a bigger value
+# of N.  Experimentation reveals that N=2400 finds the solution..
+# 
+
+use strict;
+use warnings;
+use feature 'say';
+use Getopt::Long;
+use Data::Dumper;
+
+
+my $debug=0;
+
+die "Usage: first-pentagon-number-pair [--debug] NP\n" unless
+	GetOptions( "debug"=>\$debug ) && @ARGV<2;
+
+my $np = shift // 2400;
+my @p = map { $_ * (3*$_-1) / 2 } 1..$np;
+
+#die Dumper(\@p);
+
+my %isp = map { $_ => 1 } @p;
+#die Dumper(\%isp);
+
+# try all pairs where first>second (so that the diff doesn't need abs())..
+
+foreach my $fpos (0..$#p)
+{
+	my $first = $p[$fpos];
+	foreach my $spos (0..$fpos-1)
+	{
+		my $second = $p[$spos];
+		die if $first <= $second;
+		say "trying $first, $second" if $debug;
+		my $diff = $first-$second;
+		next unless $isp{$diff};
+		my $sum = $first+$second;
+		next unless $isp{$sum};
+		say "found pair P[$fpos], P[$spos]: $first, $second: sum=$sum, diff=$diff";
+		exit 0;
+	}
+}