diff options
| author | Jörg Sommrey <28217714+jo-37@users.noreply.github.com> | 2025-07-11 22:59:03 +0200 |
|---|---|---|
| committer | Jörg Sommrey <28217714+jo-37@users.noreply.github.com> | 2025-07-11 22:59:03 +0200 |
| commit | f5124f55ffe9bce6a5a2861cbb34e7d5cac855f0 (patch) | |
| tree | 3a7302c64a425644dd65565bf481a25c9cddb75f | |
| parent | 416e96fc2b3e5ef01a2fd7bc3107b19f88f1f767 (diff) | |
| parent | ce41ecd55155a336448ffd49ee5f36461b5d28c2 (diff) | |
| download | perlweeklychallenge-club-f5124f55ffe9bce6a5a2861cbb34e7d5cac855f0.tar.gz perlweeklychallenge-club-f5124f55ffe9bce6a5a2861cbb34e7d5cac855f0.tar.bz2 perlweeklychallenge-club-f5124f55ffe9bce6a5a2861cbb34e7d5cac855f0.zip | |
Solutions to challenge 329
| -rw-r--r-- | challenge-329/jo-37/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-329/jo-37/perl/ch-1.pl | 91 | ||||
| -rwxr-xr-x | challenge-329/jo-37/perl/ch-2.pl | 111 |
3 files changed, 203 insertions, 0 deletions
diff --git a/challenge-329/jo-37/blog.txt b/challenge-329/jo-37/blog.txt new file mode 100644 index 0000000000..8de21ed4e8 --- /dev/null +++ b/challenge-329/jo-37/blog.txt @@ -0,0 +1 @@ +https://github.sommrey.de/the-bears-den/2025/07/11/ch-329.html diff --git a/challenge-329/jo-37/perl/ch-1.pl b/challenge-329/jo-37/perl/ch-1.pl new file mode 100755 index 0000000000..5808ec1220 --- /dev/null +++ b/challenge-329/jo-37/perl/ch-1.pl @@ -0,0 +1,91 @@ +#!/usr/bin/perl + +use v5.26; +use Test2::V0 -no_srand; +use Test2::Tools::Subtest 'subtest_streamed'; +use Getopt::Long; +use experimental 'signatures'; + +use List::Util 'uniqint'; + + +### 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 == 1; + +sub usage { + die <<~EOS; + $0 - count integers + + usage: $0 [-examples] [-tests] [STR] + + -examples + run the examples from the challenge + + -tests + run some tests + + STR + a string + + EOS +} + + +### Input and Output + +say "@{[count_int(shift)]}"; + + +### Implementation +# +# For details see: +# https://github.sommrey.de/the-bears-den/2025/07/11/ch-329.html#task-1 + + +sub count_int { + uniqint shift =~ /\d+/g; +} + + +### Examples and Tests + +sub run_tests ($examples, $tests) { + return unless $examples || $tests; + + state sub run_example ($args, $expected, $name) { + my @result = count_int(@$args); + is \@result, $expected, + "$name: (@$args) -> (@$expected)"; + } + + plan 2; + + $examples ? subtest_streamed(examples => sub { + my @examples = ( + [["the1weekly2challenge2"], [1, 2], 'example 1'], + [["go21od1lu5c7k"], [21, 1, 5, 7], 'example 2'], + [["4p3e2r1l"], [4, 3, 2, 1], '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; +} diff --git a/challenge-329/jo-37/perl/ch-2.pl b/challenge-329/jo-37/perl/ch-2.pl new file mode 100755 index 0000000000..d4e6c38760 --- /dev/null +++ b/challenge-329/jo-37/perl/ch-2.pl @@ -0,0 +1,111 @@ +#!/usr/bin/perl + +use v5.26; +use Test2::V0 -no_srand; +use Test2::Tools::Subtest 'subtest_streamed'; +use Getopt::Long; +use experimental 'signatures'; + +use Set::Scalar; +use List::UtilsBy 'max_by'; + +### 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 - nice string + + usage: $0 [-examples] [-tests] [STR] + + -examples + run the examples from the challenge + + -tests + run some tests + + STR + a string + + EOS +} + + +### Input and Output + +say nice_string(shift); + + +### Implementation +# +# For details see: +# https://github.sommrey.de/the-bears-den/2025/07/11/ch-329.html#task-2 + +sub split_nice ($str) { + my $nice = Set::Scalar->new($str =~ /\p{Ll}/g) * + Set::Scalar->new(map lc, $str =~ /\p{Lu}/g); + return () if $nice->is_null; + my @parts = grep $_, split qr{[^ @$nice]+}ixx, $str; + @parts == 1 ? @parts : map split_nice($_), @parts; +} + +sub nice_string ($str) { + (max_by {length} split_nice($str)) // ''; +} + + +### Examples and Tests + +sub run_tests ($examples, $tests) { + return unless $examples || $tests; + + state sub run_example ($args, $expected, $name) { + my $result = nice_string(@$args); + is $result, $expected, + qq{$name: "@$args" -> "$expected"}; + } + + plan 2; + + $examples ? subtest_streamed(examples => sub { + my @examples = ( + [["YaaAho"], "aaA", 'example 1'], + [["cC"], "cC", 'example 2'], + [["A"], "", 'example 3'], + ); + plan scalar @examples; + for (@examples) { + run_example @$_; + } + }) : pass 'skip examples'; + + $tests ? subtest_streamed(tests => sub { + my @tests = ( + [["abdAcAaAcBbdcabD"], "AaA", 'recurse substrings'], + [["aA1BBb"], "BBb", 'non-letter'], + [["abcDd"], "Dd", 'non-nice head'], + [["Ddefg"], "Dd", 'non-nice tail'], + [["AacbB"], "Aa", 'non-unique substring'], + [["abAcBab"], "", 'segmented'], + [["aA Bb"], "aA", 'blank'], + [["äÄÖöüÜßSs"], "äÄÖöüÜ", 'umlauts'], + [["aAxaAbBxaAbBcCxaAbBcCdD"], "aAbBcCdD", 'multiple substrings'], + ); + plan scalar @tests; + for (@tests) { + run_example @$_; + } + }) : pass 'skip tests'; + + exit; +} |
