Merge pull request #5066 from wlmb/challenges

Add solutions to PWC135

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";
+}