Merge pull request #5591 from dcw803/master

imported my solutions to this week's questions

4 files changed, 227 insertions, 46 deletions

diff --git a/challenge-149/duncan-c-white/README b/challenge-149/duncan-c-white/README
index 586c2b6679..2a58cddb5b 100644
--- a/challenge-149/duncan-c-white/README
+++ b/challenge-149/duncan-c-white/README
@@ -1,58 +1,31 @@
-TASK #1 - Eban Numbers
+TASK #1 - Fibonacci Digit Sum
 
-Write a script to generate all Eban Numbers <= 100.
-
-An Eban number is a number that has no letter 'e' in it when the
-number is spelled in English (American or British).
-
-Example
-
-2, 4, 6, 30, 32 are the first 5 Eban numbers.
-
-MY NOTES: Very easy, no doubt there are CPAN modules to "speak" numbers
-in English, but let's do it from first principles..
-
-
-TASK #2 - Cardano Triplets
-
-Write a script to generate first 5 Cardano Triplets.
-
-A triplet of positive integers (a,b,c) is called a Cardano Triplet if
-it satisfies the below condition.
-
-  cuberoot(a+b.sqrt(c)) + cuberoot(a-b.sqrt(c)) = 1
+Given an input $N, generate the first $N numbers for which the sum of
+their digits is a Fibonacci number.
 
 Example
 
-(2,1,5) is the first Cardano Triplet.
+f(20)=[0, 1, 2, 3, 5, 8, 10, 11, 12, 14, 17, 20, 21, 23, 26, 30, 32, 35, 41, 44]
 
-MY NOTES: Ok, two mildly tricky things:
-1. real arithmetic means "=" is imprecise, we can't even use rationals as
-   sqrt() and cuberoot() are involved, so we'll need our old abs(diff)<epsilon
-   trick..   and
-2. the question says (2,1,5) is the "first" Cardano triplet - in what order?
+MY NOTES: Pretty easy.  Only question: how many Fibonacci numbers do we
+need to compute?  Let's extend the sequence whenever we need..
 
-The answer to the latter question sets the basic structure of the program.
-Perhaps we should "order by minimum sum of triplet numbers"?  ch-2.pl does
-that, effectively generating all (a,b,c) where a+b+c=SUM for gradually
-increasing values of SUM, testing whether each (a,b,c) triple is a Cardano
-triple.  It works perfectly well - but quite slowly.
 
-I then built a SECOND VERSION (ch-2FAST.pl) which uses a much more efficient
-parameterised version of Cardano Triplets that I found on the Internet.
-See the top comments in that for a longer explanation, but it turns out
-that we can (nearly) directly pick out Cardano triples by calculating:
+TASK #2 - Largest Square
 
-a=3k+2 and x=(k+1)**2(8k+5) for each k
+Given a number base, derive the largest perfect square with no repeated
+digits and return it as a string. (For base>10, use 'A'..'Z'.)
 
-(where x represents bsquared*c)
+Example:
 
-then we need to break x down into b and c - noting that several (b,c) pairs
-may result from a single value of x.
+    f(2)="1"
+    f(4)="3201"
+    f(10)="9814072356"
+    f(12)="B8750A649321"
 
-How much faster is this than ch-2.pl?  For n=40, ch-2 takes 30 seconds where
-ch-2FAST takes just under 2 seconds!  And this gets better as n increases,
-ch-2FAST takes 6.9s for n=100, but I gave up on running ch-2 40 after a couple
-of minutes when it had only found about 60 triples.
 
