Solutions to challenge 267

3 files changed, 158 insertions, 0 deletions

diff --git a/challenge-267/jo-37/blog.txt b/challenge-267/jo-37/blog.txt
new file mode 100644
index 0000000000..698c1a51a3
--- /dev/null
+++ b/challenge-267/jo-37/blog.txt
@@ -0,0 +1 @@
+https://github.sommrey.de/the-bears-den/2024/05/03/ch-267.html
diff --git a/challenge-267/jo-37/perl/ch-1.pl b/challenge-267/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..2924a900ca
--- /dev/null
+++ b/challenge-267/jo-37/perl/ch-1.pl
@@ -0,0 +1,65 @@
+#!/usr/bin/perl -s
+
+use v5.24;
+use Test2::V0;
+use List::Util 'reduce';
+
+
+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 numbers
+
+EOS
+
+
+### Input and Output
+
+say product_sign(@ARGV);
+
+
+### Implementation
+#
+# For details see:
+# https://github.sommrey.de/the-bears-den/2024/05/03/ch-267.html#task-1
+
+
+sub product_sign {
+    eval {reduce {($b || die) < 0 ? -$a : $a} 1, @_} // 0;
+}
+
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        is product_sign(-1, -2, -3, -4, 3, 2, 1),  1, 'example 1';
+        is product_sign(1, 2, 0, -2, -1),          0, 'example 2';
+        is product_sign(-1, -1, 1, -1, 2),        -1, 'example 3';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+
+        is product_sign( 10, (-10) x (1e6 - 1)), -1, 'large negative product';
+        is product_sign(  0, (-10) x (1e6 - 1)),  0, 'zero product';
+        is product_sign(-10, (-10) x (1e6 - 1)),  1, 'large positive product';
+
+	}
+
+    done_testing;
+    exit;
+}
diff --git a/challenge-267/jo-37/perl/ch-2.pl b/challenge-267/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..658892f971
--- /dev/null
+++ b/challenge-267/jo-37/perl/ch-2.pl
@@ -0,0 +1,92 @@
+#!/usr/bin/perl -s
+
+use v5.24;
+use Test2::V0;
+use experimental 'signatures';
+
+our ($tests, $examples, $limit, $widths);
+$limit //= 100;
+my @widths = split /[,\s]\s*/, $widths;
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless @ARGV && @widths == 26;
+usage: $0 [-examples] [-tests] [-limit=L] [-widths=W1,...,W26] STR
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+-limit=L
+    maximum line length. Default: 100
+
+-widths=W1,...,W26
+    character widths
+
+STR
+    a string
+
+EOS
+
+
+### Input and Output
+
+printf "(%d, %d)\n", line_counts(shift, \@widths, $limit);
+
+
+
+### Implementation
+#
+# For details see:
+# https://github.sommrey.de/the-bears-den/2024/05/03/ch-267.html#task-2
+
+
+sub line_counts ($str, $widths, $limit) {
+	my ($lines, $width) = (0, 0);
+    state $letters;
+    $letters->@{'a' .. 'z'} = (0 .. 25) unless $letters;
+    for my $c ($str =~ /[a-z]/g) {
+        my $len = $widths->[$letters->{$c}];
+        if ($width + $len > $limit) {
+            $width = 0;
+        }
+        $lines++ unless $width;
+        $width += $len;
+    }
+
+    ($lines, $width);
+}
+
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        is [line_counts("abcdefghijklmnopqrstuvwxyz",
+                [10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,
+                    10,10,10,10,10,10,10,10], 100)], [3, 60], 'example 1';
+
+        is [line_counts("bbbcccdddaaa",
+                [4,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,
+                    10,10,10,10,10,10,10,10], 100)], [2, 4], 'example 2';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+
+        is [line_counts("a" x 10, [(10) x 26], 100)], [1, 100], 'full line';
+
+        is [line_counts(("b" x 10) . ("a" x 10), [0, (10) x 25], 100)],
+            [1, 100], 'zero length';
+
+        is [line_counts("", [(1) x 26], 100)],
+            [0, 0], 'empty string';
+	}
+
+    done_testing;
+    exit;
+}