- Added solutions by Guillermo Ramos.

2 files changed, 183 insertions, 0 deletions

diff --git a/challenge-010/guillermo-ramos/perl5/ch-1.pl b/challenge-010/guillermo-ramos/perl5/ch-1.pl
new file mode 100644
index 0000000000..f2073ad8bd
--- /dev/null
+++ b/challenge-010/guillermo-ramos/perl5/ch-1.pl
@@ -0,0 +1,118 @@
+#!/usr/bin/env perl
+#
+# 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;
+
+# CLI usage
+sub usage {
+	print "$0 {-e ARABIC | -d ROMAN | --test}\n";
+	exit shift;
+}
+usage -1 unless @ARGV > 0;
+if ($ARGV[0] eq "--test") {
+	test();
+} else {
+	usage -1 unless @ARGV == 2;
+	if ($ARGV[0] eq "-d") {
+		print decode($ARGV[1]), "\n";
+	} elsif ($ARGV[0] eq "-e") {
+		print encode($ARGV[1]), "\n";
+	} else {
+		usage -1;
+	}
+}
+
+# roman -> arabic
+sub decode {
+	my @roman = split //, shift;
+
+	# Decimal value of each roman symbol
+	my %dec = (
+		M => 1000,
+		D =>  500,
+		C =>  100,
+		L =>   50,
+		X =>   10,
+		V =>    5,
+		I =>    1,
+	);
+	my $arabic = 0; # Return value
+
+	# Iterate over roman symbols
+	for (my $i = 0; $i < @roman; $i++) {
+		# Get current and next symbols
+		my ($currsym, $nextsym) = @roman[$i .. $i+1];
+		my $val = $dec{$currsym};
+
+		# Sub current value if next symbol is bigger; add it otherwise
+		if (defined $nextsym && $val < $dec{$nextsym}) {
+			$arabic -= $val;
+		} else {
+			$arabic += $val;
+		}
+	}
+
+	return $arabic;
+}
+
+# arabic -> roman
+sub encode {
+	die "ERROR: Unable to encode numbers bigger than 9999" if $_[0] > 9999;
+
+	my @arabic = split //, shift;
+
+	my @symbols = ("I", "V", "X", "L", "C", "D", "M");
+	my @roman; # Return value (roman symbols)
+
+	# Iterate arabic digits from right to left (upward units)
+	for (my $i = $#arabic; $i >= 0; $i--) {
+		my $digit = $arabic[$i];
+
+		# Roman symbols corresponding to (1-5-10) given the current base
+		my ($one, $five, $ten) = @symbols;
+
+		# Roman symbols to add at the beginning of the current result
+		my @to_add;
+
+		# 4 and 9 are (5-1) and (10-1) respectively
+		if ($one ne "M" && ($digit == 4 || $digit == 9)) {
+			push @to_add, $one;
+			$digit++;
+		}
+
+		# Add the roman equivalents to the current digit
+		if ($one eq "M") {
+			# For 4000-9999, just add as much M's as needed
+			push @to_add, (map $one, (1..$digit));
+		} elsif ($digit == 10) {
+			push @to_add, $ten;
+		} elsif ($digit > 4) {
+			push @to_add, ($five, map $one, (6..$digit));
+		} elsif ($digit > 0) {
+			push @to_add, (map $one, (1..$digit));
+		}
+		unshift @roman, @to_add;
+
+		# For the next decimal, discard two roman symbols (one + five)
+		shift @symbols foreach (1..2);
+	}
+
+	return join "", @roman;
+}
+
+# Property:
+#   forall (x : Arabic). x == decode(encode(x))
+sub test {
+	foreach my $i (1..9999) {
+		my $roman = encode($i);
+		my $arabic = decode($roman);
+		die "ERROR: $i -> $roman -> $arabic" if $i != $arabic;
+	}
+	print "Test successful\n";
+}
diff --git a/challenge-010/guillermo-ramos/perl5/ch-2.pl b/challenge-010/guillermo-ramos/perl5/ch-2.pl
new file mode 100644
index 0000000000..f0566df291
--- /dev/null
+++ b/challenge-010/guillermo-ramos/perl5/ch-2.pl
@@ -0,0 +1,65 @@
+#!/usr/bin/env perl
+#
+# 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;
+
+use List::Util qw<max min>;
+
+sub jaro {
+	my @s1 = split //, shift;
+	my @s2 = split //, shift;
+
+	# Two chars in s1 and s2 match if they are not farther away than this number
+	my $match_dist = int(max (scalar @s1, scalar @s2) / 2)-1;
+	$match_dist = 0 if $match_dist < 0;
+
+	# Maps indices from s1 chars to matching s2 chars
+	my %matches;
+
+	# Compute matches (fill the %matches hash)
+	S1:
+	foreach my $i (0 .. $#s1) {
+		foreach my $j ($i-min($i, $match_dist) .. min($i+$match_dist, $#s2)) {
+			# Skip s2 char if already matched
+			next if grep(/$j/, values %matches);
+
+			# If characters match, store match and advance to next char in s1
+			if ($s1[$i] eq $s2[$j]) {
+				$matches{$i} = $j;
+				next S1;
+			}
+		}
+	}
+
+	# Count number of matches and exit if 0
+	my $m = keys %matches;
+	return 0 if $m == 0;
+
+	# Count transpositions
+	my $t = 0;
+	for my $k (keys %matches) {
+		$t += 1 if $k != $matches{$k};
+	}
+
+	# Finally compute and return Jaro distance
+	return (($m/@s1) + ($m/@s2) + (($m-$t)/$m))/3;
+}
+
+sub jaro_winkler {
+	my ($s1, $s2) = @_;
+	my $jarosim = jaro $s1, $s2;
+	my $l;
+	for ($l = 0; $l < length $s1; $l++) {
+		last if (substr($s1, $l, 1) ne (substr $s2, $l, 1));
+	}
+	my $p = 0.1;
+	return $jarosim + $l*$p*(1-$jarosim);
+}
+
+die "Usage: $0 <s1> <s2>" unless @ARGV == 2;
+print jaro_winkler(@ARGV), "\n";