Merge pull request #4629 from jo-37/contrib

Solutions to challenge 123

2 files changed, 238 insertions, 0 deletions

diff --git a/challenge-123/jo-37/perl/ch-1.pl b/challenge-123/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..428b157f29
--- /dev/null
+++ b/challenge-123/jo-37/perl/ch-1.pl
@@ -0,0 +1,143 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use Test2::V0;
+use experimental 'signatures';
+use Coro::Generator;
+
+our ($tests, $examples, $verbose);
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless @ARGV == 1;
+usage: $0 [-examples] [-tests] [-verbose] [N]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+-verbose
+    print intermediate results
+
+N
+    calculate the N-th Hamming number
+
+EOS
+
+
+### Input and Output
+
+say hamming(pop);
+
+
+### Implementation
+
+# I have no idea why one would call the sequence A051037 "ugly numbers".
+# Wikipedia calls them "regular" (after some discussion about a proper
+# name), OEIS "5-smooth" and others "Hamming" numbers.  I'll call them
+# "Hamming numbers" in the following.
+#
+# Generating the Hamming numbers is known as "Hamming's problem".
+# Evolved implementations follow a path of augmenting the initial
+# one-element sequence (1) with a merger of its own 2-, 3- and 5-fold.
+# The most advanced I could find was David Eppstein's Python
+# implementation, see last reference.  The implementation here is just a
+# plain Perl port of his.  Python has a built-in "yield" statement,
+# which makes a Perl port look a bit involved at first, until I
+# discovered "Coro::Generator" leading to a straightforward solution.
+# My first naive implementation (based on the exclusion of non-Hamming
+# numbers) needed 30s to find hamming(1000), whereas now hamming(10000)
+# can be calculated in the wink of an eye.  Or consider:
+# 'time' perl -Mbigint ch-1.pl 1000000
+# 519312780448388736089589843750000000000000000000000000000000000000000000000000000000
+# 20.52user 0.30system 0:20.86elapsed 99%CPU (0avgtext+0avgdata 707232maxresident)k
+#0inputs+0outputs (0major+175730minor)pagefaults 0swaps 0inputs+0outputs (0major+259495minor)pagefaults 0swaps
+#
+# References:
+# https://en.wikipedia.org/wiki/Regular_number
+# http://oeis.org/A051037
+# https://11011110.github.io/blog/2007/03/12/hammings-problem.html
+# (cool: 0b11011110 == 0xDE)
+
+# Build a generator for powers of $p.
+sub powers ($p) {
+    generator {
+        my $pow = 1;
+        while () {
+            yield $pow;
+            $pow *= $p;
+        }
+    }
+}
+
+# Build a generator for a merged sequence of the one provided by the
+# generator $s with itself multiplied by $p.
+sub powtimes ($s, $p) {
+    generator {
+        # Initialize the cache with the first generated value.
+        my @seq = $s->();
+        # The first element comes from the generated sequence.
+        yield $seq[0];
+        # Initial "front" element taken from the sequence.
+        my $front = $s->();
+        # Initial "back" element taken as the $p-fold of the first
+        # element from the cache.
+        my $back = $seq[my $backindex = 0] * $p;
+        while () {
+            # Merge the generated sequence with its $p-fold multiple:
+            # Select the next element as the smaller of the front
+            # element provided by the generator and the back element as
+            # the p-fold of the current cached element, advancing these
+            # accordingly from the generator or the cache.
+            if ($front < $back) {
+                yield $front;
+                push @seq, $front;
+                $front = $s->();
+            } else {
+                yield $back;
+                push @seq, $back;
+                $back = $seq[++$backindex] * $p;
+            }
+        }
+    }
+}
+
+# Calculate the n-th Hamming number.
+sub hamming ($n) {
+    # Build a generator for the Hamming numbers.
+    my $hamming = powtimes(powtimes(powers(2), 3), 5);
+    # Loop over the first $n - 1 hamming numbers and print these if
+    # requested.
+    sub {say pop if $verbose}->($hamming->()) for 1 .. $n - 1;
+
+    # Return the n-th Hamming number.
+    $hamming->();
+}
+
+### Examples and tests
+
+sub run_tests {
+    local $verbose;
+    SKIP: {
+        skip "examples" unless $examples;
+
+        is hamming(7), 8, 'example 1';
+        is hamming(10), 12, 'example 2';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+        is hamming(62), 405, 'the largest number given in OEIS';
+        is hamming(1000), 51200000, 'fast enough for larger numbers';
+        is hamming(10000), 288325195312500000, 'even larger';
+        is hamming(13282), 18432000000000000000,
+            'the largest fitting into an uint64';
+        # Beyond this we have to "use bigint" as hamming(13283) is
+        # 2**64.
+	}
+
+    done_testing;
+    exit;
+}
diff --git a/challenge-123/jo-37/perl/ch-2.pl b/challenge-123/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..2fc2a2441a
--- /dev/null
+++ b/challenge-123/jo-37/perl/ch-2.pl
@@ -0,0 +1,95 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use Test2::V0 '!float';
+use PDL;
+use experimental 'signatures';
+
+our ($tests, $examples);
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless @ARGV == 8;
+usage: $0 [-examples] [-tests] [x1 y1 ... x4 y4]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+x1 y1 ... x4 y4
+    four x-y vertex coordinate pairs forming a tetragon
+
+EOS
+
+
+### Input and Output
+
+say 0 + is_square(v(@ARGV[0,1]), v(@ARGV[2,3]), v(@ARGV[4,5]), v(@ARGV[6,7]));
+
+
+### Implementation
+
+# Check if four (2-d) vertices form a square.
+# A square is a rectangle with all edges of the same length.  If a
+# tetragon has three 90° angles, the fourth must have 90°, too.  So
+# checking for three angles is sufficient for a rectangle.  Furthermore,
+# the opposite edges in an rectangle have the same length. Thus checking
+# any two neighboring edges for the same length is sufficient for a
+# square.
+# Using PDL just for its nice vector operations.
+
+sub is_square ($v1, $v2, $v3, $v4) {
+    # Transform vertex vectors to edge vectors.
+    my ($e1, $e2, $e3, $e4) = ($v2 - $v1, $v3 - $v2, $v4 - $v3, $v1 - $v4);
+
+    # Check three angles and two lengths.
+    !any pdl $e1->transpose x $e2,
+        $e2->transpose x $e3,
+        $e3->transpose x $e4,
+        $e1->transpose x $e1 - $e2->transpose x $e2;
+}
+
+# Create a column vector as 1xN piddle
+sub v (@p) {
+    pdl(@p)->dummy(0);
+}
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        is is_square(v(10, 20), v(20, 20), v(20, 10), v(10, 10)),
+            T(), 'example 1';
+        is is_square(v(12, 24), v(16, 10), v(20, 12), v(18, 16)),
+            F(), 'example 2';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+
+        is is_square(v(10, 20), v(21, 21), v(20, 10), v(10, 10)),
+            F(), 'e1/e2 not ortogonal';
+        is is_square(v(10, 20), v(20, 20), v(21, 11), v(10, 10)),
+            F(), 'e2/e3 not ortogonal';
+        is is_square(v(10, 20), v(20, 20), v(20, 10), v(11, 11)),
+            F(), 'e3/e4 not ortogonal';
+        is is_square(v(11, 21), v(20, 20), v(20, 10), v(10, 10)),
+            F(), 'e4/e1 not ortogonal';
+        is is_square(v(10, 20), v(21, 20), v(21, 10), v(10, 10)),
+            F(), 'unequal edge lengths';
+        is is_square(v(1, 1), v(3, 2), v(2, 4), v(0, 3)), T(),
+            'rotated';
+
+        my $u = sqrt(2);
+        my $v = sqrt(5);
+        is is_square(v($u, $v), v($v, $v), v($v, $u), v($u, $u)),
+            T(), 'floating point vertice coordinates'; 
+	}
+
+    done_testing;
+    exit;
+}