Merge pull request #10018 from boblied/w267

Week 267 solutions from Bob Lied

4 files changed, 152 insertions, 3 deletions

diff --git a/challenge-267/bob-lied/README b/challenge-267/bob-lied/README
index e17c006f30..164da38120 100644
--- a/challenge-267/bob-lied/README
+++ b/challenge-267/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 266 by Bob Lied
+Solutions to weekly challenge 267 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-266/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-266/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-267/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-267/bob-lied
diff --git a/challenge-267/bob-lied/blog.txt b/challenge-267/bob-lied/blog.txt
new file mode 100644
index 0000000000..0f8e323e85
--- /dev/null
+++ b/challenge-267/bob-lied/blog.txt
@@ -0,0 +1 @@
+https://dev.to/boblied/pwc-267-positively-perl-street-5390
diff --git a/challenge-267/bob-lied/perl/ch-1.pl b/challenge-267/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..56d1a10d8c
--- /dev/null
+++ b/challenge-267/bob-lied/perl/ch-1.pl
@@ -0,0 +1,52 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2024, Bob Lied
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge 267 Task 1 Product Sign
+#=============================================================================
+# You are given an array of @ints.
+# Write a script to find the sign of product of all integers in the given
+# array. The sign is 1 if the product is positive, -1 if the product is
+# negative and 0 if product is zero.
+# Example 1 Input: @ints = (-1, -2, -3, -4, 3, 2, 1)
+#           Output: 1
+# Example 2 Input: @ints = (1, 2, 0, -2, -1)
+#           Output: 0
+# Example 3 Input: @ints = (-1, -1, 1, -1, 2)
+#           Output: -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;
+
+say prodSign(@ARGV);
+
+sub prodSign(@ints)
+{
+    my $sign = 1;
+    while ( $sign && defined(my $n = shift @ints) )
+    {
+        $sign *= ($n <=> 0);
+    }
+    return $sign;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( prodSign(-1, -2, -3, -4,  3, 2, 1),  1, "Example 1");
+    is( prodSign( 1,  2,  0, -2, -1      ),  0, "Example 2");
+    is( prodSign(-1, -1,  1, -1,  2      ), -1, "Example 3");
+
+    done_testing;
+}
diff --git a/challenge-267/bob-lied/perl/ch-2.pl b/challenge-267/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..4136446e0c
--- /dev/null
+++ b/challenge-267/bob-lied/perl/ch-2.pl
@@ -0,0 +1,96 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2024, Bob Lied
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge 267 Task 2 Line Counts
+#=============================================================================
+# You are given a string, $str, and a 26-items array @widths containing
+# the width of each character from a to z.
+#
+# Write a script to find out the number of lines and the width of the
+# last line needed to display the given string, assuming you can only
+# fit 100 width units on a line.
+# Example 1 Input: $str = "abcdefghijklmnopqrstuvwxyz"
+#                  @widths = (10,10,10,10,10,10,10,10,10,10,10,10,10,
+#                             10,10,10,10,10,10,10,10,10,10,10,10,10)
+#           Output: (3, 60)
+#   Line 1: abcdefghij (100 pixels)
+#   Line 2: klmnopqrst (100 pixels)
+#   Line 3: uvwxyz (60 pixels)
+#
+# Example 2 Input: $str = "bbbcccdddaaa"
+#                  @widths = ( 4,10,10,10,10,10,10,10,10,10,10,10,10,
+#                             10,10,10,10,10,10,10,10,10,10,10,10,10)
+#           Output: (2, 4)
+#   Line 1: bbbcccdddaa (98 pixels)
+#   Line 2: a (4 pixels)
+#=============================================================================
+
+use v5.38;
+use builtin qw/true false/; no warnings "experimental::builtin";
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+use constant { MAXLINE => 100,
+               ORD_A   =>  ord('a')
+           };
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+my $str = shift;
+my @widths = (10) x 26;
+$widths[$_] = $ARGV[$_] for 0 .. $#ARGV;
+
+say '(', join(", ", lineCount($str, @widths)->@* ), ')';
+
+sub lineCount($str, @widths)
+{
+    # Normalize to lower-case a-z only
+    $str = lc $str;
+    $str =~ s/[^a-z]//g;
+
+    my $lineCount = 1;
+    my $width = 0;
+
+    # Work with character widths, actual characters don't matter
+    my @cw = map { $widths[ ord($_) - ORD_A ] } split(//, $str);
+    while ( defined(my $w = shift @cw) )
+    {
+        if ( $width + $w <= MAXLINE )
+        {
+            $width += $w;
+        }
+        else
+        {
+            $width = $w;
+            $lineCount++;
+        }
+    }
+    return [ $lineCount, $width ];
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    my $str;
+    my @widths;
+    my $lines;
+    my $last;
+
+    $str = "abcdefghijklmnopqrstuvwxyz";
+    @widths = (10,10,10,10,10,10,10,10,10,10,10,10,10,
+               10,10,10,10,10,10,10,10,10,10,10,10,10);
+    is( lineCount($str, @widths), [ 3, 60 ], "Example 1");
+
+    $str = "bbbcccdddaaa";
+    @widths = ( 4,10,10,10,10,10,10,10,10,10,10,10,10,
+               10,10,10,10,10,10,10,10,10,10,10,10,10);
+    is( lineCount($str, @widths), [ 2, 4 ], "Example 2");
+
+    done_testing;
+}