Solve 346: Longest Parenthesis & Magic Expression by E. Choroba

2 files changed, 96 insertions, 0 deletions

diff --git a/challenge-346/e-choroba/perl/ch-1.pl b/challenge-346/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..44c0f664a4
--- /dev/null
+++ b/challenge-346/e-choroba/perl/ch-1.pl
@@ -0,0 +1,35 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+sub longest_parenthesis($str) {
+    $str =~ s/^\)+//;
+    $str =~ s/\(+$//;
+    for my $length (reverse 2 .. length $str) {
+      FROM:
+        for my $from (0 .. length($str) - $length) {
+            my $depth = 0;
+            for my $pos ($from .. $from + $length - 1) {
+                $depth += substr($str, $pos, 1) eq '(' ? 1 : -1;
+                next FROM if $depth < 0;
+            }
+            return $length if 0 == $depth;
+        }
+    }
+    return 0
+}
+
+use Test::More tests => 5 + 3;
+
+is longest_parenthesis('(()())'), 6, 'Example 1';
+is longest_parenthesis(')()())'), 4, 'Example 2';
+is longest_parenthesis('((()))()(((()'), 8, 'Example 3';
+is longest_parenthesis('))))((()('), 2, 'Example 4';
+is longest_parenthesis('()(()'), 2, 'Example 5';
+
+is longest_parenthesis(''), 0, 'Empty string';
+is longest_parenthesis('('), 0, 'Single char opening';
+is longest_parenthesis(')'), 0, 'Single char closing';
+is longest_parenthesis('))))(((('), 0, 'Zero';
+is longest_parenthesis('(((())(()))((((())()()())'), 12, 'Larger';
diff --git a/challenge-346/e-choroba/perl/ch-2.pl b/challenge-346/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..9acac972ca
--- /dev/null
+++ b/challenge-346/e-choroba/perl/ch-2.pl
@@ -0,0 +1,61 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use feature qw{ say };
+use experimental qw( signatures );
+
+use Algorithm::Combinatorics qw{ variations_with_repetition };
+use List::Util qw{ mesh };
+
+sub magic_expression($str, $target) {
+    my @digits = split //, $str;
+    # We use "" for no operator.
+    my $iter = variations_with_repetition(['+', '-', '*',  ""], @digits - 1);
+    my @correct;
+    while (my $ops = $iter->next) {
+        my $expression = join "", mesh(\@digits, [@$ops, ""]);
+        next if $expression =~ /\b0[0-9]/;  # Only 0 can start with a 0.
+
+        # Implement subtraction as addition of a negative number.
+        my $eval = $expression =~ s/-/+-/gr;
+
+        # First solve all multiplications.
+        $eval =~ s/([0-9]+)\*([0-9]+)/$1*$2/ge while $eval =~ /\*/;
+
+        # Then do additions.
+        $eval =~ s/(-?[0-9]+)\+(-?[0-9]+)/$1+$2/ge while $eval =~ /\+/;
+
+        push @correct, $expression if $target == $eval;
+    }
+    return @correct
+}
+
+use Test2::V0;
+plan(5 + 1);
+
+# It seems we can't insert more than one operator, otherwise 1*-2*-3
+# would have been a solution, too.
+is [magic_expression('123', 6)],
+    bag { item $_ for '1*2*3', '1+2+3'; end },
+    'Example 1';
+
+is [magic_expression('105', 5)],
+    bag { item $_ for '1*0+5', '10-5'; end },
+    'Example 2';
+
+is [magic_expression('232', 8)],
+    bag { item $_ for '2*3+2', '2+3*2'; end },
+    'Example 3';
+
+is [magic_expression('1234', 10)],
+    bag { item $_ for '1*2*3+4', '1+2+3+4'; end },
+    'Example 4';
+
+is [magic_expression('1001', 2)],
+    bag { item $_ for '1+0*0+1', '1+0+0+1', '1+0-0+1',
+                      '1-0*0+1', '1-0+0+1', '1-0-0+1';
+          end },
+    'Example 5';
+
+my @large = magic_expression('123456789', 250);
+is scalar @large, 8, 'Large';