Perl solution for week 109, part 2

7 files changed, 202 insertions, 0 deletions

diff --git a/challenge-109/abigail/README.md b/challenge-109/abigail/README.md
index 57a25f7869..1f7b55f195 100644
--- a/challenge-109/abigail/README.md
+++ b/challenge-109/abigail/README.md
@@ -91,6 +91,7 @@ Output:
 ~~~~
 
 ### Solutions
+* [Perl](perl/ch-2.pl)
 
 ### Blog
 
diff --git a/challenge-109/abigail/perl/ch-2.pl b/challenge-109/abigail/perl/ch-2.pl
new file mode 100644
index 0000000000..ddbbe4fb38
--- /dev/null
+++ b/challenge-109/abigail/perl/ch-2.pl
@@ -0,0 +1,183 @@
+#!/opt/perl/bin/perl
+
+use 5.032;
+
+use strict;
+use warnings;
+no  warnings 'syntax';
+
+use experimental 'signatures';
+use experimental 'lexical_subs';
+
+#
+# See ../README.md
+#
+
+#
+# Run as: perl ch-2.pl < input-file
+#
+
+#
+# First note that due to symmetry, there cannot be a unique solution [1].
+# If
+#
+#      (a, b, c, d, e, f, g) = (x_1, x_2, x_3, x_4, x_5, x_6, x_7)
+#
+# is a solution, then
+#
+#      (a, b, c, d, e, f, g) = (x_7, x_6, x_5, x_4, x_3, x_2, x_1)
+#
+# must be a solution as well.
+#
+# For instance, the given example has 8 solutions, 4 of which are
+# mirror images.
+#
+# [1] This assumes no duplicate numbers in the input. Clearly, a
+#     solution where a == g, b == f, and c == e doesn't give a
+#     different solution when mirrorred. (For instance, if all 
+#     numbers are 0, there is only one solution).
+
+#
+#
+# It's easy to brute force this. There are a mere 5040 permutations
+# of the seven numbers; it would be hard to find an environment
+# where it takes more than a few milliseconds to try all permutations.
+#
+# We can improve the brute force a little, by determining early we're
+# on a wrong path. For instance, once we have picked an a, b, c, and d,
+# we can check whether a + b == b + c + d. If not, we don't have to
+# continue trying values for e, f, and g.
+#
+# However, that's not the way we go. We will first do some analysis.
+# Let the sum of each box be N. Then we have:
+#
+#   N = a + b        (1)
+#   N = b + c + d    (2)
+#   N = d + e + f    (3)
+#   N = f + g        (4)
+#
+# For (1) and (2), we get:
+#
+#   a + b = b + c + d  =>
+#   a     =     c + d  =>
+#   a - c =         d
+#
+# In the same way, (3) and (4), we get:
+#
+#   g + f = f + e + d  =>
+#   g     =     e + d  =>
+#   g - e =         d
+#
+# This leads to the following algorithm:
+# 
+#   - Calculate the differences between all pairs (7 * 6 == 42 pairs)
+#   - Find all numbers n from the input array for which there are at
+#     least two pairs giving this difference, under the condition n
+#     is not part of such a pair. (Note that if the input contains
+#     two or more of the same number, for this purpose, we treat those
+#     numbers to be different). These numbers will be our candidate for d.
+#   - Of the list of differences equalling d, consider each pair.
+#     Eliminate pairs where the same number appears in each. The first
+#     difference gives candidates for a and c; the second gives candidates
+#     for g and e. (Swapping them leaves to a symmetric solution).
+#   - We now have candidates for a, c, d, e, and g. This leaves two
+#     numbers for b and c.
+#   - Try both, and check whether a + b == b + c + d == d + e + f == f + g.
+#
+# For the given example, this means we only try 32 permutations,
+# giving us 4 different solutions (the other 4 can be found by
+# reversing the numbers).
+#
+# We are not making any assumptions on the sign of the input numbers;
+# our algorithm works fine if the input contains negative numbers.
+#
+# We will also print all solutions (including the symmetric ones)
+#
+
+while (<>) {
+    my @numbers = split;
+
+    #
+    # Find all differences
+    #
+    my %differences;
+    for (my $x = 0; $x < @numbers; $x ++) {
+        for (my $y = $x + 1; $y < @numbers; $y ++) {
+            my $diff = $numbers [$x] - $numbers [$y];
+            push @{$differences { $diff}} => [$x, $y];
+            push @{$differences {-$diff}} => [$y, $x];
+        }
+    }
+
+    #
+    # Now, iterate over the numbers, and see if there 
+    # is a number matching two differences, with all
+    # indices being different.
+    #
+    for (my $d_i = 0; $d_i < @numbers; $d_i ++) {
+        my $d = $numbers [$d_i];
+        #
+        # Find the pairs whose difference is $d. If we don't have
+        # at least two pairs where neither number is $d, this
+        # cannot be a solution.
+        #
+        my @diffs = grep {$$_ [0] != $d_i && $$_ [1] != $d_i}
+                          @{$differences {$d} || []};
+
+        next unless @diffs >= 2;
+
+        #
+        # Now, find two pairs where all indices are different.
+        #
+        for (my $x = 0; $x < @diffs; $x ++) {
+            for (my $y = $x + 1; $y < @diffs; $y ++) {
+                next if $diffs [$x] [0] == $diffs [$y] [0] ||
+                        $diffs [$x] [0] == $diffs [$y] [1] ||
+                        $diffs [$x] [1] == $diffs [$y] [0] ||
+                        $diffs [$x] [1] == $diffs [$y] [1];
+
+                #
+                # W.l.o.g. we can now assume $diffs [$x] are
+                # the indices for $a and $c, and $diffs [$y]
+                # are the indices for $g and $e.
+                #
+                my ($a_i, $c_i) = @{$diffs [$x]};
+                my ($g_i, $e_i) = @{$diffs [$y]};
+
+                #
+                # Find the unused indices
+                #
+                my %indices = map {$_ => 1} keys @numbers;
+                delete $indices {$_} for $a_i, $c_i, $d_i, $e_i, $g_i;
+
+                #
+                # This leaves two indices for $b and $e.
+                # Try them both.
+                #
+                my $left = [keys %indices];
+                foreach my $try ($left, [reverse @$left]) {
+                    my ($b_i, $f_i) = @$try;
+
+                    #
+                    # Do we have a winner?
+                    #
+                    next unless           $numbers [$a_i] + $numbers [$b_i] ==
+                        $numbers [$b_i] + $numbers [$c_i] + $numbers [$d_i] ==
+                        $numbers [$d_i] + $numbers [$e_i] + $numbers [$f_i] ==
+                                          $numbers [$f_i] + $numbers [$g_i];
+
+                    #
+                    # Print result, and the reverse, so we get all
+                    # possible solutions.
+                    #
+                    my @solution =
+                       @numbers [$a_i, $b_i, $c_i, $d_i, $e_i, $f_i, $g_i];
+
+                    local $, = " ";
+                    say         @solution;
+                    say reverse @solution;
+                }
+            }
+        }
+    }
+}
diff --git a/challenge-109/abigail/t/ctest.ini b/challenge-109/abigail/t/ctest.ini
index e2f88e41ce..afa82182bd 100644
--- a/challenge-109/abigail/t/ctest.ini
+++ b/challenge-109/abigail/t/ctest.ini
@@ -8,6 +8,8 @@
 1-2 = Fixed output/plain

 1-3 = Fixed output/fetch

 1-4 = Fixed output/compute

