diff options
| author | Jörg Sommrey <28217714+jo-37@users.noreply.github.com> | 2025-06-13 10:39:12 +0200 |
|---|---|---|
| committer | Jörg Sommrey <28217714+jo-37@users.noreply.github.com> | 2025-06-13 10:39:12 +0200 |
| commit | c73e7c45bf367f95df00383fdca58345eddb3fc1 (patch) | |
| tree | eb40ad2c156392dc6db76f2b948be691b0e0f30f | |
| parent | 0064d5a8880a28d302733e673f3155042e1424a0 (diff) | |
| parent | dc0943bbcca47b577f2f7174d94eefacd2de09a7 (diff) | |
| download | perlweeklychallenge-club-c73e7c45bf367f95df00383fdca58345eddb3fc1.tar.gz perlweeklychallenge-club-c73e7c45bf367f95df00383fdca58345eddb3fc1.tar.bz2 perlweeklychallenge-club-c73e7c45bf367f95df00383fdca58345eddb3fc1.zip | |
Solutions to challenge 325
| -rw-r--r-- | challenge-325/jo-37/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-325/jo-37/perl/ch-1.pl | 91 | ||||
| -rwxr-xr-x | challenge-325/jo-37/perl/ch-2.pl | 94 |
3 files changed, 186 insertions, 0 deletions
diff --git a/challenge-325/jo-37/blog.txt b/challenge-325/jo-37/blog.txt new file mode 100644 index 0000000000..be85ae0528 --- /dev/null +++ b/challenge-325/jo-37/blog.txt @@ -0,0 +1 @@ +https://github.sommrey.de/the-bears-den/2025/06/13/ch-325.html diff --git a/challenge-325/jo-37/perl/ch-1.pl b/challenge-325/jo-37/perl/ch-1.pl new file mode 100755 index 0000000000..e7dd4103fc --- /dev/null +++ b/challenge-325/jo-37/perl/ch-1.pl @@ -0,0 +1,91 @@ +#!/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 - maximum consecutive + + usage: $0 [-examples] [-tests] [N...] + + -examples + run the examples from the challenge + + -tests + run some tests + + N... + list of integers + + EOS +} + + +### Input and Output + +say max_consec(@ARGV); + + +### Implementation +# +# For details see: +# https://github.sommrey.de/the-bears-den/2025/06/13/ch-325.html#task-1 + + +sub max_consec { + my ($count, $val) = long(@_)->rle; + $count->where($val)->max->setbadtoval(0); +} + + +### Examples and Tests + +sub run_tests ($examples, $tests) { + return unless $examples || $tests; + + state sub run_example ($args, $expected, $name) { + my $result = max_consec(@$args); + is $result, $expected, + "$name: (@$args) -> $expected"; + } + + plan 2; + + $examples ? subtest_streamed(examples => sub { + my @examples = ( + [[0, 1, 1, 0, 1, 1, 1], 3, 'example 1'], + [[0, 0, 0, 0], 0, 'example 2'], + [[1, 0, 1, 0, 1, 1], 2, 'example 3'], + ); + plan scalar @examples; + for (@examples) { + run_example @$_; + } + }) : pass 'skip examples'; + + $tests ? subtest_streamed(tests => sub { + plan 1; + is max_consec(0, 0, 0, 0, 1, 2, 2, 3, 3, 3), 3, 'non-binary'; + }) : pass 'skip tests'; + + exit; +} diff --git a/challenge-325/jo-37/perl/ch-2.pl b/challenge-325/jo-37/perl/ch-2.pl new file mode 100755 index 0000000000..044374e96f --- /dev/null +++ b/challenge-325/jo-37/perl/ch-2.pl @@ -0,0 +1,94 @@ +#!/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 - final price + + 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 final_price(@ARGV); + + +### Implementation +# +# For details see: +# https://github.sommrey.de/the-bears-den/2025/06/13/ch-325.html#task-2 + + +sub final_price { + my $price = pdl @_; + $price - ( + (($price <= $price->dummy(0)) & + (sequence($price) > sequence($price)->dummy(0))) * $price + )->firstnonzeroover; +} + + +### Examples and Tests + +sub run_tests ($examples, $tests) { + return unless $examples || $tests; + + state sub run_example ($args, $expected, $name) { + my $result = final_price(@$args)->unpdl; + is $result, $expected, + "$name: (@$args) -> (@$expected)"; + } + + plan 2; + + $examples ? subtest_streamed(examples => sub { + my @examples = ( + [[8, 4, 6, 2, 3], [4, 2, 4, 2, 3], 'example 1'], + [[1, 2, 3, 4, 5], [1, 2, 3, 4, 5], 'example 2'], + [[7, 1, 1, 5], [6, 0, 1, 5], 'example 3'], + ); + plan scalar @examples; + for (@examples) { + run_example @$_; + } + }) : pass 'skip examples'; + + $tests ? subtest_streamed(tests => sub { + plan 1; + pass 'no tests'; + }) : pass 'skip tests'; + + exit; +} |
