### Perl Weekly Challenge: Week 135

#### Challenge 1:

Middle 3-digits

You are given an integer.

Write a script find out the middle 3-digits of the given integer, if possible otherwise throw sensible error.

##### Example 1
``````Input: \$n = 1234567
Output: 345
``````
##### Example 2
``````Input: \$n = -123
Output: 123
``````
##### Example 3
``````Input: \$n = 1
Output: too short
``````
##### Example 4
``````Input: \$n = 10
Output: even number of digits
``````

A nice and simple problem. Here's how I solved it in Perl.

First I got the input as a command line argument.

``````my \$n = shift // die "Need an integer.\n";
``````

Whether the number is positive or negative is irrelevant so I removed the initial `-` if there was one.

``````\$n =~ s/^\-//;
``````

What's left should be all digits. If there is some other character like a `.` for example, it is not an integer.

``````if (\$n !~ /^\d+\$/) {
die "Not an integer.\n";
}
``````

For the next two tests, we need to know how many digits the integer has.

``````my \$len = length \$n;
``````

If the integer has an even number of digits, we reject it.

``````if (\$len % 2 == 0) {
die "Even number of digits\n";
}
``````

If there are less than three digits in the integer, it is too short.

``````if (\$len < 3) {
die "Too short.\n";
}
``````

Now we can take out the middle three digits and print them.

``````say substr \$n, (\$len - 3) / 2, 3;
``````

(Full code on Github.)

For the Raku version, the only substantial change I had to make is that function parameters are immutable so when I removed the initial hyphen, I had to assign the result to a new variable.

``````sub MAIN(
Int \$N
) {
my \$n = \$N.subst(/^\-/, q{});

if \$n !~~ /^ \d+ \$/ {
die "\$n Not an integer.\n";
}

my \$len = \$n.chars;

if \$len % 2 == 0 {
die "Even number of digits\n";
}

if \$len < 3 {
die "Too short.\n";
}

say \$n.substr((\$len - 3) / 2, 3);
}
``````

(Full code on Github.)

#### Challenge 2:

Validate SEDOL

You are given 7-characters alphanumeric SEDOL.

Write a script to validate the given SEDOL. Print 1 if it is a valid SEDOL otherwise 0.

For more information about SEDOL, please checkout the wikipedia page.

##### Example 1
``````Input: \$SEDOL = '2936921'
Output: 1
``````
##### Example 2
``````Input: \$SEDOL = '1234567'
Output: 0
``````
##### Example 3
``````Input: \$SEDOL = 'B0YBKL9'
Output: 1
``````

I have used Perl for so many tasks like this over the years. It's the kind of thing the language is ideally suited for. I consolidated all the validation into a function which returns true or false values. (not true or false literals as Perl does nothave them.)

``````sub check {
my (\$sedol) = @_;
``````

An easy check is to make sure the prospective SEDOL is seven characters long:

``````    if (length \$sedol != 7) {
return undef;
}
``````

...then we check if it is made up of allowed characters. The first six characters should either be digits or upper case letters except vowels. The last character must be a digit. This can be expressed as a regex. The character class of digits and allowed letters is kind of ungainly but the alternative would be to list them all out and I don't think that would have been any more readable.

``````    if (\$sedol !~ /^ [0-9B-DF-HJ-NP-TV-Z]{6} [0-9] \$/x) {
return undef;
}
``````

These are the weights assigned to each character in the SEDOL. The last one is superfluous but it doesn't hurt to leave it there.

``````    my @weights = (1, 3, 1, 7, 3, 9, 1);
``````

The SEDOL has to be split into an array of its constituent characters.

``````    my @chars = split //, \$sedol;
``````

The first six characters are ordinalized (using the `ord()` function natuarally) and multiplied by their respective weights and added to a running total. The sample javascript code had a simpler way of doing this by using the characters as base 36 numbers. I had developed some code for base 35 way back in PWC 2 which I could have adapted but the `ord()` method seemed easier. Because digits and upper-case letters are disjoint sets, they had to be treated separately.

``````    my \$sum = 0;

for my \$i (0 .. 5) {
if (ord(\$chars[\$i]) >= ord('0') && ord(\$chars[\$i]) <= ord('9')) {
\$sum += \$chars[\$i] * \$weights[\$i];
} else {
\$sum += (ord(\$chars[\$i]) - ord('A')) * \$weights[\$i];
}
}
``````

The final sum is taken modulo 10. As this could still be greater than 10, modulo 10 is taken again. This results in a single digit which is compared to the last digit of the SEDOL. If it is the same, a true value is returned or a false value if it is not the same.

``````    return ((10 - \$sum % 10) % 10) == \$chars[6];
}
``````

(Full code on Github.)

This is the Raku version:

``````sub check(Str \$sedol) {
if (\$sedol.chars != 7) {
return False;
}
``````

The main thing I wish to illustrate is the nice way the allowed character class is constructed below. It is so much more readable than the Perl version.

``````    if (\$sedol !~~ /^ <[0..9] + [A..Z] - [AEIOU]> ** 6 <[0..9]> \$ /) {
return False;
}

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

my @chars = \$sedol.comb;

my \$sum = 0;

for 0 .. 5 -> \$i {
if (@chars[\$i].ord >= '0'.ord && @chars[\$i].ord <= '9'.ord) {
\$sum += @chars[\$i] * @weights[\$i];
} else {
\$sum += (@chars[\$i].ord - 'A'.ord) * @weights[\$i];
}
}

return ((10 - \$sum % 10) % 10) == @chars[6];
}
``````

(Full code on Github.)