-Can anyone find a faster version?
+MY NOTES: Obvious technique is to compute all permutations of 0..B-1 (B the
+base), and check whether each is a perfect square, and track the largest
+perfect square we find.  I hate permutations, but I'm sure I have written
+a permutation generator in previous Perl Challenges...  Oh yes, I've stolen
+code from Challenge 134 (task 1) and made it into a simple Perms module here.
diff --git a/challenge-149/duncan-c-white/perl/Perms.pm b/challenge-149/duncan-c-white/perl/Perms.pm
new file mode 100644
index 0000000000..ce65b89760
--- /dev/null
+++ b/challenge-149/duncan-c-white/perl/Perms.pm
@@ -0,0 +1,46 @@
+package Perms;
+
+# 
+# Generate permutations, one at a time, using a
+# standard lexicographic permutation algorithm.
+# 
+
+use strict;
+use warnings;
+use feature 'say';
+#use Data::Dumper;
+
+#
+# my $next = next_perm( $val );
+#	Find and return the next permutation in lexicographic order
+#	of $val.  Return undef is $val is the last permutation (in order).
+#	Algorithm treats $val as an array of digits a[n]:
+#	1. Find the largest index k such that a[k] < a[k + 1]. If no such index exists,
+#	   the permutation is the last permutation.
+#       2. Find the largest index l greater than k such that a[k] < a[l].
+#       3. Swap the value of a[k] with that of a[l].
+#       4. Reverse the sequence from a[k + 1] up to and including the final element a[n].
+#
+sub next_perm ($)
+{
+	my( $val )= @_;
+	my @a = split( //, $val );
+	my( $k, $l );
+	my $n = @a-1;
+	for( $k=$n-1; $k>=0 && ord($a[$k])>=ord($a[$k+1]); $k-- )
+	{
+	}
+	return undef if $k<0;
+	for( $l=$n; $l>$k && ord($a[$k])>=ord($a[$l]); $l-- )
+	{
+	}
+	( $a[$k], $a[$l] ) = ( $a[$l], $a[$k] );
+
+	# reverse a[k+1]..a[n]
+	@a[$k+1..$n] = reverse @a[$k+1..$n];
+
+	return join( '', @a );
+}
+
+
+1;
diff --git a/challenge-149/duncan-c-white/perl/ch-1.pl b/challenge-149/duncan-c-white/perl/ch-1.pl
new file mode 100755
index 0000000000..2ad92c61a7
--- /dev/null
+++ b/challenge-149/duncan-c-white/perl/ch-1.pl
@@ -0,0 +1,56 @@
+#!/usr/bin/perl
+# 
+# TASK #1 - Fibonacci Digit Sum
+# 
+# Given an input $N, generate the first $N numbers for which the sum of
+# their digits is a Fibonacci number.
+# 
+# Example
+# 
+# f(20)=[0, 1, 2, 3, 5, 8, 10, 11, 12, 14, 17, 20, 21, 23, 26, 30, 32, 35, 41, 44]
+# 
+# MY NOTES: Pretty easy.  Only question: how many Fibonacci numbers do we
+# need to compute?  Let's extend the sequence whenever we need..
+# 
+
+use strict;
+use warnings;
+use feature 'say';
+use Getopt::Long;
+use Data::Dumper;
+use List::Util qw(sum);
+
+my $debug=0;
+die "Usage: fib-digit-sum [--debug] [N default 20]\n"
+	unless GetOptions( "debug"=>\$debug ) && @ARGV<2;
+my $n = shift // 20;
+
+# fibonacci numbers we've calculated yet
+my @fib = (0, 1);
+
+# fibonacci numbers up to $fib[-1] as a set
+my %isfib = map { $_ => 1 } @fib;
+
+my @found;
+
+for( my $x = 0; @found < $n; $x++ )
+{
+	# form sum of digits of $x
+	my $s = sum( split(//,$x) );
+
+	# extend @fib and %isfib if necessary
+	while( $s > $fib[-1] )
+	{
+		say "s=$s, last fib known = $fib[-1], calculating more fibs" if $debug;
+		my $next = $fib[-1] + $fib[-2];
+		say " calc next fib $next" if $debug;
+		push @fib, $next;
+		$isfib{$next}++;
+	}
+
+	# now use the isfib set to see if $s is a member (given that the above
+	# loop guarantees we've calculated isfib up to $s).
+	push @found, $x if $isfib{$s};
+}
+
+say join(', ', @found);
diff --git a/challenge-149/duncan-c-white/perl/ch-2.pl b/challenge-149/duncan-c-white/perl/ch-2.pl
new file mode 100755
index 0000000000..863432e37b
--- /dev/null
+++ b/challenge-149/duncan-c-white/perl/ch-2.pl
@@ -0,0 +1,106 @@
+#!/usr/bin/perl
+# 
+# TASK #2 - Largest Square
+# 
+# Given a number base, derive the largest perfect square with no repeated
+# digits and return it as a string. (For base>10, use 'A'..'Z'.)
+# 
+# Example:
+# 
+#     f(2)="1"
+#     f(4)="3201"
+#     f(10)="9814072356"
+#     f(12)="B8750A649321"
+# 
+# 
+# MY NOTES: Obvious technique is to compute all permutations of 0..B-1 (B the
+# base), and check whether each is a perfect square, and track the largest
+# perfect square we find.  I hate permutations, but I'm sure I have written
+# a permutation generator in previous Perl Challenges...  Oh yes, stolen
+# code from Challenge 134 (task 1) and made it into a simple Perms module here.
+# This code is quite slow for bases > 8, probably needs profiling led
+# optimization but I haven't got the time.
+# 
+
+use strict;
+use warnings;
+use feature 'say';
+use Getopt::Long;
+use Function::Parameters;
+use Data::Dumper;
+
+use lib qw(.);
+use Perms;
+
+my $debug=0;
+
+die "Usage: largest-square-in-base-B [--debug] B\n" unless
+	GetOptions( "debug"=>\$debug ) && @ARGV==1;
+
+my $base = shift;
+
+die "base $base out of range 2..36\n" if $base<2 || $base>36;
+
+
+#
+# my $ispq = is_perfect_square( $n );
+#	Return 1 iff $n is a perfect square; return 0 otherwise.
+#
+fun is_perfect_square( $n )
+{
+	my $sqrt = int(sqrt($n));
+	return $sqrt*$sqrt == $n ? 1 : 0;
+}
+
+
+my @digits = (0..9, 'A'..'Z');
+my %digpos = map { $digits[$_] => $_ } 0..$#digits;
+#die Dumper( \%digpos );
+
+
+#
+# my $v = base_value($x,$base);
+#	Given a base $base (2..36) string $x, calculate
+#	it's integer value and return it.  eg bv("FF",16)==255
+#
+fun base_value( $x, $base )
+{
+	my $v = 0;
+	if( $x )
+	{
+		$x =~ /^(.*)(.)$/;
+		$x = $1;
+		my $d = $2;
+		$v = base_value( $x, $base );
+		$v *= $base;
+		$v += $digpos{$d};
+	}
+	return $v;
+}
+
+
+my $perm = join('', map { $digits[$_] } 0..$base-1 );
+#say $perm;
+#say base_value($perm,$base);
+#exit 0;
+
+my $maxval = 0;
+my $maxperm = 0;
+
+do {
+	say "perm=$perm, maxvalsofar=$maxval, maxpermsofar=$maxperm" if $debug;
+	my $v = base_value($perm,$base);
+	if( is_perfect_square($v) )
+	{
+		say "perm $perm (value $v) is a perfect square" if $debug;
+		if( $v>$maxval )
+		{
+			say "new max val $v, perm $perm" if $debug;
+			$maxval = $v;
+			$maxperm = $perm;
+		}
+	}
+	$perm = Perms::next_perm($perm);
+} while defined $perm;
+
+say $maxperm;