laurent_r

These are some answers to the Week 47 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a couple of days (February 9, 2020). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

I have really very little time to complete this blog post in time for the deadline. My explanations will be minimal, sorry about that.

Roman Calculator

Write a script that accepts two roman numbers and operation. It should then perform the operation on the give roman numbers and print the result.

For example,

perl ch-1.pl V + VI

It should print

XI

There are two possible ways to solve such a task: to try to implement a Roman numerals computation algorithm, or to convert Roman numerals to our usual numbers, make the calculations and convert the result back to Roman nummerals. To me, it is quite obvious that the second solution is the simplest and best.

Most people know more or less how Roman numerals work. They use Latin letters to represent numbers:

|---------------------------------------------------|
| Symbol |  I  |  V  |  X  |  L  |  C  |  D  |  M   |
|---------------------------------------------------|
| Value  |  1  |  5  |  10 |  50 | 100 | 500 | 1000 |
|---------------------------------------------------|

In general, Roman numerals use additive notation: for example, MCLXXIII means 1000 + 100 + 50 + 20 + 3 = 1173. Or, at least, this is so when the symbols are written from left to right in decreasing value order.

If, however, a given symbol has a smaller value than a symbol placed on its right, then this is an example of subtractive notation: in that case, the smaller symbol is subtracted from the one its right. For example, IV means 1 subtracted from 5, i.e. 5 - 1 = 4. Similarly, IX and XC respectively mean 10 - 1 = 9 and 100 - 10 = 90. And MCMXLIX corresponds to 1000 + ( 1000 - 100) + (50 - 10) + (10 - 1) = 1949.

The overall problem, though, is that there is no general standard for Roman numerals. Applying the rules above makes it possible to decode more or less unambiguously any Roman numeral coded according to such aforesaid rules, but there may be several different possible ways to encode a number into a Roman numeral. For example, 99 could be encoded as XCXI or IC (or even XCVIIII or possibly LXXXXVIIII). The first transcription (XCXI) seems to be the most frequent one, so this is the one we will chose when encoding to Roman numerals. Still, IC seems to be a valid Roman numeral for 99, so we will try at least to be able to decode it if we find it.

Note that there is no Roman numeral for zero and the largest possible Roman numeral with the above rules is 3,999.

Roman Numeral Calculation in Perl

I’ll reuse the from_roman and to_roman subroutines used in Perl Weekly Challenge 10. Please refer to this post to get explanations on how this works.

use strict;
use warnings;
use feature qw/say/;


my %rom_tab = (I => 1,  V => 5, X => 10, L => 50, C => 100, D => 500, M => 1000);

sub from_roman {
    my $roman = uc shift;
    my $numeric = 0;
    my $prev_letter = "M";
    for my $letter (split //, $roman) {
        $numeric -= 2 * $rom_tab{$prev_letter} 
            if $rom_tab{$letter} > $rom_tab{$prev_letter};
        $numeric += $rom_tab{$letter};
        $prev_letter = $letter;
    }
    return $numeric;
}

sub to_roman {
    my $arabic = shift;
    warn "$arabic out of bounds" unless $arabic > 0 and $arabic < 4000;
    my %hash = %rom_tab;
    $hash{$_->[0]} = $_->[1] for (['IV', 4], ['IX', 9], ['XL', 40], 
        ['XC', 90], ['CD', 400], ['CM', 900] );
    my $roman = "";
    for my $key (sort { $hash{$b} <=> $hash{$a} } keys %hash) {
        my $num = int ($arabic / $hash{$key});
        $roman .= $key x $num;
        $arabic -= $hash{$key} * $num; 
    }
    return $roman;
}

my @input;
for (@ARGV) {
    push @input, $_ if /[-+*\/]/;
    push @input, from_roman $_ if /[ivxlcdm]+/i;
}
die "Need at least three parameters" if @input < 3; # we need at least 1 operator and two operands
my $result = eval join ' ', @input;
say "@ARGV = ", to_roman $result;

These are a few examples of output:

$ perl  roman_calc.pl X + X
X + X = XX

$ perl  roman_calc.pl V + X
V + X = XV

$ perl  roman_calc.pl V + X + III
V + X + III = XVIII

