Perl Weekly Challenge 96.

My solutions (task 1 and task 2) to the The Weekly Challenge - 096.

Task 1: Reverse Words

Submitted by: Mohammad S Anwar You are given a string $S.

Write a script to reverse the order of words in the given string. The string may contain leading/trailing spaces. The string may have more than one space between words in the string. Print the result without leading/trailing spaces and there should be only one space between words. Example 1:

Input: $S = "The Weekly Challenge"
Output: "Challenge Weekly The"
Example 2:
Input: $S = "    Perl and   Raku are  part of the same family  "
Output: "family same the of part are Raku and Perl"

This seems a very simple task using the Perl’s reverse function. Then, the task may be performed in a oneliner.

perl -E 'say "\"", join(" ", reverse split " ", $_),"\"" foreach(@ARGV)' \
"The Weekly Challenge" \
"    Perl and   Raku are  part of the same family  "

Results:

"Challenge Weekly The"
"family same the of part are Raku and Perl"

Here I used that leading spaces are removed when splitting on a whitespace character. Nevertheless, I guess not only spaces, but all punctuation (non-words) ought to be removed. Thus I guess it is better to split on /\W+/.

perl -E 'say "\"", join(" ", reverse split /\W+/, $_),"\"" foreach(@ARGV)' \
"The Weekly Challenge" \
"    Perl and   Raku are  part of the same family  "

Results:

"Challenge Weekly The"
"family same the of part are Raku and Perl "

Unfortunately, splitting this way produces a null first element when the string starts with whitespace. That is the reason the last result above ended in a space. Thus, I filter out null elements.

perl -E 'say "\"", join(" ", grep $_, reverse split /\W+/, $_),"\"" foreach(@ARGV)' \
"The Weekly Challenge" \
"    Perl and   Raku are  part of the same family  "

Results:

"Challenge Weekly The"
"family same the of part are Raku and Perl"

Thus the complete program would be

# Perl weekly challenge 096
# Task 1: Reverse words
# Print words in reverse order separated by one space
# Remove all non-word characters
# See https://wlmb.github.io/2021/01/18/PWC096/#task-1-reverse-words

use warnings;
use strict;
use v5.10;

say "\"", join(" ", grep $_, reverse split /\W+/, $_),"\"" foreach(@ARGV);

I try it out with a few examples:

./ch-1.pl \
	 "The Weekly Challenge" \
	 "    Perl and   Raku are  part of the same family  " \
	 " What happens with punctuation signs? "

Results:

"Challenge Weekly The"
"family same the of part are Raku and Perl"
"signs puntuation with happens What"

Task 2: Edit Distance

Submitted by: Mohammad S Anwar You are given two strings $S1 and $S2.

Write a script to find out the minimum operations required to convert $S1 into $S2. The operations can be insert, remove or replace a character. Please check out Wikipedia page for more information.

Example 1:

Input: $S1 = "kitten"; $S2 = "sitting"
Output: 3

Operation 1: replace 'k' with 's'
Operation 2: replace 'e' with 'i'
Operation 3: insert 'g' at the end

Example 2:

Input: $S1 = "sunday"; $S2 = "monday"
Output: 2

Operation 1: replace 's' with 'm'
Operation 2: replace 'u' with 'o'

This is a very interesting and useful task. As such, there are several modules in CPAN that perform it. For example, Text::Fuzzy returns the distance and the edits encoded as a string with the letters k for keep, d for delete, r for replace and i for insert. With it, the task becomes a one liner.

perl -MText::Fuzzy=distance_edits -E '($x,$y)=@ARGV; ($distance,$edits)=distance_edits($x,$y);' \
     -E 'say "Strings: $x $y\nOutput: $distance\nOperations: $edits"' kitten sitting
perl -MText::Fuzzy=distance_edits -E '($x,$y)=@ARGV; ($distance,$edits)=distance_edits($x,$y);' \
     -E 'say "Strings: $x $y\nOutput: $distance\nOperations: $edits"' sunday monday

Results:

Strings: kitten sitting
Output: 3
Operations: rkkkrki
Strings: sunday monday
Output: 2
Operations: rrkkkk

Nevertheless, it is a nice exercise to implement the algorithm from scratch. I start by reading the strings from @ARGV, splitting them and counting their characters.

