Merge pull request #12984 from pme/challenge-346

challenge-346

4 files changed, 408 insertions, 0 deletions

diff --git a/challenge-346/peter-meszaros/perl/ch-1.pl b/challenge-346/peter-meszaros/perl/ch-1.pl
new file mode 100755
index 0000000000..5ff968f6df
--- /dev/null
+++ b/challenge-346/peter-meszaros/perl/ch-1.pl
@@ -0,0 +1,90 @@
+#!/usr/bin/env perl
+#
+=head1 Task 1: Longest Parenthesis
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string containing only ( and ).
+
+Write a script to find the length of the longest valid parenthesis.
+
+=head2 Example 1
+
+    Input: $str = '(()())'
+    Output: 6
+
+    Valid Parenthesis: '(()())'
+
+=head2 Example 2
+
+    Input: $str = ')()())'
+    Output: 4
+
+    Valid Parenthesis: '()()' at positions 1-4.
+
+=head2 Example 3
+
+    Input: $str = '((()))()(((()'
+    Output: 8
+
+    Valid Parenthesis: '((()))()' at positions 0-7.
+
+=head2 Example 4
+
+    Input: $str = '))))((()('
+    Output: 2
+
+    Valid Parenthesis: '()' at positions 6-7.
+
+=head2 Example 5
+
+    Input: $str = '()(()'
+    Output: 2
+
+    Valid Parenthesis: '()' at positions 0-1 and 3-4.
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+use constant { true => 1, false => 0 };
+
+my $cases = [
+    ['(()())',        6, "Example 1"],
+    [')()())',        4, "Example 2"],
+    ['((()))()(((()', 8, "Example 3"],
+    ['))))((()(',     2, "Example 4"],
+    ['()(()',         2, "Example 5"],
+];
+
+sub longest_parenthesis
+{
+    my $s = shift;
+    my @stack = (-1);
+    my $max_length = 0;
+
+    for (my $i = 0; $i < length($s); $i++) {
+        my $char = substr($s, $i, 1);
+        if ($char eq '(') {
+            push @stack, $i;
+        } else {
+            pop @stack;
+            if (@stack) {
+                my $length = $i - $stack[-1];
+                $max_length = $length if $length > $max_length;
+            } else {
+                push @stack, $i;
+            }
+        }
+    }
+    return $max_length;
+}
+
+for (@$cases) {
+    is(longest_parenthesis($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
diff --git a/challenge-346/peter-meszaros/perl/ch-2.pl b/challenge-346/peter-meszaros/perl/ch-2.pl
new file mode 100755
index 0000000000..52b59b6a3f
--- /dev/null
+++ b/challenge-346/peter-meszaros/perl/ch-2.pl
@@ -0,0 +1,85 @@
+#!/usr/bin/env perl
+#
+=head1 Task 2: Magic Expression
+
+Submitted by: Mohammad Sajid Anwar
+
+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.
+
+=head2 Example 1
+
+    Input: $str = "123", $target = 6
+    Output: ("1*2*3", "1+2+3")
+
+=head2 Example 2
+
+    Input: $str = "105", $target = 5
+    Output: ("1*0+5", "10-5")
+
+=head2 Example 3
+
+    Input: $str = "232", $target = 8
+    Output: ("2*3+2", "2+3*2")
+
+=head2 Example 4
+
+    Input: $str = "1234", $target = 10
+    Output: ("1*2*3+4", "1+2+3+4")
+
+=head2 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 strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+use constant { true => 1, false => 0 };
+use Algorithm::Combinatorics qw/variations_with_repetition/;
+
+
+my $cases = [
+    [["123",   6], ["1*2*3", "1+2+3"],      "Example 1"],
+    [["105",   5], ["1*0+5", "10-5"],       "Example 2"],
+    [["232",   8], ["2*3+2", "2+3*2"],      "Example 3"],
+    [["1234", 10], ["1*2*3+4", "1+2+3+4"],  "Example 4"],
+    [["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"],
+];
+
+sub magic_expression
+{
+    my $str    = $_[0]->[0];
+    my $target = $_[0]->[1];
+
+    my @oper = ('*', '-', '+', '');
+    my @str = split //, $str;
+    my $result;
+    my $iter = variations_with_repetition(\@oper, length($str) - 1);
+    while (my $c = $iter->next) {
+        my $expr;
+        for (my $i = 0; $i < length($str) - 1; $i++) {
+            $expr .= $str[$i] . $c->[$i];
+        }
+        $expr .= $str[-1];
+        my $eval = eval $expr;
+        next if $expr =~ /0\d/;
+        if (defined $eval && $eval == $target) {
+            push @$result, $expr;
+        }
+    }
+    return $result;
+}
+
+for (@$cases) {
+    is(magic_expression($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
diff --git a/challenge-346/peter-meszaros/tcl/ch-1.tcl b/challenge-346/peter-meszaros/tcl/ch-1.tcl
new file mode 100755
index 0000000000..cd4e85e96b
--- /dev/null
+++ b/challenge-346/peter-meszaros/tcl/ch-1.tcl
@@ -0,0 +1,88 @@
+#!/usr/bin/env tclsh
+#
+# Task 1: Longest Parenthesis
+# 
+# Submitted by: Mohammad Sajid Anwar
+# 
+# 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.
+# 
+
+package require tcltest
+
+set cases {
+    {"(()())"        6 "Example 1"}
+    {")()())"        4 "Example 2"}
+    {"((()))()(((()" 8 "Example 3"}
+    {"))))((()("     2 "Example 4"}
+    {"()(()"         2 "Example 5"}
+}
+
+proc longest_parenthesis {s} {
+    set stack {-1}
+    set max_length 0
+
+    for {set i 0} {$i < [string length $s]} {incr i} {
+        set char [string index $s $i]
+        if {$char eq "("} {
+            lappend stack $i
+        } else {
+            set stack [lrange $stack 0 end-1]
+            if {[llength $stack] > 0} {
+                set length [expr $i - [lindex $stack end]]
+                if {$length > $max_length} {
+                    set max_length $length
+                }
+            } else {
+                lappend stack $i
+            }
+        }
+    }
+    return $max_length
+}
+
+tcltest::configure -verbose {pass}
+foreach case $cases {
+    tcltest::test [lindex $case 2] {} {
+        longest_parenthesis [lindex $case 0]
+    } [lindex $case 1]
+}
+
+exit 0
+
diff --git a/challenge-346/peter-meszaros/tcl/ch-2.tcl b/challenge-346/peter-meszaros/tcl/ch-2.tcl
new file mode 100755
index 0000000000..6501b2a2ef
--- /dev/null
+++ b/challenge-346/peter-meszaros/tcl/ch-2.tcl
@@ -0,0 +1,145 @@
+#!/usr/bin/env tclsh
+#
+# Task 2: Magic Expression
+# 
+# Submitted by: Mohammad Sajid Anwar
+# 
+# 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")
+# 
+
+package require Tcl 8.6
+package require tcltest
+
+set cases {
+    {{"123"   6} {1*2*3 1+2+3}     "Example 1"}
+    {{"105"   5} {1*0+5 10-5}      "Example 2"}
+    {{"232"   8} {2*3+2 2+3*2}     "Example 3"}
+    {{"1234" 10} {1*2*3+4 1+2+3+4} "Example 4"}
+    {{"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"}
+}
+
+# Utility function to make procedures that define generators
+# Copied from https://rosettacode.org/wiki/Permutations_with_repetitions#Version_without_additional_libraries
+proc generator {name arguments body} {
+    set body [list try $body on ok {} {return -code break}]
+    set lambda [list $arguments "yield \[info coroutine\];$body"]
+    proc $name args "tailcall \
+        coroutine gen_\[incr ::generate_ctr\] apply [list $lambda] {*}\$args"
+}
+
+# How to generate permutations with repetitions
+generator permutationsWithRepetitions {input n} {
+    if {[llength $input] == 0 || $n < 1} {error "bad arguments"}
+    if {![incr n -1]} {
+        foreach el $input {
+            yield [list $el]
+        }
+    } else {
+        foreach el $input {
+            set g [permutationsWithRepetitions $input $n]
+            while 1 {
+                yield [list $el {*}[$g]]
+            }
+        }
+    }
+}
+
+proc magic_expression {p} {
+    set str    [lindex $p 0]
+    set target [lindex $p 1]
+
+    set oper { * - + "" }
+    set str_list [split $str {}]
+    set result {}
+    set len [expr [string length $str] - 1]
+
+    set g [permutationsWithRepetitions $oper $len]
+    while 1 {
+        set o [$g]
+        set expression ""
+        for {set i 0} {$i < $len} {incr i} {
+            append expression [lindex $str_list $i] [lindex $o $i]
+        }
+        append expression [lindex $str_list end]
+        if {[regexp {0\d} $expression]} {
+            continue
+        }
+        set res [expr $expression]
+        #puts "expression: $expression -> $res"
+        if {$res == $target} {
+            lappend result $expression
+        }
+    }
+    return $result
+}
+
+tcltest::configure -verbose {pass}
+foreach case $cases {
+    tcltest::test [lindex $case 2] {} {
+        magic_expression [lindex $case 0]
+    } [lindex $case 1]
+}
+
+exit 0
+
+
+
+sub magic_expression
+{
+    my $str    = $_[0]->[0];
+    my $target = $_[0]->[1];
+
+    my @oper = ('*', '-', '+', '');
+    my @str = split //, $str;
+    my $result;
+    my $iter = variations_with_repetition(\@oper, length($str) - 1);
+    while (my $c = $iter->next) {
+        my $expr;
+        for (my $i = 0; $i < length($str) - 1; $i++) {
+            $expr .= $str[$i] . $c->[$i];
+        }
+        $expr .= $str[-1];
+        my $eval = eval $expr;
+        next if $expr =~ /0\d/;
+        if (defined $eval && $eval == $target) {
+            push @$result, $expr;
+        }
+    }
+    return $result;
+}
+
+for (@$cases) {
+    is(magic_expression($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;