challenge-010 andrezgz solution

2 files changed, 190 insertions, 0 deletions

diff --git a/challenge-010/andrezgz/perl5/ch-1.pl b/challenge-010/andrezgz/perl5/ch-1.pl
new file mode 100644
index 0000000000..021587e75a
--- /dev/null
+++ b/challenge-010/andrezgz/perl5/ch-1.pl
@@ -0,0 +1,86 @@
+#!/usr/bin/perl
+
+# https://perlweeklychallenge.org/blog/perl-weekly-challenge-010/
+# Challenge #1
+# Write a script to encode/decode Roman numerals.
+# For example, given Roman numeral CCXLVI, it should return 246.
+# Similarly, for decimal number 39, it should return XXXIX.
+# Checkout wikipedia page for more information.
+# https://en.wikipedia.org/wiki/Roman_numerals
+
+use strict;
+use warnings;
+
+die "Usage: $0 <DECIMAL|ROMAN>" unless $ARGV[0];
+
+my %roman_table = (
+    'I'  => 1,
+    'IV' => 4,
+    'V'  => 5,
+    'IX' => 9,
+    'X'  => 10,
+    'XL' => 40,
+    'L'  => 50,
+    'XC' => 90,
+    'C'  => 100,
+    'CD' => 400,
+    'D'  => 500,
+    'CM' => 900,
+    'M'  => 1000
+);
+
+my $arg = $ARGV[0];
+
+if ($arg =~ /^\d+$/i) {
+    die "Decimal number should be between 1 and 3999" if ($arg < 1 || $arg > 3999);
+    print encode_roman($arg);
+}
+else {
+    die "Invalid roman number" unless ( _is_valid_roman($arg) );
+    print decode_roman(uc $arg);
+}
+
+exit 0;
+
+# Subtractive notation roman number validation
+sub _is_valid_roman {
+    return $arg =~ /
+                ^                       # String start
+                M{0,3}                  # Matching from 1000 to 3000
+                (?:CM|CD|D|D?C{0,3})?   # Matching from 100 to 900
+                (?:XC|XL|L|L?X{0,3})?   # Matching from 10 to 90
+                (?:IX|IV|V|V?I{0,3})?   # Matching from 1 to 9
+                $                       # String end
+            /xi;
+}
+
+sub encode_roman {
+    my $number = shift;
+    my $roman_number;
+
+    foreach my $r (sort { $roman_table{$b} <=> $roman_table{$a} } keys %roman_table) {
+        my $d = int($number / $roman_table{$r});
+        next unless $d;
+        $roman_number .= $r x $d;
+        $number -= $roman_table{$r} * $d;
+    }
+
+    return $roman_number;
+}
+
+sub decode_roman {
+    my @roman = split //, shift;
+    my $number;
+
+    while (my $c1 = shift @roman) {
+        my $c2 = @roman ? $roman[0] : 0;
+        if (!$c2 || $roman_table{$c1} >= $roman_table{$c2} ) {
+            $number += $roman_table{$c1};
+        } else {
+            $number += $roman_table{$c2} - $roman_table{$c1};
+            shift @roman;
+        }
+    }
+
+    return $number;
+}
diff --git a/challenge-010/andrezgz/perl5/ch-2.pl b/challenge-010/andrezgz/perl5/ch-2.pl
new file mode 100644
index 0000000000..a7da3bb1d5
--- /dev/null
+++ b/challenge-010/andrezgz/perl5/ch-2.pl
@@ -0,0 +1,104 @@
+#!/usr/bin/perl
+
+# https://perlweeklychallenge.org/blog/perl-weekly-challenge-010/
+# Challenge #2
+# Write a script to find Jaro-Winkler distance between two strings.
+# For more information check wikipedia page.
+# https://en.wikipedia.org/wiki/Jaro%E2%80%93Winkler_distance
+
+use strict;
+use warnings;
+
+die "Usage: $0 <string> <string>" if (scalar @ARGV != 2);
+
+#Using lower case for checking similarity
+my $dw = 1 - simw(map {lc} @ARGV);;
+print 'Jaro-Winkler distance: '.sprintf("%.3f",$dw).$/;
+
+exit 0;
+
+#Jaro-Winkler similarity
+sub simw {
+    my ($s1,$s2,$p) = @_;
+    #Scaling factor
+    $p = 0.1 unless $p;
+
+    my $simj = simj($s1,$s2);
+
+    my $prefix = _common_prefix($s1,$s2);
+
+    my $simw = $simj + $prefix * $p * (1- $simj);
+
+    return $simw;
+}
+
+#Common prefix
+sub _common_prefix {
+    my ($s1,$s2) = @_;
+
+    my @chr1 = split //, $s1;
+    my @chr2 = split //, $s2;
+
+    my $prefix = 0;
+    do {
+        last unless ( defined $chr2[$_] && $chr1[$_] eq $chr2[$_] );
+        $prefix++;
+    } for 0..3; #prefix up to 4
+    return $prefix;
+}
+
+#Jaro similarity
+sub simj {
+    my ($s1,$s2) = @_;
+
+    my $l1 = length($s1);
+    my $l2 = length($s2);
+
+    #Matching distance
+    my $max_l = $l1 > $l2 ? $l1 : $l2;
+    my $match_dist = int($max_l / 2 - 1);
+
+    my @chr1 = split //, $s1;
+    my @chr2 = split //, $s2;
+    my @chr2tmp = @chr2;
+
+    my @matches;
+    my %matches_position;
+
+    for (my $i = 0; $i < $l1; $i++) {
+
+        my $init = $i - $match_dist;
+        $init = 0 if $init < 0;
+
+        my $end = $i + $match_dist + 1;
+        $end = $l2 if $end > $l2;
+
+        for (my $j = $init; $j < $end; $j++) {
+            if ($chr1[$i] eq $chr2tmp[$j]){
+                push @matches, $chr1[$i];
+                $matches_position{$j} = $i; #required to detect transpositions
+                $chr2tmp[$j]='-'; # avoid matching with the same character
+                last;
+            }
+        }
+    }
+
+    my $m = @matches;
+    #Jaro similarity is 0 if there are no matches
+    return 0 if ($m == 0);
+
+    my $transpositions = 0;
+    my $j = 0;
+    for (my $i = 0; $j < $m; $i++) {
+        if (exists $matches_position{$i}){
+            $transpositions++ if( $chr2[$i] ne $matches[$j]);
+            $j++;
+        }
+    }
+
+    my $t = $transpositions / 2;
+
+    my $simj = 1/3 * ($m/$l1 + $m/$l2 + ($m - $t)/$m);
+
+    return $simj;
+}