diff options
| author | Simon Proctor <simon.proctor@zpg.co.uk> | 2019-05-28 12:53:49 +0100 |
|---|---|---|
| committer | Simon Proctor <simon.proctor@zpg.co.uk> | 2019-05-28 12:53:49 +0100 |
| commit | 045c00cbca82a109b27895c0f12aa34276e02a2a (patch) | |
| tree | 7863662bbf74b738232079d6520096ab5e91abd6 /challenge-010/simon-proctor | |
| parent | fe4fa3ef2072abbd008bce478a203e47f5ad4b4f (diff) | |
| download | perlweeklychallenge-club-045c00cbca82a109b27895c0f12aa34276e02a2a.tar.gz perlweeklychallenge-club-045c00cbca82a109b27895c0f12aa34276e02a2a.tar.bz2 perlweeklychallenge-club-045c00cbca82a109b27895c0f12aa34276e02a2a.zip | |
Int to Str conversion too
Diffstat (limited to 'challenge-010/simon-proctor')
| -rwxr-xr-x | challenge-010/simon-proctor/perl6/ch-1.p6 | 75 |
1 files changed, 74 insertions, 1 deletions
diff --git a/challenge-010/simon-proctor/perl6/ch-1.p6 b/challenge-010/simon-proctor/perl6/ch-1.p6 index 5fe7597097..345662b987 100755 --- a/challenge-010/simon-proctor/perl6/ch-1.p6 +++ b/challenge-010/simon-proctor/perl6/ch-1.p6 @@ -4,8 +4,9 @@ use v6; my %*SUB-MAIN-OPTS = :named-anywhere; subset RomanInt of Int where 0 < * < 3001; +subset RomanStr of Str where * ~~ /^ <[M C D X L V I Ⅿ Ⅽ Ⅾ Ⅹ Ⅼ Ⅴ Ⅰ Ⅻ Ⅺ Ⅸ Ⅷ Ⅶ Ⅵ Ⅳ Ⅲ Ⅱ]>+ $/; -sub to-roman (RomanInt $number is copy, @values) is export { +sub to-roman (RomanInt $number is copy, @values) { my $out = ""; for @values -> $pair { @@ -19,6 +20,71 @@ sub to-roman (RomanInt $number is copy, @values) is export { $out; } +sub from-roman( RomanStr $roman is copy ) { + my %roman-map = ( + "M" => 1000, + "Ⅿ" => 1000, + "CM" => 900, + "ⅭⅯ" => 900, + "D" => 500, + "Ⅾ" => 500, + "CD" => 400, + "ⅭⅮ" => 400, + "C" => 100, + "Ⅽ" => 100, + "XC" => 90, + "ⅩⅭ" => 90, + "L" => 50, + "Ⅼ" => 50, + "XL" => 40, + "ⅩⅬ" => 40, + "Ⅻ" => 12, + "Ⅺ" => 11, + "X" => 10, + "Ⅹ" => 10, + "Ⅸ" => 9, + "IX" => 9, + "ⅠⅩ" => 9, + "Ⅷ" => 8, + "Ⅶ" => 7, + "Ⅵ" => 6, + "VI" => 6, + "ⅤⅠ" => 6, + "V" => 5, + "Ⅴ" => 5, + "Ⅳ" => 4, + "IV" => 4, + "ⅠⅤ" => 4, + "Ⅲ" => 3, + "Ⅱ" => 2, + "I" => 1, + "Ⅰ" => 1, + ); + + my $out = 0; + while my $match = $roman ~~ s!^ "M" | "Ⅿ" | + "CM" | "ⅭⅯ" | + "D" | "Ⅾ" | + "CD" | "ⅭⅮ" | + "C" | "Ⅽ" | + "XC" | "ⅩⅭ" | + "L" | "Ⅼ" | + "XL" | "ⅩⅬ" | + "Ⅻ" | "Ⅺ" | + "X" | "Ⅹ" | + "Ⅸ" | "IX" | "ⅠⅩ" | + "Ⅷ" | "Ⅶ" | + "Ⅵ" | "VI" | "ⅤⅠ" | + "V" | "Ⅴ" | + "Ⅳ" | "IV" | "ⅠⅤ" | + "Ⅲ" | "Ⅱ" | + "I" | "Ⅰ" !! { + $out += %roman-map{$match}; + note "$match : $roman : $out"; + } + $out; +} + #| Help data multi sub MAIN( :h(:$help) ) { say $*USAGE; @@ -39,4 +105,11 @@ multi sub MAIN( } say to-roman( $i, @values ); +} + +#| Print the arabic version of the roman numeral string +multi sub MAIN( + RomanStr $roman #= Roman numeral string to convert +) { + say from-roman( $roman ); }
\ No newline at end of file |