imported my solutions to this week's tasks

3 files changed, 238 insertions, 24 deletions

diff --git a/challenge-115/duncan-c-white/README b/challenge-115/duncan-c-white/README
index de73e12315..d6cdf5924e 100644
--- a/challenge-115/duncan-c-white/README
+++ b/challenge-115/duncan-c-white/README
@@ -1,42 +1,49 @@
-Task 1: "Next Palindrome Number
+Task 1: "String Chain
 
-You are given a positive integer $N.
+You are given an array of strings.
 
-Write a script to find out the next Palindrome Number higher than the given integer $N.
+Write a script to find out if the given strings can be chained to form
+a circle. Print 1 if found otherwise 0.
 
-Example
+A string $S can be put before another string $T in circle if the last
+character of $S is same as first character of $T.
 
-  Input: $N = 1234
-  Output: 1331
+Examples:
 
-  Input: $N = 999
-  Output: 1001
+  Input: @S = ("abc", "dea", "cd")
+  Output: 1 as we can form circle e.g. "abc", "cd", "dea".
+
+  Input: @S = ("ade", "cbd", "fgh")
+  Output: 0 as we can't form circle.
 "
 
-My notes: sounds very simple.  Generate and test for palindromic-ness.
+My notes: word chains are often quite hard. HOWEVER, this time it's a circular word chain
+using ALL the words, so that's much easier:
+1. we don't have to try "what if we start with this word (for each word)", just pick one.
+2. we must use every word.
 
+(2) also implies an obvious shortcut to speed up failure (0) case:
+fail if numwords(starting_with_a_letter) != numwords(ending_with_that_letter).
+But I don't think I need implement that.
 
-Task 2: "Higher Integer Set Bits
 
-You are given a positive integer $N.
+Task 2: "Largest Multiple (Even)
 
-Write a script to find the next higher integer having the same number
-of 1 bits in binary representation as $N.
+You are given a list of positive integers (0-9), single digit.
 
-Example
+Write a script to find the largest multiple of 2 that can be formed from the list.
 
-Input: $N = 3
-Output: 5
+Examples
 
-Binary representation of 3 is 011. There are two 1 bits. So the next
-higher integer is 5 having the same the number of 1 bits i.e. 101.
+  Input: @N = (1, 0, 2, 6)
+  Output: 6210
 
-Input: $N = 12
-Output: 17
+  Input: @N = (1, 4, 2, 8)
+  Output: 8412
 
-Binary representation of 12 is 1100. There are two 1 bits. So the next
-higher integer is 17 having the same number of 1 bits i.e. 10001.
+  Input: @N = (4, 1, 7, 6)
+  Output: 7614
 "
 
