Week 273 solutions

Alternate solution for  ch-1.pl

typo

3 files changed, 108 insertions, 3 deletions

diff --git a/challenge-273/bob-lied/README b/challenge-273/bob-lied/README
index ebf6fe8695..fbef60f528 100644
--- a/challenge-273/bob-lied/README
+++ b/challenge-273/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 272 by Bob Lied
+Solutions to weekly challenge 273 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-272/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-272/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-273/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-273/bob-lied
diff --git a/challenge-273/bob-lied/perl/ch-1.pl b/challenge-273/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..15f0409cda
--- /dev/null
+++ b/challenge-273/bob-lied/perl/ch-1.pl
@@ -0,0 +1,61 @@
+#!/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 273 Task 1 Percentage of Character
+#=============================================================================
+# You are given a string, $str and a character $char.
+# Write a script to return the percentage, nearest whole, of given
+# character in the given string.
+# Example 1 Input: $str = "perl", $char = "e"
+#           Output: 25
+# Example 2 Input: $str = "java", $char = "a"
+#           Output: 50
+# Example 3 Input: $str = "python", $char = "m"
+#           Output: 0
+# Example 4 Input: $str = "ada", $char = "a"
+#           Output: 67
+# Example 5 Input: $str = "ballerina", $char = "l"
+#           Output: 22
+# Example 6 Input: $str = "analitik", $char = "k"
+#           Output: 13
+#=============================================================================
+
+use v5.40;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+say pctOfChar(@ARGV);
+
+sub pctOfChar($str, $char)
+{
+    # Solutioh 1: delete everything that isn't char, use remaining length
+    # my $occur = length( $str =~ s/[^$char]//gr );
+    
+    # Solution 2: Global match in list context yields an array of
+    # matching characters. Assigning to scalar yields length of the list.
+    my $occur = @{[ $str =~ m/$char/g ]};
+    return int( 100*($occur / length($str)) + 0.5 );
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( pctOfChar("perl",      "e"), 25, "Example 1 perl e");
+    is( pctOfChar("java",      "a"), 50, "Example 2 java a");
+    is( pctOfChar("python",    "m"),  0, "Example 3 python m");
+    is( pctOfChar("ada",       "a"), 67, "Example 4 ada a");
+    is( pctOfChar("ballerina", "l"), 22, "Example 5 ballerina l");
+    is( pctOfChar("analitik",  "k"), 13, "Example 6 analitik k");
+
+    is( pctOfChar("rrrr", "r"), 100, "100%");
+
+    done_testing;
+}
diff --git a/challenge-273/bob-lied/perl/ch-2.pl b/challenge-273/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..817a23bef8
--- /dev/null
+++ b/challenge-273/bob-lied/perl/ch-2.pl
@@ -0,0 +1,44 @@
+#!/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 273 Task 2 B after A
+#=============================================================================
+# You are given a string, $str.
+# Write a script to return true if there is at least one b, and no a
+# appears after the first b.
+# Example 1 Input: $str = "aabb" Output: true
+# Example 2 Input: $str = "abab" Output: false
+# Example 3 Input: $str = "aaa" Output: false
+# Example 4 Input: $str = "bbb" Output: true
+#=============================================================================
+
+use v5.40;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+say ( bAfterA($_) ? "true" : "false" ) for @ARGV;
+
+sub bAfterA($str)
+{
+    my $w = index($str, "b");
+    return $w >= 0 && index($str, "a", $w) < 0;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is (bAfterA("aabb"), true,  "Example 1");
+    is (bAfterA("abab"), false, "Example 2");
+    is (bAfterA("aaa" ), false, "Example 3");
+    is (bAfterA("bbb" ), true,  "Example 4");
+
+    done_testing;
+}