Solutions to challenges 339, 340, 341, 342 and 343

15 files changed, 1038 insertions, 0 deletions

diff --git a/challenge-339/jo-37/blog.txt b/challenge-339/jo-37/blog.txt
new file mode 100644
index 0000000000..08bdabe60c
--- /dev/null
+++ b/challenge-339/jo-37/blog.txt
@@ -0,0 +1 @@
+https://github.sommrey.de/the-bears-den/2025/10/17/ch-339.html
diff --git a/challenge-339/jo-37/perl/ch-1.pl b/challenge-339/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..5317ab772a
--- /dev/null
+++ b/challenge-339/jo-37/perl/ch-1.pl
@@ -0,0 +1,155 @@
+#!/usr/bin/perl
+
+use v5.26;
+use Test2::V0 qw(!float -no_srand);
+use Test2::Tools::Subtest 'subtest_streamed';
+use Getopt::Long;
+use experimental 'signatures';
+
+use PDL;
+use PDL::NiceSlice;
+
+### Options and Arguments
+
+my ($tests, $examples, $verbose);
+GetOptions(
+    'examples!' => \$examples,
+    'tests!'    => \$tests,
+    'verbose!'  => \$verbose,
+) or usage();
+
+run_tests($examples, $tests);	# tests do not return
+
+usage() unless @ARGV > 3;
+
+sub usage {
+    die <<~EOS;
+    $0 - max diff
+
+    usage: $0 [-examples] [-tests] [--] [N...]
+
+    -examples
+        run the examples from the challenge
+     
+    -tests
+        run some tests
+
+    N...
+        list of at least four numbers
+
+    EOS
+}
+
+
+### Input and Output
+
+say max_diff(@ARGV);
+
+
+### Implementation
+#
+# For details see:
+# https://github.sommrey.de/the-bears-den/2025/10/17/ch-339.html#task-1
+
+sub max_diff (@n) {
+    my $n = long @n;
+    $n->badflag(1);
+    my $pd = null;
+    for my $subs ([\&find_max, \&find_min, 1], [\&find_min, \&find_max, -1]) {
+        my $nc = $n->copy;
+        my $m1 = &{$subs->[0]}($nc);
+        my $m2 = &{$subs->[1]}($nc->where($nc->isgood));
+        $pd = $pd->append($subs->[2] * ($m1 - $m2));
+    }
+
+    max $pd;
+}
+
+sub remove_prod ($l) {
+    my $prod = $l->prod;
+    $l .= $l->badvalue;
+
+    $prod;
+}
+
+sub find_max ($n) {
+    goto &remove_prod if $n->nelem == 2;
+
+    my ($pos, $neg) = which_both $n >= 0;
+    my $max_ind = null;
+    if ($pos->nelem >= 2) {
+        $max_ind = $max_ind->glue(1, maximum_n_ind($n, 2));
+    }
+    if ($neg->nelem >= 2) {
+        $max_ind = $max_ind->glue(1, minimum_n_ind($n, 2));
+    }
+    my $max = $n->index1d($max_ind)->prodover->maximum_ind;
+
+    remove_prod($n($max_ind(,($max))));
+}
+
+sub find_min ($n) {
+    goto &remove_prod if $n->nelem == 2;
+
+    my ($pos, $neg) = which_both $n >= 0;
+    if (!$neg->isempty && !$pos->isempty) {
+        return remove_prod($n(cat(($n->minmaximum)[2, 3])));
+    } elsif ($pos->isempty) {
+        return remove_prod($n(maximum_n_ind($n, 2)));
+    } else {
+        return remove_prod($n(minimum_n_ind($n, 2)));
+    }
+}
+
+
+### Examples and Tests
+
+sub run_tests ($examples, $tests) {
+    return unless $examples || $tests;
+
+    state sub run_example ($args, $expected, $name) {
+        my $result = max_diff(@$args);
+        is $result, $expected,
+            "$name: (@$args) -> $expected";
+    }
+
+    plan 2;
+
+    $examples ? subtest_streamed(examples => sub {
+        my @examples = (
+            [[5, 9, 3, 4, 6], 42, 'example 1'],
+            [[1, -2, 3, -4], 10, 'example 2'],
+            [[-3, -1, -2, -4], 10, 'example 3'],
+            [[10, 2, 0, 5, 1], 50, 'example 4'],
+            [[7, 8, 9, 10, 10], 44, 'example 5'],
+        );
+        plan scalar @examples;
+        for (@examples) {
+            run_example @$_;
+        }
+    }) : pass 'skip examples';
+
+    $tests ? subtest_streamed(tests => sub {
+        my @tests = (
+            [[4, 3, 2, 1, -6, -7], 40, 'first example from blog'],
+            [[5, 3, 2, 1, -6, -7], 41, 'second example from blog'],
+            [[3, 2, 1, -5, -6], 28, 'max max, pos min'],
+            [[3, 2, -1, -5, -6], 33, 'max max, neg min'],
+            [[5, 2, 1, -4, -6], 32, 'min min, pos max'],
+            [[5, 2, -1, -6], 28, 'min min, neg max'],
+            [[5, 3, 2, 1, -6], 36, 'min min, pos max'],
+            [[3, 3, 1, -4, -5], 18, 'min min, pos max, two neg'],
+            [[1, 2, 3, 4], 10, 'all pos'],
+            [[-1, 2, 3, 4], 14, 'one neg'],
+            [[-1, -2, 3, 4], 10, 'two neg'],
+            [[-1, -2, -3, 4], 14, 'three neg'],
+            [[-1, -2, -3, -4], 10, 'all neg'],
+        );
+        plan scalar @tests;
+        for (@tests) {
+            run_example @$_;
+        }
+    }) : pass 'skip tests';
+
+    exit;
+}
diff --git a/challenge-339/jo-37/perl/ch-2.pl b/challenge-339/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..6f8658c2c1
--- /dev/null
+++ b/challenge-339/jo-37/perl/ch-2.pl
@@ -0,0 +1,92 @@
+#!/usr/bin/perl
+
+use v5.26;
+use Test2::V0 qw(!float -no_srand);
+use Test2::Tools::Subtest 'subtest_streamed';
+use Getopt::Long;
+use experimental 'signatures';
+
+use PDL;
+
+### Options and Arguments
+
+my ($tests, $examples, $verbose);
+GetOptions(
+    'examples!' => \$examples,
+    'tests!'    => \$tests,
+    'verbose!'  => \$verbose,
+) or usage();
+
+run_tests($examples, $tests);	# tests do not return
+
+usage() unless @ARGV;
+
+sub usage {
+    die <<~EOS;
+    $0 - peak point
+
+    usage: $0 [-examples] [-tests] [--] [N...]
+
+    -examples
+        run the examples from the challenge
+     
+    -tests
+        run some tests
+
+    N...
+        list of numbers
+
+    EOS
+}
+
+
+### Input and Output
+
+say peak_point(@ARGV);
+
+
+### Implementation
+#
+# For details see:
+# https://github.sommrey.de/the-bears-den/2025/10/17/ch-339.html#task-2
+
+
+sub peak_point {
+    max cumusumover pdl 0, @_;
+}
+
+
+### Examples and Tests
+
+sub run_tests ($examples, $tests) {
+    return unless $examples || $tests;
+
+    state sub run_example ($args, $expected, $name) {
+        my $result = peak_point(@$args);
+        is $result, $expected,
+            "$name: (@$args) -> $expected";
+    }
+
+    plan 2;
+
+    $examples ? subtest_streamed(examples => sub {
+        my @examples = (
+            [[-5, 1, 5, -9, 2], 1, 'example 1'],
+            [[10, 10, 10, -25], 30, 'example 2'],
+            [[3, -4, 2, 5, -6, 1], 6, 'example 3'],
+            [[-1, -2, -3, -4], 0, 'example 4'],
+            [[-10, 15, 5], 10, 'example 5'],
+        );
+        plan scalar @examples;
+        for (@examples) {
+            run_example @$_;
+        }
+    }) : pass 'skip examples';
+
+    $tests ? subtest_streamed(tests => sub {
+        plan 1;
+        pass 'no tests';
+    }) : pass 'skip tests';
+
+    exit;
+}
diff --git a/challenge-340/jo-37/blog.txt b/challenge-340/jo-37/blog.txt
new file mode 100644
index 0000000000..ff6e439441
--- /dev/null
+++ b/challenge-340/jo-37/blog.txt
@@ -0,0 +1 @@
+https://github.sommrey.de/the-bears-den/2025/10/17/ch-340.html
diff --git a/challenge-340/jo-37/perl/ch-1.pl b/challenge-340/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..a310bf6284
--- /dev/null
+++ b/challenge-340/jo-37/perl/ch-1.pl
@@ -0,0 +1,92 @@
+#!/usr/bin/perl
+
+use v5.26;
+use Test2::V0 -no_srand;
+use Test2::Tools::Subtest 'subtest_streamed';
+use Getopt::Long;
+use experimental 'signatures';
+
+
+### Options and Arguments
+
+my ($tests, $examples, $verbose);
+GetOptions(
+    'examples!' => \$examples,
+    'tests!'    => \$tests,
+    'verbose!'  => \$verbose,
+) or usage();
+
+run_tests($examples, $tests);	# tests do not return
+
+usage() unless @ARGV;
+
+sub usage {
+    die <<~EOS;
+    $0 - duplicate removals
+
+    usage: $0 [-examples] [-tests] [STR]
+
+    -examples
+        run the examples from the challenge
+     
+    -tests
+        run some tests
+
+    STR
+        a string
+
+    EOS
+}
+
+
+### Input and Output
+
+say duplicate_removals(shift);
+
+
+### Implementation
+#
+# For details see:
+# https://github.sommrey.de/the-bears-den/2025/10/17/ch-340.html#task-1
+
+
+sub duplicate_removals ($str) {
+    1 while $str =~ s/(.)\1//;
+    $str;
+}
+
+
+### Examples and Tests
+
+sub run_tests ($examples, $tests) {
+    return unless $examples || $tests;
+
+    state sub run_example ($args, $expected, $name) {
+        my $result = duplicate_removals(@$args);
+        is $result, $expected,
+            "$name: (@$args) -> $expected";
+    }
+
+    plan 2;
+
+    $examples ? subtest_streamed(examples => sub {
+        my @examples = (
+            [['abbaca'], 'ca', 'example 1'],
+            [['azxxzy'], 'ay', 'example 2'],
+            [['aaaaaaaa'], '', 'example 3'],
+            [['aabccba'], 'a', 'example 4'],
+            [['abcddcba'], '', 'example 5'],
+        );
+        plan scalar @examples;
+        for (@examples) {
+            run_example @$_;
+        }
+    }) : pass 'skip examples';
+
+    $tests ? subtest_streamed(tests => sub {
+        plan 1;
+        pass 'no tests';
+    }) : pass 'skip tests';
+
+    exit;
+}
diff --git a/challenge-340/jo-37/perl/ch-2.pl b/challenge-340/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..9977e5ad76
--- /dev/null
+++ b/challenge-340/jo-37/perl/ch-2.pl
@@ -0,0 +1,97 @@
+#!/usr/bin/perl
+
+use v5.26;
+use Test2::V0 -no_srand;
+use Test2::Tools::Subtest 'subtest_streamed';
+use Getopt::Long;
+use experimental 'signatures';
+
+use List::MoreUtils qw(all slideatatime);
+
+
+### Options and Arguments
+
+my ($tests, $examples, $verbose);
+GetOptions(
+    'examples!' => \$examples,
+    'tests!'    => \$tests,
+    'verbose!'  => \$verbose,
+) or usage();
+
+run_tests($examples, $tests);	# tests do not return
+
+usage() unless @ARGV;
+
+sub usage {
+    die <<~EOS;
+    $0 - ascending numbers
+
+    usage: $0 [-examples] [-tests] [STR]
+
+    -examples
+        run the examples from the challenge
+     
+    -tests
+        run some tests
+
+    STR
+        a string or a list of words
+
+    EOS
+}
+
+
+### Input and Output
+
+say +(qw(true false))[!ascending_numbers("@ARGV")];
+
+
+### Implementation
+#
+# For details see:
+# https://github.sommrey.de/the-bears-den/2025/10/17/ch-340.html#task-2
+
+
+sub ascending_numbers ($str) {
+    my $it = slideatatime 1, 2, grep /^\d+$/, split /\s+/, $str;
+    while (my @pair = $it->()) {
+        return if @pair > 1 && $pair[1] <= $pair[0];
+    }
+    1;
+}
+
+
+### Examples and Tests
+
+sub run_tests ($examples, $tests) {
+    return unless $examples || $tests;
+
+    state sub run_example ($args, $expected, $name) {
+        my $result = ascending_numbers(@$args);
+        is $result, $expected,
+            "$name: (@$args) -> " . $expected->name;
+    }
+
+    plan 2;
+
+    $examples ? subtest_streamed(examples => sub {
+        my @examples = (
+            [["The cat has 3 kittens 7 toys 10 beds"], T(), 'example 1'],
+            [["Alice bought 5 apples 2 oranges 9 bananas"], F(), 'example 2'],
+            [["I ran 1 mile 2 days 3 weeks 4 months"], T(), 'example 3'],
+            [["Bob has 10 cars 10 bikes"], F(), 'example 4'],
+            [["Zero is 0 one is 1 two is 2"], T(), 'example 5'],
+        );
+        plan scalar @examples;
+        for (@examples) {
+            run_example @$_;
+        }
+    }) : pass 'skip examples';
+
+    $tests ? subtest_streamed(tests => sub {
+        plan 1;
+        pass 'no tests';
+    }) : pass 'skip tests';
+
+    exit;
+}
diff --git a/challenge-341/jo-37/blog.txt b/challenge-341/jo-37/blog.txt
new file mode 100644
index 0000000000..ed16b61bf2
--- /dev/null
+++ b/challenge-341/jo-37/blog.txt
@@ -0,0 +1 @@
+https://github.sommrey.de/the-bears-den/2025/10/17/ch-341.html
diff --git a/challenge-341/jo-37/perl/ch-1.pl b/challenge-341/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..466153ce1f
--- /dev/null
+++ b/challenge-341/jo-37/perl/ch-1.pl
@@ -0,0 +1,97 @@
+#!/usr/bin/perl
+
+use v5.26;
+use Test2::V0 -no_srand;
+use Test2::Tools::Subtest 'subtest_streamed';
+use Getopt::Long;
+use experimental 'signatures';
+
+
+### Options and Arguments
+
+my ($tests, $examples, $verbose, $broken);
+GetOptions(
+    'examples!' => \$examples,
+    'tests!'    => \$tests,
+    'verbose!'  => \$verbose,
+    'broken=s'  => \$broken,
+) or usage();
+
+$broken //= '';
+
+run_tests($examples, $tests);	# tests do not return
+
+usage() unless @ARGV;
+
+sub usage {
+    die <<~EOS;
+    $0 - broken keys
+
+    usage: $0 [-examples] [-tests] [-verbose] [--] [-broken BROKEN] [STR]
+
+    -examples
+        run the examples from the challenge
+     
+    -tests
+        run some tests
+
+    -broken BROKEN
+        string containing the broken keys
+
+    STR
+        string or list of words
+
+    EOS
+}
+
+
+### Input and Output
+
+say scalar broken_keys([split //, $broken], "@ARGV");
+
+
+### Implementation
+#
+# For details see:
+# https://github.sommrey.de/the-bears-den/2025/10/17/ch-341.html#task-1
+
+sub broken_keys {
+    my $typeable = qr{^[^\s@{+shift}]+$}ixx;
+
+    grep /$typeable/, split /\s+/, shift;
+}
+
+### Examples and Tests
+
+sub run_tests ($examples, $tests) {
+    return unless $examples || $tests;
+
+    state sub run_example ($args, $expected, $name) {
+        my $result = broken_keys(@$args);
+        is $result, $expected,
+            "$name: (($args->[0]->@*), '$args->[1]') -> $expected";
+    }
+
+    plan 2;
+
+    $examples ? subtest_streamed(examples => sub {
+        my @examples = (
+            [[[qw(d)], 'Hello World'], 1, 'example 1'],
+            [[[qw(a e)], 'apple banana cherry'], 0, 'example 2'],
+            [[[], 'coding is fun'], 3, 'example 3'],
+            [[[qw(a b)], 'The weekly challenge'], 2, 'example 4'],
+            [[[qw(p)], 'Perl and Python'], 1, 'example 5'],
+        );
+        plan scalar @examples;
+        for (@examples) {
+            run_example @$_;
+        }
+    }) : pass 'skip examples';
+
+    $tests ? subtest_streamed(tests => sub {
+        plan 1;
+        pass 'no tests';
+    }) : pass 'skip tests';
+
+    exit;
+}
diff --git a/challenge-341/jo-37/perl/ch-2.pl b/challenge-341/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..1c9dfee91e
--- /dev/null
+++ b/challenge-341/jo-37/perl/ch-2.pl
@@ -0,0 +1,103 @@
+#!/usr/bin/perl
+
+use v5.26;
+use Test2::V0 -no_srand;
+use Test2::Tools::Subtest 'subtest_streamed';
+use Getopt::Long;
+use experimental 'signatures';
+
+
+### Options and Arguments
+
+my ($tests, $examples, $verbose, $chr);
+GetOptions(
+    'examples!' => \$examples,
+    'tests!'    => \$tests,
+    'verbose!'  => \$verbose,
+    'chr=s'    => \$chr,
+) or usage();
+
+$chr //= '';
+
+run_tests($examples, $tests);	# tests do not return
+
+usage() unless @ARGV == 1;
+
+sub usage {
+    die <<~EOS;
+    $0 - Task Title
+
+    usage: $0 [-examples] [-tests]  [-chr C STR]
+
+    -examples
+        run the examples from the challenge
+     
+    -tests
+        run some tests
+
+    -char C
+        a character
+
+    STR
+        a string
+
+    EOS
+}
+
+
+### Input and Output
+
+say reverse_prefix($chr, shift);
+
+
+### Implementation
+#
+# For details see:
+# https://github.sommrey.de/the-bears-den/2025/10/17/ch-341.html#task-2
+
+sub reverse_prefix ($chr, $str) {
+    $str =~ s/.*?$chr/reverse $&/er;
+}
+
+
+### Examples and Tests
+
+sub run_tests ($examples, $tests) {
+    return unless $examples || $tests;
+
+    state sub run_example ($args, $expected, $name) {
+        my $result = reverse_prefix(@$args);
+        is $result, $expected,
+            "$name: (@$args) -> $expected";
+    }
+
+    plan 2;
+
+    $examples ? subtest_streamed(examples => sub {
+        my @examples = (
+            [[qw(g programming)], 'gorpramming', 'example 1'],
+            [[qw(h hello)], 'hello', 'example 2'],
+            [[qw(h abcdefghij)], 'hgfedcbaij', 'example 3'],
+            [[qw(s reverse)], 'srevere', 'example 4'],
+            [[qw(r perl)], 'repl', 'example 5'],
+        );
+        plan scalar @examples;
+        for (@examples) {
+            run_example @$_;
+        }
+    }) : pass 'skip examples';
+
+    $tests ? subtest_streamed(tests => sub {
+        my @tests = (
+            [[qw(d abc)], 'abc', 'not found'],
+            [[qw(de abcdefg)], 'edcbafg', 'search string'],
+            [['', 'abc'], 'abc', 'no char'],
+        );
+        plan scalar @tests;
+        for (@tests) {
+            run_example @$_;
+        }
+    }) : pass 'skip tests';
+
+    exit;
+}
diff --git a/challenge-342/jo-37/blog.txt b/challenge-342/jo-37/blog.txt
new file mode 100644
index 0000000000..aa64cc47b9
--- /dev/null
+++ b/challenge-342/jo-37/blog.txt
@@ -0,0 +1 @@
+https://github.sommrey.de/the-bears-den/2025/10/17/ch-342.html
diff --git a/challenge-342/jo-37/perl/ch-1.pl b/challenge-342/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..a9cb79ee9f
--- /dev/null
+++ b/challenge-342/jo-37/perl/ch-1.pl
@@ -0,0 +1,96 @@
+#!/usr/bin/perl
+
+use v5.26;
+use Test2::V0 -no_srand;
+use Test2::Tools::Subtest 'subtest_streamed';
+use Getopt::Long;
+use experimental 'signatures';
+
+use List::MoreUtils 'part';
+use List::Util 'mesh';
+
+### Options and Arguments
+
+my ($tests, $examples, $verbose);
+GetOptions(
+    'examples!' => \$examples,
+    'tests!'    => \$tests,
+    'verbose!'  => \$verbose,
+) or usage();
+
+run_tests($examples, $tests);	# tests do not return
+
+usage() unless @ARGV;
+
+sub usage {
+    die <<~EOS;
+    $0 - balance string
+
+    usage: $0 [-examples] [-tests] [STR]
+
+    -examples
+        run the examples from the challenge
+     
+    -tests
+        run some tests
+
+    STR
+        a string containing letters and digits only
+
+    EOS
+}
+
+
+### Input and Output
+
+say balance_string(shift);
+
+
+### Implementation
+#
+# For details see:
+# https://github.sommrey.de/the-bears-den/2025/10/17/ch-342.html#task-1
+
+
+sub balance_string ($str) {
+    my @parts = part {/\D/} sort split //, $str;
+    my $ld = $parts[1]->@* - $parts[0]->@*;
+    return '' if abs $ld > 1;
+    join '', (mesh $ld > 0 ? reverse @parts : @parts)[0 .. length($str) - 1];
+}
+
+
+### Examples and Tests
+
+sub run_tests ($examples, $tests) {
+    return unless $examples || $tests;
+
+    state sub run_example ($args, $expected, $name) {
+        my $result = balance_string(@$args);
+        is $result, $expected,
+            "$name: ('@$args') -> '$expected'";
+    }
+
+    plan 2;
+
+    $examples ? subtest_streamed(examples => sub {
+        my @examples = (
+            [['a0b1c2'], '0a1b2c', 'example 1'],
+            [['abc12'], 'a1b2c', 'example 2'],
+            [['0a2b1c3'], '0a1b2c3', 'example 3'],
+            [['1a23'], '', 'example 4'],
+            [['ab123'], '1a2b3', 'example 5'],
+        );
+        plan scalar @examples;
+        for (@examples) {
+            run_example @$_;
+        }
+    }) : pass 'skip examples';
+
+    $tests ? subtest_streamed(tests => sub {
+        plan 1;
+        pass 'no tests';
+    }) : pass 'skip tests';
+
+    exit;
+}
diff --git a/challenge-342/jo-37/perl/ch-2.pl b/challenge-342/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..1e795f027e
--- /dev/null
+++ b/challenge-342/jo-37/perl/ch-2.pl
@@ -0,0 +1,95 @@
+#!/usr/bin/perl
+
+use v5.26;
+use Test2::V0 qw(!float -no_srand);
+use Test2::Tools::Subtest 'subtest_streamed';
+use Getopt::Long;
+use experimental 'signatures';
+
+use PDL;
+use PDL::NiceSlice;
+
+
+### Options and Arguments
+
+my ($tests, $examples, $verbose);
+GetOptions(
+    'examples!' => \$examples,
+    'tests!'    => \$tests,
+    'verbose!'  => \$verbose,
+) or usage();
+
+run_tests($examples, $tests);	# tests do not return
+
+usage() unless @ARGV;
+
+sub usage {
+    die <<~EOS;
+    $0 - max score
+
+    usage: $0 [-examples] [-tests] [BIN]
+
+    -examples
+        run the examples from the challenge
+     
+    -tests
+        run some tests
+
+    BIN
+        binary number
+
+    EOS
+}
+
+
+### Input and Output
+
+say max_score(shift);
+
+
+### Implementation
+#
+# For details see:
+# https://github.sommrey.de/the-bears-den/2025/10/17/ch-342.html#task-2
+
+
+sub max_score {
+    my $bin = long split //, shift;
+    max +(1 - $bin)->(0:-2)->cumusumover + $bin(-1:1)->cumusumover->(-1:0);
+}
+
+
+### Examples and Tests
+
+sub run_tests ($examples, $tests) {
+    return unless $examples || $tests;
+
+    state sub run_example ($args, $expected, $name) {
+        my $result = max_score(@$args);
+        is $result, $expected,
+            "$name: ('@$args') -> $expected";
+    }
+
+    plan 2;
+
+    $examples ? subtest_streamed(examples => sub {
+        my @examples = (
+            [['0011'], 4, 'example 1'],
+            [['0000'], 3, 'example 2'],
+            [['1111'], 3, 'example 3'],
+            [['0101'], 3, 'example 4'],
+            [['011101'], 5, 'example 5'],
+        );
+        plan scalar @examples;
+        for (@examples) {
+            run_example @$_;
+        }
+    }) : pass 'skip examples';
+
+    $tests ? subtest_streamed(tests => sub {
+        plan 1;
+        pass 'no tests';
+    }) : pass 'skip tests';
+
+    exit;
+}
diff --git a/challenge-343/jo-37/blog.txt b/challenge-343/jo-37/blog.txt
new file mode 100644
index 0000000000..69e4d6c7e5
--- /dev/null
+++ b/challenge-343/jo-37/blog.txt
@@ -0,0 +1 @@
+https://github.sommrey.de/the-bears-den/2025/10/17/ch-343.html
diff --git a/challenge-343/jo-37/perl/ch-1.pl b/challenge-343/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..4b1da04a62
--- /dev/null
+++ b/challenge-343/jo-37/perl/ch-1.pl
@@ -0,0 +1,92 @@
+#!/usr/bin/perl
+
+use v5.26;
+use Test2::V0 -no_srand;
+use Test2::Tools::Subtest 'subtest_streamed';
+use Getopt::Long;
+use experimental 'signatures';
+
+use List::Util 'min';
+
+### Options and Arguments
+
+my ($tests, $examples, $verbose);
+GetOptions(
+    'examples!' => \$examples,
+    'tests!'    => \$tests,
+    'verbose!'  => \$verbose,
+) or usage();
+
+run_tests($examples, $tests);	# tests do not return
+
+usage() unless @ARGV;
+
+sub usage {
+    die <<~EOS;
+    $0 - zero friend
+
+    usage: $0 [-examples] [-tests] [-verbose] [--] [N...]
+
+    -examples
+        run the examples from the challenge
+     
+    -tests
+        run some tests
+
+    N...
+        list of numbers
+
+    EOS
+}
+
+
+### Input and Output
+
+say zero_friend(@ARGV);
+
+
+### Implementation
+#
+# For details see:
+# https://github.sommrey.de/the-bears-den/2025/10/17/ch-343.html#task-1
+
+
+sub zero_friend {
+    min map abs, @_;
+}
+
+
+### Examples and Tests
+
+sub run_tests ($examples, $tests) {
+    return unless $examples || $tests;
+
+    state sub run_example ($args, $expected, $name) {
+        my $result = zero_friend(@$args);
+        is $result, $expected,
+            "$name: (@$args) -> $expected";
+    }
+
+    plan 2;
+
+    $examples ? subtest_streamed(examples => sub {
+        my @examples = (
+            [[4, 2, -1, 3, -2], 1, 'example 1'],
+            [[-5, 5, -3, 3, -1, 1], 1, 'example 2'],
+            [[7, -3, 0, 2, -8], 0, 'example 3'],
+            [[-2, -5, -1, -8], 1, 'example 4'],
+            [[-2, 2, -4, 4, -1, 1], 1, 'example 5'],
+        );
+        plan scalar @examples;
+        for (@examples) {
+            run_example @$_;
+        }
+    }) : pass 'skip examples';
+
+    $tests ? subtest_streamed(tests => sub {
+        plan 1;
+        pass 'no tests';
+    }) : pass 'skip tests';
+
+    exit;
+}
diff --git a/challenge-343/jo-37/perl/ch-2.pl b/challenge-343/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..a5d9e1464b
--- /dev/null
+++ b/challenge-343/jo-37/perl/ch-2.pl
@@ -0,0 +1,114 @@
+#!/usr/bin/perl
+
+use v5.26;
+use Test2::V0 -no_srand;
+use Test2::Tools::Subtest 'subtest_streamed';
+use Getopt::Long;
+use experimental 'signatures';
+
+use List::Util 'sum';
+
+### Options and Arguments
+
+my ($tests, $examples, $verbose);
+GetOptions(
+    'examples!' => \$examples,
+    'tests!'    => \$tests,
+    'verbose!'  => \$verbose,
+) or usage();
+
+run_tests($examples, $tests);	# tests do not return
+
+usage() unless @ARGV;
+
+sub usage {
+    die <<~EOS;
+    $0 - champion team
+
+    usage: $0 [-examples] [-tests] [GRID]
+
+    -examples
+        run the examples from the challenge
+     
+    -tests
+        run some tests
+
+    GRID
+        matrix representing the results of all team pairings
+        in the form R00,R01,R02,... R10,R11,R12,... ...
+    EOS
+}
+
+
+### Input and Output
+
+say champion_team(map [split ',', $_], @ARGV);
+
+
+### Implementation
+#
+# For details see:
+# https://github.sommrey.de/the-bears-den/2025/10/17/ch-343.html#task-2
+
+sub champion_team {
+    my @wins = map {sum @$_} @_;
+    (sort {$wins[$a] <=> $wins[$b] || 2 * $_[$a][$b] - 1} 0 .. $#_)[-1];
+}
+
+
+### Examples and Tests
+
+sub run_tests ($examples, $tests) {
+    return unless $examples || $tests;
+
+    state sub run_example ($args, $expected, $name) {
+        my $result = champion_team(@$args);
+        is $result, $expected,
+            "$name: (@{[map qq{[@$_]}, @$args]}) -> $expected";
+    }
+
+    plan 2;
+
+    $examples ? subtest_streamed(examples => sub {
+        my @examples = (
+            [[[0, 1, 1],
+              [0, 0, 1],
+              [0, 0, 0]], 0, 'example 1'],
+            [[[0, 1, 0, 0],
+              [0, 0, 0, 0],
+              [1, 1, 0, 0],
+              [1, 1, 1, 0]], 3, 'example 2'],
+            [[[0, 1, 0, 1],
+              [0, 0, 1, 1],
+              [1, 0, 0, 0],
+              [0, 0, 1, 0]], 0, 'example 3'],
+            [[[0, 1, 1],
+              [0, 0, 0],
+              [0, 1, 0]], 0, 'example 4'],
+            [[[0, 0, 0, 0, 0],
+              [1, 0, 0, 0, 0],
+              [1, 1, 0, 1, 1],
+              [1, 1, 0, 0, 0],
+              [1, 1, 0, 1, 0]], 2, 'example 5'],
+        );
+        plan scalar @examples;
+        for (@examples) {
+            run_example @$_;
+        }
+    }) : pass 'skip examples';
+
+    $tests ? subtest_streamed(tests => sub {
+        my @tests = (
+            [[[0, 1, 1, 0],
+              [0, 0, 1, 0],
+              [0, 0, 0, 0],
+              [1, 0, 0, 0]], 0, '3 beats 0'],
+        );
+        plan scalar @tests;
+        for (@tests) {
+            run_example @$_;
+        }
+    }) : pass 'skip tests';
+