Merge pull request #7784 from jo-37/subsequent

Solutions for weeks 001 - 027

48 files changed, 1861 insertions, 0 deletions

diff --git a/challenge-001/jo-37/perl/ch-1.pl b/challenge-001/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..468a16db83
--- /dev/null
+++ b/challenge-001/jo-37/perl/ch-1.pl
@@ -0,0 +1,10 @@
+#!/usr/bin/perl
+
+use v5.12;
+use strict;
+use warnings;
+
+for ($a = 'Perl Weekly Challenge') {
+	my $n = y/e/E/;
+	say "$_: $n";
+}
diff --git a/challenge-001/jo-37/perl/ch-2.pl b/challenge-001/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..c6fcb3e635
--- /dev/null
+++ b/challenge-001/jo-37/perl/ch-2.pl
@@ -0,0 +1,9 @@
+#!/usr/bin/perl
+
+use 5.012;
+use strict;
+use warnings;
+
+say join ', ', map $_%15?$_%5?$_%3?$_:'fizz':'buzz':'fizzbuzz', 1 .. 20;
+
+
diff --git a/challenge-002/jo-37/perl/ch-1.pl b/challenge-002/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..2717f9c7a2
--- /dev/null
+++ b/challenge-002/jo-37/perl/ch-1.pl
@@ -0,0 +1,7 @@
+#!/usr/bin/perl
+
+use 5.012;
+use strict;
+use warnings;
+
+say join "\n", map $_ + 0, '000123', 123;
diff --git a/challenge-002/jo-37/perl/ch-2.pl b/challenge-002/jo-37/perl/ch-2.pl
new file mode 100644
index 0000000000..d10ceb7280
--- /dev/null
+++ b/challenge-002/jo-37/perl/ch-2.pl
@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+
+use Test2::V0;
+use Math::Utils 'moduli';
+use List::Util 'reduce';
+
+my @b35 = (0 .. 9, 'A' .. 'Y');
+my %b35 = map {($b35[$_] => $_)} 0 .. $#b35;
+
+sub to_b35 {
+	join '', map $b35[$_], reverse moduli(shift, 35);	
+}
+
+sub from_b35 {
+	reduce {$a * 35 + $b35{$b}} 0, split //, shift;
+}
+
+is to_b35(0), '0';
+is to_b35(9), '9';
+is to_b35(10), 'A';
+is to_b35(34), 'Y';
+is to_b35(35), '10';
+is from_b35(to_b35(7**$_)), 7**$_ for 1 .. 18;
+
+done_testing;
diff --git a/challenge-003/jo-37/perl/ch-1.sh b/challenge-003/jo-37/perl/ch-1.sh
new file mode 100755
index 0000000000..d1673e49ce
--- /dev/null
+++ b/challenge-003/jo-37/perl/ch-1.sh
@@ -0,0 +1,4 @@
+#!/bin/sh
+
+# Back to the future: This task will be solved in week 123.
+../../../challenge-123/jo-37/perl/ch-1.pl -verbose $1
diff --git a/challenge-003/jo-37/perl/ch-2.pl b/challenge-003/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..ae26b799c4
--- /dev/null
+++ b/challenge-003/jo-37/perl/ch-2.pl
@@ -0,0 +1,19 @@
+#!/usr/bin/perl
+
+use v5.16;
+use warnings;
+use List::MoreUtils 'slide';
+
+
+### Implementation
+# First row is a single one.
+# In the following rows, each element is the sum of the two elements
+# from the row above, where this is embedded between two zeroes.
+
+main: {
+    my @row = (1);
+    for (1 .. shift) {
+        say "@row";
+        @row = slide {$a + $b} 0, @row, 0;
+    }
+}
diff --git a/challenge-004/jo-37/perl/ch-1.pl b/challenge-004/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..d38f7fb496
--- /dev/null
+++ b/challenge-004/jo-37/perl/ch-1.pl
@@ -0,0 +1,2 @@
+#!/usr/bin/perl
+use Math::BigFloat;print Math::BigFloat->bpi(65)
diff --git a/challenge-004/jo-37/perl/ch-2.pl b/challenge-004/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..b7065f744a
--- /dev/null
+++ b/challenge-004/jo-37/perl/ch-2.pl
@@ -0,0 +1,40 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use warnings;
+use experimental 'signatures';
+
+our $letters;
+
+die <<EOS unless @ARGV && $letters;
+usage: $0 -letters=LETTERS [FILE]
+
+-letters=LETTERS
+    list of letters
+
+FILE
+    Name of a file containing one word per line. Use '-' for STDIN.
+
+EOS
+
+
+### Input and Output
+
+main: {
+    my %letters;
+    $letters{$_}++ for split //, lc $letters;
+    while (<>) {
+        chomp;
+        say if check_word(\%letters, lc);
+    }
+}
+
+### Implementation
+
+sub check_word ($letters, $word) {
+    my %letters = %$letters;
+    for my $l (split //, $word) {
+        return unless exists $letters{$l} && $letters{$l}--;
+    }
+    1;
+}
diff --git a/challenge-006/jo-37/perl/ch-1.pl b/challenge-006/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..a54df67b3c
--- /dev/null
+++ b/challenge-006/jo-37/perl/ch-1.pl
@@ -0,0 +1,57 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use Test2::V0;
+
+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...
+    sorted list of numbers
+
+EOS
+
+
+### Input and Output
+
+say compact(@ARGV);
+
+
+### Implementation
+
+# Join list elements with commas, replace commas between successive
+# numbers with hyphens, remove elements enclosed with hyphens and
+# finally replace hyphens between successive numbers with commas.
+sub compact {
+    join(',',  @_) =~ s/(\d+)\K,(?=(\d+))/$2 == $1 + 1 ? '-' : ','/egr
+    =~ s/-\d+(?=-)//gr
+    =~ s/(\d+)\K-(?=(\d+))/$2 == $1 + 1 ? ',' : '-'/egr;
+}
+
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        is compact(1,2,3,4,9,10,14,15,16), '1-4,9,10,14-16', 'example';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+	}
+
+    done_testing;
+    exit;
+}
diff --git a/challenge-006/jo-37/perl/ch-2.pl b/challenge-006/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..54015ae882
--- /dev/null
+++ b/challenge-006/jo-37/perl/ch-2.pl
@@ -0,0 +1,9 @@
+#!/usr/bin/perl
+
+use v5.16;
+use warnings;
+use Math::BigFloat;
+
+say Math::BigFloat->bexp(
+    Math::BigFloat->bpi->bmul(Math::BigFloat->new(163)->bsqrt)
+);
diff --git a/challenge-007/jo-37/perl/ch-1.pl b/challenge-007/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..7667e5f174
--- /dev/null
+++ b/challenge-007/jo-37/perl/ch-1.pl
@@ -0,0 +1,26 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use warnings;
+use Math::Prime::Util qw(vecsum todigits);
+
+our $base;
+$base ||= 10;
+
+die <<EOS unless @ARGV;
+usage: $0 [-base=B] N
+
+-base=B
+    find Niven numbers in base B
+
+N
+    find Niven numbers up to N
+
+EOS
+
+
+# Implementation
+
+for (1 .. shift) {
+    say unless $_ % vecsum todigits $_, $base;
+}
diff --git a/challenge-007/jo-37/perl/ch-2.pl b/challenge-007/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..ad28650a9a
--- /dev/null
+++ b/challenge-007/jo-37/perl/ch-2.pl
@@ -0,0 +1,92 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use Test2::V0;
+use autodie;
+use List::MoreUtils qw(zip6);
+use List::Util qw(sum);
+use Graph::Undirected;
+use experimental qw(signatures);
+
+our ($tests, $examples);
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless @ARGV == 3;
+usage: $0 [-examples] [-tests] [WORD1 WORD2 FILE]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+WORD1 WORD2
+    begin and end of a word ladder
+
+FILE
+    name of a file containing a list of equal sized words.  Use '-' for STDIN
+
+EOS
+
+
+### Input and Output
+
+main: {
+    my ($x, $y) = splice(@ARGV, 0, 2);
+    say "(@{[ladder(\*ARGV, $x, $y)]})";
+}
+
+
+### Implementation
+
+# Build a graph from the words in file handle $fh.  Each word represents
+# one vertex.  Two vertices are connected if the words are neighbors
+# (see below).  In the resulting graph find the shortest path between
+# two given words $x and $y.
+sub ladder ($fh, $x, $y) {
+    my $g = Graph::Undirected->new;
+    # Add vertices.
+    while (<$fh>) {
+        chomp;
+        $g->add_vertex(lc $_);
+    }
+    # Loop over vertex pairs and add an edge for each neighboring pair.
+    my @vertices = $g->vertices;
+    for my $i (1 .. $#vertices - 1) {
+        my $vi = $vertices[$i];
+        for my $k ($i + 1 .. $#vertices) {
+            my $vk = $vertices[$k];
+            $g->add_edge($vi, $vk) if neighbors($vi, $vk);
+        }
+    }
+    # Find the shortest path between $x and $y.
+    $g->SP_Dijkstra($x, $y);
+}
+
+# Test if two words are "neighbors", i.e. they differ in exactly one
+# character position.
+sub neighbors ($x, $y) {
+    # Circumvent zip6's prototype.
+    1 == sum map $_->[0] ne $_->[1], &zip6([split //, $x], [split //, $y]) 
+}
+
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        open my $words, '-|', q{egrep -i -e '^[a-z]{4}$' /usr/share/dict/words};
+        is [ladder($words, 'cold', 'warm')], [qw(cold cord card ward warm)],
+            'example';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+	}
+
+    done_testing;
+    exit;
+}
diff --git a/challenge-008/jo-37/perl/ch-1.pl b/challenge-008/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..fad350e5b5
--- /dev/null
+++ b/challenge-008/jo-37/perl/ch-1.pl
@@ -0,0 +1,62 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use Test2::V0;
+use bigint;
+use List::Gen;
+use Math::Prime::Util 'divisor_sum';
+
+our ($tests, $examples, $verbose);
+
+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
+    print the first N perfect numbers
+
+EOS
+
+
+### Input and Output
+
+gen_perfect()->take(shift)->say;
+
+
+### Implementation
+
+# No need to consider odd perfect numbers as none is known yet.  Thus
+# restricting to those generated from Mersenne primes.
+# Build a generator for even perfect primes.
+sub gen_perfect {
+	<2..>->map(sub {2**($_ - 1) * (2**$_ - 1)})
+        ->filter(sub {divisor_sum($_) == 2 * $_});
+}
+
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        is gen_perfect()->take(5), [6, 28, 496, 8128, 33550336],
+            'task 1 from OEIS';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+
+        is gen_perfect()->get(5), 8589869056, 'next from OEIS';
+	}
+
+    done_testing;
+    exit;
+}
diff --git a/challenge-008/jo-37/perl/ch-2.pl b/challenge-008/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..6523dea489
--- /dev/null
+++ b/challenge-008/jo-37/perl/ch-2.pl
@@ -0,0 +1,56 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use Test2::V0;
+use List::Util 'max';
+
+our ($tests, $examples);
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless @ARGV;
+usage: $0 [-examples] [-tests] [STRING...]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+STRING...
+    strings to be centered
+
+EOS
+
+
+### Input and Output
+
+say for center(@ARGV);
+
+
+### Implementation
+
+sub center {
+    my $max = max map length, @_;
+    map ' ' x (($max - length)/2) . $_, @_;
+}
+
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        is [center("This", "is", "a test of the", "center function")],
+        ["     This", "      is", " a test of the", "center function"],
+        'example';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+	}
+
+    done_testing;
+    exit;
+}
diff --git a/challenge-009/jo-37/perl/ch-1.pl b/challenge-009/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..9c41c49ff0
--- /dev/null
+++ b/challenge-009/jo-37/perl/ch-1.pl
@@ -0,0 +1,64 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use Test2::V0;
+use List::Gen;
+use Math::Prime::Util 'todigits';
+use List::Util 'uniq';
+use experimental 'signatures';
+
+our ($tests, $examples, $base);
+$base ||= 10;
+
+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
+
+-base=B
+    process numbers in base B
+
+N
+    find the first square having at least N different digits in base B.
+
+EOS
+
+
+### Input and Output
+
+say gen_squares(shift, $base)->();
+
+### Implementation
+
+
+# Build a generator for square numbers having at least $n different
+# digits in base $base.
+sub gen_squares ($n, $base) {
+    <1..>->map('**2')->filter(sub{uniq(todigits($_, $base)) >= $n});
+}
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+
+        is gen_squares(5, 10)->take(20),
+        [12769, 13456, 13689, 13924, 15376, 15876, 16384, 17689, 17956,
+            18496, 18769, 20164, 20736, 21609, 21904, 23104, 23409, 23716,
+            28561, 29584], 'from A235720';
+	}
+
+    done_testing;
+    exit;
+}
diff --git a/challenge-009/jo-37/perl/ch-2.pl b/challenge-009/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..3659480166
--- /dev/null
+++ b/challenge-009/jo-37/perl/ch-2.pl
@@ -0,0 +1,127 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use Test2::V0;
+use List::UtilsBy 'rev_nsort_by';
+use experimental 'postderef';
+
+use constant R_DENSE => 0;
+use constant R_STD => 1;
+use constant R_MOD => 2;
+
+our ($tests, $examples, $mod, $dense);
+
+my $mode = R_STD;
+$mode = R_MOD if $mod;
+$mode = R_DENSE if $dense;
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless @ARGV;
+usage: $0 [-examples] [-tests] [-mod | -dense] [ID:SCORE...]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+-mod
+    use "modified ranking"
+
+-dense
+    use "dense ranking"
+
+ID:SCORE
+    list of identifier / score pairs
+
+EOS
+
+
+### Input and Output
+say "$_->{id}:$_->{rank}" for
+@{rank($mode, map {my %h; @h{qw(id score)} = split /:/; \%h} @ARGV)};
+
+
+### Implementation
+
+
+# Expecting a list of hash refs with two required keys: id and score. Id
+# is an identifier for the item and score a number, where larger numbers
+# are regarded as "better".  First sort the list descending by score.
+# Then collect references to the value for the key "rank".  Equal scores
+# go into the same array.  Then assign ranks according to the selected
+# mode. 
+sub rank {
+    my $mode = shift;
+
+    # sort descending
+    my @sorted = rev_nsort_by {$_->{score}} @_;
+    # collect references:
+    my $lastscore = 'inf';
+    my @ranks;
+    for (@sorted) {
+        if ($_->{score} < $lastscore) {
+            # a lower score opens a new rank group
+            push @ranks, [\$_->{rank}];
+        } else {
+            # an equal score goes into the corresponding group
+            push $ranks[-1]->@*, \$_->{rank};
+        }
+        $lastscore = $_->{score};
+    }
+    my $rank = 0;
+    for (@ranks) {
+        # Prepend a gap in "modified" mode, step otherwise
+        $rank += ($mode == R_MOD) ? @$_ : 1;
+        $$_ = $rank for @$_;
+        # Append a gap in "standard" mode
+        $rank += ($mode == R_STD) * ($#$_);
+    }
+
+    \@sorted;
+}
+
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+        my @items = (
+            {id => 'B', score => 1},
+            {id => 'C', score => 2},
+            {id => 'D', score => 2},
+            {id => 'A', score =>3}
+        );
+
+        like rank(R_STD, @items),
+            bag {item hash {field id => 'B'; field rank => 4};
+                item hash {field id => 'C'; field rank => 2};
+                item hash {field id => 'D'; field rank => 2};
+                item hash {field id => 'A'; field rank => 1};
+                end;
+            }, 'standard rank';
+        like rank(R_MOD, @items),
+            bag {item hash {field id => 'B'; field rank => 4};
+                item hash {field id => 'C'; field rank => 3};
+                item hash {field id => 'D'; field rank => 3};
+                item hash {field id => 'A'; field rank => 1};
+                end;
+            }, 'modified rank';
+        like rank(R_DENSE, @items),
+            bag {item hash {field id => 'B'; field rank => 3};
+                item hash {field id => 'C'; field rank => 2};
+                item hash {field id => 'D'; field rank => 2};
+                item hash {field id => 'A'; field rank => 1};
+                end;
+            }, 'dense rank';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+	}
+
+    done_testing;
+    exit;
+}
diff --git a/challenge-010/jo-37/perl/ch-1.pl b/challenge-010/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..20f2fd70a3
--- /dev/null
+++ b/challenge-010/jo-37/perl/ch-1.pl
@@ -0,0 +1,10 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use warnings;
+use Roman;
+
+main: {
+    my $input = shift;
+    say isroman($input) ? arabic($input) : Roman($input);
+}
diff --git a/challenge-010/jo-37/perl/ch-2.pl b/challenge-010/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..1ed334d426
--- /dev/null
+++ b/challenge-010/jo-37/perl/ch-2.pl
@@ -0,0 +1,17 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use warnings;
+use List::Util 'max';
+use Text::JaroWinkler 'strcmp95';
+
+die <<EOS unless @ARGV == 2;
+usage: $0 STR1 STR2
+
+STR1 STR2
+    two strings
+
+EOS
+
+
+say strcmp95(@ARGV, max map length, @ARGV);
diff --git a/challenge-011/jo-37/perl/ch-1.pl b/challenge-011/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..63f4a768d3
--- /dev/null
+++ b/challenge-011/jo-37/perl/ch-1.pl
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+
+use v5.16;
+use warnings;
+
+# 212 F - 32 F = 180 degF = 100 K, i.e. 1.8 degF = 1 K
+# Fahrenheit to Kelvin: (F - 32)/1.8 + 273.15
+# Celsius to Kelvin: C + 273.15
+# (x - 32)/1.8 + 273.15 = x + 273.15
+# x - 32 = 1.8 * x
+# -32 = 0.8 * x
+# x = -40
+say -40;
diff --git a/challenge-011/jo-37/perl/ch-2.pl b/challenge-011/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..6006211af5
--- /dev/null
+++ b/challenge-011/jo-37/perl/ch-2.pl
@@ -0,0 +1,7 @@
+#!/usr/bin/perl
+
+use v5.16;
+use warnings;
+use PDL;
+
+say identity(shift);
diff --git a/challenge-012/jo-37/perl/ch-1.pl b/challenge-012/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..d8eccb06d3
--- /dev/null
+++ b/challenge-012/jo-37/perl/ch-1.pl
@@ -0,0 +1,11 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use warnings;
+use bigint;
+use List::Gen;
+use Math::Prime::Util qw(is_prime pn_primorial);
+
+# Build a generator for non-prime Euclid numbers and print the first N
+# thereof (Default: N = 1)
+<1..>->map(sub{pn_primorial($_)+1})->filter(sub{!is_prime($_)})->say(shift||1);
diff --git a/challe