Merge pull request #4189 from wlmb/challenges

Add solutions to PWC115

3 files changed, 45 insertions, 0 deletions

diff --git a/challenge-115/wlmb/blog.txt b/challenge-115/wlmb/blog.txt
new file mode 100644
index 0000000000..aee45b1687
--- /dev/null
+++ b/challenge-115/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2021/06/01/PWC115/
diff --git a/challenge-115/wlmb/perl/ch-1.pl b/challenge-115/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..a2accad0fd
--- /dev/null
+++ b/challenge-115/wlmb/perl/ch-1.pl
@@ -0,0 +1,24 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 115
+# Task 1: String Chain
+#
+# See https://wlmb.github.io/2021/06/01/PWC115/#task-1-string-chain
+use strict;
+use warnings;
+use v5.12;
+use List::Util qw(reduce);
+use PDL;
+
+my @strings=@ARGV;
+die "Usage ./ch-1.pl string1 [string2...]" unless @strings;
+my $C=zeroes(long,scalar(@strings), scalar(@strings)); #connectivity matrix
+map {my $f=$_;map {$C->slice("$f,$_").=follows($f, $_)}
+    (0..@strings-1)}(0..@strings-1);
+my $R=reduce {map{$_->diagonal(0,1).=0}($a,$b); $b x $a;}
+             ($C) x @strings;
+say "Input: ", join " ", @strings;
+say "Output: ", all($R->diagonal(0,1)>0);
+sub follows {
+    my ($from, $to)=map {$strings[$_]} @_;
+    return substr($from,-1,1) eq substr($to,0,1);
+}
diff --git a/challenge-115/wlmb/perl/ch-2.pl b/challenge-115/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..e58d9898cf
--- /dev/null
+++ b/challenge-115/wlmb/perl/ch-2.pl
@@ -0,0 +1,20 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 115
+# Task 2: Largest Multiple
+#
+# See https://wlmb.github.io/2021/06/01/PWC115/#task-2-largest-multiple
+use strict;
+use warnings;
+use v5.12;
+use List::MoreUtils qw(first_index);
+foreach(@ARGV){
+    die "Usage: ./ch-2.pl digits1 [digits2...]"
+         unless m/^\d+$/;
+    say "Input: $_";
+    my @digits=sort {$a<=>$b} split '', $_;
+    my $even_index=first_index {$_%2==0} @digits;
+    say("No even number may be constructed from input"), next
+         unless $even_index>=0;
+    my $last=splice @digits, $even_index,1;
+    say "Output: ", reverse(@digits), $last;
+}