Merge pull request #7918 from dcw803/master

committed my perl solutions to this week's tasks

3 files changed, 279 insertions, 47 deletions

diff --git a/challenge-212/duncan-c-white/README b/challenge-212/duncan-c-white/README
index a7d82c8b31..89f2c82665 100644
--- a/challenge-212/duncan-c-white/README
+++ b/challenge-212/duncan-c-white/README
@@ -1,71 +1,69 @@
-Task 1: Special Bit Characters
+Task 1: Jumping Letters
 
-You are given an array of binary bits that ends with 0.
+You are given a word having alphabetic characters only, and a list of
+positive integers of the same length
 
-Valid sequences in the bit string are:
-
-[0] -decodes-to-> "a"
-[1, 0] -> "b"
-[1, 1] -> "c"
-
-Write a script to print 1 if the last character is an 'a' otherwise
-print 0.
+Write a script to print the new word generated after jumping forward
+each letter in the given word by the integer in the list. The given list
+would have exactly the number as the total alphabets in the given word.
 
 Example 1
 
-  Input: @bits = (1, 0, 0)
-  Output: 1
+  Input: $word = 'Perl' and @jump = (2,22,19,9)
+  Output: Raku
 
-  The given array bits can be decoded as 2-bits character (10) followed
-  by 1-bit character (0).
+  'P' jumps 2 place forward and becomes 'R'.
+  'e' jumps 22 place forward and becomes 'a'. (jump is cyclic i.e. after 'z' you go back to 'a')
+  'r' jumps 19 place forward and becomes 'k'.
+  'l' jumps 9 place forward and becomes 'u'.
 
 Example 2
 
-  Input: @bits = (1, 1, 1, 0)
-  Output: 0
+  Input: $word = 'Raku' and @jump = (24,4,7,17)
+  Output: 'Perl'
 
-  Possible decode can be 2-bits character (11) followed by 2-bits
-  character (10) i.e. the last character is not 1-bit character.
+MY NOTES: sounds very easy.  Essentially ROT(n) for a different value of n for
+each letter.
 
-MY NOTES: very easy.  decode string then check last letter of decoded version.
-I wonder if there's a way of decoding-and-checking together, though.
+GUEST LANGUAGE: As a bonus, I will have a go at translating ch-1.pl into C
+but I'll do that tomorrow.
 
-GUEST LANGUAGE: As a bonus, I also had a go at translating ch-1.pl into C
-(look in the C directory for that).
 
+Task 2: Rearrange Groups
 
-Task 2: Merge Account
+You are given a list of integers and group size greater than zero.
 
-You are given an array of accounts i.e. name with list of email addresses.
-
-Write a script to merge the accounts where possible. The accounts can
-only be merged if they have at least one email address in common.
+Write a script to split the list into equal groups of the given size where
+integers are in sequential order. If it can't be done then print -1.
 
 Example 1:
 
-  Input: @accounts = [ ["A", "a1@a.com", "a2@a.com"],
-                       ["B", "b1@b.com"],
-                       ["A", "a3@a.com", "a1@a.com"] ]
-                     ]
-
-  Output: [ ["A", "a1@a.com", "a2@a.com", "a3@a.com"],
-            ["B", "b1@b.com"] ]
+  Input: @list = (1,2,3,5,1,2,7,6,3) and $size = 3
+  Output: (1,2,3), (1,2,3), (5,6,7)
 
 Example 2:
 
-  Input: @accounts = [ ["A", "a1@a.com", "a2@a.com"],
-                       ["B", "b1@b.com"],
-                       ["A", "a3@a.com"],
-                       ["B", "b2@b.com", "b1@b.com"] ]
+  Input: @list = (1,2,3) and $size = 2
+  Output: -1
+
+Example 3:
+
+  Input: @list = (1,2,4,3,5,3) and $size = 3
+  Output: (1,2,3), (3,4,5)
+
+Example 4:
 
-  Output: [ ["A", "a1@a.com", "a2@a.com"],
-            ["A", "a3@a.com"],
-            ["B", "b1@b.com", "b2@b.com"] ]
+Input: @list = (1,5,2,6,4,7) and $size = 3
+Output: -1
 
