## Perl Weekly Challenge 135: Middle 3-Digits and Validate SEDOL

These are some answers to the Week 135 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on October 24, 2021 at 24:00). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

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
``````

### Middle 3-Digits in Raku

This is pretty simple. We write a `mid-three` subroutine that returns an error message if the input number has an even number of digits or if it is too small (less than 3 digits). Once this is done, the subroutine finds the mid-point of the sting and returns the substring starting one digit earlier and ending one digit later.

``````sub mid-three (Int \$in is copy) {
\$in = abs(\$in);
my \$length = \$in.chars;
return "Even number of digits" if \$length %% 2;
return "Too short" if \$length < 3;
my \$mid-point = (\$length - 1) /2;
return substr(\$in, \$mid-point - 1, 3);
}
for <1234567 -123 1 10 -54321> -> \$n {
say "\$n -> ", mid-three \$n;
}
``````

This program displays the following output:

``````\$ raku ./mid-three.raku
1234567 -> 345
-123 -> 123
1 -> Too short
10 -> Even number of digits
-54321 -> 432
``````

### Middle 3-Digits in Perl

Again, we have a `mid_three` subroutine that returns an error message if the input number has an even number of digits or if it is too small (less than 3 digits). Once this is done, the subroutine finds the mid-point of the sting and returns the substring starting one digit earlier and ending one digit later.

``````use strict;
use warnings;
use feature "say";

sub mid_three {
my \$in = abs \$_;
my \$length = length \$in;
return "Even number of digits" unless \$length % 2;
return "Too short" if \$length < 3;
my \$mid_point = (\$length - 1) /2;
return substr(\$in, \$mid_point - 1, 3);
}
for my \$n (qw<1234567 -123 1 10 -54321>) {
say "\$n -> ", mid_three \$n;
}
``````

This program displays the following output:

``````\$ perl mid-three.pl
1234567 -> 345
-123 -> 123
1 -> Too short
10 -> Even number of digits
-54321 -> 432
``````

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.

Example 1:

``````Input: \$SEDOL = '2936921'
Output: 1
``````

Example 2:

``````Input: \$SEDOL = '1234567'
Output: 0
``````

Example 3:

``````Input: \$SEDOL = 'B0YBKL9'
Output: 1
``````

### Validate SEDOL in Raku

The `sedol` subroutine returns 0 if the input string contains a vowel or if it not made of 6 alphanumerical characters followed by 1 digit. After these checks, it splits the input string into a sequence of 6 characters and 1 digit (presumably the check digit). It then populates a `%values` hash with the numeric values for the 10 digits and 26 letters. It then computes the weighted sum of the input sequence of 6 characters and then computes the checksum. If the checksum thus calculated is equal to the checksum found in the input string (the last digit), then we have a valid Sedol and the subroutine can return 1. Otherwise the subroutine return 0.

``````sub sedol( Str \$in ) {
return 0 if \$in  ~~ /<[AEIOU]>/;  # Vowels not allowed
return 0 unless \$in ~~ /^ <[0..9B..Z]>**6 <[0..9]> \$/; # 6 alphanumericals + 1 digit
my (\$sedol, \$check) = substr(\$in, 0, 6), substr(\$in, 6, 1);
my %values;
my \$count = 0;
for ( 0..9, 'A'..'Z').flat -> \$val {
%values{\$val} = \$count++;
}
my @weights = 1, 3, 1, 7, 3, 9;
my \$sum = [+] @weights Z* map {%values{\$_}}, \$sedol.comb;
my \$check_digit = (10 - \$sum % 10) % 10;
return 1 if \$check_digit == \$check;
0
}
for <456765 65AR345 2936921 1234567 B0YBKL9> -> \$s {
say "\$s: ", sedol(\$s);
}
``````

This program displays the following output:

``````\$ raku ./sedol.raku
456765: 0
65AR345: 0
2936921: 1
1234567: 0
B0YBKL9: 1
``````

### Validate SEDOL in Perl

This is essentially the same algorithm as in the Raku solution above: the `sedol` subroutine returns 0 if the input string contains a vowel or if it not made of 6 alphanumerical characters followed by 1 digit. After these checks, it splits the input string into a sequence of 6 characters and 1 digit (presumably the check digit). It then populates a `%values` hash with the numeric values for the 10 digits and 26 letters. It then computes the weighted sum of the input sequence of 6 characters and then computes the checksum. If the checksum thus calculated is equal to the checksum found in the input string (the last digit), then we have a valid Sedol and the subroutine can return 1. Otherwise the subroutine return 0.

``````use strict;
use warnings;
use feature "say";

sub sedol {
my \$in = shift;
return 0 if \$in  =~ /[AEIOU]/i;  # Vowels not allowed
return 0 unless \$in =~ /^[A-Z0-9]{6}[0-9]\$/; # 6 alphanumericals + 1 digit
my (\$sedol, \$check) = (substr(\$in, 0, 6), substr(\$in, 6, 1));
my %values;
my \$count = 0;
for my \$val ( 0..9, 'A'..'Z') {
\$values{\$val} = \$count++;
}
my @weights = (1, 3, 1, 7, 3, 9);
my \$sum = 0;
my @chars = split //, \$sedol;
for my \$i (0..5) {
\$sum += \$values{\$chars[\$i]} * \$weights[\$i];
}
my \$check_digit = (10 - \$sum % 10) % 10;
return 1 if \$check_digit == \$check;
0
}
for my \$s (qw<456765 65AR345 2936921 1234567 B0YBKL9>) {
say "\$s: ", sedol(\$s);
}
``````

This program displays the following output:

``````\$ perl  ./sedol.pl
456765: 0
65AR345: 0
2936921: 1
1234567: 0
B0YBKL9: 1
``````

## Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on October 31, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can. I am the author of the "Think Perl 6" book (O'Reilly, 2017) and I blog about the Perl 5 and Raku programming languages.