This is my response to the Perl Weekly Challenge #47.
|
Write a script that accepts two roman numbers and
operation. It should then perform the operation on the given roman numbers
and print the result.
For example, |
This challenge is similar to Challenge #10.1 («Write a script to encode/decode Roman numbers»). So simliar that I could copy the two procedures «to-roman» and «from-roman» from my solution. See Roman Numbers with Perl Ⅵ for details.
I have chosen to put them in a module «Number::Roman» this time, as I use them several times:
File: lib/Number/Roman.rakumod
use v6;
unit module Number::Roman;
our sub to-roman (Int $number is copy) is export(:to)
{
my $string = "";
while $number >= 1000 { $string ~= "M"; $number -= 1000; }
if $number >= 900 { $string ~= "CM"; $number -= 900; }
if $number >= 500 { $string ~= "D"; $number -= 500; }
if $number >= 400 { $string ~= "CD"; $number -= 400; }
while $number >= 100 { $string ~= "C"; $number -= 100; }
if $number >= 90 { $string ~= "XC"; $number -= 90; }
if $number >= 50 { $string ~= "L"; $number -= 50; }
if $number >= 40 { $string ~= "XL"; $number -= 40; }
while $number >= 10 { $string ~= "X"; $number -= 10; }
if $number >= 9 { $string ~= "IX"; $number -= 9; }
if $number >= 5 { $string ~= "V"; $number -= 5; }
if $number >= 4 { $string ~= "IV"; $number -= 4; }
while $number >= 1 { $string ~= "I"; $number -= 1; }
return $string;
}
my %value = (I => 1, V => 5, X => 10, L => 50, C => 100, D => 500, M => 1000);
my Set $valid-roman = %value.keys.Set;
my $current-value = Inf;
our sub from-roman (Str $roman) is export(:from)
{
my @digits = $roman.comb;
die "Non-Roman digit $_ detected." unless $valid-roman{$_} for @digits;
my $number = 0;
while @digits
{
my $current = @digits.shift;
if @digits.elems
{
if %value{@digits[0]} > %value{$current}
{
$number += %value{@digits.shift} - %value{$current};
next;
}
}
$number += %value{$current};
}
return to-roman($number) eq $roman # [1]
?? $number
!! die "Not a valid Roman Number: $roman";
}
[1] Non-Compliant Roman Values are prevented by a round-trip check. If we just return «$number» without this check things like «IIIII» would be translated to «5». The round-trip check translates «5» back to «V» (and not «IIIII»), so the conversion fails.
The module is not available on CPAN, but I may be open for persuation...
I have chosen the four basic operators only: addition (+), subtraction
(-), multiplication (*) and division (/). I have added (pun intended)
«x» as an alias for «*», as the latter requires
quoting on the command line.
This program uses several «multi MAIN» to choose the right operation:
File: roman-calculator-multi
use lib "lib";
use Number::Roman :to, :from;
multi MAIN (Str $first, "+", Str $second)
{
say to-roman( from-roman($first) + from-roman($second) );
}
multi MAIN (Str $first, "-", Str $second)
{
say to-roman( from-roman($first) - from-roman($second) );
}
multi MAIN (Str $first, '*', Str $second)
{
say to-roman( from-roman($first) * from-roman($second) );
}
multi MAIN (Str $first, 'x', Str $second)
{
say to-roman( from-roman($first) * from-roman($second) );
}
multi MAIN (Str $first, "/", Str $second)
{
say to-roman(Int( from-roman($first) / from-roman($second)) ); # [1]
}
[1] We (the Romans) do not support fractional values, which we could get from division. Strip of any fractional part with «Int» to avoid that.
Running it:
$ raku roman-calculator-multi XII + VII # -> XIX
$ raku roman-calculator-multi XII - VII # -> V
$ raku roman-calculator-multi XII '*' VII # -> LXXXIV
$ raku roman-calculator-multi XII x VII # -> LXXXIV
The module code does not support zero or negative values, but returns an empty string. (Feel free to consider this wrong.)
$ raku roman-calculator-multi XII - C # -> ''
$ raku roman-calculator-multi XII - XII # -> ''
Non-Compliant Roman Values cause program termination:
$ raku roman-calculator-multi MMCICIMIVI + I
Not a valid Roman Number: MMCICIMIVI
in sub from-roman at ...
$ raku roman-calculator-multi CZ + I
Non-Roman digit Z detected.
in sub from-roman at ...
We get a shorter program when we use «given/when», Raku's take on «switch». It is easier to read as well.
File: roman-calculator-given
use lib "lib";
use Number::Roman :to, :from;
unit sub MAIN (Str $first, Str $operator, Str $second);
my $f = from-roman($first);
my $s = from-roman($second);
given $operator
{
when '+' { say to-roman($f + $s) };
when '-' { say to-roman($f - $s) };
when 'x' { say to-roman($f * $s) };
when '*' { say to-roman($f * $s) };
when '/' { say to-roman(Int($f) / Int($s)) };
}
The behaviour is the same.
use MONKEY-TYPING; # [1]
... # [2]
augment class Int # [3]
{
method roman # [4]
{
return to-roman(self);
}
multi method base ("r") # [5]
{
return self.roman;
}
}
augment class Str # [6]
{
method from-roman # [7]
{
return from-roman(self);
}
multi method parse-base ("r") # [8]
{
return self.from-roman;
}
}
[1] This incantation is required to allow augmenting built-in classes.
[2] The original code in module is here.
[3] We start with the «Int» class,
[4] • adding a «roman» method that returns the Int translated to a Roman number.
[5] • adding a new variant of «base» that takes «r» as argument. The «multi» is required, as Raku has other versions of «base» with different signatures (than «r»).
[6] Then we add do the «Str» class,
[7] • adding a «from-roman» method that returns the Roman number translated to an integer.
[8] • As for «base», but the other direction (from Roman number to integer).
Let us see what we can do with it, in REPL:
$ raku
To exit type 'exit' or '^D'
> use lib "lib";
> use Number::Roman;
> "MCM".from-roman
1900
> 1900.roman
MCM
> "MCM".parse-base('r');
1900
> 1900.base('r');
MCM
That surely looks awesome. (Not necessarily useful, though.)
Here is a modified version of the program, using the new methods instead of the procedures:
File: roman-calculator-given-turbo
use lib "lib";
use Number::Roman;
unit sub MAIN (Str $first, Str $operator, Str $second);
my Int $f = $first.from-roman;
my Int $s = $second.from-roman;
given $operator
{
when '+' { say ($f + $s).roman };
when '-' { say ($f - $s).roman };
when 'x' { say ($f * $s).roman };
when '*' { say ($f * $s).roman };
when '/' { say (Int($f) / Int($s)).roman };
}
Running it:
$ raku roman-calculator-given-turbo MM - II
MCMXCVIII
use Number::Roman :to, :from;
unit class Number::Roman::OO;
has Int $.value;
multi method new (Str $string) { self.bless(value => from-roman($string)) }
multi method new($value) { self.bless(:$value) }
method Str { to-roman(self.value) }
method Int { self.value }
method Real { self.value } [1]
[1] This one isn't needed now, but will be whan we start comparing objects numerically (e.g. with «<») as that uses «Real» coersion behind the scenes.
This is enough to convert between Roman numbers and integers and vice versa:
$ raku
To exit type 'exit' or '^D'
> use lib "lib"
> use Number::Roman::OO
> my $a = Number::Roman::OO.new(1900)
> say $a.Str; # -> MCM
> say $a.Int; # -> 1900
> my $b = Number::Roman::OO.new('MCM')
> say $b.Str; # -> MCM
> say $b.Int; # -> 1900
But it isn't much fun without the possibility to change the values, which was the purpose of the challenge.
I have added methods thad adds, subtracts, multiplies and divides. They are invoked on a «Number::Roman::OO» object, but the value to apply can either be another object or an integer (and thus set up with «multi method»).
File: lib/Number/Roman/OO.rakumod (partial)
multi method add (Number::Roman::OO:D $obj)
{
return self.new(self.value + $obj.Int)
}
multi method add (Int $int)
{
return self.new(self.value - $int)
}
multi method sub (Number::Roman::OO:D $obj)
{
return self.new(self.value + $obj.Int)
}
multi method sub (Int $int)
{
return self.new(self.value - $int)
}
multi method mul (Number::Roman::OO:D $obj)
{
return self.new(self.value * $obj.Int)
}
multi method mul (Int $int)
{
return self.new(self.value * $int)
}
multi method div (Number::Roman::OO:D $obj)
{
return self.new(Int(self.value / $obj.Int))
}
multi method div (Int $int)
{
return self.new(Int(self.value / $int))
}
I have chosen to have these methods return a new object, and leave the original one intact. That is how Raku behaves (most of the time), in Functional Programming style.
That makes it possible to do things like this:
my $a = Number::Roman::OO.new(1921);
my $b = $a.add(19);
my $c = $b.sub($a);
And that is fine, but we can add (overload) the operators as well:
File: lib/Number/Roman/OO.rakumod (partial)
multi sub infix:<+> (Number::Roman::OO:D $a, Number::Roman::OO:D $b) is export
{
Number::Roman::OO.new($a.Int + $b.Int);
}
multi sub infix:<+> (Number::Roman::OO:D $a, Int:D $b)
{
Number::Roman::OO.new($a.Int + $b);
}
multi sub infix:<-> (Number::Roman::OO:D $a, Number::Roman::OO:D $b) is export
{
Number::Roman::OO.new($a.Int - $b.Int);
}
multi sub infix:<-> (Number::Roman::OO:D $a, Int:D $b)
{
Number::Roman::OO.new($a.Int - $b);
}
multi sub infix:<*> (Number::Roman::OO:D $a, Number::Roman::OO:D $b) is export
{
Number::Roman::OO.new($a.Int * $b.Int);
}
multi sub infix:<*> (Number::Roman::OO:D $a, Int:D $b)
{
Number::Roman::OO.new($a.Int * $b);
}
multi sub infix:</> (Number::Roman::OO:D $a, Number::Roman::OO:D $b) is export
{
Number::Roman::OO.new(Int($a.Int / $b.Int));
}
multi sub infix:</> (Number::Roman::OO:D $a, Int:D $b)
{
Number::Roman::OO.new(Int($a.Int / $b));
}
Now we can do this:
File: oo-test
use lib "lib";
use Number::Roman::OO;
my $a = Number::Roman::OO.new(12);
my $b = Number::Roman::OO.new("MCM");
say "{ $a.Str } => { $a.Int }";
say "{ $b.Str } => { $b.Int }";
my $c = $a.add($b); say "{ $c.Str } => { $c.Int }";
my $d = $c.add(27); say "{ $d.Str } => { $d.Int }";
my $e = $c + $d; say "{ $e.Str } => { $e.Int }";
my $f = $d + 999; say "{ $f.Str } => { $f.Int }";
say "Something" if $a < $b;
say $a;
Running it:
$ raku oo-test
XII => 12
MCM => 1900
MCMXII => 1912
MDCCCLXXXV => 1885
MMMDCCXCVII => 3797
MMDCCCLXXXIV => 2884
Something
Number::Roman::OO.new(value => 12)
The last line in the program uses the «gist» method to stringify the value. We haven't added one to our class, so the default one is used - and it dumps the object as shown. If you want the Roman number, simply add this line to the module:
method gist { to-roman(self.value) }
Then we get «XII» as the last line of output.
|
Write a script to print first 20 Gapful Numbers greater than or equal to 100. Please check out the page for more information about Gapful Numbers. |
The page has this definition «Gapful Numbers >= 100: numbers that are divisible by the number formed by their first and last digit. Numbers up to 100 trivially have this property and are excluded.»
This is easy-ish:
File: gapful-gather-sub
my $gapful := gather # [1]
{
for 100 .. * # [2]
{
take $_ if is-gapful($_); # [3]
}
}
say "First 20 Gapful numbers: { $gapful[^20].join(',') }."; # [7]
sub is-gapful (Int $number) # [4]
{
my $divisor = $number.substr(0,1) ~ $number.substr(*-1,1); # [5]
return $number %% $divisor; # [6]
}
[1] I set up a sequence of the Gapful Numbers with «gather».
[2] Iterate over the values from 100 to Infinity,
[3] • return the number (with «take») if it is a Gapful Number.
[4] We start with the number itself,
[5] • calculate the divisor (by takin the first and the last digit in the number),
[6] • and use the «%%» divisibility operator to check if the number is divisible by the divisor.
[7] Print the first 20 values from the sequence.
Running it:
$ raku gapful-gather-sub
First 20 Gapful numbers: 100,105,108,110,120,121,130,132,135,140,\
143,150,154,160,165,170,176,180,187,190.
See docs.raku.org/routine/%% for more information about the «%%» divisibility operator.
We can inline the procedure body in the «take» expression to make it more compact (and less obvious what is going on):
File: gapful-gather
my $gapful := gather
{
for 100 .. *
{
take $_ if $_ %% ( .substr(0,1) ~ .substr(*-1,1) );
}
}
say "First 20 Gapful numbers: { $gapful[^20].join(',') }.";
The output is the same.
We can make it even more compact by replacing «gather/take» and the explicit loop with «grep»:
File: gapful-grep
my $gapful := (100 .. *).grep( { $_ %% ( .substr(0,1) ~ .substr(*-1,1) ) });
say "First 20 Gapful numbers: { $gapful[^20].join(',') }.";
And again, the output is the same.
And finally, as a one-liner:
> say "First 20 Gapful numbers: { (100 .. *).grep( { $_ %% ( .substr(0,1) ~ .substr(*-1,1) ) })[^20].join(',') }.";
First 20 Gapful numbers: 100,105,108,110,120,121,130,132,135,140,143,150,154,160,165,170,176,180,187,190.
And that's it.