aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMohammad Sajid Anwar <Mohammad.Anwar@yahoo.com>2025-06-13 10:10:19 +0100
committerGitHub <noreply@github.com>2025-06-13 10:10:19 +0100
commit9a865665023c78a45bb1029af514b81af80650d0 (patch)
treeeb40ad2c156392dc6db76f2b948be691b0e0f30f
parent0064d5a8880a28d302733e673f3155042e1424a0 (diff)
parentc73e7c45bf367f95df00383fdca58345eddb3fc1 (diff)
downloadperlweeklychallenge-club-9a865665023c78a45bb1029af514b81af80650d0.tar.gz
perlweeklychallenge-club-9a865665023c78a45bb1029af514b81af80650d0.tar.bz2
perlweeklychallenge-club-9a865665023c78a45bb1029af514b81af80650d0.zip
Merge pull request #12173 from jo-37/contrib
Solutions to challenge 325
-rw-r--r--challenge-325/jo-37/blog.txt1
-rwxr-xr-xchallenge-325/jo-37/perl/ch-1.pl91
-rwxr-xr-xchallenge-325/jo-37/perl/ch-2.pl94
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;
+}