diff options
Diffstat (limited to 'challenge-096')
| -rw-r--r-- | challenge-096/lubos-kolouch/perl/ch-1.pl | 34 | ||||
| -rw-r--r-- | challenge-096/lubos-kolouch/perl/ch-2.pl | 56 |
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; |
