Merge pull request #9307 from boblied/w249

Week 249 from Bob Lied

4 files changed, 129 insertions, 3 deletions

diff --git a/challenge-249/bob-lied/README b/challenge-249/bob-lied/README
index 882a98a265..851f9dd290 100644
--- a/challenge-249/bob-lied/README
+++ b/challenge-249/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 248 by Bob Lied
+Solutions to weekly challenge 249 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-248/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-248/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-249/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-249/bob-lied
diff --git a/challenge-249/bob-lied/blog.txt b/challenge-249/bob-lied/blog.txt
new file mode 100644
index 0000000000..36e23384a7
--- /dev/null
+++ b/challenge-249/bob-lied/blog.txt
@@ -0,0 +1 @@
+https://dev.to/boblied/pwc-249-56hg
diff --git a/challenge-249/bob-lied/perl/ch-1.pl b/challenge-249/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..e829ac71ee
--- /dev/null
+++ b/challenge-249/bob-lied/perl/ch-1.pl
@@ -0,0 +1,65 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge 249 Task 1 Equal Pairs
+#=============================================================================
+# You are given an array of integers with even number of elements.
+# Write a script to divide the given array into equal pairs such that:
+# a) Each element belongs to exactly one pair.
+# b) The elements present in a pair are equal.
+# Example 1 Input: @ints = (3, 2, 3, 2, 2, 2)
+#           Output: (2, 2), (3, 3), (2, 2)
+# Example 2 Input: @ints = (1, 2, 3, 4)
+#           Output: ()
+#=============================================================================
+
+use v5.38;
+
+use builtin qw/true false/; no warnings "experimental::builtin";
+
+use List::MoreUtils qw/frequency any/;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+say "(", join(", ",
+    map { "($_->[0], $_->[1])" } equalPairs(@ARGV)->@*),
+    ")";
+
+sub equalPairs(@ints)
+{
+    return [] if @ints % 2 == 1;
+
+    my %freq = frequency @ints;
+    return [] if any { $_ % 2 == 1 } values %freq;
+
+    my @pair;
+    while ( %freq )
+    {
+        for my $n ( sort { $a <=> $b } keys %freq )
+        {
+            push @pair, [ $n, $n ];
+            $freq{$n} -= 2;
+            delete $freq{$n} if $freq{$n} == 0;
+        }
+    }
+    return \@pair;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( equalPairs(3,2,3,2,2,2), [[2,2],[3,3],[2,2]], "Example 1");
+    is( equalPairs(1,2,3,4    ), [],                  "Example 2");
+
+    is( equalPairs(6,6,6,6,2,3,2,3,4,3,4,3), [[2,2],[3,3],[4,4],[6,6],[3,3],[6,6]], "More");
+
+    done_testing;
+}
diff --git a/challenge-249/bob-lied/perl/ch-2.pl b/challenge-249/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..a64928116d
--- /dev/null
+++ b/challenge-249/bob-lied/perl/ch-2.pl
@@ -0,0 +1,60 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge 249 Task 2 DI String Match
+#=============================================================================
+# You are given a string s, consisting of only the characters "D" and "I".
+# Find a permutation of the integers [0 .. length(s)] such that for each
+# character s[i] in the string:
+# s[i] == 'I' ⇒ perm[i] < perm[i + 1]
+# s[i] == 'D' ⇒ perm[i] > perm[i + 1]
+# Example 1 Input: $str = "IDID"
+#           Output: (0, 4, 1, 3, 2)
+# Example 2 Input: $str = "III"
+#           Output: (0, 1, 2, 3)
+# Example 3 Input: $str = "DDI"
+#           Output: (3, 2, 0, 1)
+#=============================================================================
+
+use v5.38;
+use builtin qw/true false/; no warnings "experimental::builtin";
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+for my $DI ( @ARGV )
+{
+    next unless $DI =~ m/\A[ID]+\Z/;
+    say "(", join(",", di($DI)->@*), ")";
+}
+
+sub di($s)
+{
+    my @perm;
+    my @idx = 0 .. length($s);
+
+    for my $di ( split("", $s) )
+    {
+        if   ( $di eq "I" ) { push @perm, shift @idx }
+        else                { push @perm, pop   @idx }
+    }
+    push @perm, shift @idx;
+    return \@perm;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is(di("IDID"), [0,4,1,3,2], "Example 1");
+    is(di("III"),  [0,1,2,3  ], "Example 2");
+    is(di("DDI"),  [3,2,0,1  ], "Example 3");
+
+    done_testing;
+}