incorporated last week's solutions - two nice little problems

3 files changed, 172 insertions, 28 deletions

diff --git a/challenge-063/duncan-c-white/README b/challenge-063/duncan-c-white/README
index 736cbb1087..78b667bd21 100644
--- a/challenge-063/duncan-c-white/README
+++ b/challenge-063/duncan-c-white/README
@@ -1,43 +1,56 @@
-Task 1: "Sort Email Addresses
+Task 1: "Last Word
 
-Write a script that takes a list of email addresses (one per line) and sorts them first by the domain part of the email address, and then by the part to the left of the @ (known as the mailbox).
+Define sub last_word($string, $regexp) that returns the last word
+matching $regexp found in the given string, or undef if the string does
+not contain a word matching $regexp.
 
-Note that the domain is case-insensitive, while the mailbox part is case sensitive. (Some email providers choose to ignore case, but that’s another matter entirely.)
+For this challenge, a "word" is defined as any character sequence
+consisting of non-whitespace characters (\S) only. That means punctuation
+and other symbols are part of the word.
 
-If your script is invoked with arguments, it should treat them as file names and read them in order, otherwise your script should read email addresses from standard input.
-Bonus
+The $regexp is a regular expression. Take care that the regexp can only
+match individual words! See the Examples for one way this can break if
+you are not careful.
 
-Add a -u option which only includes unique email addresses in the output, just like sort -u.
-Example
+Examples
 
-If given the following list:
+last_word('  hello world',                qr/[ea]l/);      # 'hello'
+last_word("Don't match too much, Chet!",  qr/ch.t/i);      # 'Chet!'
+last_word("spaces in regexp won't match", qr/in re/);      #  undef
+last_word( join(' ', 1..1e6),             qr/^(3.*?){3}/); # '399933'
+"
 
-name@example.org
-rjt@cpan.org
-Name@example.org
-rjt@CPAN.org
-user@alpha.example.org
+My notes: cool question. Will have a go!
 
-Your script (without -u) would return:
 
-user@alpha.example.org
-rjt@cpan.org
-rjt@CPAN.org
-Name@example.org
-name@example.org
+Task 2: "Rotate String
 
-With -u, the script would return:
+Given a word made up of an arbitrary number of x and y characters, that
+word can be rotated as follows: For the ith rotation (starting at i =
+1), i % length(word) characters are moved from the front of the string to
+the end. Thus, for the string xyxx, the initial (i = 1) % 4 = 1 character
+(x) is moved to the end, forming yxxx. On the second rotation, (i = 2) %
+4 = 2 characters (yx) are moved to the end, forming xxyx, and so on. See
+below for a complete example.
 
-user@alpha.example.org
-rjt@CPAN.org
-Name@example.org
-name@example.org
-"
+Your task is to write a function that takes a string of xs and ys and
+returns the minimum non-zero number of rotations required to obtain
+the original string. You may show the individual rotations if you wish,
+but that is not required.
 
-My notes: cool question. Will have a go!
+Example
+
+Input: $word = 'xyxx';
 
+Rotation 1: you get yxxx by moving x to the end.
+Rotation 2: you get xxyx by moving yx to the end.
+Rotation 3: you get xxxy by moving xxy to the end.
+Rotation 4: you get xxxy by moving nothing as 4 % length(xyxx) == 0.
+Rotation 5: you get xxyx by moving x to the end.
+Rotation 6: you get yxxx by moving xx to the end.
+Rotation 7: you get xyxx by moving yxx to the end which is same as the given word.
 
-Task 2: "N Queens - in 3D..
+Output: 7
 "
 
