laurent_r

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.

Task 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

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 $_[0];
    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

Task 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

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.