[Melbourne-pm] Roman numerals & assessing a CPAN module

[Damian Conway]

Just in case no module proves acceptable, here's some raw code extracted
from Lingua::Romana::Perligata. It handles Roman numerals up to 1 billion.

As you see, for larger numbers it uses parens instead of the C-I-reversed-C
of classical Latin. I guess under Unicode, you could represent such
numbers more accurately with the codepoints:

    0x216D (ROMAN NUMERAL ONE HUNDRED),
    0x2160 (ROMAN NUMERAL ONE),
    0x2183 (ROMAN NUMERAL REVERSED ONE HUNDRED)

Damian

-----cut----------cut----------cut----------cut----------cut-----

    sub make_range {
        my ($unit, $five, $ten) = @_;
        my ($two, $three) = ($unit x 2, $unit x 3);
        return [
            "", $unit, $two, $three, $unit.$five, $five,
            $five.$unit, $five.$two, $five.$three, $unit.$ten
        ];
    }

    my @order = (
        make_range(qw{         I         V                  X          }),
        make_range(qw{         X         L                  C          }),
        make_range(qw{         C         D                  M          }),
        make_range(qw{         M         I))              ((I))        }),
        make_range(qw{       ((I))       I)))            (((I)))       }),
        make_range(qw{      (((I)))      I))))          ((((I))))      }),
        make_range(qw{     ((((I))))     I)))))        (((((I)))))     }),
        make_range(qw{    (((((I)))))    I))))))      ((((((I))))))    }),
        make_range(qw{   ((((((I))))))   I)))))))    (((((((I)))))))   }),
        make_range(qw{  (((((((I)))))))  I))))))))  ((((((((I))))))))  }),
    );

    my %val;
    for my $power (0..$#order) {
        @val{@{$order[$power]}} = map {$_*10**$power} 0..9;
    }

    my $roman = '('
              . join(")(", map { join("|",map { quotemeta } reverse sort(@$_)) }
                               reverse @order)
              . '|)'
              ;

    sub from_roman {
        my $roman_val = shift;
        my @numerals = $roman_val =~ /(?:$roman)/ix;
        my $arabic_num = 0;
        for my $numeral (@numerals) {
            $arabic_num += $val{$numeral};
        }
        return $arabic_num;
    }

    sub to_roman {
        my @digits = split '', shift;
        my $power = 0;
        my $roman_num = "";
        for my $digit (reverse @digits) {
            $roman_num = $order[$power++][$digit] . $roman_num;
        }
        return $roman_num;
    }