aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLuis Mochan <mochan@fis.unam.mx>2021-01-18 13:47:18 -0600
committerLuis Mochan <mochan@fis.unam.mx>2021-01-18 13:47:18 -0600
commitdf99ff7d6e2c429536b357e76576142aca1aeed5 (patch)
tree718d142a2f40c88fb49fa15cca1c4a859fa2d214
parent754e6dcd79dde5387229a23ae7eca35d70eac4a3 (diff)
downloadperlweeklychallenge-club-df99ff7d6e2c429536b357e76576142aca1aeed5.tar.gz
perlweeklychallenge-club-df99ff7d6e2c429536b357e76576142aca1aeed5.tar.bz2
perlweeklychallenge-club-df99ff7d6e2c429536b357e76576142aca1aeed5.zip
Add solutions to challenge 96
-rw-r--r--challenge-096/wlmb/blog.txt1
-rwxr-xr-xchallenge-096/wlmb/perl/ch-1.pl12
-rwxr-xr-xchallenge-096/wlmb/perl/ch-2.pl80
3 files changed, 93 insertions, 0 deletions
diff --git a/challenge-096/wlmb/blog.txt b/challenge-096/wlmb/blog.txt
new file mode 100644
index 0000000000..9b37677859
--- /dev/null
+++ b/challenge-096/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2021/01/18/PWC096/
diff --git a/challenge-096/wlmb/perl/ch-1.pl b/challenge-096/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..785c0d0106
--- /dev/null
+++ b/challenge-096/wlmb/perl/ch-1.pl
@@ -0,0 +1,12 @@
+#!/usr/bin/env perl
+# 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);
diff --git a/challenge-096/wlmb/perl/ch-2.pl b/challenge-096/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..3ad00b6cae
--- /dev/null
+++ b/challenge-096/wlmb/perl/ch-2.pl
@@ -0,0 +1,80 @@
+#!/usr/bin/env perl
+# 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;
+
+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);
+
+#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;
+ }
+}
+
+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!";
+}
+
+say "Inputs: \"$from\" -> \"$to\"\nOutput: $total_cost\n";
+say "Operation $_: $operations[$_-1]" foreach 1..@operations;
+say;