Perl & Raku solutions to Tasks 1 & 2 of the Perl Weekly Challenge #083

On branch branch-for-challenge-083
Changes to be committed:
	new file:   challenge-083/athanasius/perl/ch-1.pl
	new file:   challenge-083/athanasius/perl/ch-2.pl
	new file:   challenge-083/athanasius/raku/ch-1.raku
	new file:   challenge-083/athanasius/raku/ch-2.raku

4 files changed, 484 insertions, 0 deletions

diff --git a/challenge-083/athanasius/perl/ch-1.pl b/challenge-083/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..1e4a8171db
--- /dev/null
+++ b/challenge-083/athanasius/perl/ch-1.pl
@@ -0,0 +1,87 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 083
+=========================
+
+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
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use Const::Fast;        # Exports const()
+
+const my $USAGE =>
+"Usage:
+  perl $0 <S>
+
+    <S>    A single string containing 3 or more words separated by whitespace";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 083, Task #1: Words Length (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $args = scalar @ARGV;
+       $args >  0                or error('Input string missing');
+       $args == 1                or error('Too many command-line arguments');
+
+    my $S     = $ARGV[0];
+    my @words = split /\s+/, $S;
+
+    scalar @words >= 3           or error('Too few words in the input string');
+
+    print qq[Input: \$S = "$S"\n\n];
+
+    my $length  = 0;
+       $length += length for @words[1 .. $#words - 1];
+
+    print "Output: $length\n";
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE\n";
+}
+
+###############################################################################
diff --git a/challenge-083/athanasius/perl/ch-2.pl b/challenge-083/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..60c5c509aa
--- /dev/null
+++ b/challenge-083/athanasius/perl/ch-2.pl
@@ -0,0 +1,165 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 083
+=========================
+
+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
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Assumptions:
+1.  The input array is non-empty.
+2.  A "positive number" here means an integer greater than zero.
+3.  Both the final sum and the flip count are to be minimised, but minimising
+    the final sum (i.e., the sum after some of the numbers have been flipped)
+    takes priority over minimising the count of numbers to be flipped.
+
+Algorithm:
+    Brute force (i.e., exhaustive inspection of possible combinations), using
+    Algorithm::Combinatorics::subsets(). Note that this is inefficient for bags
+    (multisets) because repeated elements result in repeated, identical, sub-
+    sets (combinations). (This drawback is shared by the List::PowerSet and
+    Data::PowerSet modules.)
+
+=cut
+#==============================================================================
+
+                                                # Exports:
+use strict;
+use warnings;
+use Algorithm::Combinatorics qw( subsets );
+use Const::Fast;                                # const()
+use List::Util               qw( sum0 );
+use Regexp::Common           qw( number );      # %RE{num}
+use constant EXPLAIN => 1;
+
+const my $USAGE =>
+"Usage:
+  perl $0 [<A> ...]
+
+    [<A> ...]    A non-empty array of positive integers\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 083, Task #2: Flip Array (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my @A = parse_command_line();
+
+    printf "  Input:  \@A = (%s)\n", join ', ', @A;
+
+    my $total_sum       = sum0 @A;
+    my $min_flipped_sum = $total_sum;
+    my @nums_to_flip;
+
+    my $iter = subsets(\@A);
+
+    while (my $comb = $iter->next)
+    {
+        next if scalar @$comb == 0 ||
+                scalar @$comb == scalar @A;
+
+        my $comb_sum    = sum0 @$comb;
+        my $flipped_sum = $total_sum - 2 * $comb_sum;
+
+        next if $flipped_sum < 0;
+
+        if    ($flipped_sum <  $min_flipped_sum)
+        {
+            $min_flipped_sum = $flipped_sum;
+            @nums_to_flip    = @$comb;
+        }
+        elsif ($flipped_sum == $min_flipped_sum &&
+               scalar @$comb <  scalar @nums_to_flip)
+        {
+            @nums_to_flip    = @$comb;
+        }
+    }
+
+    my $nums_to_flip = scalar @nums_to_flip;
+
+    print "  Output: $nums_to_flip\n";
+
+    if (EXPLAIN)
+    {
+        print  "\nExplanation:\n";
+        printf "  Flipping the sign of %d element%s %sgives the result %d\n",
+            $nums_to_flip,
+            $nums_to_flip == 1 ? '' : 's',
+            $nums_to_flip == 0 ? '' : '(' . join(', ', @nums_to_flip) . ') ',
+            $min_flipped_sum;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    scalar @ARGV > 0
+                or  die qq[ERROR: No command-line arguments\n]        . $USAGE;
+
+    for (@ARGV)
+    {
+        / \A $RE{num}{int} \z /x
+                or  die qq[ERROR: Non-integer "$_"\n]                 . $USAGE;
+        $_ <  0 and die qq[ERROR: Negative integer "$_"\n]            . $USAGE;
+        $_ == 0 and die qq[ERROR: Zero is not a "positive" integer\n] . $USAGE;
+    }
+
+    return @ARGV;
+}
+
+###############################################################################
diff --git a/challenge-083/athanasius/raku/ch-1.raku b/challenge-083/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..03118f930a
--- /dev/null
+++ b/challenge-083/athanasius/raku/ch-1.raku
@@ -0,0 +1,86 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 083
+=========================
+
+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
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 083, Task #1: Words Length (Raku)\n".put;
+}
+
+##=============================================================================
+sub MAIN
+(
+    Str:D $S         #= A single string containing 3 or more words separated by
+                     #= whitespace
+)
+##=============================================================================
+{
+    my Str @words = $S.split: /\s+/, :skip-empty;
+
+    @words.elems >= 3            or error('Too few words in the input string');
+
+    qq[Input: \$S = "$S"\n].put;
+
+    my UInt $length  = 0;
+            $length += .chars for @words[1 .. *-2];
+
+    "Output: $length".put;
+}
+
+#------------------------------------------------------------------------------
+sub error( Str:D $message )
+#------------------------------------------------------------------------------
+{
+    "ERROR: $message".put;
+    USAGE();
+
+    exit 1;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-083/athanasius/raku/ch-2.raku b/challenge-083/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..119ef5b4a5
--- /dev/null
+++ b/challenge-083/athanasius/raku/ch-2.raku
@@ -0,0 +1,146 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 083
+=========================
+
+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
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Assumptions:
+1.  The input array is non-empty.
+2.  A "positive number" here means an integer greater than zero.
+3.  Both the final sum and the flip count are to be minimised, but minimising
+    the final sum (i.e., the sum after some of the numbers have been flipped)
+    takes priority over minimising the count of numbers to be flipped.
+
+Algorithm:
+    Brute force (i.e., exhaustive inspection of possible combinations), using
+    Raku's built-in combinations() method.
+
+=end comment
+#==============================================================================
+
+my Bool constant EXPLAIN = True;
+
+subset Pos of Int where * > 0;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 083, Task #2: Flip Array (Raku)\n".put;
+}
+
+##=============================================================================
+sub MAIN
+(
+    *@A where { @A.elems > 0 &&
+                .all ~~ Pos:D }       #= A non-empty array of positive integers
+)
+##=============================================================================
+{
+    "  Input:  @A = (%s)\n".printf: @A.join: ', ';
+
+    my Pos  $total-sum       = @A.sum;
+    my UInt $min-flipped-sum = $total-sum;
+    my Pos  @nums-to-flip;
+
+    for @A.combinations -> List $comb
+    {
+        next if $comb.elems == 0 ||
+                $comb.elems == @A.elems;
+
+        my UInt $comb-sum    = $comb.sum;
+        my Int  $flipped-sum = $total-sum - 2 * $comb-sum;
+
+        next if $flipped-sum < 0;
+
+        if    $flipped-sum <  $min-flipped-sum
+        {
+            $min-flipped-sum = $flipped-sum;
+            @nums-to-flip    = $comb.split(/\s+/, :skip-empty).map: { .Int };
+        }
+        elsif $flipped-sum == $min-flipped-sum
+        {
+            my Pos @new-nums = $comb.split(/\s+/, :skip-empty).map: { .Int };
+
+            if @new-nums.elems < @nums-to-flip.elems
+            {
+                @nums-to-flip = @new-nums;
+            }
+        }
+    }
+
+    my UInt $nums-to-flip = @nums-to-flip.elems;
+
+    "  Output: $nums-to-flip".put;
+
+    if EXPLAIN
+    {
+        "\nExplanation:".put;
+        "  Flipping the sign of %d element%s %sgives the result %d\n".printf:
+                $nums-to-flip,
+                $nums-to-flip == 1 ?? '' !! 's',
+                $nums-to-flip == 0 ?? '' !! "({ @nums-to-flip.join(', ') }) ",
+                $min-flipped-sum;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+###############################################################################