Challenge 10 by Jaldhar H. Vyas

4 files changed, 472 insertions, 0 deletions

diff --git a/challenge-010/jaldhar-h-vyas/perl5/ch-1.pl b/challenge-010/jaldhar-h-vyas/perl5/ch-1.pl
new file mode 100755
index 0000000000..e3153067b2
--- /dev/null
+++ b/challenge-010/jaldhar-h-vyas/perl5/ch-1.pl
@@ -0,0 +1,135 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use 5.010;
+use experimental 'switch';
+
+sub usage {
+    print <<"-USAGE-";
+    Usage:
+    $0 -f <number>
+    $0 -t <number>
+
+    -f          convert Roman numerals to a decimal number
+    -t          convert a number (between 1 and 3000) to Roman numerals
+    <number>    the number to convert
+-USAGE-
+    exit(1);
+}
+
+sub fromRoman {
+    my ($number) = @_;
+    my $result;
+
+    while () {
+        given ($number) {
+            when (/\GMMM/gc) { $result += 3000; }
+            when (/\GMM/gc)  { $result += 2000; }
+            when (/\GM/gc)   { $result += 1000; }
+
+            when (/\GCM/gc)   { $result += 900; }
+            when (/\GDCCC/gc) { $result += 800; }
+            when (/\GDCC/gc)  { $result += 700; }
+            when (/\GDC/gc)   { $result += 600; }
+            when (/\GD/gc)    { $result += 500; }
+            when (/\GCD/gc)   { $result += 400; }
+            when (/\GCCC/gc)  { $result += 300; }
+            when (/\GCC/gc)   { $result += 200; }
+            when (/\GC/gc)    { $result += 100; }
+
+            when (/\GXC/gc)   { $result += 90; }
+            when (/\GLXXX/gc) { $result += 80; }
+            when (/\GLXX/gc)  { $result += 70; }
+            when (/\GLX/gc)   { $result += 60; }
+            when (/\GL/gc)    { $result += 50; }
+            when (/\GXL/gc)   { $result += 40; }
+            when (/\GXXX/gc)  { $result += 30; }
+            when (/\GXX/gc)   { $result += 20; }
+            when (/\GX/gc)    { $result += 10; }
+
+            when (/\GIX/gc)   { $result += 9; }
+            when (/\GVIII/gc) { $result += 8; }
+            when (/\GVII/gc)  { $result += 7; }
+            when (/\GVI/gc)   { $result += 6; }
+            when (/\GV/gc)    { $result += 5; }
+            when (/\GIV/gc)   { $result += 4; }
+            when (/\GIII/gc)  { $result += 3; }
+            when (/\GII/gc)   { $result += 2; }
+            when (/\GI/gc)    { $result += 1; }
+
+            when (/\G$/gc)    { last; }
+            default           { $result = 0; last; } # some unexpected input
+        }
+    }
+    return $result;
+}
+
+sub toRoman {
+    my ($number) = @_;
+
+    if ($number < 1 || $number > 3000) {
+        usage();
+    }
+
+    my $result;
+
+    given ($number / 1000 % 10) {
+        when (1) { $result .= 'M'; }
+        when (2) { $result .= 'MM'; }
+        when (3) { $result .= 'MMM'; }
+        default {}
+    }
+
+    given ($number / 100 % 10) {
+        when (1) { $result .= 'C'; }
+        when (2) { $result .= 'CC'; }
+        when (3) { $result .= 'CCC'; }
+        when (4) { $result .= 'CD'; }
+        when (5) { $result .= 'D'; }
+        when (6) { $result .= 'DC'; }
+        when (7) { $result .= 'DCC'; }
+        when (8) { $result .= 'DCCC'; }
+        when (9) { $result .= 'CM'; }
+        default {}
+    }
+
+    given ($number / 10 % 10) {
+        when (1) { $result .= 'X'; }
+        when (2) { $result .= 'XX'; }
+        when (3) { $result .= 'XXX'; }
+        when (4) { $result .= 'XL'; }
+        when (5) { $result .= 'L'; }
+        when (6) { $result .= 'LX'; }
+        when (7) { $result .= 'LXX'; }
+        when (8) { $result .= 'LXXX'; }
+        when (9) { $result .= 'XC'; }
+        default {}
+    }
+
+    given ($number % 10) {
+        when (1) { $result .= 'I'; }
+        when (2) { $result .= 'II'; }
+        when (3) { $result .= 'III'; }
+        when (4) { $result .= 'IV'; }
+        when (5) { $result .= 'V'; }
+        when (6) { $result .= 'VI'; }
+        when (7) { $result .= 'VII'; }
+        when (8) { $result .= 'VIII'; }
+        when (9) { $result .= 'IX'; }
+        default {}
+    }
+
+    return $result;
+}
+
+if (scalar @ARGV < 2) {
+   usage();
+}
+
+if ($ARGV[0] eq '-f') {
+   say fromRoman($ARGV[1]);
+} elsif ($ARGV[0] eq '-t') {
+   say toRoman($ARGV[1]);
+} else {
+   usage();
+}
\ No newline at end of file
diff --git a/challenge-010/jaldhar-h-vyas/perl5/ch-2.pl b/challenge-010/jaldhar-h-vyas/perl5/ch-2.pl
new file mode 100755
index 0000000000..d44602f30e
--- /dev/null
+++ b/challenge-010/jaldhar-h-vyas/perl5/ch-2.pl
@@ -0,0 +1,84 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use 5.010;
+
+sub usage {
+    print <<"-USAGE-";
+    Usage:
+    $0 <string1> <string2>
+
+    <string1>    First string to compare
+    <string2>    Second string to compare
+-USAGE-
+    exit(1);
+}
+
+sub prefix {
+    my ($string1, $string2) = @_;
+    my @prefix1 = split //, substr($string1, 0, 4);
+    my @prefix2 = split //, substr($string2, 0, 4);
+    my $result = 0;
+
+    for my $i (0 .. 3) {
+        if (defined $prefix2[$i] && $prefix1[$i] eq $prefix2[$i]) {
+            $result++;
+        } else {
+            last;
+        }
+    }
+
+    return $result;
+}
+
+sub jaroSimilarity {
+    my ($string1, $string2) = @_;
+
+    my $m = 0; # matches
+    my $t = 0; # transpositions
+    my $near = int((length $string1) / 2 - 1);
+    my @chars = split //, $string1;
+
+    for my $i (0 .. scalar @chars - 1) {
+        my $pos = index $string2, $chars[$i];
+        if ($pos > -1) {
+            $m++;
+            if (abs($pos - $i) > $near) {
+                $t++;
+            }
+            substr($string2, $pos, 1) = ' '; # prevent using same char twice.
+        }
+    }
+    $t /= 2;
+
+    return $m
+      ? 1/3 * ($m / (length $string1) + $m / (length $string2) + ($m - $t) / $m)
+      : 0;
+}
+
+sub jaroWinklerSimilarity {
+    my ($string1, $string2) = @_;
+    my $j = jaroSimilarity($string1, $string2);
+
+    return $j + (prefix($string1, $string2) * 0.1) * (1 - $j);
+}
+
+sub jaroWinklerDistance {
+    my ($string1, $string2) = @_;
+
+    return 1 - jaroWinklerSimilarity($string1, $string2);
+}
+
+sub swap {
+    my ($s1, $s2) = @_;
+
+    return length $s1 >= length $s2 ? ($s1, $s2) : ($s2, $s1);
+}
+
+if (scalar @ARGV != 2) {
+   usage();
+}
+
+my ($string1, $string2) = swap($ARGV[0], $ARGV[1]);
+
+say jaroWinklerDistance($string1, $string2);
\ No newline at end of file
diff --git a/challenge-010/jaldhar-h-vyas/perl6/ch-1.p6 b/challenge-010/jaldhar-h-vyas/perl6/ch-1.p6
new file mode 100755
index 0000000000..8c4ffea4f0
--- /dev/null
+++ b/challenge-010/jaldhar-h-vyas/perl6/ch-1.p6
@@ -0,0 +1,191 @@
+#!/usr/bin/perl6
+
+grammar RomanNumerals {
+    token TOP {
+        <thousands>? <hundreds>? <tens>? <ones>?
+    }
+
+    token thousands {
+        <ThreeM> | <TwoM> | <OneM>
+    }
+
+    token hundreds {
+        <NineC> | <EightC> | <SevenC> | <SixC> | <FiveC> | <FourC> | <ThreeC> | 
+        <TwoC> | <OneC>
+    }
+
+    token tens {
+        <NineX> | <EightX> | <SevenX> | <SixX> | <FiveX> | <FourX> | <ThreeX> |
+        <TwoX> | <OneX>
+    }
+
+    token ones {
+        <NineI> | <EightI> | <SevenI> | <SixI> | <FiveI> | <FourI> | <ThreeI> |
+        <TwoI> | <OneI>
+    }
+
+    token ThreeM { MMM }
+    token TwoM { MM }
+    token OneM { M }
+
+    token NineC { CM }
+    token EightC { DCCC }
+    token SevenC { DCC }
+    token SixC { DC }
+    token FiveC { D }
+    token FourC { CD }
+    token ThreeC { CCC }
+    token TwoC { CC }
+    token OneC { C }
+
+    token NineX { XC }
+    token EightX { LXXX }
+    token SevenX { LXX }
+    token SixX { LX }
+    token FiveX { L }
+    token FourX { XL }
+    token ThreeX { XXX }
+    token TwoX { XX }
+    token OneX { X }
+
+    token NineI { IX }
+    token EightI { VIII }
+    token SevenI { VII }
+    token SixI { VI }
+    token FiveI { V }
+    token FourI { IV }
+    token ThreeI { III }
+    token TwoI { II }
+    token OneI { I }
+}
+
+class RomanNumeralsAction {
+    method TOP($/) {
+        make $/.values».made.sum;
+    }
+
+    method thousands($/) {
+        make $/.values[0].made;
+    }
+
+    method hundreds($/) {
+        make $/.values[0].made;
+    }
+
+    method tens($/) {
+        make $/.values[0].made;
+    }
+
+    method ones($/) {
+        make $/.values[0].made;
+    }
+
+    method ThreeM($/) { make 3000; }
+    method TwoM($/)   { make 2000; }
+    method OneM($/)   { make 1000; }
+
+    method NineC($/)  { make 900; }
+    method EightC($/) { make 800; }
+    method SevenC($/) { make 700; }
+    method SixC($/)   { make 600; }
+    method FiveC($/)  { make 500; }
+    method FourC($/)  { make 400; }
+    method ThreeC($/) { make 300; }
+    method TwoC($/)   { make 200; }
+    method OneC($/)   { make 100; }
+
+    method NineX($/)  { make 90; }
+    method EightX($/) { make 80; }
+    method SevenX($/) { make 70; }
+    method SixX($/)   { make 60; }
+    method FiveX($/)  { make 50; }
+    method FourX($/)  { make 40; }
+    method ThreeX($/) { make 30; }
+    method TwoX($/)   { make 20; }
+    method OneX($/)   { make 10; }
+
+    method NineI($/)  { make 9; }
+    method EightI($/) { make 8; }
+    method SevenI($/) { make 7; }
+    method SixI($/)   { make 6; }
+    method FiveI($/)  { make 5; }
+    method FourI($/)  { make 4; }
+    method ThreeI($/) { make 3; }
+    method TwoI($/)   { make 2; }
+    method OneI($/)   { make 1; }
+}
+
+sub fromRoman(Str $number where .uc) {
+    my $decimal = RomanNumerals.parse($number,
+                    actions => RomanNumeralsAction.new);
+    if defined $decimal {
+        return $decimal.made;
+    }
+    return 0;
+}
+
+sub toRoman(Int $number where { $number >= 1 && $number <= 3000 }) {
+    my Str $result;
+
+    given ($number div 1000) {
+        when 1 { $result ~= 'M'; }
+        when 2 { $result ~= 'MM'; }
+        when 3 { $result ~= 'MMM'; }
+        default {}
+    }
+
+    given ($number div 100 % 10) {
+        when 1 { $result ~= 'C'; }
+        when 2 { $result ~= 'CC'; }
+        when 3 { $result ~= 'CCC'; }
+        when 4 { $result ~= 'CD'; }
+        when 5 { $result ~= 'D'; }
+        when 6 { $result ~= 'DC'; }
+        when 7 { $result ~= 'DCC'; }
+        when 8 { $result ~= 'DCCC'; }
+        when 9 { $result ~= 'CM'; }
+        default {}
+    }
+
+    given ($number div 10 % 10) {
+        when 1 { $result ~= 'X'; }
+        when 2 { $result ~= 'XX'; }
+        when 3 { $result ~= 'XXX'; }
+        when 4 { $result ~= 'XL'; }
+        when 5 { $result ~= 'L'; }
+        when 6 { $result ~= 'LX'; }
+        when 7 { $result ~= 'LXX'; }
+        when 8 { $result ~= 'LXXX'; }
+        when 9 { $result ~= 'XC'; }
+        default {}
+    }
+
+    given ($number % 10) {
+        when 1 { $result ~= 'I'; }
+        when 2 { $result ~= 'II'; }
+        when 3 { $result ~= 'III'; }
+        when 4 { $result ~= 'IV'; }
+        when 5 { $result ~= 'V'; }
+        when 6 { $result ~= 'VI'; }
+        when 7 { $result ~= 'VII'; }
+        when 8 { $result ~= 'VIII'; }
+        when 9 { $result ~= 'IX'; }
+        default {}
+    }
+
+    return $result;
+}
+
+multi sub MAIN(
+    $number,            #= the number to convert
+    Bool :$f! where .so #= convert Roman numerals to a decimal number
+) {
+    say fromRoman($number);
+}
+
+multi sub MAIN(
+    $number,
+    Bool :$t! where .so #= convert a number (between 1 and 3000) to Roman numerals
+) {
+    say toRoman($number.Int);
+}
\ No newline at end of file
diff --git a/challenge-010/jaldhar-h-vyas/perl6/ch-2.p6 b/challenge-010/jaldhar-h-vyas/perl6/ch-2.p6
new file mode 100644
index 0000000000..225624e16a
--- /dev/null
+++ b/challenge-010/jaldhar-h-vyas/perl6/ch-2.p6
@@ -0,0 +1,62 @@
+#!/usr/bin/perl6
+
+sub prefix(Str $string1, Str $string2) {
+    my @prefix1 = $string1.comb;
+    my @prefix2 = $string2.comb;
+    my $result = 0;
+
+    for 0 .. 3 -> $i {
+        if (@prefix2[$i].defined && @prefix1[$i] eq @prefix2[$i]) {
+            $result++;
+        } else {
+            last;
+        }
+    }
+    return $result;
+}
+
+sub jaroSimilarity(Str $string1, Str $string2) {
+    my Str $string2Copy = $string2;
+    my $m = 0; # matches
+    my $t = 0; # transpositions
+    my $near = $string1.chars / 2 - 1;
+    my @chars = $string1.comb;
+
+    for 0 .. @chars.elems - 1 -> $i {
+        my $pos = $string2Copy.index(@chars[$i]);
+        if $pos.defined {
+            $m++;
+            if abs($pos - $i) > $near {
+                $t++;
+            }
+            $string2Copy.substr-rw($pos, 1) = ' '; # prevent using same char twice.
+        }
+    }
+    $t /= 2;
+
+    return $m
+      ?? 1/3 * ($m / $string1.chars + $m / $string2.chars + ($m - $t) / $m)
+      !! 0;
+}
+
+sub jaroWinklerSimilarity(Str $string1, Str $string2) {
+    my $j = jaroSimilarity($string1, $string2);
+
+    return $j + (prefix($string1, $string2) * 0.1) * (1 - $j);
+}
+
+sub jaroWinklerDistance(Str $string1, Str $string2) {
+    return 1 - jaroWinklerSimilarity($string1, $string2);
+}
+
+sub swap(Str $s1, Str $s2) {
+    return (max($s1.chars, $s2.chars) ~~ $s1.chars) ?? ($s1, $s2) !! ($s2, $s1);
+}
+
+multi sub MAIN(
+    Str $arg1,   #= First string to compare.
+    Str $arg2    #= Second string to compare.
+) {
+    my ($string1, $string2) = swap($arg1, $arg2);
+    say jaroWinklerDistance($string1, $string2);
+}
\ No newline at end of file