aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--challenge-346/bob-lied/README.md8
-rw-r--r--challenge-346/bob-lied/perl/ch-1.pl121
-rw-r--r--challenge-346/bob-lied/perl/ch-2.pl116
3 files changed, 241 insertions, 4 deletions
diff --git a/challenge-346/bob-lied/README.md b/challenge-346/bob-lied/README.md
index ee7721333a..f38a58abd4 100644
--- a/challenge-346/bob-lied/README.md
+++ b/challenge-346/bob-lied/README.md
@@ -1,5 +1,5 @@
-# Solutions to weekly challenge 345 by Bob Lied
+# Solutions to weekly challenge 346 by Bob Lied
-## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-345/)
-## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-345/bob-lied)
-[Blog](https://dev.to/boblied/pwc-345-i-went-to-the-mountains-43i0)
+## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-346/)
+## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-346/bob-lied)
+[Blog](https://dev.to/boblied/)
diff --git a/challenge-346/bob-lied/perl/ch-1.pl b/challenge-346/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..0daafd4dbf
--- /dev/null
+++ b/challenge-346/bob-lied/perl/ch-1.pl
@@ -0,0 +1,121 @@
+#!/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 346 Task 1 Longest Parenthesis
+#=============================================================================
+# You are given a string containing only ( and ).
+# Write a script to find the length of the longest valid parenthesis.
+# Example 1 Input: $str = '(()())'
+# Output: 6
+# Valid Parenthesis: '(()())'
+# Example 2 Input: $str = ')()())'
+# Output: 4
+# Valid Parenthesis: '()()' at positions 1-4.
+# Example 3 Input: $str = '((()))()(((()'
+# Output: 8
+# Valid Parenthesis: '((()))()' at positions 0-7.
+# Example 4 Input: $str = '))))((()('
+# Output: 2
+# Valid Parenthesis: '()' at positions 6-7.
+# Example 5 Input: $str = '()(()'
+# Output: 2
+# Valid Parenthesis: '()' at positions 0-1 and 3-4.
+#=============================================================================
+
+use v5.42;
+
+
+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 longestParen($_) for @ARGV;
+
+#=============================================================================
+sub longestParenSub($str)
+{
+ # Since the ony characters are ( and ), if there are any balanced
+ # sets at all, at some point there must be a (). Replace those with
+ # something else (I'm using xx). Then keep replacing matching pairs
+ # of parenthese as long as we have (xxxxxx) patterns.
+ while ( $str =~ s/\((x*)\)/x$1x/g ) { }
+
+ # Extract the strings of x, map to length, and find the longest one.
+ use List::Util qw/max/;
+ return ( max map { length($_) } $str =~ m/x+/g ) // 0;
+}
+sub longestParen($str)
+{
+ # Leading ) and trailing ( can never pair up, so a small
+ # optimization is to trim those off before we start.
+ $str =~ s/^\)+//;
+ $str =~ s/\($//;
+
+ # Stack up when we hit a (, pop off when we find a ).
+ my @stack = ( -1 );
+ my $longest = my $streak = 0;
+ for my ($i, $p) ( indexed split(//, $str) )
+ {
+ if ( $p eq '(' )
+ {
+ push @stack, $i; # Note, pushing index
+ }
+ else {
+ pop @stack;
+ if ( @stack )
+ {
+ my $len = $i - $stack[-1];
+ $logger->debug(") i=$i len=$len stack=(@stack)");
+ $longest = $len if $len > $longest;
+ }
+ }
+ $logger->debug("$p i=$i, longest=$longest, stack=(@stack)");
+ }
+
+ return $longest;
+}
+
+sub runTest
+{
+ use Test2::V0;
+
+ is( longestParen('(()())' ), 6, "Example 1");
+ is( longestParen(')()())' ), 4, "Example 2");
+ is( longestParen('((()))()(((()'), 8, "Example 3");
+ is( longestParen('))))((()(' ), 2, "Example 4");
+ is( longestParen('()(()' ), 2, "Example 5");
+ is( longestParen(')))))' ), 0, "None )");
+ is( longestParen('(((((' ), 0, "None (");
+ is( longestParen('))(((' ), 0, "None )(");
+ is( longestParen('(((((())))))' ), 12, "All");
+
+ done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+ use Benchmark qw/cmpthese/;
+
+ my $str = join('', map { int(rand(2)) % 2 ? '(' : ')' } 1..100);
+ $logger->debug($str);
+ cmpthese($repeat, {
+ stack => sub { longestParen($str) },
+ subst => sub { longestParenSub($str) },
+ });
+}
diff --git a/challenge-346/bob-lied/perl/ch-2.pl b/challenge-346/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..ee93a1f817
--- /dev/null
+++ b/challenge-346/bob-lied/perl/ch-2.pl
@@ -0,0 +1,116 @@
+#!/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 346 Task 2 Magic Expression
+#=============================================================================
+# You are given a string containing only digits and a target integer.
+# Write a script to insert binary operators +, - and * between the digits
+# in the given string that evaluates to target integer.
+# Example 1 Input: $str = "123", $target = 6
+# Output: ("1*2*3", "1+2+3")
+# Example 2 Input: $str = "105", $target = 5
+# Output: ("1*0+5", "10-5")
+# Example 3 Input: $str = "232", $target = 8
+# Output: ("2*3+2", "2+3*2")
+# Example 4 Input: $str = "1234", $target = 10
+# Output: ("1*2*3+4", "1+2+3+4")
+# Example 5 Input: $str = "1001", $target = 2
+# Output: ("1+0*0+1", "1+0+0+1", "1+0-0+1", "1-0*0+1", "1-0+0+1", "1-0-0+1")
+#=============================================================================
+
+use v5.42;
+use feature "class"; no warnings "experimental::class";
+
+
+use Getopt::Long;
+my $Verbose = false;
+my $DoTest = false;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+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();
+}
+#=============================================================================
+# Iterator to do permutations by counting. If there are 'base' objects, count
+# in base 'base'. Take it up to 'n' choices, then return undef to signal
+# the end.
+class Permute {
+ field $base :param //= 4;
+ field $n :param //= 3;
+ field $max = $base ** ($n);
+
+ field @c = (0) x $n;
+ field $count = 0;
+ field $number = 0;
+
+ method next()
+ {
+ return undef if ++$number >= $max;
+
+ my $place = 0;
+ my $carry;
+ while ( ($carry = (++$c[$place] % $base)) == 0 )
+ {
+ $c[$place++] = 0;
+ }
+ return $self;
+ }
+
+ # Return the selections as reference to array.
+ method val() { return $number < $max ? \@c : undef }
+
+ method show() { "(" . join(" ", reverse(@c)) . ")" }
+};
+#=============================================================================
+
+exit(!runTest()) if $DoTest;
+
+say '(', join(', ', magic(@ARGV)->@*), ')';
+
+#=============================================================================
+sub magic($str, $target)
+{
+ state @OP = ("", "-", "+", "*");
+ $logger->debug("@OP");
+
+ my @s = split(//, $str);
+ my @expr;
+
+ my $count = Permute->new( base => scalar(@OP), n => $#s );
+
+ for ( ; my $idx = $count->val ; $count->next )
+ {
+ my @ops = ( ( map { $OP[$_] } $count->val()->@*), "");
+
+ use List::Util qw/mesh/;
+ my $e = join("", mesh \@s, \@ops);
+
+ # Numbers with leading zeroes don't count
+ next if $e =~ m/^0\d|[^0-9]0\d/;
+
+ my $t = eval $e;
+ $logger->debug("ops:", $count->show(), " |", join("|", @ops), '|', "expr: ", $e, "=$t");
+ push @expr, $e if $t == $target;
+ }
+
+ return [sort @expr];
+}
+
+sub runTest
+{
+ use Test2::V0;
+
+ is( magic("123", 6), ["1*2*3", "1+2+3" ] , "Example 1");
+ is( magic("105", 5), ["1*0+5", "10-5" ] , "Example 2");
+ is( magic("232", 8), ["2*3+2", "2+3*2" ] , "Example 3");
+ is( magic("1234", 10), ["1*2*3+4", "1+2+3+4"] , "Example 4");
+ is( magic("1001", 2), ["1+0*0+1", "1+0+0+1", "1+0-0+1", "1-0*0+1", "1-0+0+1", "1-0-0+1"] , "Example 5");
+
+ done_testing;
+}
generated by cgit (git 2.34.1) at 2026-04-18 22:24:34 +0000