Challenge 346

2 files changed, 113 insertions, 0 deletions

diff --git a/challenge-346/mahnkong/perl/ch-1.pl b/challenge-346/mahnkong/perl/ch-1.pl
new file mode 100644
index 0000000000..7cfa9da985
--- /dev/null
+++ b/challenge-346/mahnkong/perl/ch-1.pl
@@ -0,0 +1,42 @@
+use strict;
+use warnings;
+use feature 'signatures';
+use Test::More 'no_plan';
+
+sub run($str) {
+    my @candidates;
+    foreach my $c (split //, $str) {
+        my $open = 0;
+        if ($c eq '(') {
+            push @candidates, {
+                open => 0,
+                found => 0,
+            };
+            $open = 1;
+        } elsif ($c eq ')') {
+            $open = -1;
+        }
+        foreach my $candidate (@candidates) {
+            next unless exists $candidate->{open};
+            $candidate->{found} += 1;
+            $candidate->{open} += $open;
+            if ($candidate->{open} == 0) {
+                push @candidates, {
+                    found => $candidate->{found},
+                }
+            }
+        }
+    }
+
+    my $result = 0;
+    foreach my $candidate (@candidates) {
+        $result = $candidate->{found} if ! exists $candidate->{open} && $candidate->{found} > $result;
+    }
+    return $result;
+}
+
+is(run('(()())'), 6, "Example 1");
+is(run(')()())'), 4, "Example 2");
+is(run('((()))()(((()'), 8, "Example 3");
+is(run('))))((()('), 2, "Example 4");
+is(run('()(()'), 2, "Example 5");
diff --git a/challenge-346/mahnkong/perl/ch-2.pl b/challenge-346/mahnkong/perl/ch-2.pl
new file mode 100644
index 0000000000..d0479e9190
--- /dev/null
+++ b/challenge-346/mahnkong/perl/ch-2.pl
@@ -0,0 +1,71 @@
+use strict;
+use warnings;
+use feature 'signatures';
+use Test::More 'no_plan';
+
+my @operations = ('*', '+', '-');
+
+sub all_substring_splits($str, $prefix) {
+    $prefix //= [];
+    my @results;
+
+    if ($str eq '') {
+        push @results, [@$prefix];
+        return @results;
+    }
+
+    for my $i (1 .. length($str)) {
+        my $first = substr($str, 0, $i);
+        my $rest  = substr($str, $i);
+        push @results, all_substring_splits($rest, [@$prefix, $first]);
+    }
+
+    return @results;
+}
+
+sub add_operators($list, @result) {
+    if (scalar(@$list)) {
+        my $left = shift @$list;
+        my @local;
+        if (scalar(@result)) {
+            foreach my $r (@result) {
+                if (scalar(@$list)) {
+                    foreach my $operator (@operations) {
+                        push @local, "$r$left$operator";
+                    }
+                } else {
+                    push @local, "$r$left";
+                }
+            }
+        } else {
+            foreach my $operator (@operations) {
+                push @local, "$left$operator";
+            }
+        }
+        @result = @local;
+
+        foreach my $part (@$list) {
+            @result = add_operators($list, @result);
+        }
+    }
+    return @result;
+}
+
+
+sub run($str, $target) {
+    my @result;
+    foreach my $candidate_list (all_substring_splits($str, undef)) {
+        next if scalar(@$candidate_list == 1);
+        next if grep /^0\d/, @$candidate_list;
+        foreach my $eval (add_operators($candidate_list)) {
+            push @result, $eval if $target == eval $eval;
+        }
+    }
+    return \@result;
+}
+
+is_deeply(run("123", 6), ["1*2*3", "1+2+3"], "Example 1");
+is_deeply(run("105", 5), ["1*0+5", "10-5"], "Example 2");
+is_deeply(run("232", 8), ["2*3+2", "2+3*2"], "Example 3");
+is_deeply(run("1234", 10), ["1*2*3+4", "1+2+3+4"], "Example 4");
+is_deeply(run("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");