Merge pull request #3353 from LubosKolouch/master

Solutions LK

4 files changed, 165 insertions, 0 deletions

diff --git a/challenge-001/lubos-kolouch/perl/ch-1.pl b/challenge-001/lubos-kolouch/perl/ch-1.pl
new file mode 100644
index 0000000000..cb28f13ebe
--- /dev/null
+++ b/challenge-001/lubos-kolouch/perl/ch-1.pl
@@ -0,0 +1,33 @@
+#!/usr/bin/perl 
+#===============================================================================
+#
+#         FILE: ch-1.pl
+#
+#        USAGE: ./ch-1.pl  
+#
+#  DESCRIPTION: Perl Weekly Challenge 001
+#               https://perlweeklychallenge.org/blog/perl-weekly-challenge-001/
+#               Task 1 - replace characters
+#
+#       AUTHOR: Lubos Kolouch
+#      CREATED: 01/23/2021 03:36:54 PM
+#===============================================================================
+
+use strict;
+use warnings;
+
+sub replace_e {
+    my $what = shift;
+
+    my $count = () = $what =~ /e/g;
+
+    $what =~ s/e/E/g;
+
+    return [$count, $what];
+}
+
+use Test::More;
+
+is_deeply(replace_e('Perl Weekly Challenge'), [5, 'PErl WEEkly ChallEngE']);
+done_testing;
+
diff --git a/challenge-001/lubos-kolouch/perl/ch-2.pl b/challenge-001/lubos-kolouch/perl/ch-2.pl
new file mode 100644
index 0000000000..5addf8f8a3
--- /dev/null
+++ b/challenge-001/lubos-kolouch/perl/ch-2.pl
@@ -0,0 +1,42 @@
+#!/usr/bin/perl 
+#===============================================================================
+#
+#         FILE: ch-1.pl
+#
+#        USAGE: ./ch-1.pl  
+#
+#  DESCRIPTION: Perl Weekly Challenge 001
+#               https://perlweeklychallenge.org/blog/perl-weekly-challenge-001/
+#               Task 2 - FizzBuzz
+#
+#       AUTHOR: Lubos Kolouch
+#      CREATED: 01/23/2021 03:36:54 PM
+#===============================================================================
+
+use strict;
+use warnings;
+
+sub fizz_buzz {
+    my $what = shift;
+
+    my @output;
+
+    for (1..20) {
+        
+        my $line = '';
+
+        $line = 'fizz' if $_ % 3 == 0;
+        $line .= 'buzz' if $_ % 5 == 0;
+        $line = $_ unless $line;
+
+        push @output, $line;
+    }
+
+    return \@output;
+}
+
+use Test::More;
+
+is_deeply(fizz_buzz(), [1, 2, 'fizz', 4, 'buzz', 'fizz', 7, 8, 'fizz', 'buzz', 11, 'fizz', 13, 14, 'fizzbuzz', 16, 17, 'fizz', 19, 'buzz']);
+done_testing;
+
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;