Merge pull request #4284 from jo-37/contrib

Solutions to challenge 117

2 files changed, 348 insertions, 0 deletions

diff --git a/challenge-117/jo-37/perl/ch-1.pl b/challenge-117/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..ad21fc4e73
--- /dev/null
+++ b/challenge-117/jo-37/perl/ch-1.pl
@@ -0,0 +1,139 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use Test2::V0;
+use warnings;
+use autodie;
+use experimental 'signatures';
+
+our ($tests, $examples, $rows);
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless @ARGV && $rows;
+usage: $0 [-examples] [-tests] [-rows=n filename]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+-rows=n
+    expect n rows in the given file
+
+filename
+    filename containing numbered rows
+
+EOS
+
+
+### Input and Output
+
+say join "\n", @{find_missing_rows(*ARGV{IO}, $rows)};
+
+
+### Implementation
+
+# The task is certainly over-determined:
+# - There are 14 rows of data.
+# - It's stated that rows are numbered 1 to 15.
+# - It's stated that one row would be missing.
+# Either the specification of the number of missing rows or the desired
+# number of rows is superfluous.  Ignoring the number of missing rows
+# here.
+# Note: Ignoring both the number of rows *and* the number of missing
+# rows prevents the determination of a missing last row.
+sub find_missing_rows ($fh, $rows) {
+    my %rows;
+    @rows{1 .. $rows} = (1 .. $rows);
+    # Row numbers shall be separated with a comma from the rest of the
+    # row and may have leading zeros.
+    delete @rows{do {local $/; <$fh> =~ /^0*(\d+)(?=,)/mg}};
+
+    [sort {$a <=> $b} values %rows];
+}
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        open my $fh, '<', \(<<EOS =~ s/^ +//gmr);
+            11, Line Eleven
+            1, Line one
+            9, Line Nine
+            13, Line Thirteen
+            2, Line two
+            6, Line Six
+            8, Line Eight
+            10, Line Ten
+            7, Line Seven
+            4, Line Four
+            14, Line Fourteen
+            3, Line three
+            15, Line Fifteen
+            5, Line Five
+EOS
+        is find_missing_rows($fh, 15), [12], 'example';
+        close $fh;
+
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+
+        my $fh;
+
+        open $fh, '<', \(<<EOS =~ s/^ +//gmr);
+            2, Line two
+            3, Line three
+EOS
+        is find_missing_rows($fh, 3), [1], 'missing first row';
+        close $fh;
+
+        open $fh, '<', \(<<EOS =~ s/^ +//gmr);
+            1, Line one
+            2, Line two
+EOS
+        is find_missing_rows($fh, 3), [3], 'missing last row';
+        close $fh;
+
+        open $fh, '<', \(<<EOS =~ s/^ +//gmr);
+            1, Line one
+            2, Line two
+            3, Line three
+EOS
+        is find_missing_rows($fh, 3), [], 'nothing missing';
+        close $fh;
+
+        open $fh, '<', \(<<EOS =~ s/^ +//gmr);
+            01, Line one
+            02, Line two
+            03, Line three
+EOS
+        is find_missing_rows($fh, 3), [], 'leading zeros';
+        close $fh;
+
+        open $fh, '<', \(<<EOS =~ s/^ +//gmr);
+            1, Line one
+            3, Line three
+            5, Line Five
+EOS
+        is find_missing_rows($fh, 5), [2, 4], 'multiple missing rows';
+        close $fh;
+
+        open $fh, '<', \(<<EOS =~ s/^ +//gmr);
+            1, Line one
+            2 Line two
+            3, Line three
+EOS
+        is find_missing_rows($fh, 3), [2], 'malformed line number';
+        close $fh;
+
+	}
+
+    done_testing;
+    exit;
+}
diff --git a/challenge-117/jo-37/perl/ch-2.pl b/challenge-117/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..4ad624017c
--- /dev/null
+++ b/challenge-117/jo-37/perl/ch-2.pl
@@ -0,0 +1,209 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use Test2::V0;
+use Graph;
+use experimental qw(signatures postderef);
+
+our ($tests, $examples, $triangle, $from, $to);
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless @ARGV && defined($from) && defined($to) || $triangle;
+usage: $0 [-examples] [-tests] [-triangle=n | -from=v_f -to=v_t edge ...]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+-triangle=n
+    build triangular graph having size n
+
+-from=v_f
+    use v_f as starting vertex
+
+-to=v_t
+    use v_t as ending vertex
+
+edge ...
+    specify the graph by its edges.  Each edge has the form
+    'h-t-l' with 'h' as the head vertex, 't' as the tail vertex and
+    'l' as the edge label.
+
+    Example 1 may have these vertex assignments:
+
+        a
+       ⇙ ⇘
+      b ⇒ c
+     ⇙ ⇘ ⇙ ⇘
+    d ⇒ e ⇒ f
+
+    and it may be run as:
+
+    $0 -from=a -to=f a-b-L a-c-R b-c-H b-d-L b-e-R c-e-L c-f-R d-e-H e-f-H
+
+    or simply:
+
+    $0 -triangle=2
+
+EOS
+
+
+### Input and Output
+
+my $g;
+if ($triangle) {
+    $g = graph_from_edges(triangle($triangle));
+    $from = "0 0";
+    $to = "$triangle $triangle";
+} else {
+    $g = graph_from_edges([@ARGV]);
+}
+
+say "@{paths_from_to($g, $from, $to)}";
+
+
+### Implementation
+
+# For a highly regular graph as given in the task there is certainly a
+# pattern in the solution that permits its straight construction.  As a
+# lame excuse for not searching for such pattern, I'm going to solve a
+# more general task.
+# Considering a directed acyclic graph (DAG) with labeled edges.
+# Then find all paths between a given start and end vertex and print the
+# concatenated edge labels for every path.
+#
+# This easily earns the N=10-bonus.
+#
+# Having implemented the lazy solution, it provides the sequence of
+# the count of possible paths for a given triangle size as:
+# 2, 6, 22, 90, 394, 1806,...
+# Consulting OEIS reveals this sequence as the "Large Schröder Numbers".
+# See http://oeis.org/A006318 and
+# https://en.wikipedia.org/wiki/Schröder_number.  Not even thinking
+# about generating the 17518619320890 paths for N=20.
+
+# Find all paths in the given DAG starting in vertex $from and ending in
+# vertex $to and collect the concatenated edges' labels.
+sub paths_from_to ($g, $from, $to) {
+    # Apply a single empty prefix to the start vertex.
+    my %paths = ($from => ['']);
+    # Process vertices in topological order.
+    for my $vertex ($g->topological_sort) {
+        # At the end vertex all paths from the start vertex are known
+        # due to the topological ordering.
+        return $paths{$vertex} if $vertex eq $to;
+        # For every outgoing edge append the edge's label to the label
+        # sequence for all paths leading to the current vertex and then
+        # append this list to the path list for the edge's tail vertex.
+        # This is a no-op until the start vertex is hit.
+        for my $succ ($g->successors($vertex)) {
+            my $label = $g->get_edge_attribute($vertex, $succ, 'label');
+            push $paths{$succ}->@*, map $_ . $label, $paths{$vertex}->@*;
+        }
+    }
+}
+
+# Build a graph from its labeled edges.  Edges are expected in the
+# form "h-t-l" with "h" as the head vertex, "t" as the tail vertex and
+# "l" as the label.
+sub graph_from_edges ($edges) {
+    my $g = Graph->new;
+    for (@$edges) {
+        my ($h, $t, $l) = split /-/;
+        $g->set_edge_attribute($h, $t, label => $l);
+    }
+    die "not a DAG\n" unless $g->is_dag;
+
+    $g;
+}
+
+# Generate the edges for a triangular graph of size $n according to the
+# task.  Edges have the form "head-tail-label", vertices have the form
+# "row col"
+sub triangle ($n) {
+    my @edges;
+    for my $row (0 .. $n) {
+        for my $col (0 .. $row) {
+            my @vert = ($row, $col);
+            if ($col < $row) {
+                my @horiz = ($row, $col + 1);
+                push @edges, "@vert-@horiz-H";
+            }
+            if ($row < $n) {
+                my @left = ($row + 1, $col);
+                my @right = ($row + 1, $col + 1);
+                push @edges, "@vert-@left-L", "@vert-@right-R";
+            }
+        }
+    }
+
+    \@edges;
+}
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        is paths_from_to(graph_from_edges(triangle(2)), '0 0', '2 2'),
+            bag {
+                item 'RR';
+                item 'LHR';
+                item 'LRH';
+                item 'RLH';
+                item 'LHLH';
+                item 'LLHH';
+                end;
+            }, 'example 1';
+
+        is paths_from_to(graph_from_edges(triangle(1)), '0 0', '1 1'),
+            bag {
+                item 'R';
+                item 'LH';
+                end;
+            }, 'example 2';
+
+        is scalar(@{paths_from_to(
+                graph_from_edges(triangle(10)), '0 0', '10 10')}
+            ), 1037718, 'N=10';
+
+
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+
+#    A less regular DAG as a test object with two source vertices.
+#
+#        a
+#       ⇙ ⇘
+#      b   c   d
+#     ⇙ ⇘ ⇙ ⇘ ⇙ ⇘
+#    e ⇐ f   g ⇐ h
+#     ⇘ ⇙ ⇘ ⇙ ⇘ ⇙
+#      i   j   k
+#       ⇘ ⇙
+#        l
+
+        my $g = graph_from_edges([qw(
+                a-b-L a-c-R
+                b-e-L b-f-R c-f-L c-g-R d-g-L d-h-R
+                e-i-R f-e-H f-i-L f-j-R g-j-L g-k-R h-g-H h-k-L
+                i-l-R j-l-L)]);
+
+        is paths_from_to($g, 'a', 'k'), ['RRR'], 'unique path';
+        is paths_from_to($g, 'b', 'k'), [], 'not reachable';
+        is paths_from_to($g, 'j', 'c'), [], 'out of topological order';
+
+        like dies {graph_from_edges([qw(a-b-D b-a-U)])}, qr/not a DAG/,
+            'not a directed acyclic graph';
+
+	}
+
+    done_testing;
+    exit;
+}