Wherein we determine the values buried deep within the story and contemplate how we can balance the complexities life — doing our best to come out roughly even.
THE WEEKLY CHALLENGE – PERL & RAKU #83
episode one:
“Try the other word!”
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: 23Method
What defines a word? Overthinking this as usual, the obvious division is whitespace. But we should consider for a minute that we do have options, such as the “word boundary” \b character class. This is the zero-width assertion between a word character and a non-word character. While this certainly sounds about right, that’s going to choke on apostrophes and hyphens, so, no. We could accommodate that case but, in echoes of the other week’s Natural Language Programming challenge, how far do we go? Do we include compound words? Accented letters? How about internal punctuation in a phrase? Although not normally considered part of a word, it certainly isn’t whitespace. It goes without saying that the definition is rather non-specific about what exactly constitutes a word in this context, or we wouldn’t be having this conversation. Whitespace is the only thing that is specified as not being part of a word, so in the end that’s really all we have to go on. So let’s just try and keep to the spirit of the thing. We’ll keep it simple and define terms to say the things at the front and back that extend up to the first internal whitespace are the first and last words, as long as there’s something in there that isn’t whitespace as part of it. Oh how the simplest of things can get so complicated. But it doesn’t matter much what exactly we do here, as long as we define what is is we chose to do.
A simple, straightforward way to go about this thing we’ve decided upon is to trim spaces from the front and back and then split the string on any remaining whitespace, giving us a list of words. Using an array slice we then ignore the first and last elements of this list, then sum the lengths for the remaining elements — a very well mannered, procedural way of going about things.
On the other hand, we could have as easily joined the remaining words together and taken the length of the resultant string to get a count, or even 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 that. On the other hand, writing about what I could have done probably took more time than actually implementing it. Hmm.
Perl Solution
Ok, so I implemented it.
$_ = 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. Let’s see what we can still do:
The regular expression engine operates from left to right when examining alternate options, so in the first substitution above, 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 alternate at the end. The quantifiers in the first two alternates hinge on stopping when we get to whitespace, but these spaces will not be removed until after those parts operate. We can also go ahead and relate everything in terms of being pro- or anti- whitespace, the only thing we really know in this challenge. And why not? We’ll even throw in some extra whitespace to make the expression more readable. It’s whitespace all the way down, baby. All the way down.
$_ = $ARGV[0];
s/ ^\s* \S+ | \S+ \s*$ | \s+ //xg;
say length $_;
Finally, should we desire, we can rephrase everything as a one-liner:
perl -e '$_=$ARGV[0];s/^\s\S+|\S+\s$|\s+//g;print length $_, "\n"'
Because, you know, newlines are whitespace.
Oct 22, 2020 at 8:20:53 PM
~/PWC/83_1_no_not_that_word.pl
-----------------------------------------------------------------------
23
23
Note that as I left both routines active the output is repeated.
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];
## first output
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 $_; ## second output
Raku Solution
In all fairness to Raku I wrote the procedural Perl 5 version first, then did all the refinement in crafting this elegant Raku version. I then took those refinements and went back to the Perl 5 to refactor. So that short and clever solution above is more accurately termed to be a port of this, rather than vice versa.
unit sub MAIN (Str $str = " The purpose of our lives is to be happy ") ;
$_ = $str;
s:g/^ \s* \S+ | \S+ \s* $ | \s+//;
say $_.chars;
episode two:
“‘Flip’ it, not… oh, never mind. Just flip it”
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 description 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-negative value is not only applied to the total sum, but the positive value previously applied no longer counts toward the sum either, giving a 2-fold effect on the total. So switching any individual element n changes the sum by -2n from the original, unaltered sum.
The fact that the end goal 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 longer and longer combinations of flips to see if the goal can be achieved. If we continue to not find the goal we will have no choice but to keep examining every combination in search of it before we can abandon that ideal and look for the next-best thing.
We can stop looking at any time once we find a sum of zero, but should we fail we will have already had to go through and examine every combination of elements negated, so we won’t need to go through this again. By keeping track of the first instance found of any particular total with a list of the items negated to produce it, we can at this point look for the lowest value for all the totals found and select that as our solution.
Perl Solution
Although we can short-circuit should we find a 0 solution, it remains quite likely that every combination will need to be addressed, so we will draw on Algorithm::Combinatorics to do our heavy lifting. And since we’re using modules, we may as well import sum and first as well, from List::Util. We parse through the combinations, tabulating the results in an array — elements are filled on a first-come-first-served basis, so as we’re increasing the complexity of the combinations as we go, those array elements filled first will contain fewer members. In this way we abide by the second directive to get the lowest sum in the minimum of moves.
If at any point we reach 0 we have our solution and stop further processing. Interestingly enough, this seems, with random data, much more likely than one might at first think. Rather than allow user input I created a random pick of 10 numbers 1-1000. As every number generated has an equal probability of having an equivalent to be reversed, the positive and negative elements buffer themselves nicely, with an end result we can usually get quite close to 0, with the outcome improving as we add elements to our list.
Oct 22, 2020 at 11:27:25 PM
~/Code/PWC/83-2-flip-the-pain-away.pl
-----------------------------------------------------------------
input array : 941 452 580 904 816 124 96 583 12 849
minimum sum : 3
negative values: -904 -816 -96 -12 -849
equation:
941 + 452 + 580 + 124 + 583 - 904 - 816 - 96 - 12 - 849 = 3
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 } (1..10);
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 @*;
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";
Raku Solution
In Raku we had some issues dereferencing deep array structures that were getting unwieldy. How I do wish we had a simple routine to bring everything back to the surface:
[((1, (2,4), 4, (5,6,7))] --> (1, 2, 3, 4, 5, 6, 7)
It seems like the kind of thing that would really come in handy, a super-slip routine of some sort.
In any case the trick of keeping the sum results as array indices that made things easier in Perl was fighting me here. Moving the tabulation to a hash alleviated that particular problem, but of course hash keys are strings, so finding the smallest numerical hash key became a little tricky. A little explicit recasting set that right and again all was well. Decontainerizing as required from that point was more straightforward with the usual .flat and slips. As with the first task, after generalizing the core logic in Perl, I improved everything on the rewrite here. In this case that was formulating the clever output phase, creating the equation and whatnot. I then ported that fun stuff back over to the Perl version.
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 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";
Programming Excursions in Perl and Raku 