Continues from previous week.

Welcome to the Perl review for Week 047 of the Weekly Challenge! For a quick overview, go through the original tasks and recap of the weekly challenge.

## Getting in Touch

Email › Email me (Ryan) with any feedback about this review.

GitHub › Submit a pull request for any issues you may find with this page.

Twitter › Join the discussion on Twitter!

We’d greatly appreciate any feedback you’d like to give.

## Table of Contents

### Task 1

[ Alicia Bielsa | Andrezgz | Athanasius | Cheok-Yin Fung | Dave Cross | Dave Jacoby | Duane Powell | Duncan C. White | E. Choroba | Jaldhar H. Vyas | Javier Luque | Laurent Rosenfeld | Lubos Kolouch | Phillip Harris | Ruben Westerberg | Ryan Thompson | Saif Ahmed | User Person | Wanderdoc ]

### Task 2

[ Alicia Bielsa | Andrezgz | Athanasius | Cheok-Yin Fung | Colin Crain | Cristina Heredia | Dave Cross | Dave Jacoby | Duane Powell | Duncan C. White | E. Choroba | Jaldhar H. Vyas | Javier Luque | Laurent Rosenfeld | Lubos Kolouch | Mohammad S Anwar | Phillip Harris | Ruben Westerberg | Ryan Thompson | Saif Ahmed | Steven Wilson | Ulrich Rieke | User Person | Wanderdoc ]

### Blogs

# Task #1 - Roman Calculator

The first task is to write a script that accepts two Roman numbers and an arithmetic operator. It should then calculate the result and return it as another Roman number. For example:

```
perl ch-1.pl V + VI
XI
```