-My notes: sorry, I'm rather busy, sounds like a horrible problem, not doing it.
+My notes: sounds like fun.  Nice question.
diff --git a/challenge-063/duncan-c-white/perl/ch-1.pl b/challenge-063/duncan-c-white/perl/ch-1.pl
new file mode 100755
index 0000000000..cb59f5447a
--- /dev/null
+++ b/challenge-063/duncan-c-white/perl/ch-1.pl
@@ -0,0 +1,57 @@
+#!/usr/bin/perl
+#
+# Task 1: "Last Word
+#
+# Define sub last_word($string, $regexp) that returns the last word
+# matching $regexp found in the given string, or undef if the string does
+# not contain a word matching $regexp.
+# 
+# For this challenge, a "word" is defined as any character sequence
+# consisting of non-whitespace characters (\S) only. That means punctuation
+# and other symbols are part of the word.
+# 
+# The $regexp is a regular expression. Take care that the regexp can only
+# match individual words! See the Examples for one way this can break if
+# you are not careful.
+# 
+# Examples
+# 
+# last_word('  hello world',                qr/[ea]l/);      # 'hello'
+# last_word("Don't match too much, Chet!",  qr/ch.t/i);      # 'Chet!'
+# last_word("spaces in regexp won't match", qr/in re/);      #  undef
+# last_word( join(' ', 1..1e6),             qr/^(3.*?){3}/); # '399933'
+# "
+# 
+# My notes: cool question. Will have a go!
+#
+
+use strict;
+use warnings;
+use feature 'say';
+use Function::Parameters;
+
+die "Usage: last-word REGEX PHRASE\n" unless @ARGV>1;
+
+my $regex = shift;
+my $phrase = join(' ', @ARGV);
+
+$regex = qr/$regex/o;
+
+#
+# my $lastword = lastword( $string, $regex );
+#	Split $string into (whitespace separated) words
+#	and then find and return the last of those words
+#	which match the given $regex.  Return undef if
+#	no word matches.
+#
+fun lastword( $string, $regex )
+{
+	foreach my $word (reverse(split(/\s+/, $string)))
+	{
+		return $word if $word =~ $regex;
+	}
+	return undef;
+}
+
+my $lastword = lastword( $phrase, $regex );
+say $lastword // "undefined";
diff --git a/challenge-063/duncan-c-white/perl/ch-2.pl b/challenge-063/duncan-c-white/perl/ch-2.pl
new file mode 100755
index 0000000000..2b1221da7b
--- /dev/null
+++ b/challenge-063/duncan-c-white/perl/ch-2.pl
@@ -0,0 +1,74 @@
+#!/usr/bin/perl
+#
+# Task 2: "Rotate String
+#
+# Given a word made up of an arbitrary number of x and y characters, that
+# word can be rotated as follows: For the ith rotation (starting at i =
+# 1), i % length(word) characters are moved from the front of the string to
+# the end. Thus, for the string xyxx, the initial (i = 1) % 4 = 1 character
+# (x) is moved to the end, forming yxxx. On the second rotation, (i = 2) %
+# 4 = 2 characters (yx) are moved to the end, forming xxyx, and so on. See
+# below for a complete example.
+# 
+# Your task is to write a function that takes a string of xs and ys and
+# returns the minimum non-zero number of rotations required to obtain
+# the original string. You may show the individual rotations if you wish,
+# but that is not required.
+# 
+# Example
+# 
+# Input: $word = 'xyxx';
+# 
+# Rotation 1: you get yxxx by moving x to the end.
+# Rotation 2: you get xxyx by moving yx to the end.
+# Rotation 3: you get xxxy by moving xxy to the end.
+# Rotation 4: you get xxxy by moving nothing as 4 % length(xyxx) == 0.
+# Rotation 5: you get xxyx by moving x to the end.
+# Rotation 6: you get yxxx by moving xx to the end.
+# Rotation 7: you get xyxx by moving yxx to the end which is the original.
+# 
+# Output: 7
+# "
+# 
+# My notes: sounds like fun.  Nice question.
+# 
+
+use strict;
+use warnings;
+use feature 'say';
+use Function::Parameters;
+use Getopt::Long;
+
+my $verbose = 0;
+my $result = GetOptions( "verbose" => \$verbose );
+die "Usage: rotate-string [-v|--verbose] xystring\n" unless
+	$result && @ARGV==1;
+my $xy = shift;
+
+#
+# my $n = rotate( $xy );
+#	Rotate the $xy string (a sequence of xs and ys)
+#	repeatedly as described in the top comment,
+#	and return the number of rotations needed before
+#	we get back to the original $xy string.
+#
+fun rotate( $xy )
+{
+	my $len = length($xy);
+	my $curr = $xy;
+	my $n;
+	for( $n=0; ; $n++ )
+	{
+		my $n4 = $n % 4;
+		next if $n4==0;
+		my $new = substr($curr,$n4,$len-$n4).substr($curr,0,$n4);
+		say "rotation $n: $new" if $verbose;
+		$curr = $new;
+		last if $curr eq $xy;
+	}
+	return $n;
+}
+
+
+my $n = rotate( $xy );
+say "$n rotations needed";