Merge branch 'master' of github.com:manwar/perlweeklychallenge-club into challenges

91 files changed, 3673 insertions, 49 deletions

diff --git a/challenge-249/arne-sommer/blog.txt b/challenge-249/arne-sommer/blog.txt
new file mode 100644
index 0000000000..9c3ec53f8a
--- /dev/null
+++ b/challenge-249/arne-sommer/blog.txt
@@ -0,0 +1 @@
+https://raku-musings.com/equal-di.html
diff --git a/challenge-249/arne-sommer/raku/ch-1.raku b/challenge-249/arne-sommer/raku/ch-1.raku
new file mode 100755
index 0000000000..96989560ee
--- /dev/null
+++ b/challenge-249/arne-sommer/raku/ch-1.raku
@@ -0,0 +1,28 @@
+#! /usr/bin/env raku
+
+unit sub MAIN (*@ints where @ints.elems %% 2 && @ints.elems > 0 && all(@ints) ~~ Int, :v(:$verbose));
+
+my @output;
+my @sorted = @ints>>.Int.sort;
+
+say ":Sorted: { @sorted.join(",") }" if $verbose;
+
+while @sorted
+{
+  my $first  = @sorted.shift;
+  my $second = @sorted.shift;
+
+  if $first == $second
+  {
+    @output.push: ($first, $second);
+    say ":Pair: $first,$second" if $verbose;
+  }
+  else
+  {
+    say ":Non-pair: $first,$second" if $verbose;
+    say "()";
+    exit;
+  }
+}
+
+say @output.map({ "($_[0], $_[1])"}).join(", ");
diff --git a/challenge-249/arne-sommer/raku/ch-2.raku b/challenge-249/arne-sommer/raku/ch-2.raku
new file mode 100755
index 0000000000..9f90401bc1
--- /dev/null
+++ b/challenge-249/arne-sommer/raku/ch-2.raku
@@ -0,0 +1,25 @@
+#! /usr/bin/env raku
+
+unit sub MAIN ($s where $s ~~ /^<[ID]>+$/, :v(:$verbose));
+
+my @output;
+my @integers = (0 .. $s.chars);
+
+for $s.comb -> $char
+{
+  if $char eq "I"
+  {
+    @output.push: @integers.shift;
+    say ":I -> lowest integer { @output.tail }" if $verbose;
+  }
+  else
+  {
+    @output.push: @integers.pop;
+    say ":D -> highest integer { @output.tail }" if $verbose;
+  }
+}
+
+@output.push: @integers[0];
+say ":  -> remaining integer { @output.tail }" if $verbose;
+
+say "({ @output.join(", ") })";
diff --git a/challenge-249/arne-sommer/raku/di-string-match b/challenge-249/arne-sommer/raku/di-string-match
new file mode 100755
index 0000000000..9f90401bc1
--- /dev/null
+++ b/challenge-249/arne-sommer/raku/di-string-match
@@ -0,0 +1,25 @@
+#! /usr/bin/env raku
+
+unit sub MAIN ($s where $s ~~ /^<[ID]>+$/, :v(:$verbose));
+
+my @output;
+my @integers = (0 .. $s.chars);
+
+for $s.comb -> $char
+{
+  if $char eq "I"
+  {
+    @output.push: @integers.shift;
+    say ":I -> lowest integer { @output.tail }" if $verbose;
+  }
+  else
+  {
+    @output.push: @integers.pop;
+    say ":D -> highest integer { @output.tail }" if $verbose;
+  }
+}
+
+@output.push: @integers[0];
+say ":  -> remaining integer { @output.tail }" if $verbose;
+
+say "({ @output.join(", ") })";
diff --git a/challenge-249/arne-sommer/raku/equal-pairs b/challenge-249/arne-sommer/raku/equal-pairs
new file mode 100755
index 0000000000..96989560ee
--- /dev/null
+++ b/challenge-249/arne-sommer/raku/equal-pairs
@@ -0,0 +1,28 @@
+#! /usr/bin/env raku
+
+unit sub MAIN (*@ints where @ints.elems %% 2 && @ints.elems > 0 && all(@ints) ~~ Int, :v(:$verbose));
+
+my @output;
+my @sorted = @ints>>.Int.sort;
+
+say ":Sorted: { @sorted.join(",") }" if $verbose;
+
+while @sorted
+{
+  my $first  = @sorted.shift;
+  my $second = @sorted.shift;
+
+  if $first == $second
+  {
+    @output.push: ($first, $second);
+    say ":Pair: $first,$second" if $verbose;
+  }
+  else
+  {
+    say ":Non-pair: $first,$second" if $verbose;
+    say "()";
+    exit;
+  }
+}
+
+say @output.map({ "($_[0], $_[1])"}).join(", ");
diff --git a/challenge-249/dave-jacoby/blog.txt b/challenge-249/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..d526ba7bd9
--- /dev/null
+++ b/challenge-249/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2023/12/26/i-did-weekly-challenge-249.html
diff --git a/challenge-249/dave-jacoby/perl/ch-1.pl b/challenge-249/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..fa9ffc48d6
--- /dev/null
+++ b/challenge-249/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,38 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+my @examples = (
+
+    [ 3, 2, 3, 2, 2, 2 ],
+    [ 1, 2, 3, 4 ],
+);
+
+for my $example (@examples) {
+    my $input  = join ', ', $example->@*;
+    my @output = equal_pairs( $example->@* );
+    my $output = join ', ',
+        map { qq{($_)} } map { join ', ', $_->@* } @output;
+
+    say <<~"END";
+    Input:  \$ints = ($input)
+    Output: ($output)
+    END
+}
+
+sub equal_pairs (@input) {
+    my @output;
+    my %hash;
+    for my $i (@input) {
+        if ( $hash{$i} ) {
+            push @output, [ $i, $i ];
+            delete $hash{$i};
+        }
+        else {
+            $hash{$i} = 1;
+        }
+    }
+    return @output;
+}
diff --git a/challenge-249/dave-jacoby/perl/ch-2.pl b/challenge-249/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..171fe13288
--- /dev/null
+++ b/challenge-249/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,43 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+use Algorithm::Permute;
+
+my @examples = ( "IDID", "III", "DDI" );
+
+for my $e (@examples) {
+    my @output = di_string_match($e);
+    my $output = join "\n        ", sort
+        map { qq{($_)} }
+        map { join ', ', $_->@* } @output;
+
+    say <<~"END";
+    Input:  \$str = $e
+
+    Output: $output
+    END
+}
+
+sub di_string_match ($str) {
+    my @output;
+    my @s = 0 .. length $str;
+    my $p = Algorithm::Permute->new( [@s] );
+OUTER: while ( my @perm = $p->next ) {
+        for my $i ( 0 .. -1 + length $str ) {
+            my $l = substr $str, $i, 1;
+            if ( $l eq 'I' ) {
+                next OUTER unless $perm[$i] < $perm[ $i + 1 ];
+            }
+            elsif ( $l eq 'D' ) {
+                next OUTER unless $perm[$i] > $perm[ $i + 1 ];
+            }
+        }
+        push @output, \@perm;
+    }
+
+    return @output;
+}
+
diff --git a/challenge-249/e-choroba/perl/ch-1.pl b/challenge-249/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..41f1d964ab
--- /dev/null
+++ b/challenge-249/e-choroba/perl/ch-1.pl
@@ -0,0 +1,75 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+sub equal_pairs_count(@ints) {
+    my %seen;
+    ++$seen{$_} for @ints;
+    return [map $seen{$_} % 2 ? return []
+                              : ([$_, $_]) x ($seen{$_} / 2),
+            keys %seen]
+}
+
+sub equal_pairs_odd(@ints) {
+    my %odd;
+    my @pairs;
+    for my $i (@ints) {
+        if (exists $odd{$i}) {
+            delete $odd{$i};
+            push @pairs, [$i, $i];
+        } else {
+            undef $odd{$i};
+        }
+    }
+    return keys %odd ? [] : \@pairs
+}
+
+
+use Test2::V0 -srand => srand;
+plan 2 + 1;
+
+my $type = 'count';
+*equal_pairs = *equal_pairs_count{CODE};
+for (1, 2) {
+    subtest $type => sub {
+        plan 5;
+
+        is equal_pairs(3, 2, 3, 2, 2, 2),
+            bag { item $_ for [2, 2], [2, 2], [3, 3]; },
+            'Example 1';
+
+        is equal_pairs(1, 2, 3, 4), [], 'Example 2';
+
+
+        is equal_pairs(-1, -1, -2, -2),
+            bag { item $_ for [-1, -1], [-2, -2]; },
+            'Negative numbers';
+
+        is equal_pairs(1, 1, 1, 1, 2, 2, 2, 2),
+            bag { item $_ for [1, 1], [1, 1], [2, 2], [2, 2]; },
+            'More than once';
+
+        is equal_pairs(1, 1, 1, 1, 2, 2, 2, 2, 1),
+            [],
+            'More than once odd';
+    };
+
+    no warnings 'redefine';
+    $type = 'odd';
+    *equal_pairs = *equal_pairs_odd{CODE};
+}
+
+use Benchmark qw{ cmpthese };
+
+my @l = map int rand 1000, 1 .. 100_000;
+is equal_pairs_odd(@l), equal_pairs_count(@l), 'same';
+cmpthese(-3, {
+    odd   => sub { equal_pairs_odd(@l) },
+    count => sub { equal_pairs_count(@l) },
+});
+