Perl Weekly Challenge 135.
My solutions (task 1, and task 2 ) to the The Weekly Challenge - 135.
Task 1: Middle 3-digits
Submitted by: Mohammad S Anwar
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
This seems simple enough for a oneliner: Take input from the command line, remove optional sign, get length, compute initial position, test length and output.
perl -E '($s=$i=$ARGV[0])=~s/^[+-]//; $l=length $s; $b=($l-3)/2;\
say "$i->", $l%2==0?"Even":$l<3?"Short":substr $s, $b,3;' 1234567
perl -E '($s=$i=$ARGV[0])=~s/^[+-]//; $l=length $s; $b=($l-3)/2;\
say "$i->", $l%2==0?"Even":$l<3?"Short":substr $s, $b,3;' -- -123
perl -E '($s=$i=$ARGV[0])=~s/^[+-]//; $l=length $s; $b=($l-3)/2;
say "$i->", $l%2==0?"Even":$l<3?"Short":substr $s, $b,3;' 1
perl -E '($s=$i=$ARGV[0])=~s/^[+-]//; $l=length $s; $b=($l-3)/2;\
say "$i->", $l%2==0?"Even":$l<3?"Short":substr $s, $b,3;' 10
Results:
1234567->345
-123->123
1->Short
10->Even
(Notice the -- in the -123 case, so that Perl doesn’t
interpret the minus sign as flagging a Perl option.)
A full program might take the desired number of digits as an additional parameter.
# Perl weekly challenge 135
# Task 1: Middle 3-digits
#
# See https://wlmb.github.io/2021/10/20/PWC135/#task-1-middle-3-digits
use v5.12;
use warnings;
my @even_odd=qw(even odd);
say "Usage: ./ch-1.pl howmany number [number] ..." and exit unless @ARGV>1;
my $how_many= shift @ARGV;
my $parity=$how_many%2; # Desire an even or an odd number of digits?
foreach my $input(@ARGV){
(my $digits=$input)=~s/^[+-]//; # Remove leading sign
my $length=length $digits;
my $begin=($length-$how_many)/2; # initial position
my $output=
$digits!~/^\d+$/ ? "Expected only digits"
:$length%2!=$parity? "Expected an $even_odd[$parity] number of digits"
:$length<$how_many ? "Expected more than $how_many digits"
:substr($digits, $begin, $how_many). " (middle $how_many digits)";
say "Input: $input\nOutput: $output";
}
Examples:
./ch-1.pl 3 1234567 -123 1 10
Results:
Input: 1234567
Output: 345 (middle 3 digits)
Input: -123
Output: 123 (middle 3 digits)
Input: 1
Output: Expected more than 3 digits
Input: 10
Output: Expected an odd number of digits
Other examples:
./ch-1.pl 3 1234567 12345678
./ch-1.pl 4 1234567 12345678
Results:
Input: 1234567
Output: 345 (middle 3 digits)
Input: 12345678
Output: Expected an odd number of digits
Input: 1234567
Output: Expected an even number of digits
Input: 12345678
Output: 3456 (middle 4 digits)
Task 2: Validate SEDOL
Submitted by: Mohammad S Anwar
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
According to the wikipedia article SEDOLS are words consisting of 7 characters. The first six are digits or consonants. The last one is a check digit. The weighted sum of the values of all the characters is congruent with 0 modulo 10 using the weights 1,3,1,7,3,9,1 and where the values are the positions occupied in the list 0..9,A..Z. I assume that lower case letters are valid and may be converted to uppercase before testing. I understand that old style SEDOLS had only digits while new style SEDOLS start with B or higher letter. Also, words starting in 9 are reserved for end user allocation; I guess they can contain consonants besides digits. If the first character is a digit other than 9, the word would correspond to an old style SEDOL, which had no letters, only digits. The first digit then indicates the origin. I use below all the information from the wikipedia page (as I understood it).
# Perl weekly challenge 135
# Task 2: Validate SEDOL
#
# See https://wlmb.github.io/2021/10/20/PWC135/#task-2-validate-sedol
use v5.12;
use warnings;
use List::Util qw(all sum0);
use List::MoreUtils qw(pairwise);
my @weights=(1,3,1,7,3,9,1);
my $i=0;
my %values=map {$_=> $i++} 0..9,"A".."Z"; # compute weights
map {$values{$_}=undef} split '', "AEIOU"; # remove vowels
my %origin;
$origin{6}="Asia or Africa";
@origin{0,3}=("UK or Ireland")x2;
@origin{4,5,7}=("Europe")x3;
$origin{2}="America";
foreach(@ARGV){
say "Input: $_, Output: ", is_sedol($_);
}
sub is_sedol {
my @s=split '', uc shift; # Assume lc is valid
return "0, Need 7 chars" unless @s==7;
return "0, Last char should be digit" unless $s[6]=~m/\d/;
return "0, Invalid char" unless all {defined $values{$_}} @s; # valid chars
my @v=@values{@s};
return "0, Wrong check digit"
unless (sum0 pairwise {$a*$b} @weights, @v)%10==0;
return "1, End user SEDOL" if $v[0]==9; # Assume no other restriction
return "1, New SEDOL" if $s[0] ge 'B';
return "0, Only digits for old SEDOLs" unless all {$_<10} @v;
return "1, Old SEDOL, probably from $origin{$v[0]}" if defined $origin{$v[0]};
return "1, Old SEDOL, unknown origin";
}
Examples:
./ch-2.pl 2936921 1234567 B0YBKL9
Results:
Input: 2936921, Output: 1, Old SEDOL, probably from America
Input: 1234567, Output: 0, Wrong check digit
Input: B0YBKL9, Output: 1, New SEDOL
Other examples:
./ch-2.pl 123 123456C ACDFGH5 1234564 9234565 92B4567 \
BCDFGH4 bcdfgh4 1C34563 0234564 1234563 2234562 \
3234561 4234560 5234569 6234568 7234567 8234566
Results:
Input: 123, Output: 0, Need 7 chars
Input: 123456C, Output: 0, Last char should be digit
Input: ACDFGH5, Output: 0, Invalid char
Input: 1234564, Output: 0, Wrong check digit
Input: 9234565, Output: 1, End user SEDOL
Input: 92B4567, Output: 1, End user SEDOL
Input: BCDFGH4, Output: 1, New SEDOL
Input: bcdfgh4, Output: 1, New SEDOL
Input: 1C34563, Output: 0, Only digits for old SEDOLs
Input: 0234564, Output: 1, Old SEDOL, probably from UK or Ireland
Input: 1234563, Output: 1, Old SEDOL, unknown origin
Input: 2234562, Output: 1, Old SEDOL, probably from America
Input: 3234561, Output: 1, Old SEDOL, probably from UK or Ireland
Input: 4234560, Output: 1, Old SEDOL, probably from Europe
Input: 5234569, Output: 1, Old SEDOL, probably from Europe
Input: 6234568, Output: 1, Old SEDOL, probably from Asia or Africa
Input: 7234567, Output: 1, Old SEDOL, probably from Europe
Input: 8234566, Output: 1, Old SEDOL, unknown origin