aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJörg Sommrey <28217714+jo-37@users.noreply.github.com>2025-07-11 22:59:03 +0200
committerJörg Sommrey <28217714+jo-37@users.noreply.github.com>2025-07-11 22:59:03 +0200
commitf5124f55ffe9bce6a5a2861cbb34e7d5cac855f0 (patch)
tree3a7302c64a425644dd65565bf481a25c9cddb75f
parent416e96fc2b3e5ef01a2fd7bc3107b19f88f1f767 (diff)
parentce41ecd55155a336448ffd49ee5f36461b5d28c2 (diff)
downloadperlweeklychallenge-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.txt1
-rwxr-xr-xchallenge-329/jo-37/perl/ch-1.pl91
-rwxr-xr-xchallenge-329/jo-37/perl/ch-2.pl111
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;
+}