-My notes: also sounds pretty simple.  Generate and test for "having B
-bits set in the binary representation".
+My notes: should be easy (multiple of 2 == even number).  Obvious heuristic is: put biggest digit
+first, but I suppose it's possible that no even numbers would result.  Hell, just try all perms..
diff --git a/challenge-115/duncan-c-white/perl/ch-1.pl b/challenge-115/duncan-c-white/perl/ch-1.pl
new file mode 100755
index 0000000000..3a594ca578
--- /dev/null
+++ b/challenge-115/duncan-c-white/perl/ch-1.pl
@@ -0,0 +1,118 @@
+#!/usr/bin/perl
+# 
+# Task 1: "String Chain
+# 
+# You are given an array of strings.
+# 
+# Write a script to find out if the given strings can be chained to form
+# a circle. Print 1 if found otherwise 0.
+# 
+# A string $S can be put before another string $T in circle if the last
+# character of $S is same as first character of $T.
+# 
+# Examples:
+# 
+#   Input: @S = ("abc", "dea", "cd")
+#   Output: 1 as we can form circle e.g. "abc", "cd", "dea".
+# 
+#   Input: @S = ("ade", "cbd", "fgh")
+#   Output: 0 as we can't form circle.
+# "
+# 
+# My notes: word chains are often quite hard. HOWEVER, this time it's a circular word chain
+# using ALL the words, so that's much easier:
+# 1. we don't have to try "what if we start with this word (for each word)", just pick one.
+# 2. we must use every word.
+# There's also (if needed) an obvious shortcut to speed up failure (0) case:
+# fail if numwords(starting_with_a_letter) != numwords(ending_with_that_letter).
+#
+# (2) also implies an obvious shortcut to speed up failure (0) case:
+# fail if numwords(starting_with_a_letter) != numwords(ending_with_that_letter).
+# But I don't think I need implement that.
+# 
+
+use strict;
+use warnings;
+use feature 'say';
+use Function::Parameters;
+use Getopt::Long;
+use Data::Dumper;
+
+my $debug = 0;
+die "Usage: word-circle [--debug] Wd Wd...\n" if
+	GetOptions( "debug" => \$debug ) && @ARGV==0;
+my @wd = @ARGV;
+
+
+# @{$start{letter}} = list of words starting with that letter
+my %start;
+
+
+#
+# make_start( @wd );
+#	Make %start from the words in @wd.
+#
+fun make_start( @wd )
+{
+	foreach my $w (@wd)
+	{
+		$w =~ /^(.)/;
+		my $first = $1;
+		$start{$first} //= [];
+		push @{$start{$first}}, $w;
+	}
+	#die Dumper( \%start );
+}
+
+
+#
+# my $iscircle = wordcircle( @wd );
+#	Determine whether all the words in @wd form a chained word
+#	circle as the problem describes.
+#	Return 1 iff they do, 0 otherwise.
+#
+fun wordcircle( @wd )
+{
+	make_start( @wd );
+	my $w = $wd[0];
+	my $found = rec_wordcircle( $w, $w, { map { $_ => 1 } @wd } );
+	return $found;
+}
+
+#
+# my $iscircle = rec_wordcircle( $targetwd, $fromwd, $unused );
+#	Recursive word circle finder: can you find a circle of words from
+#	word $fromwd leading to word $targetwd in 1-or-more-steps, using
+#	all words, with %$unused the words unused so far, using %start and %end maps.
+#	Return 1 iff we can, 0 otherwise.
+#
+fun rec_wordcircle( $targetwd, $w, $unused )
+{
+	$w =~ /(.)$/;
+	my $last = $1;
+
+	my $u = join(',',sort keys %$unused );
+	#say "rwc: w=$w, target=$targetwd, unused=$u, first=$first, last=$last";
+
+	my @next = grep { $unused->{$_} } @{$start{$last}};
+	if( $debug )
+	{
+		my $uuw = join(',', sort keys %$unused);
+		say "rwc: w=$w, unused words $uuw, unused next words: ", join(',',@next);
+	}
+	foreach my $nextw (@next)
+	{
+		my %un = %$unused;			# mark $nextw as used now
+		delete $un{$nextw};
+		return 1 if $nextw eq $targetwd && keys %un == 0;
+		next if $nextw eq $targetwd;
+
+		my $found = rec_wordcircle( $targetwd, $nextw, \%un );
+		return 1 if $found;
+	}
+	return 0;
+}
+
+
+my $iscircle = wordcircle( @wd );
+say $iscircle;
diff --git a/challenge-115/duncan-c-white/perl/ch-2.pl b/challenge-115/duncan-c-white/perl/ch-2.pl
new file mode 100755
index 0000000000..382b38a808
--- /dev/null
+++ b/challenge-115/duncan-c-white/perl/ch-2.pl
@@ -0,0 +1,89 @@
+#!/usr/bin/perl
+# 
+# Task 2: "Largest Multiple (Even)
+# 
+# You are given a list of positive integers (0-9), single digit.
+# 
+# Write a script to find the largest multiple of 2 that can be formed from the list.
+# 
+# Examples
+# 
+#   Input: @N = (1, 0, 2, 6)
+#   Output: 6210
+# 
+#   Input: @N = (1, 4, 2, 8)
+#   Output: 8412
+# 
+#   Input: @N = (4, 1, 7, 6)
+#   Output: 7614
+# "
+# 
+# My notes: should be easy (multiple of 2 == even number).  Obvious heuristic is: put biggest digit
+# first, but I suppose it's possible that no even numbers would result.  Hell, just try all perms..
+# 
+
+use strict;
+use warnings;
+use feature 'say';
+use Function::Parameters;
+#use Data::Dumper;
+
+die "Usage: largest-even D D...\n" if @ARGV==0;
+my @digits = @ARGV;
+
+die "All values should be decimal digits\n" unless (grep { /^[0-9]$/ } @digits) == @digits;
+die "At least one digit must be even\n" if (grep { /^[02468]$/ } @digits) == 0;
+
+
+#
+# try_all_perms( $callback, @digits );
+#	Permutation generator: Invoke $callback->( permutation )
+#	once for every permutation of @digits.
+#
+fun try_all_perms( $callback, @digits )
+{
+	rec_allperm( $callback, [], @digits );
+}
+
+
+#
+# rec_allperm( $callback, $prefix, @rest );
+#	Recursive all permutations generator.  Given a "permutation prefix" of @$prefix,
+#	and a collection of unused digits @rest, for all permutations of @$prefix + @rest,
+#	calling $callback->( permutation ) for each complete permutation found.
+#
+fun rec_allperm( $callback, $prefix, @rest )
+{
+	foreach my $pos (0..$#rest)
+	{
+		my $x = $rest[$pos];
+		# try with $x first (after @$prefix)
+		my @pre = @$prefix;
+		push @pre, $x;
+
+		# delete pos $pos from copy of @rest
+		my @r = @rest;
+		splice( @r, $pos, 1 );
+
+		if( @r == 0 )
+		{
+			$callback->( @pre );
+		} else
+		{
+			rec_allperm( $callback, \@pre, @r );
+		}
+	}
+}
+
+
+my $max = 0;
+
+fun eachperm(@perm)
+{
+	my $p = join('', @perm);
+	#say "perm: $p";
+	$max = $p if $p > $max && $p % 2 == 0;
+}
+
+try_all_perms( \&eachperm, @digits );
+say "$max";