$ perl  roman_calc.pl V + X + III + V
V + X + III + V = XXIII

Roman Numeral Calculation in Raku

I’ll reuse the from-roman and to-roman subroutines used in Perl Weekly Challenge 10. Please refer to this post to get explanations on how this works.

use v6;
use MONKEY-SEE-NO-EVAL;

subset Roman-str of Str where $_ ~~ /^<[IVXLCDMivxlcdm]>+$/;

my %rom-tab = < I 1   V 5   X 10   L 50   C 100  D 500  M 1000 
               IV 4  IX 9   XL 40  XC 90  CD 400   CM 900 >;
my @ordered_romans = reverse sort { %rom-tab{$_} }, keys %rom-tab;

sub from-roman (Roman-str $roman) {
    my $numeric = 0;
    my $prev_letter = "M";
    for $roman.uc.comb -> $letter {
        $numeric -= 2 * %rom-tab{$prev_letter} 
            if %rom-tab{$letter} > %rom-tab{$prev_letter};
        $numeric += %rom-tab{$letter};
        $prev_letter = $letter;
    }
    return $numeric;
}

sub to-roman (Int $arabic is copy where  { 0 < $_ < 4000 }) {
    my $roman = "";
    for @ordered_romans -> $key {
        my $num = ($arabic / %rom-tab{$key}).Int;
        $roman ~= $key x $num;
        $arabic -= %rom-tab{$key} * $num; 
    }
    return $roman;
}

my @input;
for @*ARGS {
    push @input, $_ if /<[-+*\/]>/;
    push @input, from-roman $_ if m:i/<[ivxlcdm]>+/;
}
die "Need at least three parameters" if @input < 3; # we need at least 1 operator and two operands
my $result = EVAL join ' ', @input;
say "@*ARGS[] = ", to-roman $result;

Some sample runs:

$ perl6 roman_calc.p6 III + V
III + V = VIII

$ perl6 roman_calc.p6 III + V + X
III + V + X = XVIII

$ perl6 roman_calc.p6 III + V + X - I
III + V + X - I = XVII

Gapful Numbers

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.

Gapful numbers are 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.

Basically, we need to check for all numbers from 100 on whether they are divisible by the number formed by the concatenation of their first and last digits, and stop the process once we have collected 20 numbers.

Gapful Numbers in Perl

There are several ways to extract the first and the last digits of a number. The first that came to my mind was a simple regex:

use strict;
use warnings;
use feature "say";

my @gapful = ();
my $current = 100;
do {
    my ($start, $end) = $current =~ /^(\d)\d+(\d)$/;
    push @gapful, $current unless $current % ($start . $end);
    $current ++;
} until $#gapful >= 19;
say "@gapful";

This program displays the following output:

$ perl gapful.pl
100 105 108 110 120 121 130 132 135 140 143 150 154 160 165 170 176 180 187 190

Although performance really doesn’t matter very much for such a simple task, using the substr built-in function might be more efficient that a regex. Here, we only show the loop, without the boilerplate code at the beginning of the program:

do {
    my $div = join '', substr ($current, 0, 1), substr ($current, -1, 1);
    push @gapful, $current unless $current % $div;
    $current ++;
} while $#gapful < 19;
say "@gapful";

This produces the same output as above.

Another way is to split each number into individual digits and to use a slice to pick up the first and last ones:

while ($#gapful < 19) {
    my $div = join '', (split //, $current)[0, -1];
    push @gapful, $current unless $current % $div;
    $current++;
};
say "@gapful";

This also produces the same output.

Gapful Numbers in Raku

In Raku, we don’t need a loop to manage the number of gapful numbers: we can just create a lazy infinite list of such numbers and get the first 20 ones:

my @gapful = grep { $_ %% .comb[0,*-1].join }, 100..*;
say @gapful[0..19];

We have again the sale output as before.

This is now so short and simple that we can boil it down to a Raku one-liner:

$ perl6 -e 'say (grep { $_ %% .comb[0,*-1].join}, 100..*)[0..19];'
(100 105 108 110 120 121 130 132 135 140 143 150 154 160 165 170 176 180 187 190)

Wrapping up

The next week Perl Weekly Challenge is due to start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, February 23, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.