Merge pull request #3353 from LubosKolouch/master

Solutions LK

2 files changed, 90 insertions, 0 deletions

diff --git a/challenge-096/lubos-kolouch/perl/ch-1.pl b/challenge-096/lubos-kolouch/perl/ch-1.pl
new file mode 100644
index 0000000000..ba81a88954
--- /dev/null
+++ b/challenge-096/lubos-kolouch/perl/ch-1.pl
@@ -0,0 +1,34 @@
+#!/usr/bin/perl 
+#===============================================================================
+#
+#         FILE: ch-1.pl
+#
+#        USAGE: ./ch-1.pl  
+#
+#  DESCRIPTION: Perl Weekly Challenge #096
+#               https://perlweeklychallenge.org/blog/perl-weekly-challenge-096/
+#               Task 1 - Reverse Words
+#  
+#       AUTHOR: Lubos Kolouch
+#      VERSION: 1.0
+#      CREATED: 01/23/2021 11:20:18 AM
+#===============================================================================
+
+use strict;
+use warnings;
+
+sub reverse_words {
+    my $what = shift;
+
+    # split leaves the initial space
+    $what =~ s/^\s+//;
+
+    return  join ' ', reverse split /\s+/, $what;
+}
+
+use Test::More;
+
+is(reverse_words('The Weekly Challenge'), 'Challenge Weekly The');
+is(reverse_words('    Perl and   Raku are  part of the same family  '), 'family same the of part are Raku and Perl');
+
+done_testing;
diff --git a/challenge-096/lubos-kolouch/perl/ch-2.pl b/challenge-096/lubos-kolouch/perl/ch-2.pl
new file mode 100644
index 0000000000..3940ae6923
--- /dev/null
+++ b/challenge-096/lubos-kolouch/perl/ch-2.pl
@@ -0,0 +1,56 @@
+#!/usr/bin/perl 
+#===============================================================================
+#
+#         FILE: ch-2.pl
+#
+#        USAGE: ./ch-2.pl  
+#
+#  DESCRIPTION: Perl Weekly Challenge #096
+#               https://perlweeklychallenge.org/blog/perl-weekly-challenge-096/
+#               Task 2 - Edit Distance
+#  
+#       AUTHOR: Lubos Kolouch
+#      VERSION: 1.0
+#      CREATED: 01/23/2021 11:20:18 AM
+#===============================================================================
+
+use strict;
+use warnings;
+use List::Util qw/min/;
+
+sub edit_distance {
+    my $what = shift;
+
+    # Wagner-Fischer algorithm
+    # https://en.wikipedia.org/wiki/Wagner–Fischer_algorithm
+
+    my @d;
+
+    $d[0][0] = 0;
+    $d[$_][0] = $_ for (1..length($what->[0]));
+    $d[0][$_] = $_ for (1..length($what->[1]));
+
+    for my $j (1..length($what->[1])) {
+        for my $i (1..length($what->[0])) {
+
+		
+			my $substitutionCost = 0;
+			if (substr($what->[0], $i-1, 1) ne substr($what->[1], $j-1, 1)) {
+				$substitutionCost = 1;
+			}
+
+            $d[$i][$j] = min($d[$i-1][$j] + 1,                   # deletion
+                           $d[$i][$j-1] + 1,                   # insertion
+                           $d[$i-1][$j-1] + $substitutionCost);  # substitution
+		}
+	}
+
+    return $d[length($what->[0])][length($what->[1])];
+
+}
+
+use Test::More;
+
+is(edit_distance(['sitting', 'kitten']), 3);
+is(edit_distance(['sunday', 'monday']), 2);
+done_testing;