This challenge tends to require a fair amount of code. The average solution length was 90 lines (for comparison, Task #2 averaged 29 lines), with several nearing 200 lines. The average would have been higher if not for several hackers’ use of CPAN modules and code from Week 010.

As such, I will have to be more selective in the code that I highlight. Please remember you can always click the solution link for the full code. If I didn’t highlight a part of your code you believe is worth looking at more closely in the context of this review, please let me know!

## Alicia Bielsa

Alicia Bielsa’s solution uses `Readonly::Hash`

es to map the Roman numerals to their Arabic values (e.g., `X => 10`

), and takes the `reverse`

to map in the other direction. She writes `romanToDecimal`

and `decimalToRoman`

subroutines so the solution can be calculated. Here is the `romanToDecimal`

sub:

```
sub romanToDecimal {
my $romanNumber = shift;
my $previousValue = 0;
my $decimalNumber = 0;
foreach my $romanSymbol (split('',$romanNumber)) {
if ($HASH_ROMAN_DECIMAL{$romanSymbol} > $previousValue ){
#Previous value was substractive mode, we substract twice.
$decimalNumber -= $previousValue * 2;
}
$decimalNumber += $HASH_ROMAN_DECIMAL{$romanSymbol};
$previousValue = $HASH_ROMAN_DECIMAL{$romanSymbol};
}
return $decimalNumber;
}
```

Alicia also included error checking for the arguments, with and `isOperationAccepted`

and `isRomanNumber`

. Here is the latter:

```
sub isRomanNumber {
my $numberToCheck = shift;
my $isRoman = 0;
my $romanDigits = join ( '', keys %HASH_ROMAN_DECIMAL);
if ($numberToCheck =~ /^[$romanDigits]+$/ ){
$isRoman = 1;
}
return $isRoman;
}
```

Overall, Alicia’s solution feels complete and robust.

## Andrezgz

Andrezgz’s solution wisely re-uses code from previous challenges (dispatch tables from week 39, and Roman numeral encoding from week 10).

Andrezgz’s check for a valid Roman number is a regex, and checks for reasonable counts of each numeral:

```
sub _is_valid_roman {
return $_[0] =~ /
^ # String start
M{0,3} # Matching from 1000 to 3000
(?:CM|CD|D|D?C{0,3})? # Matching from 100 to 900
(?:XC|XL|L|L?X{0,3})? # Matching from 10 to 90
(?:IX|IV|V|V?I{0,3})? # Matching from 1 to 9
$ # String end
/xi;
}
```

I know this code is the same as Andrezgz’s week 10 solution, but it did not get highlighted in that review.

Thanks to the re-used code, the new code that Andrezgz wrote this week ended up being quite short:

```
my $operations = {
'+' => sub { $_[0] + $_[1] },
'-' => sub { $_[0] - $_[1] },
'x' => sub { $_[0] * $_[1] },
'/' => sub { $_[0] / $_[1] },
};
my $rn1 = shift;
my $op = shift;
my $rn2 = shift;
my $result = $operations->{$op}->( decode_roman(uc $rn1) , decode_roman(uc $rn2) );
print encode_roman($result);
```

The solution itself has comprehensive error checking, which I omitted for brevity.

## Athanasius

Athanasius’s solution uses `Math::Roman`

to convert to and from Roman numbers. The top-level logic looks like this, using string `eval`

for the calculation itself:

```
my @OPERATIONS => qw( + - * / % ); # '/' denotes *integer* division
my @ROMAN_DIGITS => qw( I V X L C D M );
my $args = scalar @ARGV;
$args == 3 or die "ERROR: Expected 3 command-line args but found $args\n";
my $lhs = validate_roman(uc $ARGV[0]);
my $op = $ARGV[1];
any { $op eq $_ } @OPERATIONS or die "ERROR: Unknown operator '$op'\n";
my $rhs = validate_roman(uc $ARGV[2]);
my $rslt = roman(int eval "$lhs $op $rhs");
printf "%s %s %s = %s\n", uc $ARGV[0], $op, uc $ARGV[2], $rslt;
```

The `validate_roman`

sub checks whether a string is a valid Roman number, and,
if so, takes it through `Math::Roman`

:

```
sub validate_roman {
my ($roman) = @_;
for my $digit (split //, $roman) {
any { $digit eq $_ } @ROMAN_DIGITS
or die "ERROR: Unknown Roman digit '$digit'\n";
}
my $math_roman = roman($roman);
$math_roman->is_nan() and die 'ERROR: ', Math::Roman::error(), "\n";
return $math_roman->as_number();
}
```

## Cheok-Yin Fung

Cheok-Yin Fung’s solution uses string `eval`

as well:

```
my $formula;
chomp($_ = <STDIN>);
if (/([A-Z]+)(\s*)([\+,\-,\*])(\s*)([A-Z]+)/) {
$formula = roman_to_dec($1).$3.roman_to_dec($5);
}
my $result = eval $formula;
print dec_to_roman($result), "\n";
```

The regex to extract the arguments would be the perfect place to add error checking, so that arbitrary code is not passed to the `eval`

.

Cheok-Yin Fung’s `roman_to_dec`

is interesting (`%sk`

maps Roman numerals to Arabic values):

```
sub roman_to_dec {
my $total = 0;
my @char = split //, $_[0];
for my $i (0..$#char-1) {
$total += $sk{$char[$i]};
if ($sk{$char[$i]} < $sk{$char[$i+1]}) {
$total = $total - 2*$sk{$char[$i]};
}
}
$total += $sk{$char[$#char]};
$total;
}
```

There is a `dec_to_roman`

as well that I won’t show here, as it is long. It subtracts the value of the next digit (or pair) it can, in a loop, until it reaches zero.

## Dave Cross

Dave Cross’s solution also taps into CPAN, using `Roman`

for a concise solution with dispatch tables:

```
use Roman;
my %ops = (
'+' => sub { $_[0] + $_[1] },
'-' => sub { $_[0] - $_[1] },
'/' => sub { $_[0] / $_[1] },
'x' => sub { $_[0] * $_[1] },
);
my ($l, $op, $r) = @ARGV;
unless (exists $ops{$op}) {
warn "'$op' is not a recognised operation\n";
die 'Valid operations are: ', join(', ', keys %ops), "\n";
}
say Roman( $ops{$op}->(arabic($l), arabic($r)) );
```

## Dave Jacoby

It seems both Daves opted to `use Roman`

this week! Dave Jacoby’s solution defines a map of valid operators, and then starts converting:

```
use Roman;
my %operators = map { $_ => 1 } qw{ + - / * };
if ( scalar @ARGV > 2 ) {
my ( $r1, $op, $r2 ) = @ARGV;
if ( !$operators{$op} ) {
say 'not an operator';
exit;
}
if ( !isroman($r1) ) { say qq{"$r1" is not a roman numeral}; exit; }
if ( !isroman($r2) ) { say qq{"$r2" is not a roman numeral}; exit; }
my $a1 = arabic($r1);
my $a2 = arabic($r2);
my $a3 = 0;
if ( $op eq '+' ) { $a3 = $a1 + $a2 }
if ( $op eq '-' ) { $a3 = $a1 - $a2 }
if ( $op eq '*' ) { $a3 = $a1 * $a2 }
if ( $op eq '/' ) { $a3 = $a1 / $a2 }
my $r3 = uc roman($a3);
say qq{ $r1 $op $r2 = $r3 };
}
else { say 'We need an operator and two roman numbers' }
```

**Blog** › Counting from 100 is the Fun Part

## Duane Powell

Duane Powell’s solution defines `arabic`

and `roman`

functions to convert between Arabic and Roman numbers. `roman`

is essentially an `if`

chain in a `while`

loop to greedily build the Roman number from the largest to smallest digits, shown here, in part:

```
sub roman {
my $arabic = shift;
$arabic = int($arabic);
my $roman = '';
while ($arabic > 0) {
if ($arabic >= 1000) {
$roman .= $roman{1000};
$arabic -= 1000;
next;
}
if ($arabic >= 900) {
$roman .= $roman{900};
$arabic -= 900;
next;
}
...
if ($arabic >= 1) {
$roman .= $roman{1};
$arabic -= 1;
next;
}
}
return $roman;
}
```

The `arabic`

function `split`

s the input Roman number, and then looks for patterns of numerals like `IX`

that need to be considered together, before considering numerals individually:

```
sub arabic {
my @roman = split(//, uc(shift));
my ($arabic, $next, $error, $min) = (0, '', '', 1000);
while (scalar @roman and not $error) {
# Check for matching pair of Roman numerals, eg 'IV'
if (scalar @roman > 1) {
$next = $roman[0].$roman[1];
if ( defined($arabic{$next}) ) {
$arabic += $arabic{$next};
$error = "Roman numeral out of sequence at $next" if ($arabic{$next} > $min);
$min = $arabic{$next};
shift @roman;
shift @roman;
next;
}
}
# Pair not found, maybe there is one matching numeral, eg 'I'
if (scalar @roman > 0) {
$next = $roman[0];
if ( defined($arabic{$next}) ) {
$arabic += $arabic{$next};
$error = "Roman numeral out of sequence at $next" if ($arabic{$next} > $min);
$min = $arabic{$next};
shift @roman;
next;
}
else {
$error = "Invalid Roman numeral at $next";
}
}
}
if ($error) {
say $error;
exit;
}
return $arabic;
}
```

The main logic is then simple:

```
my $n = arabic($r1);
my $m = arabic($r2);
my $a = eval "$n $op $m";
my $r = roman($a);
say $r, " (", $a, ")";
```

## Duncan C. White

Duncan C. White’s solution uses `Roman`

as well:

```
use Roman;
die "Usage: romancalc R1 OP R2 [R1 and R2 are Roman numerals or integers]\n".
"or: romancalc test\n"
unless @ARGV==3 || (@ARGV==1 && $ARGV[0] eq "test");
my( $r1, $op, $r2 ) = @ARGV;
my $origr1 = $r1;
my $origr2 = $r2;
$r1 = fromroman($r1) if $r1 =~ /^[MCDLXVI]+$/;
$r2 = fromroman($r2) if $r2 =~ /^[MCDLXVI]+$/;
die "romancalc: bad r1: $r1\n" unless $r1 > 1 && $r1 < 4000;
die "romancalc: bad r2: $r2\n" unless $r2 > 1 && $r2 < 4000;
my $n = eval "$r1 $op $r2" || die "romancalc: bad operator $op\n";
$n = int($n);
my $r = toroman($n);
say "result of $origr1 ($r1) $op $origr2 ($r2): $r ($n)";
```

## E. Choroba

E. Choroba’s solution reuses his Roman/Arabic code from Week 10, adding a dispatch table to handle the arithmetic:

```
use lib '.';
use MyRoman qw{ to_roman from_roman }; # Extracted from PWC010/1.
my ($n1, $op, $n2) = @ARGV;
my $function = { '+' => sub { $_[0] + $_[1] },
'-' => sub { $_[0] - $_[1] },
'*' => sub { $_[0] * $_[1] },
'/' => sub { int($_[0] / $_[1]) }
}->{$op}
or die "Unknown operator $op.";
say to_roman($function->(map from_roman($_), $n1, $n2));
```

## Jaldhar H. Vyas

Jaldhar H. Vyas’s solution goes through a multi-step procedure whereby each Arabic number is converted naïvely to the simplest expression of Roman numerals. E.g, 4 would be `IIII`

, and is then `normalize`

d to `IV`

. A similar process happens in the reverse order.

There is also a `reorder`

function that puts the numerals in their proper order, just before the `normalize`

step:

```
sub reorder {
my ($num) = @_;
my %order = (
'M' => 0, 'D' => 1, 'C' => 2, 'L' => 3, 'X' => 4, 'V' => 5, 'I' => 6
);
return join q{}, sort { $order{$a} <=> $order{$b} } split //, $num;
}
sub normalize {
my ($num) = @_;
my @from = qw/ IIIII IIII VV VIV XXXXX XXXX LL LXL CCCCC CCCC DD DCD /;
my @to = qw/ V IV X IX L XL C XC D CD M CM /;
for my $i (0 .. scalar @from - 1) {
$num =~ s/$from[$i]/$to[$i]/g;
}
return $num;
}
```

The main logic supports addition and subtraction. Pay close attention to how these operations are implemented:

```
my ($num1, $op, $num2) = @ARGV;
if ($op eq '+') {
say normalize(reorder(unprefix($num1) . unprefix($num2)));
} elsif ($op eq '-') {
my $un1 = unprefix($num1);
my $un2 = unprefix($num2);
while (length $un2) {
($un1, $un2) = expandLargest(removeCommon($un1, $un2));
}
say normalize($un1);
} else {
usage();
}
```

And now we see the reason Jaldhar needed those “extra” subroutines: he never converts the numbers to Arabic at all! For example, the addition operator simply expands and concatenates the Roman numbers, and then normalizes them again so the answer is in proper Roman format. I like this approach a lot.

## Javier Luque

Javier Luque’s solution uses `Number::Convert::Roman`

to do the conversion, so the code is relatively short:

```
use Number::Convert::Roman;
my $input_string = join ' ', @ARGV;
my $c = Number::Convert::Roman->new;
my %operations = (
'+' => sub {return ($c->arabic($_[0]) + $c->arabic($_[1]))},
'-' => sub {return ($c->arabic($_[0]) - $c->arabic($_[1]))},
'x' => sub {return ($c->arabic($_[0]) * $c->arabic($_[1]))},
'/' => sub {return ($c->arabic($_[0]) / $c->arabic($_[1]))},
);
if ($input_string =~ /^(\w+)\s*([\+\-x\/])\s*(\w+)$/) {
say $c->roman(int($operations{$2}->($1, $3)));
} else {
say "Invalid input";
}
```

Javier uses a dispatch table in `%operations`

for simple yet extensible code, and the `$input_string`

regexp serves to help parse and validate the input.

**Blog** › 047 – Perl Weekly Challenge

## Laurent Rosenfeld

Laurent Rosenfeld’s solution also re-uses his `from_roman`

and `to_roman`

subroutines from Week 10. However, I would like to highlight his `from_roman`

subroutine in particular, as it uses a less common algorithm:

```
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;
}
```

Since Roman numbers are additive (i.e., you simply add the values of each numeral) *unless* the following numeral is greater than the current one (e.g., `IV`

: `I`

(1) is less than `V`

(5)), in which case that relationship is a subtractive one.

What Laurent does here, when building up the answer in `$numeric`

, is to *always* add the numbers, *and* if `$letter`

is greater than the `$prev_letter`

, subtract it twice, to make up for the addition.

Laurent’s main logic is similarly concise:

```
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;
```

**Blog** › Roman Calculator and Gapful Numbers

## Lubos Kolouch

Lubos Kolouch’s solution also uses `Roman`

. Lubos has a `roman_magic`

sub that does the, well, *magic* step of taking two Roman numbers and an operator, and returning the result in Roman form:

```
use Roman;
sub roman_magic {
my ($v1, $op, $v2) = @_;
my $rom_v1 = arabic($v1);
my $rom_v2 = arabic($v2);
return uc(roman(eval "$rom_v1 $op $rom_v2"))
}
```

His main code is then, simply:

```
my ($v1, $op, $v2) = @ARGV;
print roman_magic($v1, $op, $v2)."\n";
```

## Phillip Harris

Phillip Harris’s solution uses an `if ... elsif`

chain to perform the desired arithmetic operation:

```
my $input = join( " ", @ARGV );
if ( $input !~ /.*?([IVXLCDM]+)(.*?)([IVXLCDM]+)/ ) { die "Invalid input" }
my $number1 = $1;
my $operator = $2;
my $number2 = $3;
$operator =~ s/[^\+\-\*\/]//g;
if ( $operator eq '+' ) {
print dec2rom( rom2dec($number1) + rom2dec($number2) );
}
elsif ( $operator eq '-' ) {
print dec2rom( rom2dec($number1) - rom2dec($number2) );
}
elsif ( $operator eq '*' ) {
print dec2rom( rom2dec($number1) * rom2dec($number2) );
}
elsif ( $operator eq '/' ) {
print dec2rom( int( rom2dec($number1) / rom2dec($number2) + .5 ) );
}
else { die "Invalid operator" }
print "\n";
```

Phillip’s `dec2rom`

and `rom2dec`

subs do the heavy lifting. I’d like to show the `dec2rom`

sub:

```
sub dec2rom {
my @rdb = qw(I IV V IX X XL L XC C CD D CM M);
my @ddb = qw(1 4 5 9 10 40 50 90 100 400 500 900 1000);
my $dec = $_[0];
my $rom;
for ( my $x = $#ddb ; $x >= 0 ; $x-- ) {
if ( $dec / $ddb[$x] >= 1 ) {
$rom .= $rdb[$x] x int( $dec / $ddb[$x] );
$dec = $dec - ( $ddb[$x] * int( $dec / $ddb[$x] ) );
}
}
return $rom;
}
```

Phillip’s algorithm here is an efficient and concise variant of the subtraction method we’ve seen before. Phillip realizes that once you have used a numeral (or subtractive group like `IV`

), it can’t appear again, so he checks for each of them in turn (from largest to smallest), subtracting from the input number while the output string is built up.

## Ruben Westerberg

Ruben Westerberg’s solution contains `romanToDecimal`

and `decimalToRoman`

subs. `romanToDecimal`

is interesting:

```
sub romanToDecimal {
my %r=(M=>1000, D=>500, C=>100, L=>50, X=>10, V=>5, I=>1);
my @c=split '', shift;
my $diff=0;
my $sum=0;
for (my $i=0; $i<@c; $i++) {
if (($i+1) < @c) {
if ($r{$c[$i+1]} > $r{$c[$i]}) {
$diff=$r{$c[$i]};
}
else {
$sum+= $r{$c[$i]} -$diff;
$diff=0;
}
}
else {
$sum+=$r{$c[$i]} -$diff;
}
}
return $sum;
}
```

The input Roman number is `split`

into a `@c`

character array. Similar to Laruent’s solution, above, Ruben looks at the current character and the next character. If the next character is greater, the current character is subtracted from it on the *next* iteration. Otherwise, `$diff`

will be zero.

The main logic uses `given ... when`

to perform the correct operation:

```
use v5.26;
no warnings qw<experimental>;
my ($operand1,$operator, $operand2)=@ARGV;
($operand1,$operand2)=map {
given ($_) {
romanToDecimal($_) when /[MDCLXVI]/;
$_ when /\d+/;
"Not a digit or roman numeral";
}
} ($operand1,$operand2);
my $result = do {
given ($operator) {
$operand1+$operand2 when /\+/;
$operand1-$operand2 when /\-/;
$operand1*$operand2 when /\*/;
int ($operand1/$operand2) when /\//;
"Unkown";
}
};
print decimalToRoman($result);
```

## Ryan Thompson

My solution is partly re-used from some code I wrote years ago. After defining a `%rom`

hash which maps every single and double character to its value (e.g., `I => 1, IV => 4, ...`

), conversion is easy. (`@mor`

is all the pairs in `%rom`

, sorted in descending order of their value:

```
my @mor = map { [ $rom{$_} => $_ ] } sort { $rom{$b} <=> $rom{$a} } keys %rom;
sub arabic_to_roman {
my $n = shift;
my $r = '';
while ($n) {
my ($val, $rom) = @{( first { $_->[0] <= $n } @mor )};
$n -= $val;
$r .= $rom;
}
$r;
}
```

As you can see, the `$r`

result is built by greedily subtracting the highest value possible, until the number, `$n`

reaches zero. Since `@mor`

contains pairs like `IV`

and `XL`

, it just works.

Going the other way is even easier:

```
sub roman_to_arabic {
sum map { $rom{$_} } pop =~ /(I[VX]|X[LC]|C[DM]|[IVXLCDM])/g
}
```

The regex pulls out any single numerals *and* also pulls out pairs, so it will sum the correct fragments of the string.

My main logic uses string `eval`

with some sanitization of the input, so it can handle arbitrary arithmetic expressions, not just a single operator:

```
say roman_expr(join ' ', @ARGV) and exit if @ARGV;
# Perform arbitrary expressions using Roman numerals
sub roman_expr {
my $expr = shift;
$expr =~ s/\b([IVXLCDM]+)\b/roman_to_arabic($1)/eg;
die "Invalid expression" if $expr =~ m![^ 0-9+*%/()-]!;
arabic_to_roman( eval $expr );
}
```

**Blog** › Roman Calculator

## Saif Ahmed

Saif Ahmed’s solution, as I’ve come to expect, is comprehensive, and interesting. Saif went to some effort to support larger Roman numbers, which are typically depicted with an overline, which means “multiply this digit by 1000”. So, when I put `MCM * X`

into Saif’s prompt, it shows (roughly):

```
_ _
Answer = XMX
```

Saif uses the ANSI “overline” sequence `\e[0;53m`

, so I can’t show it exactly, here. You can turn this off in his script, and it’s automatically disabled on Windows.

Saif uses string `eval`

to calculate the result after converting the Roman numbers to Arabic with the `arabic`

sub:

```
our @converter=(
[900 ,"CM"], [1000,"M" ], [400 ,"CD"], [500 ,"D" ],
[90 ,"XC"], [100 ,"C" ], [40 ,"XL"], [50 ,"L" ],
[9 ,"IX"], [10 ,"X" ], [4 ,"IV"], [5 ,"V" ],
[1 ,"I" ],
);
sub arabic {
my $roman = shift;
return 0 if !$roman;
my $arabic = 0;
foreach my $conv (@converter) {
my $re = $$conv[1];
$arabic += $$conv[0] while $roman =~ s/$re//i;
}
return $arabic;
}
```

This is a nicely compact implementation, taking the next highest pair `@converter`

that matches the input string.

## User Person

User Person’s solution uses `Roman`

to convert to and from Roman numbers. Here’s the main logic:

```
print STDERR "[Arabic number detected in input]\n" if $argString =~ m{\d+};
$argString =~ s{(\s*[-+*/%]\s*)}{ $1 }g;
$argString =~ s{([MDCLXVI]+)}{arabic $1}ge;
my $result = eval $argString;
my $oldResult = $result;
$result = int $result;
my $decimal = $oldResult - $result;
print STDERR "Calculation result had a decimal $decimal that was truncated.\n" if $decimal;
if ( $result == 0) {
print "N (no formal zero)\n"; # https://en.wikipedia.org/wiki/Roman_numerals#Zero
} elsif ($result > 3_999) {
die "Calculation result $result exceeds MMMCMXCIX (3,999) the maximum value of the Roman number format.\n";
} elsif ($result < 0) {
die "Calculation result $result is negative. Roman numbers are positive integers.\n";
} else {
$result = Roman(int $result);
print "$result\n";
}
```

The logic is quite comprehensive, even going so far as to disallow Arabic numbers in the input, even though `eval`

would handle them. I respect User Person’s strict adherence to the business logic!

## Wanderdoc

Wanderdoc’s solution contains the comment that the code was `Way too cumbersome, I think.`

. At 133 lines (~108 SLOC), it is lengthy, but I disagree with “cumbersome,” as it is written in a modular style with several short (5-10 line) subroutines that all serve a purpose.

```
# Some basic data.
my %romans = (I => 1, V => 5, X => 10,
L => 50, C => 100, D => 500,
M => 1000);
my %arabic = reverse %romans;
my %expand = ('I~V' => 'I', 'V~X' => 'I', 'X~L' => 'X', 'L~C' => 'X', 'C~D' => 'C', 'D~M' => 'C',
'M~M'=> 'M');
my %before;
for my $key ( sort { $romans{$expand{$a}} <=> $romans{$expand{$b}} } keys %expand ) {
my ($left, $right) = split(/~/, $key);
$before{ $right } = $expand{$key} if not exists $before{ $right };
$before{ $left } = $expand{$key} if not exists $before{ $left };
}
```

The data structures in Wanderdoc’s solution were interesting. As you can see, the `%expand`

hash contains the pairings of subtractive numerals, and maps them to the numerals that would follow them (e.g., `VX`

would always come before `I`

), which is helpful to Wanderdoc’s subs.

Below is the main logic (I’ve removed some input validation, for brevity). I respect Wanderdoc’s willingness to credit others for techniques used. After all, re-use and sharing of code and ideas is what makes the whole field of computer science better overall.

```
# Roman numerals regex - e.g. here: https://stackoverflow.com/questions/267399
my $rom_re = qr/^M{0,3}(?:C[MD]|D?C{0,3})(?:X[CL]|L?X{0,3})(?:I[XV]|V?I{0,3})$/;
my $re_opr = qr#^(?:[+-/]|\*{1,2})$#;
my ($op_1, $opr, $op_2) = @ARGV;
# Dispatch table for calculations, learned from choroba.
my %calc = (
'+' => sub { return $_[0] + $_[1]; },
'-' => sub { return $_[0] - $_[1]; },
'*' => sub { return $_[0] * $_[1]; },
'/' => sub { # Well, there is no 0 in Roman numerals :-)
return "ERROR: Division by zero!" if 0 == $_[1];
return int($_[0] / $_[1]); },
'**' => sub { return $_[0] ** $_[1]; },
);
# Transformation, calculation and back-transformation.
($op_1, $op_2) = map rom2int($_) , ($op_1, $op_2);
my $result = $calc{$opr}->($op_1, $op_2);
$result = int2rom($result);
print $result, $/;
```

# Task #2 - Gapful Numbers

The Gapful numbers are defined by OEIS sequence A108343

This task had us write a script to print the first 20 Gapful numbers. Gapful numbers are numbers, 100 or greater, that are divisible by the concatenation of their first and last digits. So, for example, 100 is a gapful number because 100 is divisible by 10. 102 is not, because 102 is not divisible by 12.

The solutions to this were considerably shorter than Task 1’s solutions, so I’ll be able to showcase more of the exceptional talent we have participating in this challenge.

The solutions were all quite similar, as there are only a few reasonable ways to get the first and last digits of a number and check for divisibility. Still, there are a couple solutions you’ll see that iterate in interesting ways.

## Alicia Bielsa

Alicia Bielsa’s solution uses `split`

to get the `$firstDigit`

and `$lastDigit`

, and then the modulo operator to test for divisibility:

```
my $totalGapfulNumbers = 20;
my $totalGapfulNumbersFound = 0;
my $currentNumber = 100;
while ($totalGapfulNumbersFound < $totalGapfulNumbers ) {
my ($firstDigit, $lastDigit ) = (split('',$currentNumber))[0, length($currentNumber)-1];
my $firstLastNumber = $firstDigit.$lastDigit;
if ($currentNumber % $firstLastNumber == 0) {
print "Gapful number found: $currentNumber\n";
$totalGapfulNumbersFound++;
}
$currentNumber++;
}
```

We will definitely be seeing this approach again!

## Andrezgz

Andrezgz’s solution uses `substr`

to pull out the first and last characters:

```
use strict;
use warnings;
my $n = 99;
my $gapfuls = 0;
while ($gapfuls < 20) {
print $n.$/ if ++$n % ( substr($n, 0, 1) . substr($n, -1) ) == 0 && $gapfuls++;
}
```

Note the negative index to `substr`

means “from the right”, so -1 is the last character in the string. Perl’s array indexing works the same way.

## Athanasius

Athanasius’s solution uses `split`

to get the first character, and `$num % 10`

to get the last character, then checks divisibility with the modulo operator:

```
while ( $count < $TARGET ) {
my $div = ( split //, $num )[0] * 10 + $num % 10;
if ( $num++ % $div == 0 ) {
push @gapfuls, $num - 1;
++$count;
}
}
printf "The first %d Gapful Numbers greater than or equal to %d are:\n%s\n",
$TARGET, $MINIMUM, join ', ', @gapfuls;
```

## Cheok-Yin Fung

Cheok-Yin Fung’s solution gets the first and last digits with integer arithmetic, with the following justification for the maximum length of the 20th gapful number:

```
# All integers with the pattern _ABAB_ is gapful(_AB_*101) and there are
# 10*9/2 + 9 = 54 (A runs from 0 to 9, B runs from 0 to 9, 0000 is not counted)
# such integers. In short, all 20 first >= 100 gapful numbers are larger than
# 99 and smaller than 9999.
my $th;
my $c = 0;
for my $N (100..999) {
$th = 10 * int($N / 100) + ($N % 10);
if ($N % $th == 0) {$c++; print $c, ". ", $N , "\n";}
if ($c==20) {exit;}
}
for my $N (1000..9999) {
$th = 10 * int($N / 1000) + ($N % 10);
if ($N % $th == 0) {$c++; print $c, ". ", $N , "\n";}
if ($c==20) {exit;}
}
```

## Colin Crain

Colin Crain’s solution uses `substr`

to get the first and last digits:

```
my $testval = 99;
my @output;
while (scalar @output < 20 && $testval++ ) {
my $gap = substr( $testval, 0, 1 ) . substr( $testval, -1, 1 );
push @output, $testval if $testval % $gap == 0;
}
say for @output;
```

## Cristina Heredia

Cristina Heredia’s solution
uses `split`

to get the digits of the number:

```
my $max = 20;
my $counter = 0;
my @divided;
my @solution;
for (my $number = 100; $counter < $max; $number++) {
my $newNumber;
@divided = split(/d?/, $number);
$newNumber = @divided[0].@divided[@divided-1];
if (($number % $newNumber) == 0) {
push(@solution, $number);
$counter++;
}
}
print "The first $max Gapful Numbers are:\n";
for (my $i = 0; $i < @solution; $i++) {
print "@solution[$i]\n";
}
```

The `split /d?/, $number`

works, but most likely does so in an unintended way: The regex matches zero or one literal `d`

characters, so in this case (where no literal `d`

characters are expected in the input), it will have the same effect as `split //`

, which is to split on every character.

I would also use `$solution[$i]`

to reference a single array element instead of `@solution[$i]`

.

## Dave Cross

Dave Cross’s solution builds up an array of `@gapful`

numbers, using a slice of `split`

for the first and last characters:

```
my @gapful;
$_ = 100;
while (@gapful < 20) {
push @gapful, $_ unless $_ % join '', (split //)[0, -1];
++$_;
}
say "@gapful";
```

## Dave Jacoby

Dave Jacoby’s solution showcases a few different methods of attacking this problem. The first is Dave’s “readable” solution:

```
my @x;
my $n = 100;
while ( scalar @x < 20 ) {
my @n = split //, $n;
my $i = join '', $n[0], $n[-1];
push @x, $n if $n % $i == 0;
$n++;
}
say join "\n", @x;
say '-' x 30;
```

Dave also included a “way cool” functional version:

```
say join "\n", grep { state $c = 0; $c++ < 20 }
grep { my $i = join '', substr( $_, 0, 1 ), substr( $_, -1 ); $_ % $i == 0 }100 .. 1000;
```

Dave, I agree, it’s way cool.

And finally, an iterator, which is a good fit for this problem:

```
my $next = make_iterator(100);
while ( my $n = $next->() ) {
state $c = 0;
my $i = my $i = join '', substr( $n, 0, 1 ), substr( $n, -1 );
if ( 0==$n%$i){
say $n;
$c++;
}
last if $c >19;
}
sub make_iterator ( $start ) {
return sub {
state $i = $start;
return $i++;
}
}
```

**Blog** › Counting from 100 is the Fun Part

## Duane Powell

Duane Powell’s solution uses `split`

to get the first and last digits of a three-digit number, and concatenates them into `$x`

. He then uses `int`

eger division to check for divisibility:

```
my @gap;
my $n = 100;
while (scalar @gap < 20) {
my ($a,undef,$b) = split(//,$n);
my $x = "$a$b"; # form new number by combining first and last digit of $n
push @gap, $n if ($n/$x == int($n/$x));
$n++;
}
say join(',',@gap);
```

## Duncan C. White

Duncan C. White’s solution uses a regex with captures to get the first and last digits, combines them arithmetically, and then returns the result of a modulo operation to test for divisibility:

```
use Function::Parameters;
fun gapful( $i ) {
$i =~ /^(\d).*(\d)$/; # find first and largest digits
my $div = 10*$1 + $2;
return $i % $div == 0 ? 1 : 0;
}
die "Usage: ch-2.pl [FirstN]\n" if @ARGV>1;
my $n = shift // 20;
my $found = 0;
for( my $i = 100; $found<$n; $i++ ) {
next unless gapful( $i );
say $i;
$found++;
}
```

## E. Choroba

E. Choroba’s solution creates an iterator that returns the next gapful number, lazily:

```
sub gapful_iterator {
my ($n) = @_;
my $iterator = sub {
$n++ until 0 == $n % join "", $n =~ /^(.)/, $n=~ /(.)$/;
$n++
};
}
my $iter = gapful_iterator(100);
say $iter->() for 1 .. 20;
```

## Jaldhar H. Vyas

Jaldhar H. Vyas’s solution uses `split`

and modulo in a loop to build the list of `@gapfuls`

:

```
my @gapfuls;
my $number = 100;
while (scalar @gapfuls != 20) {
my @digits = split //, $number;
my $divisor = join q{}, ($digits[0], $digits[-1]);
if ($number % $divisor == 0) {
push @gapfuls, $number;
}
$number++;
}
say join ', ', @gapfuls;
```

## Javier Luque

Javier Luque’s solution uses a capturing regex, concatenates the first and last digits, and then uses mod arithmetic:

```
my $n = 100;
my $p = 0;
while ($p < 20) {
$n =~ /^(\d)\d*(\d)$/;
my $g_divisor = $1 . $2;
if ($n % $g_divisor == 0){
$p++;
say $n . ' / ' . $g_divisor . ' = ' .
($n / $g_divisor);
}
$n++;
}
```

**Blog** › 047 – Perl Weekly Challenge

## Laurent Rosenfeld

Laurent Rosenfeld’s solution builds up a list of `@gapful`

numbers with the help of a capturing regex and our best friend in this task, the modulo operator:

```
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";
```

**Blog** › Roman Calculator and Gapful Numbers

## Lubos Kolouch

Lubos Kolouch’s solution uses `substr`

to get the first and third digits:

```
my $count = 0;
for (100..10000) {
if ($_ % int(substr($_,0,1).substr($_,2,1)) == 0) {
say;
$count++;
last if $count == 20;
}
}
```

Lubos’ loop goes to 10000, so `substr($_,2,1)`

will not always return the last digit. Fortunately, the first 20 gapful numbers are all three digit numbers, so it works in this case.

## Mohammad S Anwar

Mohammad S Anwar’s solution also works on three digit numbers, using `split`

, and then `sprintf`

to combine the first and third digits:

```
my $start = 99;
my $count = 0;
while ($count <= 20) {
$start++;
my ($d1, $d2, $d3) = split //, $start;
my $divisor = sprintf("%d%d", $d1, $d3);
if ($start % $divisor != 0) {
next;
}
else {
$count++;
print sprintf("%d / %d\n", $start, $divisor);
}
}
```

## Phillip Harris

Phillip Harris’s solution uses
`substr`

with `0`

and `-1`

for indicies to get the first and last digits:

```
$x = 100;
while ( $gaps < 20 ) {
if ( $x % ( substr( $x, 0, 1 ) . substr( $x, -1 ) ) == 0 ) {
print "$x\n";
$gaps++;
}
$x++;
}
```

## Ruben Westerberg

Ruben Westerberg’s solution uses `split`

and an array slice of the result to get the first and last digits:

```
my @gapful;
while (@gapful < 20) {
state $i=99;
push @gapful, $i unless ++$i % int join "", do {my @a=split("",$i);@a[0,-1]};
}
print join " ",@gapful;
```

## Ryan Thompson

My solution first defines an `is_gapful`

sub that uses `split`

and a slice:

```
sub is_gapful(_) { $_ = pop; not $_ % join '', (split '')[0,-1] }
```

Then I gather the `@r`

esult in the following `for`

loop:

```
sub first_n_gapful {
my $N = shift;
my @r;
for ($_ = 100; @r < $N; $_++) {
push @r, $_ if is_gapful;
}
@r;
}
say for first_n_gapful(shift // 20);
```

**Blog** › Gapful Numbers

## Saif Ahmed

Saif Ahmed’s solution concatenates two `substr`

results:

```
my $test=99;
my $found=0;
while ($found++<20) {
while( ++$test % (substr($test,0,1).substr($test,-1,1))) { }
print $found," ",$test,"\n";
}
```

## Steven Wilson

Steven Wilson’s solution concatenates `substr`

calls as well:

```
my @gapful_numbers;
my $current_number = 100;
while ( scalar @gapful_numbers < 20 ) {
my $divisor = ( substr $current_number, 0, 1 )
. ( substr $current_number, -1, 1 );
if ( $current_number % $divisor == 0 ) {
push @gapful_numbers, $current_number;
}
$current_number++;
}
say join ' ', @gapful_numbers;
```

## Ulrich Rieke

Ulrich Rieke’s solution defines an `isGapful`

sub that uses a capturing regex:

```
sub isGapful {
my $number = shift ;
$number =~ /(\d)\d+(\d)/ ;
my $first = $1 ;
my $last = $2 ;
return ( ($number % ( $first . $last )) == 0 ) ;
}
```

The results are then gathered with the following `while`

loop, then printed:

```
my @numbers ;
my $start = 99 ;
while ( scalar @numbers != 20 ) {
$start++ ;
if ( isGapful( $start ) ) {
push( @numbers, $start ) ;
}
}
map { print "$_ " } @numbers ;
print "\n" ;
```

## User Person

User Person’s solution defines a `firstDigit`

helper sub to return the first digit of a number (there is no `lastDigit`

sub, as a simple `% 10`

is used for that):

```
sub firstDigit {
my $number = $_[0];
while ($number >= 10) {
$number /= 10;
}
return int($number);
}
```

The numbers are then printed in the body of the following `for`

loop:

```
my $QUANTITY = 20;
my ($first, $last);
my $count = 0;
for (my $i = 100; $count < $QUANTITY ; ++$i) {
$first = firstDigit $i;
$last = $i % 10;
my $formedBy = ($first * 10) + $last;
if ( $i % $formedBy == 0 ) {
print "$i ";
++$count;
}
}
print "\n";
```

## Wanderdoc

Wanderdoc’s solution also has a `gapful`

sub, using a `split`

slice:

```
sub gapful {
my $num = $_[0];
my $div = join('',(split(//,$num))[0, -1]);
return 0 == $num % $div;
}
```

The results are then printed in this `while`

loop:

```
my $number = 100;
my $counter = 0;
while ( $counter < 20 ) {
gapful($number) and print join(' ', ++$counter,$number), $/;
$number++;
}
```

## See Also

### Perl blogs this week:

**Dave Jacoby** › Counting from 100 is the Fun Part

**Javier Luque** › 047 – Perl Weekly Challenge

**Laurent Rosenfeld** › Roman Calculator and Gapful Numbers

**Ryan Thompson** › Roman Calculator | Gapful Numbers