aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--challenge-135/wlmb/blog.txt1
-rwxr-xr-xchallenge-135/wlmb/perl/ch-1.pl22
-rwxr-xr-xchallenge-135/wlmb/perl/ch-2.pl36
3 files changed, 59 insertions, 0 deletions
diff --git a/challenge-135/wlmb/blog.txt b/challenge-135/wlmb/blog.txt
new file mode 100644
index 0000000000..fef84f860d
--- /dev/null
+++ b/challenge-135/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2021/10/20/PWC135/
diff --git a/challenge-135/wlmb/perl/ch-1.pl b/challenge-135/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..27412c472b
--- /dev/null
+++ b/challenge-135/wlmb/perl/ch-1.pl
@@ -0,0 +1,22 @@
+#!/usr/bin/env perl
+# 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";
+}
diff --git a/challenge-135/wlmb/perl/ch-2.pl b/challenge-135/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..85de19fe50
--- /dev/null
+++ b/challenge-135/wlmb/perl/ch-2.pl
@@ -0,0 +1,36 @@
+#!/usr/bin/env perl
+# 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";
+}