Solutions to the challenge-063.

2 files changed, 86 insertions, 0 deletions

diff --git a/challenge-063/wanderdoc/perl/ch-1.pl b/challenge-063/wanderdoc/perl/ch-1.pl
new file mode 100644
index 0000000000..b271ee4ca2
--- /dev/null
+++ b/challenge-063/wanderdoc/perl/ch-1.pl
@@ -0,0 +1,48 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+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! 
+=cut
+
+
+use Test::More;
+
+is(last_word('  hello world',                qr/[ea]l/),      'hello',  'found <hello>');
+is(last_word("Don't match too much, Chet!",  qr/ch.t/i),      'Chet!',  'found <Chet!>');
+is(last_word("spaces in regexp won't match", qr/in re/),      undef,    'rejected space');
+is(last_word( join(' ', 1..1e6),             qr/^(3.*?){3}/), '399933', 'found <399933>');
+is(last_word( join(' ', 1e3.. 2e3 ),         qr/135$/),       '1135',   'found <1135>');
+done_testing();
+
+sub last_word
+{
+     my ($string, $re) = @_; 
+     my @words = split(/\s+/, $string); 
+     my $match;
+
+     for my $word ( @words )
+     {
+          if ( $word =~ $re )
+          {
+               $match = $word;
+          }
+     }
+     return $match;
+}
+
+
+
+
+
+=output
+ok 1 - found <hello>
+ok 2 - found <Chet!>
+ok 3 - rejected space
+ok 4 - found <399933>
+ok 5 - found <1135>
+1..5
+=cut
\ No newline at end of file
diff --git a/challenge-063/wanderdoc/perl/ch-2.pl b/challenge-063/wanderdoc/perl/ch-2.pl
new file mode 100644
index 0000000000..0c37f379e5
--- /dev/null
+++ b/challenge-063/wanderdoc/perl/ch-2.pl
@@ -0,0 +1,38 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+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 maximum 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.
+=cut
+
+
+
+
+
+
+
+
+for my $string ( qw (xyxx xy xxyyyyy xxxyyyyy xyxyxx xxxxxxxy xyyyyyyy) )
+{
+     my $num = rotate($string);
+     print $num, $/, $/;
+}
+
+sub rotate
+{
+     my $str = $_[0];
+
+     my $orig = $str;
+     my $len = length($str);
+     my $n = 0;
+     do
+     {
+          $n++;
+          $str = substr($str, $n % $len) . substr($str, 0, $n % $len); 
+          print "DEBUG: ${n}: ${str}$/";
+     } 
+     while ($str ne $orig);
+     return $n;
+}
\ No newline at end of file