diff options
| -rw-r--r-- | challenge-304/jo-37/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-304/jo-37/perl/ch-1.pl | 112 | ||||
| -rwxr-xr-x | challenge-304/jo-37/perl/ch-2.pl | 95 |
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; +} |