Merge pull request #1542 from saiftynet/branch-055

Challenge-055 solutions by saiftynet

2 files changed, 187 insertions, 0 deletions

diff --git a/challenge-055/saiftynet/perl/ch-1.pl b/challenge-055/saiftynet/perl/ch-1.pl
new file mode 100644
index 0000000000..4babbffc9b
--- /dev/null
+++ b/challenge-055/saiftynet/perl/ch-1.pl
@@ -0,0 +1,102 @@
+#!/usr/env/perl
+# Task 1 Challenge 055 Solution by saiftynet
+# Flip Binary
+# You are given a binary number B, consisting of N binary digits 
+# 0 or 1: s0, s1, …, s(N-1).
+# Choose two indices L and R such that 0 ≤ L ≤ R < N and flip 
+# the digits s(L), s(L+1), …, s(R). By flipping, we mean change 
+# 0 to 1 and vice-versa.
+
+# Flipping selective bits in a binary number can done using a mask to
+# differentiate between the bits to be flipped and the bits to be left
+# and using this in a binary operation  (~$bin & $mask) | ($bin & ~$mask).
+# But this is Perl and flipping strings is also straightforward.
+# This solution offers both methods
+
+$bin= "0101001001110";  # a string is used to preserve leading zeros
+$verbosity=0;           # setting this to one enables more verbose output
+
+stringFlips($bin, $verbosity);
+binFlips   ($bin, $verbosity);
+
+sub stringFlips{
+  my ($binString,$verbose)=@_;
+  my $maxIndex=(length $binString)-1;
+  my @bestFlips=();
+  my $maxCount=0;
+  for my $l(0..$maxIndex){                 # all possible l
+    for my $r ($l..$maxIndex){            # all possible r
+        # extract segment
+        my $flip=substr($binString,$l,$r-$l+1);
+        my $flipped=$binString;
+        # flip segment
+        $flip=~tr/01/10/;
+        # insert flipped portion back
+        substr($flipped,$l,$r-$l+1,$flip);
+         
+        my $count=scalar(()= $flipped=~/1/g);
+        if ($count > $maxCount){     # new high score
+           @bestFlips=([$l,$r]);      # reset the list of best flips
+           $maxCount=$count;
+        }
+        elsif($count==$maxCount){    # another pair achieves high score
+           push @bestFlips, [$l,$r];  # save it among the best
+        }
+         
+        # verbose option for debugging purposes
+        printf "L=%2d R=%2d produces %s with %d ones\n",
+                   $l,$r,$flipped,$count if $verbose;
+	  
+    }
+  }
+  print "Flips using string transformation and substitution method\n";
+  print scalar @bestFlips." best Flips generated from flips of '$binString' giving $maxCount ones\n";
+  foreach my $lr (@bestFlips){
+     print "(L=$$lr[0], R=$$lr[1])\n";
+  }	
+}
+
+sub binFlips{   
+  my ($binString,$verbose)=@_;
+  my $maxLength=(length $binString)-1;
+  my $maxCount=0;
+  my @bestFlips=();
+  for my $l (0..$maxLength){                 # all possible l
+     for my $r ($l..$maxLength){             # all possible r		 
+        # create a mask
+        my $maskString=("0"x$l).("1"x($r-$l+1)).("0"x($maxLength-$r));
+        
+        # selective flipping
+        my $result=selectiveFlip($binString,$maskString);
+        
+        # count the number of ones
+        my $count=scalar(()= $result=~/1/g); 
+                                            
+        if ($count > $maxCount){             # new high score
+           @bestFlips=([$l,$r, $maskString]);# reset the list of best flips
+           $maxCount=$count;
+        }
+        elsif($count==$maxCount){            # another pair achieves high score
+           push @bestFlips, [$l,$r,$maskString];# save these
+        }
+        
+        # verbose option for debugging purposes
+        printf "L=%2d R=%2d gives flip mask %s produces %s with %d ones\n",
+                   $l,$r,$maskString,$result,$count if $verbose;
+     }
+  }
+  print "Flips using binary operations method\n";
+  print scalar @bestFlips." best Flips generated from flips of '$binString' giving $maxCount ones\n";
+  foreach my $lr (@bestFlips){
+     print "(L=$$lr[0], R=$$lr[1])\n";
+  }
+}
+
+sub selectiveFlip{
+  my ($binS,$maskS)=@_;
+  $bin =oct("0b$binS" );
+  $mask=oct("0b$maskS");
+  return sprintf ("%0*b",length $binS, (~$bin & $mask) | ($bin & ~$mask));
+}
+
+
diff --git a/challenge-055/saiftynet/perl/ch-2.pl b/challenge-055/saiftynet/perl/ch-2.pl
new file mode 100644
index 0000000000..e6ad544b77
--- /dev/null
+++ b/challenge-055/saiftynet/perl/ch-2.pl
@@ -0,0 +1,85 @@
+#!/usr/env/perl
+# Task 2 Challenge 055 Solution by saiftynet
+# Wave Array
+# Any array N of non-unique, unsorted integers can be arranged into 
+# a wave-like array such that n1 ≥ n2 ≤ n3 ≥ n4 ≤ n5 and so on.
+# For example, given the array [1, 2, 3, 4], possible wave arrays 
+# include [2, 1, 4, 3] or [4, 1, 3, 2], since 2 ≥ 1 ≤ 4 ≥ 3 and 
+# 4 ≥ 1 ≤ 3 ≥ 2. This is not a complete list.
+# Write a script to print all possible wave arrays for an integer 
+# array N of arbitrary length.
+# Notes:When considering N of any length, note that the first element 
+# is always greater than or equal to the second, and then the ≤, 
+# ≥, ≤, … sequence alternates until the end of the array.
+
+
+use strict;use warnings;
+my @list=(3,1,4,5);
+
+# Notes The list may contain repeated numbers. The wavinesss
+# requirement for the task is that the first pair is descending
+
+# Sequence builder.  This builds a set of @results.  Each result
+# contains two lists, one the sequence that is being assembled, and one
+# that# contains elements that have not yet been used.  Initially
+# there are no sequences built, and all the list elements are available.
+# Two circular lists are used rather than keeping an index, shifting
+# from one end and pushing to the other.  For sequences that contain
+# duplicate values, no attempt is made to remove duplicate sedquences 
+# that may be found as a result.
+
+my @results=([[],[@list]]);
+while (1){
+   my $res=$results[0];
+   my @rest=@{$res->[1]};    # extract sequence
+   my @seq= @{$res->[0]};    # extract potential next elemenets
+   last unless @rest;        # exit loop when no more elements left 
+   foreach (1..@rest){       # for each of the potential elements
+      my $next=shift @rest; 
+      push @results,[[@seq,$next],[@rest]] # add sequence and remnant to result
+      if wavy2(@seq,$next) eq "Down first";  # but only if the result is wavy
+          push @rest,$next;     # rotate the remnant list
+      }
+      shift @results;           # rotate the results
+}
+
+# print out the sequences found
+print "The list ( ".join (", ",@list). " ) can be made to form the following wavy lists: -\n";
+foreach my $res (@results){
+   print join  (",",@{$$res[0]}),"\n";
+}
+
+# phase detector: detects whether the sequence is oscillating throughout length
+# and whether the wave first transition is negative or positive.  It ignores
+# consecutive equal values, as long as phase is maintained afterwards
+#  4      2      7      6        6         6      9      1
+#    down    up    down    equal    equal     up     down      = Acceptable
+#
+#  4      2      7      6        6         6      1      9
+#    down    up    down   equal      equal     down   up       =  Not Acceptable
+# simply comparing adjacent values may fail when there are three or more consecutive
+# equal values
+
+sub wavy2{
+  my @seq=@_;
+  my ($evenUp,$evenDown,$oddUp,$oddDown);
+  foreach my $i (1..$#seq){
+    if ($i%2){                      # phases are even or odd, up going or down going
+       $evenUp=1   if ($seq[$i]>$seq[$i-1]);
+       $evenDown=1 if ($seq[$i]<$seq[$i-1]);
+    }
+    else{
+       $oddUp=1   if ($seq[$i]>$seq[$i-1]);
+       $oddDown=1 if ($seq[$i]<$seq[$i-1]);
+    }
+    # wavy phases have the even pahases only going one way and the odd phases
+    # in the opposite direction
+    return "Not wavy" if ($evenUp   and $evenDown) ||
+                         ($oddUp    and $oddDown)  ||
+                         ($evenUp   and $oddUp)    ||
+                         ($evenDown and $oddDown);
+  }
+  return $evenUp?"Up first":"Down first";  # returns "Up first", "Down first" or "Not wavy"
+}
+
+