diff options
| author | Jörg Sommrey <28217714+jo-37@users.noreply.github.com> | 2025-05-23 13:52:01 +0200 |
|---|---|---|
| committer | Jörg Sommrey <28217714+jo-37@users.noreply.github.com> | 2025-05-23 13:52:01 +0200 |
| commit | 402ea87398f285b9aa2c69f4efd49fe0e34fde8e (patch) | |
| tree | b865619353e718fe4b02b536ead1ae92283bcaff | |
| parent | d9a8a0d7aba084dc687dd97473f8739db9387b5c (diff) | |
| parent | 9e7903206ebf7297279d0a96b359b1e841ba78f6 (diff) | |
| download | perlweeklychallenge-club-402ea87398f285b9aa2c69f4efd49fe0e34fde8e.tar.gz perlweeklychallenge-club-402ea87398f285b9aa2c69f4efd49fe0e34fde8e.tar.bz2 perlweeklychallenge-club-402ea87398f285b9aa2c69f4efd49fe0e34fde8e.zip | |
Solutions to challenge 322
| -rw-r--r-- | challenge-322/jo-37/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-322/jo-37/perl/ch-1.pl | 101 | ||||
| -rwxr-xr-x | challenge-322/jo-37/perl/ch-2.pl | 95 |
3 files changed, 197 insertions, 0 deletions
diff --git a/challenge-322/jo-37/blog.txt b/challenge-322/jo-37/blog.txt new file mode 100644 index 0000000000..07f7b61918 --- /dev/null +++ b/challenge-322/jo-37/blog.txt @@ -0,0 +1 @@ +https://github.sommrey.de/the-bears-den/2025/05/23/ch-322.html diff --git a/challenge-322/jo-37/perl/ch-1.pl b/challenge-322/jo-37/perl/ch-1.pl new file mode 100755 index 0000000000..47d9e05c6e --- /dev/null +++ b/challenge-322/jo-37/perl/ch-1.pl @@ -0,0 +1,101 @@ +#!/usr/bin/perl + +use v5.26; +use Test2::V0 -no_srand; +use Test2::Tools::Subtest 'subtest_streamed'; +use Getopt::Long; +use experimental 'signatures'; + + +### Options and Arguments + +my ($tests, $examples, $verbose, $size); +GetOptions( + 'examples!' => \$examples, + 'tests!' => \$tests, + 'verbose!' => \$verbose, + 'size=i' => \$size, +) or usage(); + +run_tests($examples, $tests); # tests do not return + +usage() unless @ARGV && $size; + +sub usage { + die <<~EOS; + $0 - string format + + usage: $0 [-examples] [-tests] [-size I STR] + + -examples + run the examples from the challenge + + -tests + run some tests + + -size I + group size + + STR + a string + + EOS +} + + +### Input and Output + +say string_format(shift, $size); + + +### Implementation +# +# For details see: +# https://github.sommrey.de/the-bears-den/2025/05/23/ch-322.html#task-1 + + +sub string_format ($str, $i) { + join '-', $str =~ tr/-//dr =~ /^.{1,$i}(?=(?:.{$i})*+$)|.{$i}/g; +} + + +### Examples and Tests + +sub run_tests ($examples, $tests) { + return unless $examples || $tests; + + state sub run_example ($args, $expected, $name) { + my $result = string_format(@$args); + is $result, $expected, + "$name: (@$args) -> $expected"; + } + + plan 2; + + $examples ? subtest_streamed(examples => sub { + my @examples = ( + [["ABC-D-E-F", 3], "ABC-DEF", 'example 1'], + [["A-BC-D-E", 2], "A-BC-DE", 'example 2'], + [["-A-B-CD-E", 4], "A-BCDE", 'example 3'], + ); + plan scalar @examples; + for (@examples) { + run_example @$_; + } + }) : pass 'skip examples'; + + $tests ? subtest_streamed(tests => sub { + my @tests = ( + [1, 'a-b-c-d-e-f'], + [2, 'ab-cd-ef'], + [3, 'abc-def'], + [4, 'ab-cdef'], + [5, 'a-bcdef'], + [6, 'abcdef'], + ); + plan scalar @tests; + is string_format('abcdef', $_->[0]), $_->[1], "size=$_->[0]" for @tests; + }) : pass 'skip tests'; + + exit; +} diff --git a/challenge-322/jo-37/perl/ch-2.pl b/challenge-322/jo-37/perl/ch-2.pl new file mode 100755 index 0000000000..2b6081db23 --- /dev/null +++ b/challenge-322/jo-37/perl/ch-2.pl @@ -0,0 +1,95 @@ +#!/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); +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 - rank array + + usage: $0 [-examples] [-tests] [--] [I...] + + -examples + run the examples from the challenge + + -tests + run some tests + + I... + list of integers + + EOS +} + + +### Input and Output + +say rank_array(@ARGV); + + +### Implementation +# +# For details see: +# https://github.sommrey.de/the-bears-den/2025/05/23/ch-322.html#task-2 + + +sub rank_array { + my $ints = long @_; + my $si = $ints->qsorti; + my $rank = zeroes($ints); + $rank($si) .= $ints($si)->dummy(0)->enumvecg; + $rank + 1; +} + + +### Examples and Tests + +sub run_tests ($examples, $tests) { + return unless $examples || $tests; + + state sub run_example ($args, $expected, $name) { + my $result = rank_array(@$args)->unpdl; + is $result, $expected, + "$name: (@$args) -> (@$expected)"; + } + + plan 2; + + $examples ? subtest_streamed(examples => sub { + my @examples = ( + [[55, 22, 44, 33], [4, 1, 3, 2], 'example 1'], + [[10, 10, 10], [1, 1, 1], 'example 2'], + [[5, 1, 1, 4, 3], [4, 1, 1, 3, 2], 'example 3'], + ); + plan scalar @examples; + for (@examples) { + run_example @$_; + } + }) : pass 'skip examples'; + + $tests ? subtest_streamed(tests => sub { + plan 1; + is rank_array(0, 11, 23, -10, -21)->unpdl, [3, 4, 5, 2, 1], 'negative'; + }) : pass 'skip tests'; + + exit; +} |
