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

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

6 files changed, 963 insertions, 0 deletions

diff --git a/challenge-096/athanasius/perl/Matrix.pm b/challenge-096/athanasius/perl/Matrix.pm
new file mode 100644
index 0000000000..eecf63391c
--- /dev/null
+++ b/challenge-096/athanasius/perl/Matrix.pm
@@ -0,0 +1,149 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 096, Task #2: Edit Distance
+
+Matrix class for use in implementing the Wagner–Fischer algorithm for finding
+the Levenshtein distance between two strings.
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+package Matrix;
+#==============================================================================
+
+use strict;
+use warnings;
+
+#------------------------------------------------------------------------------
+sub new                                                           # Constructor
+#------------------------------------------------------------------------------
+{
+    my ($class, $word1, $word2) = @_;
+
+    my  $cols = length( $word1 ) + 1;
+    my  $rows = length( $word2 ) + 1;
+    my  @matrix;
+
+    for my $row (0 .. $rows)
+    {
+        $matrix[ $row ][ $_ ] = undef for 0 .. $cols;
+    }
+
+    $word2 = "#$word2";
+    my $i  = 0;
+
+    for my $row (1 .. $rows)
+    {
+        $matrix[ $row ][ 0 ] = substr $word2, $i, 1;
+        $matrix[ $row ][ 1 ] = $i++;
+    }
+
+    $word1 = "#$word1";
+    $i     = 0;
+
+    for my $col (1 .. $cols)
+    {
+        $matrix[ 0 ][ $col ] = substr $word1, $i, 1;
+        $matrix[ 1 ][ $col ] = $i++;
+    }
+
+    my %self = (
+                   height =>  $rows,
+                   width  =>  $cols,
+                   matrix => \@matrix,
+               );
+
+    return bless \%self, $class;
+}
+
+#------------------------------------------------------------------------------
+sub height                                              # Accessor: getter only
+#------------------------------------------------------------------------------
+{
+    my ($self) = @_;
+
+    return $self->{height};
+}
+
+#------------------------------------------------------------------------------
+sub width                                               # Accessor: getter only
+#------------------------------------------------------------------------------
+{
+    my ($self) = @_;
+
+    return $self->{width};
+}
+
+#------------------------------------------------------------------------------
+sub element                                       # Accessor: getter and setter
+#------------------------------------------------------------------------------
+{
+    my ($self, $row, $col, $value) = @_;
+
+    if (defined $value)
+    {
+        $self->{matrix}[ $row + 1 ][ $col + 1 ] = $value;       # Set
+    }
+
+    return $self->{matrix}[ $row + 1 ][ $col + 1 ];             # Get
+}
+
+#------------------------------------------------------------------------------
+sub display
+#------------------------------------------------------------------------------
+{
+    my ($self)  = @_;
+    my  $height = $self->{height};
+    my  $width  = $self->{width};
+
+    # Pre-compute the maximum widths of individual columns
+
+    my @widths = ( 1 );
+
+    for my $col (1 .. $width)
+    {
+        my $max = 0;
+
+        for my $row (1 .. $height)
+        {
+            my $current = $self->{matrix}[ $row ][ $col ];
+            my $cur_len = length $current;
+               $max     = $cur_len if $cur_len > $max;
+        }
+
+        $widths[$col] = $max;
+    }
+
+    # Draw a vertical separator
+
+    my $line  = '+';
+       $line .=  sprintf '-%s-+', '-'  x $widths[ $_ ] for 0 .. $width;
+       $line .= "\n";
+
+    # Draw the matrix
+
+    my $display = $line;
+
+    for my $row (0 .. $height)
+    {
+        $display .= '|';
+        $display .=  sprintf ' %*s |', $widths[ $_ ],
+                                       $self->{matrix}[ $row ][ $_ ] // ' '
+                        for 0 .. $width;
+        $display .= "\n" . $line;
+    }
+
+    return $display;
+}
+
+###############################################################################
+1;
+###############################################################################
diff --git a/challenge-096/athanasius/perl/ch-1.pl b/challenge-096/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..6a4df6d2a0
--- /dev/null
+++ b/challenge-096/athanasius/perl/ch-1.pl
@@ -0,0 +1,118 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl 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"
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Assumptions
+-----------
+- "Spaces" include all whitespace characters.
+-  Any punctuation attached to a word is to be considered a part of that word,
+   e.g., "Fred and Wilma, Barney and Betty" becomes
+         "Betty and Barney Wilma, and Fred"
+   with the comma still attached to "Wilma" as in the original string.
+
+Implementation
+--------------
+Split the string on whitespace, reverse the result, and re-join the reversed
+list of words into a single string using single spaces.
+
+For split()ting, advantage is taken of the the special case where the pattern
+to split on is a single space character, as documented in https://perldoc.pl/
+functions/split:
+
+ "split /PATTERN/,EXPR
+  ...
+ "As another special case, split emulates the default behavior of the command
+  line tool awk when the PATTERN is either omitted or a string composed of a
+  single space character (such as ' ' or "\x20", but not e.g. / /). In this
+  case, any leading whitespace in EXPR is removed before splitting occurs, and
+  the PATTERN is instead treated as if it were /\s+/; in particular, this means
+  that any contiguous whitespace (not just a single space character) is used as
+  a separator."
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+
+const my $USAGE =>
+"Usage:
+  perl $0 <S>
+
+    <S>    A single string containing words separated by whitespace\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 096, Task #1: Reverse Words (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $S = parse_command_line();
+
+    printf qq[Input:  "%s"\n], $S;
+    printf qq[Output: "%s"\n], join ' ', reverse split ' ', $S;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+
+    if    ($args == 0)
+    {
+        die "ERROR: No command-line arguments\n$USAGE";
+    }
+    elsif ($args >  1)
+    {
+        die "ERROR: Too many command-line arguments\n$USAGE";
+    }
+
+    return $ARGV[0];
+}
+
+###############################################################################
diff --git a/challenge-096/athanasius/perl/ch-2.pl b/challenge-096/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..ec93ec7fc5
--- /dev/null
+++ b/challenge-096/athanasius/perl/ch-2.pl
@@ -0,0 +1,258 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 096
+=========================
+
+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 [https://en.wikipedia.org/wiki/Edit_distance |Wikipedia] page for more in-
+formation.
+
+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'
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Since the allowable operations are given as "insert, remove or replace a
+character", we may assume that the edit distance required in this Task is the
+Levenshtein distance.
+
+A single insert, remove, or replace operation is assigned a cost of one. To
+determine the minimum overall cost, the dynamic-programming Wagner-Fischer
+algorithm is used. A Matrix class is provided to facilitate implementation of
+the algorithm.
+
+The Wagner-Fischer algorithm is not the fastest, but it does create a full
+matrix which can then be used to reconstruct the changes by which the first
+string has been transformed into the second. If the $EXPLAIN constant below is
+set to a true value, the minimum operations required to transform $S1 into $S2
+are listed in the output below the Levenshtein distance. If both $EXPLAIN and
+$SHOW_MATRIX are set to true values, the matrix generated by the Wagner-Fischer
+algorithm is also displayed.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use lib qw( . );
+use Matrix;
+
+const my $EXPLAIN     => 1;
+const my $SHOW_MATRIX => 0;
+const my $USAGE       =>
+"Usage:
+  perl $0 <S1> <S2>
+
+    <S1>    First string
+    <S2>    Second string\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 096, Task #2: Edit Distance (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my ($S1, $S2) = parse_command_line();
+
+    printf qq[Input:  \$S1 = "%s"; \$S2 = "%s"\n], $S1, $S2;
+
+    my ($distance, $matrix) = levenshtein_distance($S1, $S2);
+
+    printf qq[Output: %d (Levenshtein distance)\n], $distance;
+
+    if ($EXPLAIN)
+    {
+        print "\n", $matrix->display if $SHOW_MATRIX;
+
+        my $path = trace_path($matrix);
+        my $ops  = find_operations($path, $S1, $S2);
+
+        print "\n$ops" if $ops;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub levenshtein_distance
+#------------------------------------------------------------------------------
+{
+    my ($s, $t) = @_;
+    my  $matrix = Matrix->new($s, $t);
+    my  @s      = ('#', split //, $s);
+    my  @t      = ('#', split //, $t);
+
+    for my $row (1 .. $#t)
+    {
+        for my $col (1 .. $#s)
+        {
+            my $del_cost = $matrix->element($row - 1, $col    ) + 1;
+            my $ins_cost = $matrix->element($row,     $col - 1) + 1;
+            my $sub_cost = $matrix->element($row - 1, $col - 1) +
+                               (($t[ $row ] eq $s[ $col ]) ? 0  : 1);
+
+            $matrix->element($row, $col, min($del_cost, $ins_cost, $sub_cost));
+        }
+    }
+
+    return ($matrix->element($#t, $#s), $matrix);
+}
+
+#------------------------------------------------------------------------------
+sub trace_path
+#------------------------------------------------------------------------------
+{
+    my ($matrix) = @_;
+    my  $row     = $matrix->height - 1;
+    my  $col     = $matrix->width  - 1;
+    my  $min     = $matrix->element($row, $col);
+    my  @path    = [ $row, $col, $min ];
+
+    until ($row == 0 && $col == 0)
+    {
+        if    ($col == 0)
+        {
+            $min = $matrix->element(--$row,   $col);        # Move up:   insert
+        }
+        elsif ($row == 0)
+        {
+            $min = $matrix->element(  $row, --$col);        # Move left: delete
+        }
+        else
+        {
+            my $up   = $matrix->element($row - 1, $col    );
+            my $left = $matrix->element($row,     $col - 1);
+            my $diag = $matrix->element($row - 1, $col - 1);
+
+            if    ($diag <= $up   && $diag <= $left)
+            {                                               # Move up and left:
+                $min = $matrix->element(--$row, --$col);    #           replace
+            }
+            elsif ($up   <= $diag && $up   <= $left)
+            {
+                $min = $matrix->element(--$row,   $col);    # Move up:   insert
+            }
+            else
+            {
+                $min = $matrix->element(  $row, --$col);    # Move left: delete
+            }
+        }
+
+        push @path, [ $row, $col, $min ];
+    }
+
+    return [ reverse @path ];
+}
+
+#------------------------------------------------------------------------------
+sub find_operations
+#------------------------------------------------------------------------------
+{
+    my ($path, $s, $t) = @_;
+    my  $summary       = '';
+    my  $last          = shift @$path;
+    my  $count         = 0;
+
+    while (my $next = shift @$path)
+    {
+        if ($next->[2] > $last->[2])
+        {
+            my  $op;
+
+            if    ($next->[0] == $last->[0])
+            {
+                $op = sprintf "remove '%s'",
+                               substr($s, $next->[1] - 1, 1);
+            }
+            elsif ($next->[1] == $last->[1])
+            {
+                $op = sprintf "insert '%s'",
+                               substr($t, $next->[0] - 1, 1);
+            }
+            else
+            {
+                $op = sprintf "replace '%s' with '%s'",
+                               substr($s, $next->[1] - 1, 1),
+                               substr($t, $next->[0] - 1, 1);
+            }
+
+            $summary .= sprintf "Operation %d: %s\n", ++$count, $op;
+        }
+
+        $last = $next;
+    }
+
+    return $summary;
+}
+
+#------------------------------------------------------------------------------
+sub min
+#------------------------------------------------------------------------------
+{
+    my ($x, $y, $z) = @_;
+
+    my  $min = $x;
+        $min = $y if $y < $min;
+        $min = $z if $z < $min;
+
+    return $min;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+
+    if    ($args < 2)
+    {
+        die "ERROR: Too few command-line arguments\n$USAGE";
+    }
+    elsif ($args > 2)
+    {
+        die "ERROR: Too many command-line arguments\n$USAGE";
+    }
+
+    return @ARGV[ 0 .. 1 ];
+}
+
+###############################################################################
diff --git a/challenge-096/athanasius/raku/Matrix.rakumod b/challenge-096/athanasius/raku/Matrix.rakumod
new file mode 100644
index 0000000000..4f79fbf7c4
--- /dev/null
+++ b/challenge-096/athanasius/raku/Matrix.rakumod
@@ -0,0 +1,120 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 096, Task #2: Edit Distance
+
+Matrix class for use in implementing the Wagner–Fischer algorithm for finding
+the Levenshtein distance between two strings.
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+unit class Matrix;
+#==============================================================================
+
+#------------------------------------------------------------------------------
+# Matrix attributes
+#------------------------------------------------------------------------------
+
+has UInt       $.height;
+has UInt       $.width;
+has Array[Str] @!matrix;
+
+#------------------------------------------------------------------------------
+submethod BUILD( Str:D :$S1, Str:D :$S2 )
+#------------------------------------------------------------------------------
+{
+    $!width  = $S1.chars + 1;
+    $!height = $S2.chars + 1;
+
+    for 0 .. $!height -> UInt $row
+    {
+        @!matrix[$row    ] = Array[Str].new;
+        @!matrix[$row; $_] = Nil for 0 .. $!width;
+    }
+
+    my Str $word2 = "#$S2";
+    my $i = 0;
+
+    for 1 .. $!height -> UInt $row
+    {
+        @!matrix[$row; 0] = $word2.substr: $i, 1;
+        @!matrix[$row; 1] = "$i";
+        ++$i;
+    }
+
+    my Str $word1 = "#$S1";
+
+    $i = 0;
+
+    for 1 .. $!width -> UInt $col
+    {
+        @!matrix[0; $col] = $word1.substr: $i, 1;
+        @!matrix[1; $col] = "$i";
+        ++$i;
+    }
+}
+
+#------------------------------------------------------------------------------
+method element( UInt:D $row, UInt:D $col, UInt $value? --> UInt:D )  # Accessor
+#------------------------------------------------------------------------------
+{
+    if $value.defined
+    {
+        @!matrix[$row + 1; $col + 1] = "$value";            # Set
+    }
+
+    return @!matrix[$row + 1; $col + 1].UInt;               # Get
+}
+
+#------------------------------------------------------------------------------
+method display
+#------------------------------------------------------------------------------
+{
+    # Pre-compute the maximum widths of individual columns
+
+    my UInt @widths = 1;
+
+    for 1 .. $!width -> UInt $col
+    {
+        my UInt $max = 0;
+
+        for 1 .. $!height -> UInt $row
+        {
+            my Str  $current = @!matrix[$row; $col];
+            my UInt $cur-len = $current.chars;
+                    $max     = $cur-len if $cur-len > $max;
+        }
+
+        @widths[ $col ] = $max;
+    }
+
+    # Draw a vertical separator
+
+    my Str $line  = '+';
+           $line ~= '-%s-+'.sprintf: '-'  x @widths[ $_ ] for 0 .. $!width;
+           $line ~= "\n";
+
+    # Draw the matrix
+
+    my Str $display = $line;
+
+    for 0 .. $!height -> UInt $row
+    {
+        $display ~= '|';
+        $display ~= ' %*s |'.sprintf: @widths[ $_ ], @!matrix[$row; $_] // ' '
+                        for 0 .. $!width;
+        $display ~= "\n" ~ $line;
+    }
+
+    return $display;
+}
+
+##############################################################################
diff --git a/challenge-096/athanasius/raku/ch-1.raku b/challenge-096/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..444b3c64e2
--- /dev/null
+++ b/challenge-096/athanasius/raku/ch-1.raku
@@ -0,0 +1,90 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl 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"
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Assumptions
+-----------
+- "Spaces" include all whitespace characters.
+-  Any punctuation attached to a word is to be considered a part of that word,
+   e.g., "Fred and Wilma, Barney and Betty" becomes
+         "Betty and Barney Wilma, and Fred"
+   with the comma still attached to "Wilma" as in the original string.
+
+Implementation
+--------------
+Split the string on whitespace, reverse the result, and re-join the reversed
+list of words into a single string using single spaces.
+
+Note: The named parameter ":skip-empty" ensures that split() "do[es] not return
+empty strings before or after a delimiter" (https://docs.raku.org/routine/
+split), thereby removing leading and trailing whitespace.
+
+=end comment
+#==============================================================================
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 096, Task #1: Reverse Words (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    Str:D $S        #= A single string containing words separated by whitespace
+)
+#==============================================================================
+{
+    qq[Input:  "%s"\n].printf: $S;
+    qq[Output: "%s"\n].printf: $S.split(/\s+/, :skip-empty).reverse.join: ' ';
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-096/athanasius/raku/ch-2.raku b/challenge-096/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..6b8059d802
--- /dev/null
+++ b/challenge-096/athanasius/raku/ch-2.raku
@@ -0,0 +1,228 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 096
+=========================
+
+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 [https://en.wikipedia.org/wiki/Edit_distance |Wikipedia] page for more in-
+formation.
+
+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'
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Since the allowable operations are given as "insert, remove or replace a
+character", we may assume that the edit distance required in this Task is the
+Levenshtein distance.
+
+A single insert, remove, or replace operation is assigned a cost of one. To
+determine the minimum overall cost, the dynamic-programming Wagner-Fischer
+algorithm is used. A Matrix class is provided to facilitate implementation of
+the algorithm.
+
+The Wagner-Fischer algorithm is not the fastest, but it does create a full
+matrix which can then be used to reconstruct the changes by which the first
+string has been transformed into the second. If the $EXPLAIN constant below is
+set to True, the minimum operations required to transform $S1 into $S2 will be
+listed in the output below the Levenshtein distance. If both $EXPLAIN and
+$SHOW-MATRIX are True, the matrix generated by the Wagner-Fischer algorithm is
+also displayed.
+
+=end comment
+#==============================================================================
+
+use lib < . >;
+use Matrix;
+
+my Bool constant $EXPLAIN     = True;
+my Bool constant $SHOW-MATRIX = False;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 096, Task #2: Edit Distance (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    Str:D $S1,                        #= First  string
+    Str:D $S2                         #= Second string
+)
+#==============================================================================
+{
+    qq[Input:  \$S1 = "%s"; \$S2 = "%s"\n].printf: $S1, $S2;
+
+    my (UInt $distance, Matrix $matrix) = levenshtein-distance($S1, $S2);
+
+    qq[Output: %d (Levenshtein distance)\n].printf: $distance;
+
+    if $EXPLAIN
+    {
+        "\n%s".printf: $matrix.display if $SHOW-MATRIX;
+
+        my Array:D[UInt:D] @path = trace-path($matrix);
+        my Str             $ops  = find-ops(@path, $S1, $S2);
+
+        print "\n$ops" if $ops;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub levenshtein-distance( Str:D $s, Str:D $t --> List:D[UInt:D, Matrix:D] )
+#------------------------------------------------------------------------------
+{
+    my Matrix $matrix = Matrix.new(S1 => $s, S2 => $t);
+    my Str    @s      = "#$s".split: '', :skip-empty;
+    my Str    @t      = "#$t".split: '', :skip-empty;
+
+    for 1 .. @t.end -> UInt $row
+    {
+        for 1 .. @s.end -> UInt $col
+        {
+            my UInt $del-cost = $matrix.element($row - 1, $col    ) + 1;
+            my UInt $ins-cost = $matrix.element($row,     $col - 1) + 1;
+            my UInt $sub-cost = $matrix.element($row - 1, $col - 1) +
+                                  ((@t[ $row ] eq @s[ $col ]) ?? 0 !! 1);
+
+            $matrix.element($row, $col, ($del-cost, $ins-cost, $sub-cost).min);
+        }
+    }
+
+    return $matrix.element(@t.end, @s.end), $matrix;
+}
+
+#------------------------------------------------------------------------------
+sub trace-path( Matrix:D $matrix --> Seq:D[Array:D[UInt:D]] )
+#------------------------------------------------------------------------------
+{
+    my UInt        $row  = $matrix.height - 1;
+    my UInt        $col  = $matrix.width  - 1;
+    my UInt        $min  = $matrix.element($row, $col).UInt;
+    my Array[UInt] @path = Array[Array[UInt]].new;
+
+    @path.push: Array[UInt].new( $row, $col, $min );
+
+    until $row == 0 && $col == 0
+    {
+        if    $col == 0
+        {
+            $min = $matrix.element(--$row,   $col);         # Move up:   insert
+        }
+        elsif $row == 0
+        {
+            $min = $matrix.element(  $row, --$col);         # Move left: delete
+        }
+        else
+        {
+            my UInt $up   = $matrix.element($row - 1, $col    );
+            my UInt $left = $matrix.element($row,     $col - 1);
+            my UInt $diag = $matrix.element($row - 1, $col - 1);
+
+            if    $diag <= $up   && $diag <= $left
+            {                                               # Move up and left:
+                $min = $matrix.element(--$row, --$col);     #           replace
+            }
+            elsif $up   <= $diag && $up   <= $left
+            {
+                $min = $matrix.element(--$row,   $col);     # Move up:   insert
+            }
+            else
+            {
+                $min = $matrix.element(  $row, --$col);     # Move left: delete
+            }
+        }
+
+        @path.push: Array[UInt].new( $row, $col, $min );
+    }
+
+    return @path.reverse;
+}
+
+#------------------------------------------------------------------------------
+sub find-ops( Array:D[Array:D[UInt:D]] $path, Str:D $s, Str:D $t --> Str:D )
+#------------------------------------------------------------------------------
+{
+    my Str         $summary = '';
+    my Array[UInt] $last    = $path.shift;
+    my UInt        $count   = 0;
+
+    while $path
+    {
+        my Array[UInt] $next = $path.shift;
+
+        if $next[2] > $last[2]
+        {
+            my Str $op;
+
+            if    $next[0] == $last[0]
+            {
+                $op = "remove '%s'".sprintf: $s.substr: $next[1] - 1, 1;
+            }
+            elsif $next[1] == $last[1]
+            {
+                $op = "insert '%s'".sprintf: $t.substr: $next[0] - 1, 1;
+            }
+            else
+            {
+                $op = "replace '%s' with '%s'".sprintf:
+                                             $s.substr( $next[1] - 1, 1 ),
+                                             $t.substr( $next[0] - 1, 1 );
+            }
+
+            $summary ~= sprintf "Operation %d: %s\n", ++$count, $op;
+        }
+
+        $last = $next;
+    }
+
+    return $summary;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################