-MY NOTES: fiddly and rather inelegant, especially only being allowed to
-merge two entries if the intersection of the email lists is non empty.
-Will also need to choose an input format, how about a list of words of the
-form A:a1@a.com,a2@a.com, B:b1@b.com, A:a3@a.com and B:b2@b.com,b1@b.com
+MY NOTES: sounds reasonably easy as a brute force search.  But hang on, do we
+need backtracking or not?  i.e. if you find a run-of-$size-consecutive-numbers
+is that run necessarily a part of the solution, allowing you to extract any
+run you find whether needing to backtrack?  no, not if that run is PART of a
+longer run of consecutive numbers.  What if we only find run-of-$size-
+consecutive-numbers isolated at the start, ie. where first(run)-1 is not
+present in the input?  Then we should be able to: repeatedly pick any one run,
+add it to solution, remove it from input, repeat until input is empty.
 
-(TODO) GUEST LANGUAGE: As a bonus, I also had a go at translating ch-2.pl into C
-(TODO) (look in the C directory for that)
+GUEST LANGUAGE: As a bonus, I will have a go at translating ch-2.pl into C
+but I'll do that tomorrow.
diff --git a/challenge-212/duncan-c-white/perl/ch-1.pl b/challenge-212/duncan-c-white/perl/ch-1.pl
new file mode 100755
index 0000000000..5501eccc81
--- /dev/null
+++ b/challenge-212/duncan-c-white/perl/ch-1.pl
@@ -0,0 +1,86 @@
+#!/usr/bin/perl
+# 
+# Task 1: Jumping Letters
+# 
+# You are given a word having alphabetic characters only, and a list of
+# positive integers of the same length
+# 
+# Write a script to print the new word generated after jumping forward
+# each letter in the given word by the integer in the list. The given list
+# would have exactly the number as the total alphabets in the given word.
+# 
+# Example 1
+# 
+#   Input: $word = 'Perl' and @jump = (2,22,19,9)
+#   Output: Raku
+# 
+#   'P' jumps 2 place forward and becomes 'R'.
+#   'e' jumps 22 place forward and becomes 'a'.
+#       (jump is cyclic i.e. after 'z' you go back to 'a')
+#   'r' jumps 19 place forward and becomes 'k'.
+#   'l' jumps 9 place forward and becomes 'u'.
+# 
+# Example 2
+# 
+#   Input: $word = 'Raku' and @jump = (24,4,7,17)
+#   Output: 'Perl'
+# 
+# MY NOTES: sounds very easy.  Essentially ROT(n) for a different value of n for
+# each letter.
+# 
+# GUEST LANGUAGE: As a bonus, I will have a go at translating ch-1.pl into C
+# but I'll do that tomorrow.
+# 
+
+use strict;
+use warnings;
+use feature 'say';
+use Getopt::Long;
+use Data::Dumper;
+use List::Util qw(any);
+
+my $debug=0;
+die "Usage: jumping-letters [--debug] word intlist\n"
+	unless GetOptions( "debug"=>\$debug ) && @ARGV>1;
+
+my $word = shift;
+
+my @list = split( /,/, join(',',@ARGV) );
+
+say "debug: word: $word, list: ", join(',',@list) if $debug;
+
+my $len = length($word);
+my $llen = @list;
+
+die "jumping-letters: word (len $len) must be same length as list ".
+    "(len $llen)\n"
+	unless $len == $llen;
+
+foreach my $pos (0..$len-1)
+{
+	my $letter = substr($word,$pos,1);
+	my $offset = $list[$pos];
+	say "debug: pos: $pos, letter: $letter, offset: $offset" if $debug;
+	my $base = 0;
+	if( $letter =~ /^[a-z]/ )
+	{
+		$base = ord('a');
+	} elsif( $letter =~ /^[A-Z]/ )
+	{
+		$base = ord('A');
+	} else
+	{
+		next;
+	}
+	my $lpos = ord($letter)-$base;
+	$offset = ($offset + $lpos) % 26;
+	#$offset -= 26 while $offset > 25;
+	#$offset += 26 while $offset < 0;
+	say "debug: letter=$letter, base=$base, lpos=$lpos, offset=$offset"
+		if $debug;
+	$letter = chr($offset+$base);
+	say "debug: newletter=$letter" if $debug;
+	substr($word,$pos,1) = $letter;
+}
+
+say $word;
diff --git a/challenge-212/duncan-c-white/perl/ch-2.pl b/challenge-212/duncan-c-white/perl/ch-2.pl
new file mode 100755
index 0000000000..4cc4a901ee
--- /dev/null
+++ b/challenge-212/duncan-c-white/perl/ch-2.pl
@@ -0,0 +1,148 @@
+#!/usr/bin/perl
+#
+# Task 2: Rearrange Groups
+# 
+# You are given a list of integers and group size greater than zero.
+# 
+# Write a script to split the list into equal groups of the given size where
+# integers are in sequential order. If it can't be done then print -1.
+# 
+# Example 1:
+# 
+#   Input: @list = (1,2,3,5,1,2,7,6,3) and $size = 3
+#   Output: (1,2,3), (1,2,3), (5,6,7)
+# 
+# Example 2:
+# 
+#   Input: @list = (1,2,3) and $size = 2
+#   Output: -1
+# 
+# Example 3:
+# 
+#   Input: @list = (1,2,4,3,5,3) and $size = 3
+#   Output: (1,2,3), (3,4,5)
+# 
+# Example 4:
+# 
+#   Input: @list = (1,5,2,6,4,7) and $size = 3
+#   Output: -1
+# 
+# MY NOTES: sounds reasonably easy as a brute force search.  But hang on, do we
+# need backtracking or not?  i.e. if you find a run-of-$size-consecutive-numbers
+# is that run necessarily a part of the solution, allowing you to extract any
+# run you find (irrespective of what other runs may be present in the input)
+# without needing to backtrack?  no, not if that run is PART of a longer run
+# of consecutive numbers.  What if we only find run-of-$size-consecutive-
+# numbers that are ISOLATED at the start, ie. where first(run)-1 is not
+# present in the input?  Then we should be able to: repeatedly pick any one run,
+# add it to solution, remove it from input, repeat until input is empty.
+# 
+# GUEST LANGUAGE: As a bonus, I will have a go at translating ch-2.pl into C
+# but I'll do that tomorrow.
+# 
+
+use strict;
+use warnings;
+use feature 'say';
+use Getopt::Long;
+use Data::Dumper;
+use Function::Parameters;
+
+my $debug=0;
+die "Usage: rearrange-groups [--debug] groupsize intlist\n"
+	unless GetOptions( "debug"=>\$debug ) && @ARGV > 1;
+
+my $size = shift;
+my @list = split( /,/, join(',',@ARGV) );
+
+say "debug: size=$size, list: ", join(',',@list) if $debug;
+
+
+#
+# my @seq = find_seq( $start, $size, %set );
+#	Find a run-of-$size-consecutive-elements in %set starting
+#	at $start, return the run iff we succeed in finding one,
+#	() if none can be found.
+#
+fun find_seq( $start, $size, %set )
+{
+	return () if $set{$start-1};
+	my @x;
+	for( my $want=0; $want<$size; $want++ )
+	{
+		return () unless $set{$start+$want};
+		push @x, $start+$want;
+	}
+	return @x;
+}
+
+
+#
+# my @newlist = remove_one_of_seq( $seqref, @list );
+#	Remove one of each member of @$seqref from @list, returning what's left.
+#
+fun remove_one_of_seq( $seqref, @list )
+{
+	my %set = map { $_ => 1 } @$seqref;
+
+	for( my $i=@list-1; $i>=0; $i-- )
+	{
+		if( $set{$list[$i]} )
+		{
+			delete $set{$list[$i]};
+			splice( @list, $i, 1 );
+		}
+	}
+	return @list;
+}
+
+
+#
+# my @run = find_isolated_seq( $size, @list );
+#	Ok, find a single isolated run-of-$size-consecutive-numbers in @list,
+#	and return the run (if one can be found), otherwise return ().
+#
+fun find_isolated_seq( $size, @list )
+{
+	my %set = map { $_ => 1 } @list;	# set of all distinct elements
+	foreach my $start (sort { $a <=> $b } keys %set)
+	{
+		say "debug: looking for seq starting at $start" if $debug;
+		my @seq = find_seq($start, $size, %set);
+		next unless @seq;
+		say( "debug: found seq ", join(',',@seq) ) if $debug;
+		return @seq;
+	}
+	return ();
+}
+
+
+
+my @output;	# array of size-tuples
+
+my $changed;
+do
+{
+	my @seq = find_isolated_seq( $size, @list );
+	say "debug: list=", join(',',@list), ", found seq=", join(',',@seq)
+		if $debug;
+	$changed = @seq ? 1 : 0;
+	if( $changed )
+	{
+		push @output, \@seq;
+		@list = remove_one_of_seq( \@seq, @list );
+	}
+	say( "debug: output: ", join(', ', map { '('. join(',',@$_). ')' } @output), ", list=",join(',',@list) )
+		if $debug;
+
+} while( $changed && @list );
+
+say( "debug: leftover list is: ", join(',',@list) ) if $debug;
+
+if( @list == 0 )
+{
+	say join(', ', map { '('. join(',',@$_). ')' } @output);
+} else
+{
+	say -1;
+}