Merge pull request #4275 from wlmb/challenges

Challenges

3 files changed, 55 insertions, 0 deletions

diff --git a/challenge-117/wlmb/blog.txt b/challenge-117/wlmb/blog.txt
new file mode 100644
index 0000000000..c6bf5b85ca
--- /dev/null
+++ b/challenge-117/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2021/06/15/PWC117/
diff --git a/challenge-117/wlmb/perl/ch-1.pl b/challenge-117/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..35bb4e1edf
--- /dev/null
+++ b/challenge-117/wlmb/perl/ch-1.pl
@@ -0,0 +1,21 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 117
+# Task 1: Missing row
+#
+# See https://wlmb.github.io/2021/06/15/PWC117/#task-1-missing-row
+use strict;
+use warnings;
+use v5.12;
+
+my %rows;
+@rows{1..15}=map {"Line $_"} qw(one two three four five six seven eight nine
+				ten eleven twelve thirteen fourteen fifteen);
+my $count=0;
+while(<>){
+    ++$count;
+    die "Wrong format: $_" unless /^\s*(\d+),/;
+    die "Wrong number: $_" unless defined $rows{$1};
+    delete $rows{$1};
+}
+die "Not 14 lines" unless $count==14;
+say "Missing row: $_, $rows{$_}" for keys %rows;
diff --git a/challenge-117/wlmb/perl/ch-2.pl b/challenge-117/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..3de2aecde2
--- /dev/null
+++ b/challenge-117/wlmb/perl/ch-2.pl
@@ -0,0 +1,33 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 117
+# Task 2: Find possible paths
+#
+# See https://wlmb.github.io/2021/06/15/PWC117/#task-2-find-possible-paths
+use strict;
+use warnings;
+use v5.12;
+use Text::Wrap;
+use Memoize;
+memoize qw(N P);
+my $length=25; # keep this many paths
+foreach(@ARGV){
+    my @paths=P($_-1,$_-1);
+    @paths=(@paths[0..$length], "...") if @paths>$length;
+    say "\nHeight: $_\nNumber of paths: ", N($_-1,$_-1), "\nPaths:\n", wrap ("\t", "\t", @paths);
+}
+sub N { #Number of paths
+    my ($row, $column)=@_;
+    return 0 if $column>$row;
+    return 0 if $column<0;
+    return 0 if $row < 0;
+    return 1 if $row==0 and $column==0;
+    return N($row, $column-1)+N($row-1, $column-1)+N($row-1, $column);
+}
+sub P { #actual paths
+    my ($r, $c)=@_; #row column
+    return () if $c>$r;
+    return () if $c<0;
+    return () if $r < 0;
+    return ("") if $r==0 and $c==0;
+    return ((map {$_."H"} P($r, $c-1)), (map {$_."R"} P($r-1, $c-1)), (map {$_."L"} P($r-1, $c)));
+}