Solutions to challenge 241

2 files changed, 148 insertions, 0 deletions

diff --git a/challenge-241/jo-37/perl/ch-1.pl b/challenge-241/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..93563fa2d3
--- /dev/null
+++ b/challenge-241/jo-37/perl/ch-1.pl
@@ -0,0 +1,87 @@
+#!/usr/bin/perl -s
+
+use v5.24;
+use Test2::V0 '!float';
+use PDL;
+
+our ($tests, $examples, $diff);
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless defined $diff && @ARGV > 2;
+usage: $0 [-examples] [-tests] [-diff=D N...]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+-diff=D
+    count arithmetic triplets having a difference of D
+
+N...
+    three or more integers
+
+EOS
+
+
+### Input and Output
+
+say arith_triplets($diff, @ARGV);
+
+
+### Implementation
+
+# Using graph theory to solve the task.  We take the given integers as
+# the vertices of a directed graph with their indices as unique
+# identifiers and the integers as values.  Two vertices are connected
+# with an edge if and only if the indices are in correct order and the
+# difference between the values equals the given difference.
+#
+# The adjacency matrix of a graph shows all edges, i.e. direct
+# neighboring vertices.  Furthermore, the squared adjacency matrix shows
+# the number of 2-walks between any two vertices.  In the constructed
+# "forward only" graph every walk is actually a path, each 2-path
+# corresponds to one arithmetic triplet for the given difference and the
+# sum over the elements of this squared matrix is the requested number
+# of arithmetic triplets.
+#
+# There is neither a need for the numbers to be in increasing order nor
+# for the difference to be positive.
+
+sub arith_triplets {
+    my $diff = shift;
+	my $l = long @_;
+    # Build the adjacency matrix.
+    my $adj =
+        (sequence($l) > sequence($l)->dummy(0))
+        & ($l - $l->dummy(0) == $diff);
+        
+    # Count the number of 2-paths in the graph.
+    ($adj x $adj)->sum;
+}
+
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+        is arith_triplets(3 ,=> 0, 1, 4, 6, 7, 10), 2, 'example 1';
+        is arith_triplets(2 ,=> 4, 5, 6, 7, 8, 9), 2, 'example 2';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+
+        is arith_triplets(1 ,=> 1, 2, 4, 5, 8, 9), 0, 'no triplet';
+        is arith_triplets(2 ,=> 1, 3, 3, 5), 2, 'multiple paths';
+        is arith_triplets(1 ,=> 9, 1, 8, 2, 7, 3), 1, 'not ordered';
+        is arith_triplets(0 ,=> 1, 2, 1, 4, 1, 6), 1, 'zero diff';
+        is arith_triplets(-1 ,=> 4, 3, 2, 1), 2, 'negative diff';
+	}
+
+    done_testing;
+    exit;
+}
diff --git a/challenge-241/jo-37/perl/ch-2.pl b/challenge-241/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..a6b45b5be0
--- /dev/null
+++ b/challenge-241/jo-37/perl/ch-2.pl
@@ -0,0 +1,61 @@
+#!/usr/bin/perl -s
+
+use v5.24;
+use Test2::V0 '!float';
+use Math::Prime::Util 'factor';
+use PDL;
+use PDL::NiceSlice;
+
+our ($tests, $examples);
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless @ARGV;
+usage: $0 [-examples] [-tests] [N...]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+N...
+    list of positive integers
+
+EOS
+
+
+### Input and Output
+
+say "(@{prime_order(@ARGV)})";
+
+
+### Implementation
+
+# This task is very similar to task 2 from week 238.  Following the same
+# approach.
+
+sub prime_order {
+    long(map [scalar factor $_, $_], @_)->qsortvec->((1))->unpdl;
+}
+
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        is prime_order(11, 8, 27, 4), [11, 4, 8, 27], 'example 1';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+
+        is prime_order(27, 8, 121, 49, 167, 131),
+            [131, 167, 49, 121, 8, 27], 'another example';
+	}
+
+    done_testing;
+    exit;
+}