SEDOL in the Middle with Raku and Perl

This is my response to the Perl Weekly Challenge #135.

Challenge #135.1: Middle 3-digits

Input: $n = 1234567
Output: 345

Input: $n = -123
Output: 123

Input: $n = 1
Output: too short

Input: $n = 10
Output: even number of digits

I have chosen to print the error message, as done in the examples, instead of throwing an error - as this would have given quite a different output.

#! /usr/bin/env raku

unit sub MAIN (Int $n);                                  # [1]

$n = $n.abs if $n < 0;                                   # [2]

given $n                                                 # [3]
{
  when .chars %% 2 { say "even number of digits"; }      # [4]
  when .chars < 3  { say "too short"; }                  # [5]
  default          { say .substr((.chars - 3) /2, 3); }  # [6]
}

[1] Ensure that we get an integer.

[2] Remove the sign, if any (i.e. if negative).

[3] using given/when, which is Raku speak for «switch» gives compact code. Note that given sets $_ to the spcified expression, so that we can use dot notation on nothing - which is shorthand for doing it on $_.

See docs.raku.org/language/control#index-entry-switch_(given) for more information about given/when.

[4] An even number of digits is an error.

[5] A number with less than three digits is also an error.

[6] We get here if all is well. Print the middle three digits.

Running it:

$ ./m3d 1234567
345

$ ./m3d -123
Usage:
  ./m3d <n>

$ ./m3d 1
too short

$ ./m3d 10
even number of digits

The second example (-123 ) does not satisfy the Int constraint, and I have no idea why that is so. The problem is there even if we remove the type on the input (i.e. unit sub MAIN ($n);), so here we have a problem - probably with MAIN.

We can do it manually instead:

#! /usr/bin/env raku

my $n = @*ARGS[0];

die "Not an integer" unless $n ~~ /^\-?<[1..9]><[0..9]>*$/;  # [1]

$n = $n.abs if $n < 0;

if    $n.chars %% 2 { say "even number of digits"; }         # [2]
elsif $n.chars < 3  { say "too short"; }
else                { say $n.substr(($n.chars - 3) /2, 3); }

[1] Start with an optional minus sign (\-?), one single non-zero digit (<[1..9]>) followed by zero or more digits (<[0..9]>). I am using explicit digits, as the \d regex will also match Unicode digits of all sorts.

[2] I have replaced the given/when block with a traditional if/elsif/else. Feel free to compare the two versions.

This version works as intended when given negative numbers:

$ ./m3d-args -123
123

A Perl Version

#! /usr/bin/env perl

use strict;
use warnings;
use feature 'say';

my $n = $ARGV[0] // "";

die "integer only" unless $n =~ /^\-?[1-9]\d*$/;

$n = abs($n) if $n < 0;

if (length($n) % 2 == 0)
{
  say "even number of digits";
}
elsif (length($n) < 3)
{
  say "too short";
}
else
{
  say substr($n, (length($n) -3) / 2, 3);
}

Running it gives the same result as the last Raku version:

$ ./m3d-perl 1234567
345

$ ./m3d-perl -123
123

$ ./m3d-perl 1
too short

$ ./m3d-perl 10
even number of digits

Challenge #135.2: Validate SEDOL

Input: $SEDOL = '2936921'
Output: 1

Input: $SEDOL = '1234567'
Output: 0

Input: $SEDOL = 'B0YBKL9'
Output: 1

This is pretty straight forward:

#! /usr/bin/env raku

subset SEDOL where * ~~ /<[0..9 BCDFGHJKLMNPQRSTVWXZ]>**6<[0..9]>/;  # [1]

unit sub MAIN (SEDOL $SEDOL);

my @weight = (1, 3, 1, 7, 3, 9, 1);

my $sum = (^6).map({ $SEDOL.substr($_, 1).parse-base(35) * @weight[$_] }).sum;
                                                                      # [2]

my $check = (10 - ($sum % 10)) % 10;

say + ($SEDOL.substr(6) eq $check);                                   # [3]

[1] We validate the input (length 7, and only legal characters) with a custom type, set up with subset. Note that the result is that strings that does not match, will give an error instead of 0.

[2] Using parse-base gives us the mapping between digit/letter and value for free. Note the use of map instead of a regular for loop, which gives a list that we can reduce to a sum with the aptly named sum method.

See docs.raku.org/routine/parse-base for more information about parse-base.

[3] The comparison gives a Boolean value, and we have to coerce that value into a 0 or 1 with the Numeric Coercion Prefix +.

See docs.raku.org/routine/+ for more information about the Prefix Operator +.

Running it:

$ ./validate-sedol 2936921
1

$ ./validate-sedol 1234567
0

$ ./validate-sedol B0YBKL9
Usage:
  ./validate-sedol <SEDOL>

Oops!

The problem with the third example is the letter Y. The wikipedia page clearly says that SEDOL identifier does not contain vowels. So this will fail, as Y is a wovel. But is it really a wovel? According to www.merriam-webster.com/words-at-play/why-y-is-sometimes-a-vowel-usage Y is sometimes a wovel.

Then we have to find which Y-camp SEDOL belongs to. The wikipedia page does not say anything about it, but the code example does treat Y as a wovel. It is unclear if this is based on knowledge of SEDOL rules, or is pure chance.

So I found a SEDOL lookup site, Stock Marked MBA, and had a go at the offending third example. It is in use («Abertis Infrastructuras SA»). So we have to allow Y.

It is possible to make the program shorter, practically a oneliner. Let us do that at the same time:

#! /usr/bin/env raku

subset SEDOL where * ~~ /<[0..9 BCDFGHJKLMNPQRSTVWXYZ]>**6<[0..9]>/;

unit sub MAIN (SEDOL $SEDOL);

say + ($SEDOL.substr(6) eq (10 − (((^6).map({ $SEDOL.substr($_, 1).parse-base(35) * (1, 3, 1, 7, 3, 9, 1)[$_] }).sum) % 10)) % 10);

Running it:

$ ./validate-sedol-onelinerish 2936921
1

$ ./validate-sedol-onelinerish 1234567
0

$ ./validate-sedol-onelinerish B0YBKL9
1

Looking good.

It is possible to turn it into a true oneliner, but it is hard enough to understand already.

Perl

#! /usr/bin/env perl

use strict;
use warnings;
use feature 'say';

my $SEDOL = $ARGV[0] // "";

die "SEDOL with wrong length and/or characters"
  unless $SEDOL =~ /^[0-9|BCDFGHJKLMNPQRSTVWXYZ]{6}[0-9]$/;

my @weight = (1, 3, 1, 7, 3, 9, 1);

my @alphabet = (0..9, 'A'..'Z');

my %alphabet = ( map { $alphabet[$_] => $_ } (0 .. @alphabet -1));  # [1]

my $sum;

for my $index (0..5)
{
   $sum += $alphabet{ substr($SEDOL, $index, 1) } * $weight[$index];
}

my $check = (10 - ($sum % 10)) % 10;

say 0 + (substr($SEDOL, 6) eq $check);

[1] Perl does not have parse-base, but using reverse lookup on a specially constructed hash to get the values works quite well. Note the use of map to set up the hash.

Running it gives the same result as the Raku versions:

$ ./validate-sedol-perl 2936921
1

$ ./validate-sedol-perl 1234567
0

$ ./validate-sedol-perl B0YBKL9
1

And that's it.