laurent_r

These are some answers to the Week 83 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a couple of days (October 25, 2020). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Task 1: Words Length

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

Words Length in Raku

We take the input string from the command line (but provide a default value in the case no parameter is passed to the script. Then the second code line does essentially all the work: it uses the words built-in method to split the input strings, applies a list slice to the result to remove the first and last words, and joins the result (with an empty separator since we want to ignore whitespace in the letter count). Finally, we use the chars method to find the string length.

use v6;

my $str = @*ARGS[0] // "The purpose of our lives is to be happy";
my $trimmed = join "", $str.words[1..*-2];
say $trimmed.chars;

This is an example output:

$ raku string-length.raku 'The Weekly Challenge'
6

$ raku string-length.raku
23

In fact the code is so simple that we can do it all in a Raku one-liner using chained method invocations:

$ raku -e '@*ARGS[0].words[1..*-2].join('').chars.say'  'The Weekly Challenge'
6

Words Length in Perl

We take the input string from the command line (but provide a default value in the case no parameter is passed to the script. Then we split the input string into the @words array. Finally, we take an array slice to remove the first and the last words, join the words into a string and use the length built-in to find the string length.

use strict;
use warnings;
use feature "say";

my $str = $ARGV[0] // "The purpose of our lives is to be happy";
my @words = split /\s+/, $str;
say length join "", @words[1 .. $#words -1];

Sample output:

$ perl  string-length.pl
23

$ perl  string-length.pl 'The Weekly Challenge'
6

We could also solve the problem with a Perl one-liner:

$ perl -E '@w = split /\s+/, shift; say length join "", @w[1 .. $#w -1];' 'The Weekly Challenge'
6

Words Length in Scala

This section with a Scala solution and the next one with a Python solution have been added to this blog post on Jan. 17, 2021. They are both quite simuilar to the Raku solution.

object wordLength extends App {
  val instr = "The purpose of our lives is to be happy"
  val words = instr.split(" ")
  println(words.slice(1, words.length - 1).mkString.length)
}

This script duly prints 23.

Words Length in Python

Some twenty years ago, Python was my favorite programming language. I basically stopped programming in Python around 2003, when I picked up Perl. I thought it might be a good idea to brush up my Python knowledge.

input = "The purpose of our lives is to be happy"
words = input.split()
print(len("".join(words[1:len(words)-1])))

This sscript displays the following oputput:

$ python3 word-length.py
23

Task 2: Flip Array

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

Flip Array in Raku

Given an input limited to three integers as in the provided examples, it seems it wouldn’t be too difficult to find directly the best candidates. But that wouldn’t work too well in the general case with significantly larger input. So, I decided to write a sum-up recursive subroutine to explore all possibilities and find the best candidate. The best candidate will be the smallest non-negative sum. If there are more than one smallest sum, then we look for the solution having the least number of negative integers. Note that we slightly enriched the output compared to what is requested in the task specification, because we wanted to see the solution.

my @a = (defined @*ARGS[0]) ?? @*ARGS !! (5, 5, 8);
my %result;
my @used;
sum-up @a, @used;

sub sum-up (@in is copy, @used-so-far) {
    if @in.elems <= 0 {
        my $sum = [+] @used-so-far;
        %result.push: ($sum => @used-so-far) if $sum >= 0;
    } else {
        my $item = shift @in;
        sum-up(@in, (|@used-so-far, $item));
        sum-up(@in, (|@used-so-far, - $item));
    }
}
my $min-sum = %result.keys.min({+$_});
if %result{$min-sum}[0] ~~ Int {
  say "Sum: $min-sum - digits: %result{$min-sum}";
  say "Number of negative numbers: ", 
    %result{$min-sum}.grep(* < 0).elems;
} else {
  my $min-neg = Inf;
  my $min_neg_index;
  for 0..%result{$min-sum}.end -> $i {
    my $negative_numbers = %result{$min-sum}[$i].grep(* < 0).elems;
    if $negative_numbers < $min-neg {
      $min-neg = $negative_numbers;
      $min_neg_index = $i;
    }
  }

  say "Sum: $min-sum - digits  %result{$min-sum}[$min_neg_index]";
  say "Number of negative numbers: $min-neg";
}

Below are some sample runs:

$ raku min-sum.raku
Sum: 2 - digits: 5 5 -8
Number of negative numbers: 1

$ raku min-sum.raku
Sum: 1 - digits: 3 8 -10
Number of negative numbers: 1

$ raku min-sum.raku 12 2 10
Sum: 0 - digits  -12 2 10
Number of negative numbers: 1

$ raku min-sum.raku 12 2 10 22 7 23
Sum: 2 - digits: -12 -2 10 22 7 -23
Number of negative numbers: 3

Flip Array in Perl

As noted earlier, it wouldn’t be too hard to find directly the best solution with an input of only three integers, as in the examples provided with the task. But that would be much harder with significantly larger input. So, I wrote a sum_up recursive subroutine to explore all possibilities and find the best candidate. The best candidate will be the smallest non-negative sum. If there are more than one smallest sum, then we look for the solution having the least number of negative integers.

use strict;
use warnings;
use feature "say";
use constant INF => 10 ** 12;
use Data::Dumper;

my @a = (defined $ARGV[0]) ? @ARGV : (3, 8, 10);
my %result;
my @used;
sum_up (\@a, \@used);

sub sum_up {
    my @in =  @{$_[0]};
    my @used_so_far =  @{$_[1]};
    if (@in <= 0) {
        my $sum = 0;
        $sum += $_ for @used_so_far;
        push @{$result{$sum}}, [@used_so_far] if $sum >= 0; 
    } else {
        my $item = shift @in;
        sum_up(\@in, [@used_so_far, $item]);
        sum_up(\@in, [@used_so_far, - $item]);
    }
}
# say "Result: \n", Dumper \%result;
my $min_sum = (keys %result)[0];
for my $key (keys %result) {
    $min_sum = $key if $key < $min_sum;
}
if (scalar @{$result{$min_sum}} <= 1) {
    say "Sum: $min_sum - digits: @{$result{$min_sum}[0]}";
    say "Number of negative numbers: ", 
        scalar grep $_ < 0, @{$result{$min_sum}[0]};
} else {
    my $min_neg = INF;
    my $min_neg_index;
    my @candidates = @{$result{$min_sum}};
    for my $i (0..$#candidates) {
        my $negative_numbers = scalar grep $_ < 0, @{$candidates[$i]};
        if ($negative_numbers < $min_neg) {
            $min_neg = $negative_numbers;
            $min_neg_index = $i;
        }
    }
    say "Sum: $min_sum - digits:    @{$candidates[$min_neg_index]}";
    say "Number of negative numbers: $min_neg";
}

Sample runs:

$ perl min-sum.pl
Sum: 1 - digits: 3 8 -10
Number of negative numbers: 1

$ perl min-sum.pl 5 5 8
Sum: 2 - digits: 5 5 -8
Number of negative numbers: 1

$ perl min-sum.pl 12 2 10
Sum: 0 - digits:    -12 2 10
Number of negative numbers: 1

$ perl min-sum.pl  12 2 10 22 7 23
Sum: 2 - digits: -12 -2 10 22 7 -23
Number of negative numbers: 3

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, November, 1, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.