Week 346 solutions

2 files changed, 67 insertions, 20 deletions

diff --git a/challenge-346/bob-lied/perl/ch-1.pl b/challenge-346/bob-lied/perl/ch-1.pl
index f84a011408..0daafd4dbf 100644
--- a/challenge-346/bob-lied/perl/ch-1.pl
+++ b/challenge-346/bob-lied/perl/ch-1.pl
@@ -50,33 +50,40 @@ 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;
-    my $open = 0;
     for my ($i, $p) ( indexed split(//, $str) )
     {
         if ( $p eq '(' )
         {
-            push @stack, $i;
+            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;
             }
-            else
-            {
-                push @stack, $i;
-            }
         }
         $logger->debug("$p i=$i, longest=$longest, stack=(@stack)");
     }
diff --git a/challenge-346/bob-lied/perl/ch-2.pl b/challenge-346/bob-lied/perl/ch-2.pl
index 47abbaa0c6..ee93a1f817 100644
--- a/challenge-346/bob-lied/perl/ch-2.pl
+++ b/challenge-346/bob-lied/perl/ch-2.pl
@@ -21,14 +21,14 @@
 #=============================================================================
 
 use v5.42;
+use feature "class"; no warnings "experimental::class";
 
 
 use Getopt::Long;
 my $Verbose = false;
 my $DoTest  = false;
-my $Benchmark = 0;
 
-GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$Benchmark);
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
 my $logger;
 {
     use Log::Log4perl qw(:easy);
@@ -37,9 +37,39 @@ my $logger;
     $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;
-exit( runBenchmark($Benchmark) ) if $Benchmark;
 
 say '(', join(', ', magic(@ARGV)->@*), ')';
 
@@ -48,8 +78,28 @@ sub magic($str, $target)
 {
     state @OP = ("", "-", "+", "*");
     $logger->debug("@OP");
+
+    my @s = split(//, $str);
     my @expr;
-    return \@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
@@ -64,13 +114,3 @@ sub runTest
 
     done_testing;
 }
-
-sub runBenchmark($repeat)
-{
-    use Benchmark qw/cmpthese/;
-
-    cmpthese($repeat, {
-            label => sub { },
-        });
-}
-