Challenge-063 solutions by saiftynet

2 files changed, 91 insertions, 0 deletions

diff --git a/challenge-063/saiftynet/perl/ch-1.pl b/challenge-063/saiftynet/perl/ch-1.pl
new file mode 100644
index 0000000000..9fba6a2c9d
--- /dev/null
+++ b/challenge-063/saiftynet/perl/ch-1.pl
@@ -0,0 +1,34 @@
+#!/usr/env/perl
+# Task 1 Challenge 063 Solution by saiftynet
+# Last Word Submitted by: Mohammad S Anwar
+# Reviewed by: Ryan Thompson
+# 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! 
+
+
+# Description says it all... consider word boundary to be \s
+# so split on /\s+/, reverse it so that the last is now first
+# then match each against the offered regexp.  The regexp may
+# be passed eaither as string or as qr/<regexp>/
+
+
+use v5.14;
+say last_word('  hello world',                "[ea]l");        # 'hello'
+say last_word("Don't match too much, Chet!",  qr/ch.t/i);      # 'Chet!'
+say last_word("spaces in regexp won't match", qr/in re/);      #  undef
+say last_word( join(' ', 1..1e6),             qr/^(3.*?){3}/); # '399933'
+
+sub last_word{
+  my ($str,$regExp)=@_;
+  $regExp=qr/$regExp/ unless (ref $regExp =~/Regexp/);
+  foreach my $word (reverse split /\s+/, $str){
+    return $word if $word=~m/$regExp/
+  } 
+}
+
diff --git a/challenge-063/saiftynet/perl/ch-2.pl b/challenge-063/saiftynet/perl/ch-2.pl
new file mode 100644
index 0000000000..27509be317
--- /dev/null
+++ b/challenge-063/saiftynet/perl/ch-2.pl
@@ -0,0 +1,57 @@
+#!/usr/env/perl
+# Task 2 Challenge 063 Solution by saiftynet
+#  › Rotate String
+# Submitted by: Mohammad S Anwar
+# Reviewed by: Ryan Thompson
+# 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.
+
+
+# Fairly straight forward to rotate a string using substr
+# to demonstrate the transforms that are occuring the routine
+# offers an optional verbose mode allowing outputing of each
+# transform.  Further clarity may be obtained by using the
+# optional colour parameter suitable for ANSI capable terminals.
+# Call using `rotateString($string,[$verbose],[$colour])`
+# There does not appear any need to confine the string to 
+# just "x" and "y"....this works with any string.
+
+# demos 3 modes
+# 1) without commentary
+print "\n   ". rotateString("xyxx"),                    " rotations required.\n";
+
+# 2) with commentary 
+print "\n   ". rotateString("I am spinning around!",1), " rotations required.\n";
+
+# 3) decorated commentary if Terminal accepts ANSI escape codes
+print "\n   ". rotateString("Madam I am Adam",1,1),     " rotations required.\n";
+
+sub rotateString{
+  my ($origStr,$verbose,$colour)=@_;
+  # if $verbose defined and true then outputs transforms
+  # if $verbose and $colour are true then colour transforms
+  my $workStr=$origStr;
+  my $count=0;       # count of moves
+  do{                # do means loop run at least once
+    $count++;
+    print "\n$count $workStr -> " if $verbose;   # before rotation
+    $workStr=($colour?"\e[31m":"").substr($workStr,$count%length $workStr).  
+             ($colour?"\e[32m":"").substr($workStr,0,$count%length $workStr).
+             ($colour?"\e[0m" :"");
+    print $workStr if $verbose;
+    $workStr=~s/\e\[[^m]+m//g;
+    
+  }while($origStr ne $workStr);
+  return $count;
+}
+