Merge remote-tracking branch 'upstream/master' after I got really confused with git and remotes and merging

8 files changed, 640 insertions, 0 deletions

diff --git a/challenge-010/e-choroba/blog.txt b/challenge-010/e-choroba/blog.txt
new file mode 100644
index 0000000000..66079c4efa
--- /dev/null
+++ b/challenge-010/e-choroba/blog.txt
@@ -0,0 +1 @@
+http://blogs.perl.org/users/e_choroba/2019/06/perl-weekly-challenge-010-roman-numerals.html
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
diff --git a/challenge-010/kian-meng-ang/blog.txt b/challenge-010/kian-meng-ang/blog.txt
new file mode 100644
index 0000000000..d3ed2951c2
--- /dev/null
+++ b/challenge-010/kian-meng-ang/blog.txt
@@ -0,0 +1 @@
+https://perlweeklychallenge.org/blog/review-challenge-010/
diff --git a/challenge-010/ruben-westerberg/perl5/ch-1.pl b/challenge-010/ruben-westerberg/perl5/ch-1.pl
new file mode 100755
index 0000000000..929fd12f1b
--- /dev/null
+++ b/challenge-010/ruben-westerberg/perl5/ch-1.pl
@@ -0,0 +1,87 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use List::Util;
+use v2.26;
+
+die "Need a single argument" if @ARGV != 1;
+
+
+if ($ARGV[0] =~ /[MDCLXVI]/) {
+	print romanToDecimal($ARGV[0])."\n";
+}
+elsif ($ARGV[0] =~ /\d+/) {
+	print decimalToRoman($ARGV[0])."\n";
+}
+else {
+	die "What on earth are you trying to convert?";
+}
+
+sub decimalToRoman {
+	my @digits= split "", shift;
+	
+	#my @p=qw<I X C M>;
+	#my @h=qw<V L D>;
+	my @out;
+	my @p=<I X C M>;
+	my @h=<V L D>;
+	for (my $i=0; $i < @digits; $i++) {
+		my $power=@digits-$i-1;
+		my $base=$p[$power];
+		my $half=$h[$power];
+		$_=$digits[$i];
+		if ($_ == 0) {
+		}
+
+		elsif (grep {$_ == $digits[$i]} (1..3)) {
+			push @out,$base x $_;
+
+		}
+		elsif( $_ == 4) {
+			push @out,$base;
+			push @out, $half;
+		}
+		elsif( $_ == 5) {
+			push @out, $half;
+		}
+		elsif( grep {$_ == $digits[$i]}  6..8 ) {
+			push @out, $half;
+			push @out, $base x ($_ - 5);
+		}
+		elsif ( $_== 9) {
+			push @out, $base;
+			push @out, $p[$power+1];
+		}
+		else{
+
+		}
+	}
+	return join '', @out;
+	
+}
+
+sub romanToDecimal {
+	my %r=(M=>1000, D=>500, C=>100, L=>50, X=>10, V=>5, I=>1); 
+	my @c=split '', shift;
+	my $diff=0;
+	my $sum=0;
+	for (my $i=0; $i<@c; $i++) {
+		if (($i+1) < @c) {
+			print "is Diff\n";
+
+			if ($r{$c[$i+1]} > $r{$c[$i]}) {
+				$diff=$r{$c[$i]};
+			}
+			else {
+				$sum+= $r{$c[$i]} -$diff;
+				$diff=0;
+			}
+		}
+		else {
+			$sum+=$r{$c[$i]} -$diff;
+		}
+	}
+	return $sum;
+}
+
+
diff --git a/challenge-010/ruben-westerberg/perl6/ch-1.p6 b/challenge-010/ruben-westerberg/perl6/ch-1.p6
new file mode 100755
index 0000000000..96d9a889b0
--- /dev/null
+++ b/challenge-010/ruben-westerberg/perl6/ch-1.p6
@@ -0,0 +1,79 @@
+#!/usr/bin/env perl6
+
+sub MAIN(
+	Str $input,
+) {
+	given $input {
+		when /<[MDCLXVI]>/ {
+			say romanToDecimal($_);
+		}
+		when /\d+/ {
+			say  decimalToRoman($_);
+		}
+		default {
+			die "What on earth are you trying to convert?";
+		}
+	}
+
+}
+sub decimalToRoman ($input) {
+	my @digits=$input.comb;
+	my @p=<I X C M>;
+	my @h=<V L D>;
+	my $roman= join '', do for  @digits.kv {
+		my $power=@digits-$^k-1;	
+		#decimalToRoman($^v,@digits-$^k-1);
+		my @out;
+		my $base=@p[$power];
+		my $half=@h[$power];
+		given $^v {
+			when 1..3 {
+				@out.append: $base xx $_;
+			}
+			when 4 {
+				@out.push: $base;
+				@out.push: $half;
+			}
+			when 5 {
+				@out.push: $half;
+			}
+			when 6..8 {
+				@out.push: $half;
+				@out.append: $base xx ($_- 5);
+			}
+			when 9 {
+				@out.push: $base;
+				@out.push: @p[$power+1];
+			}
+
+		}
+		|@out;
+	}
+}
+
+sub romanToDecimal($input) {
+
+	my %r=(M=>1000, C=>100 ,X=>10, I=>1, V=>5, L=>50, D=>500);
+	my @order=%r.sort: *.value <=> *.value;
+	my @c=$input.comb;
+	my $diff=0;
+	my $sum=0;
+
+	for @c.kv -> $k, $v {
+		if $k+1 < @c {
+			if (%r{@c[$k+1]} > %r{$v}) {
+				$diff=%r{$v};
+			}
+			else {
+				$sum+=%r{$v}- $diff;
+				$diff=0;
+			}
+		
+		}
+		else {
+			$sum+=%r{$v}- $diff;
+		}
+	}
+	$sum;
+}
+