diff options
| author | Jörg Sommrey <28217714+jo-37@users.noreply.github.com> | 2025-08-17 14:11:10 +0200 |
|---|---|---|
| committer | Jörg Sommrey <28217714+jo-37@users.noreply.github.com> | 2025-08-17 14:11:10 +0200 |
| commit | 600e44647c815d4da467e3749c9c3cdcc194b062 (patch) | |
| tree | 636a22552cd0d2f76eababc4dcdfa97bdf4f460b | |
| parent | 4b1a5957f2b4fc70a30c15297456f460d360c3d3 (diff) | |
| parent | 96b0d5c06ad47dd170f95dc10056e81bc30f960b (diff) | |
| download | perlweeklychallenge-club-600e44647c815d4da467e3749c9c3cdcc194b062.tar.gz perlweeklychallenge-club-600e44647c815d4da467e3749c9c3cdcc194b062.tar.bz2 perlweeklychallenge-club-600e44647c815d4da467e3749c9c3cdcc194b062.zip | |
Solutions to task 334
| -rw-r--r-- | challenge-334/jo-37/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-334/jo-37/perl/ch-1.pl | 111 | ||||
| -rwxr-xr-x | challenge-334/jo-37/perl/ch-2.pl | 109 |
3 files changed, 221 insertions, 0 deletions
diff --git a/challenge-334/jo-37/blog.txt b/challenge-334/jo-37/blog.txt new file mode 100644 index 0000000000..18ea53ff07 --- /dev/null +++ b/challenge-334/jo-37/blog.txt @@ -0,0 +1 @@ +https://github.sommrey.de/the-bears-den/2025/08/17/ch-334.html diff --git a/challenge-334/jo-37/perl/ch-1.pl b/challenge-334/jo-37/perl/ch-1.pl new file mode 100755 index 0000000000..5938e4345b --- /dev/null +++ b/challenge-334/jo-37/perl/ch-1.pl @@ -0,0 +1,111 @@ +#!/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, $from, $to); +GetOptions( + 'examples!' => \$examples, + 'tests!' => \$tests, + 'verbose!' => \$verbose, + 'from=i' => \$from, + 'to=i' => \$to, +) or usage(); + +run_tests($examples, $tests); # tests do not return + +usage() unless @ARGV && defined($from) && defined($to); + +sub usage { + die <<~EOS; + $0 - range sum + + usage: $0 [-examples] [-tests] [-from F -to T N...] + + -examples + run the examples from the challenge + + -tests + run some tests + + -from F + start index + + -to T + end index + + N... + list of numbers + + EOS +} + + +### Input and Output + +say range_sum($from, $to, @ARGV); + + +### Implementation +# +# For details see: +# https://github.sommrey.de/the-bears-den/2025/08/17/ch-334.html#task-1 + + +sub range_sum ($x, $y, @ints) { + pdl(@ints)->($x:$y)->sum; +} + + +### Examples and Tests + +sub run_tests ($examples, $tests) { + return unless $examples || $tests; + + state sub run_example ($args, $expected, $name) { + my $result = range_sum(@$args); + is $result, $expected, + "$name: ($args->@[2..$#$args]), x=$args->[0], y=$args->[1] -> $expected"; + } + + plan 2; + + $examples ? subtest_streamed(examples => sub { + my @examples = ( + [[(0, 2) ,=> (-2, 0, 3, -5, 2, -1)], 1, 'example 1'], + [[(1, 3) ,=> (1, -2, 3, -4, 5)], -3, 'example 2'], + [[(3, 4) ,=> (1, 0, 2, -1, 3)], 2, 'example 3'], + [[(0, 3) ,=> (-5, 4, -3, 2, -1, 0)], -2, 'example 4'], + [[(0, 2) ,=> (-1, 0, 2, -3, -2, 1)], 1, 'example 5'], + ); + plan scalar @examples; + for (@examples) { + run_example @$_; + } + }) : pass 'skip examples'; + + $tests ? subtest_streamed(tests => sub { + my @tests = ( + [[(1, 2) ,=> (1, 2, 4, 8, 16)], 6, 'std'], + [[(2, 1) ,=> (1, 2, 4, 8, 16)], 6, 'reverse'], + [[(1, -3) ,=> (1, 2, 4, 8, 16)], 6, 'y from end'], + [[(-4, 2) ,=> (1, 2, 4, 8, 16)], 6, 'x from end'], + [[(-4, -3) ,=> (1, 2, 4, 8, 16)], 6, 'both from end'], + [[(-3, -4) ,=> (1, 2, 4, 8, 16)], 6, 'both from end, reverse'], + ); + plan scalar @tests; + for (@tests) { + run_example @$_; + } + }) : pass 'skip tests'; + + exit; +} diff --git a/challenge-334/jo-37/perl/ch-2.pl b/challenge-334/jo-37/perl/ch-2.pl new file mode 100755 index 0000000000..51aa04f48b --- /dev/null +++ b/challenge-334/jo-37/perl/ch-2.pl @@ -0,0 +1,109 @@ +#!/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, $location); +GetOptions( + 'examples!' => \$examples, + 'tests!' => \$tests, + 'verbose!' => \$verbose, + 'location=s' => \$location, +) or usage(); + +run_tests($examples, $tests); # tests do not return + +usage() unless @ARGV && $location; + +sub usage { + die <<~EOS; + $0 - nearest valid point + + usage: $0 [-examples] [-tests] [-location [X, Y,...] [X1, Y1,...]...] + + -examples + run the examples from the challenge + + -tests + run some tests + + -location [X,Y] + current location, e.g. [3,4] or 3,4 + + [X1,Y1,...]... + list of points + e.g. [1,2] [3,1] [2,4] [2,3] or '1,2;3,1;2,4;2,3' + EOS +} + + +### Input and Output + +say nearest_valid_point($location, "@ARGV"); + + +### Implementation +# +# For details see: +# https://github.sommrey.de/the-bears-den/2025/08/17/ch-334.html#task-2 + + +sub nearest_valid_point ($x, @points) { + my $d = abs pdl(@points) - pdl($x); + (my $valid = which !$d->minover)->isempty && return -1; + $valid($d(,$valid)->sumover->minimum_ind)->sclr; +} + + +### Examples and Tests + +sub run_tests ($examples, $tests) { + return unless $examples || $tests; + + state sub run_example ($args, $expected, $name) { + my $result = nearest_valid_point(@$args); + is $result, $expected, + "$name: (@{[map qq([@$_]), @$args]}) -> $expected"; + } + + plan 2; + + $examples ? subtest_streamed(examples => sub { + my @examples = ( + [[[3, 4] ,=> ([1, 2], [3, 1], [2, 4], [2, 3])], 2, 'example 1'], + [[[2, 5] ,=> ([3, 4], [2, 3], [1, 5], [2, 5])], 3, 'example 2'], + [[[1, 1] ,=> ([2, 2], [3, 3], [4, 4])], -1, 'example 3'], + [[[0, 0] ,=> ([0, 1], [1, 0], [0, 2], [2, 0])], 0, 'example 4'], + [[[5, 5] ,=> ([5, 6], [6, 5], [5, 4], [4, 5])], 0, 'example 5'], + ); + plan scalar @examples; + for (@examples) { + run_example @$_; + } + }) : pass 'skip examples'; + + $tests ? subtest_streamed(tests => sub { + my @tests = ( + [[[1, 1, 1] ,=> ([0, 0, 0])], -1, 'no point in 3-d'], + [[[1, 1, 1] ,=> + ([0, 0, 0], + [0, 0, 1], [0, 1, 0], [1, 0, 0], + [1, 1, 0], [1, 0, 1], [0, 1, 1])], + 4, 'cube'], + ); + plan scalar @tests; + for (@tests) { + run_example @$_; + } + }) : pass 'skip tests'; + + exit; +} |
