aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--challenge-322/bob-lied/README.md6
-rw-r--r--challenge-322/bob-lied/ch-1.pl105
-rw-r--r--challenge-322/bob-lied/ch-2.pl70
3 files changed, 178 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/ch-1.pl b/challenge-322/bob-lied/ch-1.pl
new file mode 100644
index 0000000000..73e89b291c
--- /dev/null
+++ b/challenge-322/bob-lied/ch-1.pl
@@ -0,0 +1,105 @@
+#!/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 strFmtSubstr($str, $i)
+{
+ $str = reverse $str =~ s/-+//gr;
+ my $d = int( (length($str) - 0.5) / $i);
+
+ for my $p ( map { $_ * $i } reverse 1 .. $d )
+ {
+ substr($str, $p, 0, '-');
+ $logger->debug("i=$i p=$p str=$str");
+ }
+ return reverse $str;
+}
+
+sub strFmtUnpack($str, $i)
+{
+ return scalar reverse join("-", unpack("(A$i)*", reverse $str =~ s/-//gr));
+}
+
+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");
+
+ done_testing;
+}
+
+# $ perl ch-1.pl -b 200000
+# Rate substr regex unpack
+# substr 54054/s -- -54% -81%
+# regex 117647/s 118% -- -58%
+# unpack 281690/s 421% 139% --
+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) },
+ });
+}
diff --git a/challenge-322/bob-lied/ch-2.pl b/challenge-322/bob-lied/ch-2.pl
new file mode 100644
index 0000000000..8521710567
--- /dev/null
+++ b/challenge-322/bob-lied/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 { },
+ });
+}
generated by cgit (git 2.34.1) at 2026-07-04 20:45:56 +0000