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;
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);
}
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];
}
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];
}