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.)