summaryrefslogtreecommitdiff
path: root/010
diff options
context:
space:
mode:
Diffstat (limited to '010')
-rwxr-xr-x010/ch1.pl174
-rwxr-xr-x010/ch2.pl76
2 files changed, 125 insertions, 125 deletions
diff --git a/010/ch1.pl b/010/ch1.pl
index f2073ad..ad385d6 100755
--- a/010/ch1.pl
+++ b/010/ch1.pl
@@ -11,108 +11,108 @@ use warnings;
# CLI usage
sub usage {
- print "$0 {-e ARABIC | -d ROMAN | --test}\n";
- exit shift;
+ print "$0 {-e ARABIC | -d ROMAN | --test}\n";
+ exit shift;
}
usage -1 unless @ARGV > 0;
if ($ARGV[0] eq "--test") {
- 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;
- }
+ 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;
+ 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;
+ 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";
+ 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/010/ch2.pl b/010/ch2.pl
index f0566df..a5a37f5 100755
--- a/010/ch2.pl
+++ b/010/ch2.pl
@@ -11,54 +11,54 @@ use warnings;
use List::Util qw<max min>;
sub jaro {
- my @s1 = split //, shift;
- my @s2 = split //, shift;
+ 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;
+ # 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;
+ # 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);
+ # 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;
- }
- }
- }
+ # 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 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};
- }
+ # 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;
+ # 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);
+ 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;
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-23 06:39:34 +0000