+2-1 = Given example

+2-2 = With a negative number

 

 

 [1-1]

@@ -33,3 +35,7 @@ args = fetch
 [1-4/awk,bash,c,lua,node,perl,python,ruby]

 skip = 0

 args = compute

+

+

+[2-1,2-2]

+sort = 1

diff --git a/challenge-109/abigail/t/input-2-1 b/challenge-109/abigail/t/input-2-1
new file mode 100644
index 0000000000..b4457aae66
--- /dev/null
+++ b/challenge-109/abigail/t/input-2-1
@@ -0,0 +1 @@
+1 2 3 4 5 6 7
diff --git a/challenge-109/abigail/t/input-2-2 b/challenge-109/abigail/t/input-2-2
new file mode 100644
index 0000000000..335e2405f0
--- /dev/null
+++ b/challenge-109/abigail/t/input-2-2
@@ -0,0 +1 @@
+1 -2 3 4 5 6 7
diff --git a/challenge-109/abigail/t/output-2-1.exp b/challenge-109/abigail/t/output-2-1.exp
new file mode 100644
index 0000000000..83687f2b3e
--- /dev/null
+++ b/challenge-109/abigail/t/output-2-1.exp
@@ -0,0 +1,8 @@
+3 7 2 1 5 4 6
+4 5 3 1 6 2 7
+4 7 1 3 2 6 5
+5 6 2 3 1 7 4
+6 4 1 5 2 3 7
+6 4 5 1 2 7 3
+7 2 6 1 3 5 4
+7 3 2 5 1 4 6
diff --git a/challenge-109/abigail/t/output-2-2.exp b/challenge-109/abigail/t/output-2-2.exp
new file mode 100644
index 0000000000..7a67a5be9d
--- /dev/null
+++ b/challenge-109/abigail/t/output-2-2.exp
@@ -0,0 +1,2 @@
+3 7 -2 5 1 4 6
+6 4 1 5 -2 7 3