- Added solutions by Colin Crain.

4 files changed, 320 insertions, 0 deletions

diff --git a/challenge-083/colin-crain/perl/ch-1.pl b/challenge-083/colin-crain/perl/ch-1.pl
new file mode 100644
index 0000000000..0b554df0c4
--- /dev/null
+++ b/challenge-083/colin-crain/perl/ch-1.pl
@@ -0,0 +1,98 @@
+#! /opt/local/bin/perl
+#
+#       no-not-that-word-the-other-word.pl
+#
+#         TASK #1 › Words Length
+#         Submitted by: Mohammad S Anwar
+#             You are given a string $S with 3 or more words.
+# 
+#             Write a script to find the length of the string except the first
+#             and last words ignoring whitespace.
+# 
+#             Example 1:
+#                 Input: $S = "The Weekly Challenge"
+#                 Output: 6
+#                 
+#             Example 2:
+#                 Input: $S = "The purpose of our lives is to be happy"
+#                 Output: 23
+# 
+#         method: 
+#             what defines a word? Overthinking this as usual, the obvious
+#             division is whitespace. Considering for a minute we do have
+#             options, such as the "word boundry" \b character class.
+# 
+#             Yea, that's going to choke on apostrophes and hyphens, so, no.
+#             We'll keep it simple and say the things at the front and back that
+#             extend up to the whitespace are the first and last words. 
+# 
+#             A simple, straightforward way to go about this is to trim whitespace
+#             from the front and back and then split the string on remaining whitespace,
+#             giving a list of words. Using an array slice we ignore the first and last 
+#             element on this list, then sum the lengths for the remaining elements. 
+#             
+#             We could have as easily joined the words and taken the length of the 
+#             resultant string, or used a regex to substitute out words anchored to the 
+#             front and back before again substituting out remaining whitespace. That 
+#             last one sounds nice but I didn't do it. Writing this probably took more 
+#             time. 
+#             
+#             $_ = shift || " The purpose of our lives is to be happy ";
+#             s/^\s*\w+|\w+\s*$//g;
+#             s/\s+//g;
+#             say length $_;
+#             
+#             There. Happy? 
+
+#             No? Oh, come on man! Fine.
+# 
+#             The regular expression engine operates from left to right when
+#             examining options, so the left word is removed first, then the
+#             right word is searched for and removed. Extending this rationale,
+#             we can roll the second expression into the first, as another
+#             option at the end. The first parts hinge on stopping when we get
+#             to whitespace, but these spaces are not removed until after these
+#             other parts operate. We can also remove the variable. Why not?
+# 
+#             $_ = $ARGV[0];
+#             s/ ^\s* \S+ | \S+ \s*$ | \s+ //xg;
+#             say length $_;
+# 
+#             or even as a one-liner:
+# 
+#             perl -e '$_=$ARGV[0];s/^\s*\S+|\S+\s*$|\s+//xg;print length $_, "\n"'
+# 
+# 
+#             
+#             
+#
+#       2020 colin crain
+## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
+
+
+
+use warnings;
+use strict;
+use feature ":5.26";
+
+## ## ## ## ## MAIN:
+
+my $S = $ARGV[0] || " The purpose of our lives is to be happy ";
+my $sum;
+
+$S =~ s/^\s+|\s+$//g;
+my @s = split /\s+/, $S;
+say 0 if @s < 3;
+
+$sum += length $_ for @s[1..$#s-1];
+
+say $sum;
+
+
+## the shorter, cleverer way
+## the substitution evaluates the options in left-to-right order,
+## so we remove the left word, the right word and then any other whitespace
+$_ = $ARGV[0] || " The purpose of our lives is to be happy ";
+s/ ^\s* \S+ | \S+ \s*$ | \s+ //xg;
+say length $_;
+
diff --git a/challenge-083/colin-crain/perl/ch-2.pl b/challenge-083/colin-crain/perl/ch-2.pl
new file mode 100644
index 0000000000..a004e99b2a
--- /dev/null
+++ b/challenge-083/colin-crain/perl/ch-2.pl
@@ -0,0 +1,109 @@
+#! /opt/local/bin/perl5.26
+#
+#       flip-the-pain-away.pl
+# 
+#         TASK #2 › Flip Array
+#         Submitted by: Mohammad S Anwar
+#             You are given an array @A of positive numbers.
+# 
+#             Write a script to flip the sign of some members of the given array
+#             so that the sum of the all members is minimum non-negative.
+# 
+#             Given an array of positive elements, you have to flip the sign of
+#             some of its elements such that the resultant sum of the elements
+#             of array should be minimum non-negative(as close to zero as
+#             possible). Return the minimum no. of elements whose sign needs to
+#             be flipped such that the resultant sum is minimum non-negative.
+# 
+#             Example 1:
+#                 Input: @A = (3, 10, 8)
+#                 Output: 1
+#             Explanation:
+#                 Flipping the sign of just one element 10 gives 
+#                 the result 1 i.e. (3) + (-10) + (8) = 1
+#         
+#             Example 2:
+#                 Input: @A = (12, 2, 10)
+#                 Output: 1
+#             Explanation:
+#                 Flipping the sign of just one element 12 gives 
+#                 the result 0 i.e. (-12) + (2) + (10) = 0
+#
+#           method:
+#                 this task is remarkably hairy. We are given not one but two
+#                 minima to consider, first to land closest to zero, and
+#                 secondarily to do this with a minimum of movement. I believe a
+#                 careful reading of the text bears out this ordering.
+# 
+#                 Obviously one factor in play here is the sum of all the
+#                 elements. However when the sign of one element is flipped,
+#                 that now-negitive value is not only applied to the sum, but
+#                 the positive value previously applied can no longer count as
+#                 well, giving a 2-fold effect on the total.
+# 
+#                 The fact that the end goal of a sum of 0 is paramount makes
+#                 the number of elements to be negated uncertain. If the goal
+#                 cannot be completely achieved with a single flip, we will need
+#                 to consider all other possibile combinations of flips before
+#                 declaring that target to be impossible. This fact remains true
+#                 as the goalposts are moved, so we will need to keep track of
+#                 the smallest result calcuable from flipping a set number of
+#                 digits as we go, along with how we obtained that result.
+#                 
+#   
+#       2020 colin crain
+## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
+
+
+
+use warnings;
+use strict;
+use feature ":5.26";
+
+use Algorithm::Combinatorics qw( combinations );
+use List::Util qw( sum first);
+
+## ## ## ## ## MAIN:
+
+my @arr = map { (int rand 1000)  } (1..20);
+my $base_sum = sum @arr;
+my @results;
+
+for my $k ( 1..@arr ) {     ## for 1,2,3... numbers flipped
+    
+    my $min = $base_sum;
+    my $pick;
+    
+    ## make sets of nCk combinations of elements
+    my $iter = combinations(\@arr, $k);
+    while (my $c = $iter->next) {
+    
+        my $new_sum = $base_sum - 2 * sum $c->@*;
+        if ( $new_sum >= 0 and $new_sum < $min ) {
+            $min = $new_sum;
+            $pick = $c;
+        }  
+    }
+
+    ## @results is array of minimum totals as indexes holding a list of the
+    ## flips that create it, set with first instance of that minimum so shorter
+    ## lengths will populate first
+    $results[$min] ||= $pick;
+    
+    last if $min == 0;   ## we cannot do better than 0; we are done
+}
+
+my $min_sum = first { defined $results[$_] } (0..$#results);
+my @neg =  $results[$min_sum]->@*;
+my @pos = @arr;
+
+for my $n (@neg) {
+    my $idx =  first { $pos[$_] == $n } (0..$#pos);
+    splice(@pos, $idx, 1);
+}   
+
+say "input array    : @arr" ;
+say "minimum sum    : $min_sum" ;
+say "negative values:", sprintf " -%d" x @neg, @neg ;
+say "\n", "equation:\n";
+say join( ' + ', @pos) . (sprintf " - %d" x @neg, @neg) . " = $min_sum";
\ No newline at end of file
diff --git a/challenge-083/colin-crain/raku/ch-1.raku b/challenge-083/colin-crain/raku/ch-1.raku
new file mode 100644
index 0000000000..d9f064574e
--- /dev/null
+++ b/challenge-083/colin-crain/raku/ch-1.raku
@@ -0,0 +1,32 @@
+#!/usr/bin/env perl6
+# 
+#
+#       no-not-that-word-the-other-word.raku
+#
+#         TASK #1 › Words Length
+#         Submitted by: Mohammad S Anwar
+#             You are given a string $S with 3 or more words.
+# 
+#             Write a script to find the length of the string except the first
+#             and last words ignoring whitespace.
+# 
+#             Example 1:
+#                 Input: $S = "The Weekly Challenge"
+#                 Output: 6
+#                 
+#             Example 2:
+#                 Input: $S = "The purpose of our lives is to be happy"
+#                 Output: 23
+# 
+#
+#       2020 colin crain
+## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
+
+
+
+unit sub MAIN (Str $str = " The purpose of our lives is to be happy ") ;
+
+$_ = $str;
+s:g/^ \s* \S+ | \S+ \s* $ | \s+//;
+say $_.chars;
+
diff --git a/challenge-083/colin-crain/raku/ch-2.raku b/challenge-083/colin-crain/raku/ch-2.raku
new file mode 100644
index 0000000000..049f7f5b9e
--- /dev/null
+++ b/challenge-083/colin-crain/raku/ch-2.raku
@@ -0,0 +1,81 @@
+#!/usr/bin/env perl6
+# 
+#
+#       flip-the-pain-away.raku
+# 
+#         TASK #2 › Flip Array
+#         Submitted by: Mohammad S Anwar
+#             You are given an array @A of positive numbers.
+# 
+#             Write a script to flip the sign of some members of the given array
+#             so that the sum of the all members is minimum non-negative.
+# 
+#             Given an array of positive elements, you have to flip the sign of
+#             some of its elements such that the resultant sum of the elements
+#             of array should be minimum non-negative(as close to zero as
+#             possible). Return the minimum no. of elements whose sign needs to
+#             be flipped such that the resultant sum is minimum non-negative.
+# 
+#             Example 1:
+#                 Input: @A = (3, 10, 8)
+#                 Output: 1
+#             Explanation:
+#                 Flipping the sign of just one element 10 gives 
+#                 the result 1 i.e. (3) + (-10) + (8) = 1
+#         
+#             Example 2:
+#                 Input: @A = (12, 2, 10)
+#                 Output: 1
+#             Explanation:
+#                 Flipping the sign of just one element 12 gives 
+#                 the result 0 i.e. (-12) + (2) + (10) = 0
+
+#
+#       We pick a large number for our random pool
+#
+#       2020 colin crain
+## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
+
+
+
+unit sub MAIN (*@arr) ;
+@arr.elems == 0 && @arr = (1..500).pick(10);
+
+my $base_sum = @arr.sum;
+my %results;
+
+for 1..@arr.elems -> $k {
+
+    my $min = $base_sum;
+    my $pick;
+    
+    for @arr.combinations($k) -> $c {
+        my $new_sum = $base_sum - 2 * $c.sum;
+        if 0 <= $new_sum < $min {
+            $min = $new_sum;
+            $pick = $c;
+        }
+    }
+    
+    %results{$min} ||= $pick;
+    last if $min == 0;                      ## we are done, cannot do better
+    
+}
+
+%results{$base_sum}:delete;         
+my $min = %results.keys.map(*.Int).min;     ## hash keys are strings
+my @neg = %results{$min}.flat;
+
+## strip negated elements from source array --> positive values only
+my @pos = @arr;
+for |@neg.list -> $ele {
+    my $index =  @pos.first($ele, :k);
+    @pos.splice($index,1);
+}   
+
+say "input array    : ", @arr;
+say "min total      : ", $min;
+say "negative values: ", |@neg.fmt: " -%d" ;
+say "\n";
+say @pos.join(' + ') ~ " " ~ @neg.fmt("- %d").join ~ " = $min";
+