RogerBW's Blog

I’ve been doing the Perl Weekly Challenges. The latest was about doing Roman arithmetic and generating gapful numbers.

In keeping with my self-imposed rules, I installed the Roman module for Perl5. Then it's just a matter of validating everything and doing the conversions.

use Roman;

my %ol=map {$_ => 1} qw(+ - * /);
my ($a,$op,$b)=@ARGV;

unless (isroman($a)) {
  die "$a is not a valid Roman number\n";
}
unless (exists $ol{$op}) {
  die "$op is not a valid operation\n";
}
unless (isroman($b)) {
  die "$a is not a valid Roman number\n";
}

$a=arabic($a);
$b=arabic($b);
my $c;
if ($op eq '+') {
  $c=$a+$b;
} elsif ($op eq '-') {
  $c=$a-$b;
} elsif ($op eq '*') {
  $c=$a*$b;
} else {
  $c=int($a/$b);
}
if ($c<1 || $c>3999) {
  die "Result $c is out of range\n";
}

print Roman($c),"\n";

For Perl6 I kept the same conversion interface but had to implement the back-end as well, which was rather more interesting. (It will probably miss some invalid Roman numbers, though.) The Roman to Arabic conversion generates a set of matches for each digit place and checks them in descending length order. Probably greedy regexps would do this automatically but I was having a busy day.

The nested flag-checks were needed because last LABEL didn't work as the documentation described it.

sub roman ($in) {
  my @pattern=('','0','00','000','01','1','10','100','1000','02');
  my @phase=(('m','',''),('c','d','m'),('x','l','c'),('i','v','x'));
  if ($in > 3999 or $in < 1) {
    die "$in is out of range\n";
  }
  my @l=comb(/\d/,sprintf('%04d',truncate($in)));
  my $out='';
  for (0..3) -> $phase {
    my $p=@pattern[@l[$phase]];
    for (0..2) -> $ix {
      $p ~~ s:g/$ix/@phase[$phase][$ix]/;
    }
    $out ~= $p;
  }
  return $out;
}

sub Roman ($in) {
 return uc(roman($in));
}

sub arabic ($in) {
  my $im=$in;
  my @pattern=('','0','00','000','01','1','10','100','1000','02');
  my @phase=(('m','?','?'),('c','d','m'),('x','l','c'),('i','v','x'));
  my $mul=1000;
  my $n=0;
  for (0..3) -> $phase {
    my %r;
    for (1..9) -> $pi {
      my $p=@pattern[$pi];
      for (0..2) -> $ix {
        $p ~~ s:g/$ix/@phase[$phase][$ix]/;
      }
      %r{$p.chars}{$p}=$pi;
    }
    my $flag=0;
    for (4,3,2,1) -> $l {
      for (keys %r{$l}) -> $k {
        if ($im ~~ s:i/^$k//) {
          $n += $mul*%r{$l}{$k};
          $flag=1;
          last;
        }
        if ($flag) {
          last;
        }
      }
      if ($flag) {
        last;
      }
    }
    $mul /= 10;
  }
  if ($im) {
    return 0;
  }
  return $n;
}

sub isroman ($in) {
  return (!arabic($in)==0);
}

Part 2 was much simpler: a gapful number is divisible by the concatenation of its first and last digits.

my $count=20;
my $n=100;

while ($count>0) {
  $n =~ /^(.).*(.)/;
  my $d=$1.$2;
  if ($n % $d == 0) {
    print "$n\n";
    $count--;
  }
  $n++;
}

For Perl6 I got a little sneaky with the Match object.

#! /usr/bin/perl6

my $count=20;
my $n=100;

while ($count>0) {
  $n ~~ /^(.).*(.)/;
  my $d=$/.list.join('');
  if ($n % $d == 0) {
    print "$n\n";
    $count--;
  }
  $n++;
}