Merge pull request #12069 from boblied/w322

Week 322 solutions from Bob Lied

4 files changed, 193 insertions, 3 deletions

diff --git a/challenge-322/bob-lied/README.md b/challenge-322/bob-lied/README.md
index 0825268e3e..dbc624cc0a 100644
--- a/challenge-322/bob-lied/README.md
+++ b/challenge-322/bob-lied/README.md
@@ -1,4 +1,4 @@
-# Solutions to weekly challenge 321 by Bob Lied
+# Solutions to weekly challenge 322 by Bob Lied
 
-## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-321/)
-## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-321/bob-lied)
+## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-322/)
+## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-322/bob-lied)
diff --git a/challenge-322/bob-lied/blog.txt b/challenge-322/bob-lied/blog.txt
new file mode 100644
index 0000000000..97cf564eb7
--- /dev/null
+++ b/challenge-322/bob-lied/blog.txt
@@ -0,0 +1 @@
+https://dev.to/boblied/pwc-322-string-format-33pd
diff --git a/challenge-322/bob-lied/perl/ch-1.pl b/challenge-322/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..6a3fb1d9c9
--- /dev/null
+++ b/challenge-322/bob-lied/perl/ch-1.pl
@@ -0,0 +1,119 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2025, Bob Lied
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge 322 Task 1 String Format
+#=============================================================================
+# You are given a string and a positive integer.  Write a script to format
+# the string, removing any dashes, in groups of size given by the integer.
+# The first group can be smaller than the integer but should have at least
+# one character. Groups should be separated by dashes.
+# Example 1 Input: $str = "ABC-D-E-F", $i = 3
+#           Output: "ABC-DEF"
+# Example 2 Input: $str = "A-BC-D-E", $i = 2
+#           Output: "A-BC-DE"
+# Example 3 Input: $str = "-A-B-CD-E", $i = 4
+#           Output: "A-BCDE"
+#=============================================================================
+
+use v5.40;
+
+
+use Getopt::Long;
+my $Verbose = false;
+my $DoTest  = false;
+my $Benchmark = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$Benchmark);
+my $logger;
+{
+    use Log::Log4perl qw(:easy);
+    Log::Log4perl->easy_init({ level => ($Verbose ? $DEBUG : $INFO ),
+            layout => "%d{HH:mm:ss.SSS} %p{1} %m%n" });
+    $logger = Log::Log4perl->get_logger();
+}
+#=============================================================================
+
+exit(!runTest()) if $DoTest;
+exit( runBenchmark($Benchmark) ) if $Benchmark;
+
+say strFmtUnpack(@ARGV);
+
+#=============================================================================
+sub strFmtRE($str, $i)
+{
+    $str = reverse $str =~ s/-+//gr;
+    $str = reverse $str =~ s/.{$i}/$&-/gr;
+    return $str =~ s/^-//r;
+}
+
+sub strFmtUnpack($str, $i)
+{
+    return scalar reverse join("-", unpack("(A$i)*", reverse $str =~ s/-//gr));
+}
+
+sub strFmtShift($str, $i)
+{
+    my @in = split(//, $str =~ s/-//gr);
+    my $out;
+    
+    my $d = 0;
+    while ( @in )
+    {
+        $out .= pop @in;
+        $out .= '-' if ( ++$d % $i == 0 && @in );
+    }
+    return scalar reverse $out;
+}
+
+sub strFmtSubstr($str, $i)
+{
+    $str =~ s/-//g;
+    my $out = substr($str, 0, length($str) % $i, '');
+    while ( $str ne '' )
+    {
+        $out .= '-' if ( $out ne '' );
+        $out .= substr($str, 0, $i, '');
+    }
+    return $out;
+}
+
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( strFmtRE("ABC-D-E-F", 3), "ABC-DEF", "Example 1");
+    is( strFmtRE("A-BC-D-E" , 2), "A-BC-DE", "Example 2");
+    is( strFmtRE("-A-B-CD-E", 4), "A-BCDE",  "Example 3");
+
+    is( strFmtSubstr("ABC-D-E-F", 3), "ABC-DEF", "Example 1");
+    is( strFmtSubstr("A-BC-D-E" , 2), "A-BC-DE", "Example 2");
+    is( strFmtSubstr("-A-B-CD-E", 4), "A-BCDE",  "Example 3");
+
+    is( strFmtUnpack("ABC-D-E-F", 3), "ABC-DEF", "Example 1");
+    is( strFmtUnpack("A-BC-D-E" , 2), "A-BC-DE", "Example 2");
+    is( strFmtUnpack("-A-B-CD-E", 4), "A-BCDE",  "Example 3");
+
+    is( strFmtShift("ABC-D-E-F", 3), "ABC-DEF", "Example 1");
+    is( strFmtShift("A-BC-D-E" , 2), "A-BC-DE", "Example 2");
+    is( strFmtShift("-A-B-CD-E", 4), "A-BCDE",  "Example 3");
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    my $str = "xyzzy" x 200;
+    my $i   = 23;
+
+    cmpthese($repeat, {
+            regex  => sub { strFmtRE($str, $i) },
+            substr => sub { strFmtSubstr($str, $i) },
+            unpack => sub { strFmtUnpack($str, $i) },
+            shift  => sub { strFmtShift($str, $i) },
+        });
+}
diff --git a/challenge-322/bob-lied/perl/ch-2.pl b/challenge-322/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..8521710567
--- /dev/null
+++ b/challenge-322/bob-lied/perl/ch-2.pl
@@ -0,0 +1,70 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2025, Bob Lied
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge 322 Task 2 Rank Array
+#=============================================================================
+# You are given an array of integers.  Write a script to return an array
+# of the ranks of each element: the lowest value has rank 1, next lowest
+# rank 2, etc. If two elements are the same then they share the same rank.
+# Example 1 Input: @ints = (55, 22, 44, 33)
+#           Output: (4, 1, 3, 2)
+# Example 2 Input: @ints = (10, 10, 10)
+#           Output: (1, 1, 1)
+# Example 3 Input: @ints = (5, 1, 1, 4, 3)
+#           Output: (4, 1, 1, 3, 2)
+#=============================================================================
+
+use v5.40;
+
+
+use Getopt::Long;
+my $Verbose = false;
+my $DoTest  = false;
+my $Benchmark = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$Benchmark);
+my $logger;
+{
+    use Log::Log4perl qw(:easy);
+    Log::Log4perl->easy_init({ level => ($Verbose ? $DEBUG : $INFO ),
+            layout => "%d{HH:mm:ss.SSS} %p{1} %m%n" });
+    $logger = Log::Log4perl->get_logger();
+}
+#=============================================================================
+
+exit(!runTest()) if $DoTest;
+exit( runBenchmark($Benchmark) ) if $Benchmark;
+
+say '(', join(',', rankArray(@ARGV)), ')';
+
+#=============================================================================
+sub rankArray(@ints)
+{
+    my @sorted = sort { $a <=> $b } @ints;
+    my %rank;
+    my $r = 1;
+    $rank{$_} //= $r++ for ( @sorted );
+    return [ map { $rank{$_} } @ints ];
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( rankArray(55,22,44,33), [4,1,3,2  ], "Example 1");
+    is( rankArray(10,10,10   ), [1,1,1    ], "Example 2");
+    is( rankArray(5,1,1,4,3  ), [4,1,1,3,2], "Example 3");
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    cmpthese($repeat, {
+            label => sub { },
+        });
+}