# Perl weekly challenge 096
# Task 2: Edit distance.
# Calculate the number of editions required to edit a string and convert it into another.
# See https://wlmb.github.io/2021/01/11/PWC096/#task-2-edit-distance

  use warnings;
  use strict;
  use v5.10;

  # Get the two strings to compare from @ARGV
  sub usage {
      say "Usage:\n\t./ch-2.pl from_string to_string\n\tComputes the cost to edit one string and produce the other";
      exit 1;
  }
  usage() unless @ARGV==2;
  my ($from, $to)=@ARGV;
  my @from=split '', $from;
  my @to=split '', $to;
  my $from_size=@from;
  my $to_size=@to;

I follow the Wagner–Fischer algorithm from the Wikipedia. To that end I build a 2D array $costs each of whose entries ij correspond to the optimal conversion of the leading i characters of one string to the leading j characters of the other. I also build a 2D array $operations with an indicator for the last optimal operation performed to convert the corresponding substrings. I first initialize these arrays with the $costs->[$i][0]~ to convert substrings of $from to a null string, and the $costs->[0][$j] to convert a null string to substrings of $to.

my $costs;
my $operations;
# initialize the costs of $from->'' and ''->$to
$costs->[$_][0]=$_ foreach(0..$from_size); #deletions
$operations->[$_][0]='d' foreach(1..$from_size);
$costs->[0][$_]=$_ foreach(0..$to_size); #insertions
$operations->[0][$_]='i' foreach(1..$to_size);

Then I iteratively choose the optimal strategy for converting a substring of $from to a substring of $to

#Build costs matrix and choose best operations for each pair of substrings.
foreach my $j(1..$to_size){
    foreach my $i(1..$from_size){
	my $subcost=$from[$i-1] eq $to[$j-1]?0:1; # substitution cost
	my($cost,$operation);
	($cost,$operation)=($costs->[$i-1][$j-1]+$subcost,
				  $subcost?"r":"k"); #for keep or substitute
	($cost,$operation)=($costs->[$i][$j-1]+1, "i")
	    if $costs->[$i][$j-1]+1 < $cost; #insertion
	($cost,$operation)=($costs->[$i-1][$j]+1, "d")
	    if $costs->[$i-1][$j]+1 < $cost; #deletion
	$costs->[$i][$j]=$cost;
	$operations->[$i][$j]=$operation;
    }
}

The next step is to find the total cost and the sequence of operations to perform by following the $operations array backwards using the fact that replacements don’t alter the size of strings, while insertions and deletions change it by plus or minus 1.

my $total_cost=$costs->[$from_size][$to_size];
my @operations;
my ($i, $j)=($from_size, $to_size);
# Obtain optimum sequence of operations by examining the $operations array
while($i>0 || $j>0){
    my $operation=$operations->[$i][$j];
    if($operation eq 'k'){
	unshift @operations, "(Keep $from[$i-1])";
	--$i;
	--$j;
	next;
    }
    if($operation eq 'r'){
	unshift @operations, "Replace $from[$i-1] by $to[$j-1]";
	--$i;
	--$j;
	next;
    }
    if($operation eq 'i'){
	unshift @operations, "Insert $to[$j-1]";
	--$j;
	next;
    }
	if($operation eq 'd'){
	unshift @operations, "Delete $from[$i-1]";
	--$i;
	next;
    }
    die "Wrong operation!"; # Shouldn't happen
}

Finally, I output the results.

say "Inputs: \"$from\" -> \"$to\"\nOutput: $total_cost\n";
say "Operation $_: $operations[$_-1]" foreach 1..@operations;
say;

Example 1:

./ch-2.pl "kitten" "sitting"

Results:

Inputs: "kitten" -> "sitting"
Output: 3

Operation 1: Replace k by s
Operation 2: (Keep i)
Operation 3: (Keep t)
Operation 4: (Keep t)
Operation 5: Replace e by i
Operation 6: (Keep n)
Operation 7: Insert g

Example 2:

./ch-2.pl "sunday" "monday"

Results:

Inputs: "sunday" -> "monday"
Output: 2

Operation 1: Replace s by m
Operation 2: Replace u by o
Operation 3: (Keep n)
Operation 4: (Keep d)
Operation 5: (Keep a)
Operation 6: (Keep y)

Other examples to check on null strings

./ch-2.pl "" ""
./ch-2.pl "abc" ""
./ch-2.pl "" "abc"

Results:

Inputs: "" -> ""
Output: 0


Inputs: "abc" -> ""
Output: 3

Operation 1: Delete a
Operation 2: Delete b
Operation 3: Delete c

Inputs: "" -> "abc"
Output: 3

Operation 1: Insert a
Operation 2: Insert b
Operation 3: Insert c
Written on January 18, 2021