Merge pull request #12994 from wanderdoc/master

pwc 346 (wanderdoc)

2 files changed, 206 insertions, 0 deletions

diff --git a/challenge-346/wanderdoc/perl/ch-1.pl b/challenge-346/wanderdoc/perl/ch-1.pl
new file mode 100644
index 0000000000..898efc6b05
--- /dev/null
+++ b/challenge-346/wanderdoc/perl/ch-1.pl
@@ -0,0 +1,84 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+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.
+=cut
+
+
+use Test2::V0 -no_srand => 1;
+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');
+done_testing();
+
+
+sub longest_parenthesis
+{
+     my $str = $_[0];
+     my $my_parens = qr/(\((?:(?-1))*+\))/; # perlre (?PARNO) (?-PARNO) (?+PARNO) (?R) (?0)
+     my $sum_length; 
+     my $max_sum_length = 0;
+     my $prev_pos;
+
+
+     while ($str =~ /$my_parens/g)
+     {
+          my $this_length = length($1);
+          my $this_pos = pos($str);
+          if  ($prev_pos and ($prev_pos + $this_length == $this_pos) )
+          {
+               $sum_length += length($1);
+          }
+          else
+          {
+               $sum_length = $this_length;
+          }
+          $prev_pos = $this_pos;
+          $max_sum_length = $sum_length > $max_sum_length? $sum_length : $max_sum_length;
+     }
+     return $max_sum_length;
+}
diff --git a/challenge-346/wanderdoc/perl/ch-2.pl b/challenge-346/wanderdoc/perl/ch-2.pl
new file mode 100644
index 0000000000..f48e6e51dd
--- /dev/null
+++ b/challenge-346/wanderdoc/perl/ch-2.pl
@@ -0,0 +1,122 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+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")
+
+=cut
+
+
+
+
+use List::MoreUtils qw(pairwise);
+use Safe;
+use Test2::V0 -no_srand => 1;
+
+
+
+
+is([magic_expression(123, 6)], ["1*2*3", "1+2+3"], 'Example 1');
+is([magic_expression(105, 5)], ["1*0+5", "10-5"], 'Example 2');
+is([magic_expression(232, 8)], ["2*3+2", "2+3*2"], 'Example 3');
+is([magic_expression(1234, 10)], ["1*2*3+4", "1+2+3+4"], 'Example 4');
+is([magic_expression(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();
+
+sub magic_expression
+{
+     my ($str, $target) = @_;
+     my @arr = split(//, $str);
+     my @output;
+     my $iterator = variations_iterator(['*', '+', '-', ''], scalar(@arr) - 1, 1);
+     while (my $variation = $iterator->()) 
+     {
+          my @var = @$variation;
+          push @var, '';
+          my $result_str = join('', pairwise { $a . $b } @arr, @var);
+          next if $result_str =~ /(?:^|\+|\-|\*)0[0-9]/;
+          # my $result = eval $result_str;
+          my $compartment = Safe->new;
+          $compartment->permit(qw(multiply add subtract));
+          my $result = $compartment->reval($result_str);
+          push @output, $result_str if $result == $target;
+     }
+     return @output;
+}
+
+
+
+sub variations_iterator
+{
+     my ($aref, $k, $flag_repetition) = @_;
+     my @array = @$aref;
+
+     my @stack = ([]);  
+     my @remaining = (\@array); 
+
+     return sub 
+     {
+          while (@stack) 
+          {
+               # Get the current state
+               my $partial = pop @stack; 
+               my $rest = pop @remaining;
+                    
+               if ( @$partial == $k )
+               {
+                    return $partial;
+               }
+               else 
+               {
+                    for my $i ( reverse 0 .. $#$rest)
+                    {
+                         # New partial permutation
+                         my @new_partial = (@$partial, $rest->[$i]);
+
+                         # New remaining array excluding the current element
+                         # (if no repetition):
+                         my @new_rest = @$rest;
+                         if ( not $flag_repetition )
+                         {
+                              splice(@new_rest, $i, 1);
+                         }
+                         push @stack, \@new_partial;
+                         push @remaining, \@new_rest;
+                         
+                    }
+               }
+          }
+          return undef;
+     };
+}