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

Spoiler Alert: This weekly challenge deadline is due in a few days (November 1, 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: Reverse Integer

You are given an integer $N.

Write a script to reverse the given integer and print the result. Print 0 if the result doesn’t fit in 32-bit signed integer.

The number 2,147,483,647 is the maximum positive value for a 32-bit signed binary integer in computing.

Example 1:

Input: 1234
Output: 4321

Example 2:

Input: -1234
Output: -4321

Example 3:

Input: 1231230512
Output: 0

Note that the minimal value for signed negative integers is - 2 ** 31, i.e. - 2,147,483,648.

Reverse Integer in Raku

We first check if the input integer is negative and, if so, we take its absolute value and record the fact that the input was negative. Then, we just flip the digits. We set the result to 0 if the result exceeds the 32-bit limit for signed integers. We turn the result to a negative integer if the input integer was negative (and, by the way, numify the result to get rid of leading 0’s if any.

use v6;

constant $max = 2 ** 31 - 1; # i.e. 2_147_483_647

my $input = @*ARGS[0] // 1234;
my $positive = True;
if $input < 0 {
    $positive = False;
    $input = -$input;
}
my $output = $input.flip;
$output = 0 if $positive and $output >= $max;
$output = 0 if $output >= $max + 1; # 32-bit negative numbers can go up to 2 ** 31
# No specification for inputs ending with 0
# We numify $output and negate it if needed
$output = $positive ?? +$output !! -$output;
say $output;

Sample output for a few input values:

$ raku reverse-int.raku
4321

$ raku reverse-int.raku -1234
-4321

$ raku reverse-int.raku 1231230512
0

$ raku reverse-int.raku 1231230500
50321321

$ raku reverse-int.raku -1231230500
-50321321

Reverse Integer in Perl

This is simply a port to Perl of the Raku program above, please refer to the explanations above if needed.

use strict;
use warnings;
use feature "say";
use constant MAX => 2 ** 31 - 1; # i.e. 2_147_483_647

my $input = shift  // 1234;
my $positive = 1;
if ($input < 0) {
    $positive = 0;
    $input = -$input;
}
my $output = reverse $input;
$output = 0 if $positive and $output > MAX;
$output = 0 if $output > MAX + 1;
# No specification for inputs ending with 0
# We numify $output and negate it if needed
$output = $positive ? $output + 0 : -$output;
say $output;

Output for a few sample input values:

$ perl reverse-int.pl
4321

$ perl reverse-int.pl -1234
-4321

$ perl reverse-int.pl 1231230512
0

$ perl reverse-int.pl 1231230500
50321321

$ perl reverse-int.pl -1231230500
-50321321

Reverse Integer in Scala

This section with a Scala solution was added on Jan. 16, 2021. This is basically a port to Scala of the Raku and Perl solutions above.

object reverseInt extends App {
  val max: Long = (math.pow(2, 31) - 1).toLong
  val tests = List(1234, 678, -12, 432, 1147483647)
  for (item <- tests) {
    val result = flip(item)
    println(s"$item : $result")
  }
  def flip(input: Int): Int = {
    val negative = if (input < 0) true else false
    val in = input.abs
    val flipped = in.toString.reverse;
    if (negative) {
      if (flipped.toLong > max + 1) return 0
      return -1 * flipped.toInt
    } else {
      if (flipped.toLong > max) return 0
      return flipped.toInt
    }

  }
}

This program displays the following output:

1234 : 4321
678 : 876
-12 : -21
432 : 234
1147483647 : 0

Task 2: Find Square Matrices

You are given matrix of size m x n with only 1 and 0.

Write a script to find the count of squares having all four corners set as 1.

Example 1:

Input: [ 0 1 0 1 ]
       [ 0 0 1 0 ]
       [ 1 1 0 1 ]
       [ 1 0 0 1 ]

Output: 1

Explanation:
There is one square (3x3) in the given matrix with four corners as 1 starts at r=1;c=2.

[ 1 0 1 ]
[ 0 1 0 ]
[ 1 0 1 ]

Example 2:

Input: [ 1 1 0 1 ]
       [ 1 1 0 0 ]
       [ 0 1 1 1 ]
       [ 1 0 1 1 ]

Output: 4

Explanation:
There is one square (4x4) in the given matrix with four corners as 1 starts at r=1;c=1.
There is one square (3x3) in the given matrix with four corners as 1 starts at r=1;c=2.
There are two squares (2x2) in the given matrix with four corners as 1. First starts at r=1;c=1 and second starts at r=3;c=3.

Example 3:

Input: [ 0 1 0 1 ]
       [ 1 0 1 0 ]
       [ 0 1 0 0 ]
       [ 1 0 0 1 ]

Output: 0

Find Square Matrices in Raku

We first define an array of arrays of arrays representing an array of four matrices for our tests. We define a simple print-matrix subroutine to display any matrix in a human-eye friendly format. All the work is done in the find-squares subroutine, which contains three nested for loops: we loop on the possible square matrix sizes (between 2 and the smaller dimension of the input matrix), and then, for each possible size, we loop on each matrix item to see if that item can be the top left corner of a square matrix of the relevant size with each corner set to 1. If any of the four corners is 0, we move to the next item or to the next possible size once we have visited all relevant items with one size. Note that we print much more than what is requested in the task specification because we want to check the results (it would be very easy to remove these extra printed lines by commenting out the say statement near the end of the find-squares subroutine).

my @mat = [ [ [<0 1 0 1>], [<0 0 1 0>], [<1 1 0 1>], [<1 0 0 1>] ], 
            [ [<1 1 0 1>], [<1 1 0 0>], [<0 1 1 1>], [<1 0 1 1>] ],
            [ [<0 1 0 1>], [<1 0 1 0>], [<0 1 0 0>], [<1 0 0 1>] ],
            [ [<1 1 0 1 1 1>], [<1 1 1 0 1 0>], [<1 1 0 1 0 1>], 
                [<1 1 1 0 0 1>] ],
          ];

for @mat -> @m {
    print-matrix @m;
    say "Number of matrices: ", find-squares(@m), "\n";
}
sub print-matrix (@matrix) {
    for @matrix -> @row {
        say '[ ', @row.join(" "), ' ]';
    }
    say " ";
}

sub find-squares (@matrix) {
    my $nb_lines = @matrix.elems;
    my $nb_col = @matrix[0].elems;
    my $nb_squares = 0;
    my $max_square_size = min $nb_lines, $nb_col;
    for 2..$max_square_size -> $square_size {
        for 0..$nb_col - $square_size -> $j {
            for 0..$nb_lines - $square_size -> $i {
                next if @matrix[$i][$j] == 0;
                next if @matrix[$i][$j+$square_size-1] == 0;
                next if @matrix[$i+$square_size-1][$j] == 0;
                next if @matrix[$i+$square_size-1][$j+$square_size-1] == 0;
                say "Value in position $i, $j is the top left corner of a square of size $square_size";
                $nb_squares++;
            }
        }
    }
    return $nb_squares;
}

With the four sample input matrices, the program displays the following results:

[ 0 1 0 1 ]
[ 0 0 1 0 ]
[ 1 1 0 1 ]
[ 1 0 0 1 ]

Value in position 0, 1 is the top left corner of a square of size 3
Number of matrices: 1

[ 1 1 0 1 ]
[ 1 1 0 0 ]
[ 0 1 1 1 ]
[ 1 0 1 1 ]

Value in position 0, 0 is the top left corner of a square of size 2
Value in position 2, 2 is the top left corner of a square of size 2
Value in position 0, 1 is the top left corner of a square of size 3
Value in position 0, 0 is the top left corner of a square of size 4
Number of matrices: 4

[ 0 1 0 1 ]
[ 1 0 1 0 ]
[ 0 1 0 0 ]
[ 1 0 0 1 ]  
Number of matrices: 0

[ 1 1 0 1 1 1 ]
[ 1 1 1 0 1 0 ]
[ 1 1 0 1 0 1 ]
[ 1 1 1 0 0 1 ]

Value in position 0, 0 is the top left corner of a square of size 2
Value in position 1, 0 is the top left corner of a square of size 2
Value in position 2, 0 is the top left corner of a square of size 2
Value in position 1, 0 is the top left corner of a square of size 3
Value in position 0, 1 is the top left corner of a square of size 3
Value in position 0, 3 is the top left corner of a square of size 3
Number of matrices: 6

Find Square Matrices in Perl

This is a port to Perl of the Raku program immediately above, please refer to the explanations above if needed.

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

my @mat = ( [ [ qw<0 1 0 1> ], [ qw<0 0 1 0> ], [ qw<1 1 0 1> ], 
              [ qw<1 0 0 1> ] ], 
            [ [ qw<1 1 0 1> ], [ qw<1 1 0 0> ], [ qw<0 1 1 1> ], 
              [ qw<1 0 1 1> ] ],
            [ [ qw<0 1 0 1> ], [ qw<1 0 1 0> ], [ qw<0 1 0 0> ], 
              [ qw<1 0 0 1> ] ],
            [ [ qw<1 1 0 1 0 1> ], [ qw<1 0 1 0 1 1> ], 
              [ qw<1 1 0 0 1 0> ], [ qw<1 1 0 1 1 1> ] ],
          );

for my $m_ref (@mat) {
    print_matrix($m_ref);
    say "Number of matrices: ", find_squares($m_ref);
}
sub print_matrix {
    my @matrix = @{$_[0]};
    say "";
    for my $row (@matrix) {
        say '[ ', join (" ", @$row), ' ]';
    }
    say " ";
}

sub find_squares {
    my @matrix = @{$_[0]};
    my $nb_lines = scalar @matrix;
    my $nb_col = scalar @{$matrix[0]};
    my $nb_squares = 0;
    my $max_square_size = $nb_lines > $nb_col ? $nb_col : $nb_lines;
    for my $square_size (2..$max_square_size) {
        for my $j (0..$nb_col - $square_size) {
            for my $i (0..$nb_lines - $square_size) {
                next if $matrix[$i][$j] == 0;
                next if $matrix[$i][$j+$square_size-1] == 0;
                next if $matrix[$i+$square_size-1][$j] == 0;
                next if $matrix[$i+$square_size-1][$j+$square_size-1] == 0;
                say "Value in position $i, $j is the top left corner of a square of size $square_size";
                $nb_squares++;
            }
        }
    }
    return $nb_squares;
}

With the four sample input matrices, the program displays the following results:

$ perl square-matrix.pl

[ 0 1 0 1 ]
[ 0 0 1 0 ]
[ 1 1 0 1 ]
[ 1 0 0 1 ]

Value in position 0, 1 is the top left corner of a square of size 3
Number of matrices: 1

[ 1 1 0 1 ]
[ 1 1 0 0 ]
[ 0 1 1 1 ]
[ 1 0 1 1 ]

Value in position 0, 0 is the top left corner of a square of size 2
Value in position 2, 2 is the top left corner of a square of size 2
Value in position 0, 1 is the top left corner of a square of size 3
Value in position 0, 0 is the top left corner of a square of size 4
Number of matrices: 4

[ 0 1 0 1 ]
[ 1 0 1 0 ]
[ 0 1 0 0 ]
[ 1 0 0 1 ]

Number of matrices: 0

[ 1 1 0 1 0 1 ]
[ 1 0 1 0 1 1 ]
[ 1 1 0 0 1 0 ]
[ 1 1 0 1 1 1 ]

Value in position 2, 0 is the top left corner of a square of size 2
Value in position 0, 0 is the top left corner of a square of size 4
Number of matrices: 2

Note that the last example input matrix is not the same as the one in the Raku program, this is the reason why the result is different.

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, 8, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.

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.

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

On Friday, Oct. 16, 2020 around 5:00 p.m., an awful terrorist attack was perpetrated in my home-town of Conflans Sainte-Honorine in France (35,000 inhabitants), the city where I live and of which I am a city councilor. A secondary school teacher was beheaded by a crazy religious extremist who coudn’t accept that teacher’s defense of the freedom of speech. This is a terrible shock to all my fellow citizens, to the teachers and pupils of that school, and to my fellow members of the city council. Because of that, I did not have time to complete the second task of this challenge (although it was almost complete) and my blog post on the first task will be shorter than what I wanted to make. I actually considered not publishing a blog post this week, but I have written at least one blog post for every single Perl Weekly Challenge since the very beginning, I certainly do not want a madman to prevent me from continuing this uninterrupted series of blogs on PWC. And I also don’t want to leave my friend Mohammad S. Anwar alone in the cold.

Common Factors

You are given 2 positive numbers $M and $N.

Write a script to list all common factors of the given numbers.

Example 1:

Input:
    $M = 12
    $N = 18

Output:
    (1, 2, 3, 6)

Explanation:
    Factors of 12: 1, 2, 3, 4, 6
    Factors of 18: 1, 2, 3, 6, 9

Example 2:

Input:
    $M = 18
    $N = 23

Output:
    (1)

Explanation:
    Factors of 18: 1, 2, 3, 6, 9
    Factors of 23: 1

I wanted to give some more explanations, but the short version is that the common factors of two numbers are the factors of the greatest common divisor (GCD) of the two input numbers. So we will compute the GCD of the two numbers and find its divisors.

Common Factors in Raku

Raku has a built-in operator, gcd, to compute the GCD of two numbers.

The code is thus quite simple:

sub common_factors (Int $a, Int $b) {
    my $gcd = $a gcd $b;
    return (1,) if $gcd == 1;
    return ($gcd,) if $gcd.is-prime;
    return (1..$gcd).grep($gcd %% *).unique;
}
my @result = common_factors 12, 18;
say @result;

Output:

raku common_factors.raku
[1 2 3 6]

Common Factors in Perl

Perl doesn’t have a built-in GCD routine. So we will write one using Euclid’s algorithm, or, rather, a modernized version of his algorithm using the % modulo operator, rather than subtraction in the original version of Euclid’s algorithm.

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

sub gcd {
    my ($i, $j) = sort { $a <=> $b } @_;
    while ($j) {
        ($i, $j) = ($j, $i % $j);
    }
    return $i;
}

sub common_factors {
    my ($i, $j) = @_;
    my $gcd = gcd ($i, $j);
    return (1) if $gcd == 1;
    my @factors = grep { $gcd % $_ == 0 } 1..$gcd; 
    my %unique = map {$_ => 1} @factors;
    return sort { $a <=> $b } keys %unique;
}
say join " ", common_factors @ARGV;

Output:

$ perl common_factors.pl 12 18
1 2 3 6

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, October 25, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.

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

Frequency Sort

You are given file named input.

Write a script to find the frequency of all the words.

It should print the result as the first column of each line should be the frequency of the the word followed by all the words of that frequency arranged in lexicographical order. Also sort the words in the ascending order of frequency.

Input file

West Side Story

The award-winning adaptation of the classic romantic tragedy “Romeo and Juliet”. The feuding families become two warring New York City gangs, the white Jets led by Riff and the Latino Sharks, led by Bernardo. Their hatred escalates to a point where neither can coexist with any form of understanding. But when Riff’s best friend (and former Jet) Tony and Bernardo’s younger sister Maria meet at a dance, no one can do anything to stop their love. Maria and Tony begin meeting in secret, planning to run away. Then the Sharks and Jets plan a rumble under the highway—whoever wins gains control of the streets. Maria sends Tony to stop it, hoping it can end the violence. It goes terribly wrong, and before the lovers know what’s happened, tragedy strikes and doesn’t stop until the climactic and heartbreaking ending.

Note

For the sake of this task, please ignore the following in the input file:

. " ( ) , 's --

Output

1 But City It Jet Juliet Latino New Romeo Side Story Their Then West York adaptation any anything at award-winning away become before begin best classic climactic coexist control dance do doesn't end ending escalates families feuding form former friend gains gangs goes happened hatred heartbreaking highway hoping in know love lovers meet meeting neither no one plan planning point romantic rumble run secret sends sister streets strikes terribly their two under understanding until violence warring what when where white whoever wins with wrong younger

2 Bernardo Jets Riff Sharks The by it led tragedy

3 Maria Tony a can of stop

4 to

9 and the

Frequency Sort in Raku

We slurp the full contents of the file into a string, remove the:

. " ( ) , 's --

characters or pairs of characters, use the words method to split the string into words and dump these words into a $h (for histogram) Bag. We then use the %summary hash to dispatch the words according to their frequency. We then iterate over the sorted keys of the hash and output the frequencies and the sorted words for each frequency.

my Str $str = slurp "./WestSideStory.txt";
$str ~~ s:g/<[."(),]>+//;
$str ~~ s:g/[\'s]||['--']//;
my $h = bag $str.words; # histogram by words
my %summary;    # histogram by values
push %summary{$h{$_}}, $_ for $h.keys;
for %summary.keys.sort -> $k {
  say "$k ", %summary{$k}.sort.join(" ");
}

With the West Side Story summary provided above, the following output is displayed:

$ raku frequency-sort.raku
1 But City It Jet Juliet Latino New Romeo Side Story Their Then West York adaptation any anything at award-winning away become before begin best classic climactic coexist control dance do doesn't end ending}; escalates families feuding form former friend gains gangs goes happened hatred heartbreaking highway whoever hoping in know love lovers meet meeting neither no one plan planning point romantic rumble run secret sends sister streets strikes terribly their two under understanding until violence warring what when where white wins with wrong younger
2 Bernardo Jets Riff Sharks The by it led tragedy
3 Maria Tony a can of stop
4 to
9 and the

Frequency Sort in Perl

We need to explicitly read the file. We slurp the file into an array and then convert the resulting array into a single string and finally process that string in a way quite similar to what we just did in Raku, except that we use a hash instead of a Bag.

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

my $input = "WestSideStory.txt";
open my $IN, "<", $input or die "Unable to open $input $!";
my @in = <$IN>;
chomp @in;
my $str = join " ", @in;
$str =~ s/[."(),]+//g;
$str =~ s/(\'s)||(--)//g;
my %histogram;
$histogram{$_}++ for split /\s+/, $str;
my %summary;
push @{$summary{$histogram{$_}}}, $_ for keys %histogram;
for my $k (sort {$a <=> $b} keys %summary) {
    say "$k ", join " ", sort @{$summary{$k}};
}

With the West Side Story summary provided above, this program displays the following output:

$ perl frequency-sort.pl
1 But City It Jet Juliet Latino New Romeo Side Story Their Then West York adaptation any anything at award-winning away become before begin best classic climactic coexist control dance do doesn't end ending}; escalates families feuding form former friend gains gangs goes happened hatred heartbreaking highway whoever hoping in know love lovers meet meeting neither no one plan planning point romantic rumble run secret sends sister streets strikes terribly their two under understanding until violence warring what when where white wins with wrong younger
2 Bernardo Jets Riff Sharks The by it led tragedy
3 Maria Tony a can of stop
4 to
9 and the

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, October 18, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.