Solutions to challenge 304

3 files changed, 208 insertions, 0 deletions

diff --git a/challenge-304/jo-37/blog.txt b/challenge-304/jo-37/blog.txt
new file mode 100644
index 0000000000..e5a12cee7a
--- /dev/null
+++ b/challenge-304/jo-37/blog.txt
@@ -0,0 +1 @@
+https://github.sommrey.de/the-bears-den/2025/01/17/ch-304.html
diff --git a/challenge-304/jo-37/perl/ch-1.pl b/challenge-304/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..3bf19f1292
--- /dev/null
+++ b/challenge-304/jo-37/perl/ch-1.pl
@@ -0,0 +1,112 @@
+#!/usr/bin/perl
+
+use v5.26;
+use Test2::V0;
+use Test2::Tools::Subtest 'subtest_streamed';
+use Getopt::Long;
+use experimental 'signatures';
+
+
+### Options and Arguments
+
+my ($tests, $examples, $n);
+GetOptions(
+    'examples!' => \$examples,
+    'tests!'    => \$tests,
+    'replace=i' => \$n,
+) or usage();
+
+run_tests($examples, $tests);	# tests do not return
+
+usage() unless $n && @ARGV;
+
+sub usage {
+    die <<~EOS;
+    $0 - Arrange Binary
+
+    usage: $0 [-examples] [-tests] [-replace=N B...]
+
+    -help
+        print this help text
+
+    -examples
+        run the examples from the challenge
+     
+    -tests
+        run some tests
+
+    -replace=N
+        try to replace N zeroes by ones
+
+    B...
+        list of binary digits
+
+    EOS
+}
+
+
+### Input and Output
+
+say +(qw(false true))[arrange_binary($n, @ARGV)];
+
+
+### Implementation
+#
+# For details see:
+# https://github.sommrey.de/the-bears-den/2025/01/17/ch-304.html#task-1
+
+sub arrange_binary ($n, @bin) {
+    for (join '', @bin) {
+        return 0 if /11/;
+        return $n <= (() = /(?:^|0)0(?!1)/g);
+    }
+}
+
+
+### Examples and Tests
+
+sub run_tests ($examples, $tests) {
+    return unless $examples || $tests;
+
+    state sub call_impl ($name, $args, $expected) {
+        my $result = arrange_binary @$args;
+        my $n = shift @$args;
+        like $result, $expected,
+            "$name: n=$n, (@$args) -> " . $expected->name;
+    }
+
+    state sub chk_limit ($n, @bin) {
+        plan 2;
+
+        ok  arrange_binary($n, @bin), "can $n";
+        $n++;
+        ok !arrange_binary($n, @bin), "not $n"; 
+    }
+
+    plan 2;
+
+    $examples ? subtest_streamed(examples => sub {
+        my @examples = (
+            ['example 1', [1 ,=> 1, 0, 0, 0, 1], T()],
+            ['example 2', [2 ,=> 1, 0, 0, 0, 1], F()],
+        );
+        plan scalar @examples;
+        for (@examples) {
+            call_impl @$_;
+        }
+    }) : pass 'skip examples';
+
+    $tests ? subtest_streamed(tests => sub {
+        plan 7;
+
+        ok !arrange_binary(1 ,=> 1, 1, 0, 0), 'double one';
+        subtest 'at begin',    \&chk_limit, 2 ,=> 0, 0, 1, 0, 0, 0, 1;
+        subtest 'at end',      \&chk_limit, 2 ,=> 1, 0, 0, 0, 1, 0, 0;
+        subtest 'even',        \&chk_limit, 1 ,=> 1, 0, 0, 0, 1, 0, 0, 1;
+        subtest 'four zeros',  \&chk_limit, 1 ,=> 1, 0, 0, 0, 0, 1;
+        subtest 'five zeros',  \&chk_limit, 2 ,=> 1, 0, 0, 0, 0, 0, 1;
+        subtest 'single zero', \&chk_limit, 1 ,=> 0;
+    }) : pass 'skip tests';
+
+    exit;
+}
diff --git a/challenge-304/jo-37/perl/ch-2.pl b/challenge-304/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..d9cebf980d
--- /dev/null
+++ b/challenge-304/jo-37/perl/ch-2.pl
@@ -0,0 +1,95 @@
+#!/usr/bin/perl
+
+use v5.32;
+use Test2::V0 '!float', float => {-as => 'float2'};
+use Test2::Tools::Subtest 'subtest_streamed';
+use Getopt::Long;
+use PDL;
+use experimental 'signatures';
+
+
+### Options and Arguments
+
+my ($tests, $examples);
+my $length = 0;
+GetOptions(
+    'examples!' => \$examples,
+    'tests!'    => \$tests,
+    'length=i'  => \$length,
+) or usage();
+
+run_tests($examples, $tests);	# tests do not return
+
+usage() unless 0 < $length <= @ARGV;
+
+sub usage {
+    die <<~EOS;
+    $0 - Maximum Average
+
+    usage: $0 [-examples] [-tests] [-length=L N...]
+
+    -examples
+        run the examples from the challenge
+     
+    -tests
+        run some tests
+
+    -length=L
+        subarray length
+        
+    N...
+        list of numbers
+
+    EOS
+}
+
+
+### Input and Output
+
+say max_avg($length, @ARGV);
+
+
+### Implementation
+#
+# For details see:
+# https://github.sommrey.de/the-bears-den/2025/01/17/ch-304.html#task-2
+
+sub max_avg ($n, @ints) {
+    pdl(\@ints)->lags(0, 1, $n)->xchg(0, 1)->average->max->sclr;
+}
+
+
+### Examples and Tests
+
+sub run_tests ($examples, $tests) {
+    return unless $examples || $tests;
+
+    state sub call_impl ($name, $args, $expected) {
+        my $result = max_avg @$args;
+        my $l = shift @$args;
+        like $result, $expected,
+            "$name: l=$l, (@$args) -> " . $expected->name;
+    }
+
+    plan 2;
+
+    $examples ? subtest_streamed(examples => sub {
+        my @examples = (
+            ['example 1', [4 ,=> 1, 12, -5, -6, 50, 3], float2(12.75)],
+            ['example 2', [1 ,=> 5], number(5)],
+        );
+        plan scalar @examples;
+        for (@examples) {
+            call_impl @$_;
+        }
+    }) : pass 'skip examples';
+
+    $tests ? subtest_streamed(tests => sub {
+        plan 2;
+
+        is max_avg(2 ,=> 2, 2, 1), 2, 'first subarray';
+        is max_avg(2 ,=> 1, 2, 2), 2, 'last subarray';
+    }) : pass 'skip tests';
+
+    exit;
+}