challenge-342

4 files changed, 395 insertions, 0 deletions

diff --git a/challenge-342/peter-meszaros/perl/ch-1.pl b/challenge-342/peter-meszaros/perl/ch-1.pl
new file mode 100755
index 0000000000..bdfbd888ba
--- /dev/null
+++ b/challenge-342/peter-meszaros/perl/ch-1.pl
@@ -0,0 +1,82 @@
+#!/usr/bin/env perl
+#
+=head1 Task 1: Balance String
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string made up of lowercase English letters and digits only.
+
+Write a script to format the give string where no letter is followed by another
+letter and no digit is followed by another digit. If there are multiple valid
+rearrangements, always return the lexicographically smallest one. Return empty
+string if it is impossible to format the string.
+
+=head2 Example 1
+
+    Input: $str = "a0b1c2"
+    Output: "0a1b2c"
+
+=head2 Example 2
+
+    Input: $str = "abc12"
+    Output: "a1b2c"
+
+=head2 Example 3
+
+    Input: $str = "0a2b1c3"
+    Output: "0a1b2c3"
+
+=head2 Example 4
+
+    Input: $str = "1a23"
+    Output: ""
+
+=head2 Example 5
+
+    Input: $str = "ab123"
+    Output: "1a2b3"
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+
+my $cases = [
+    ["a0b1c2",  "0a1b2c",  "Example 1"],
+    ["abc12",   "a1b2c",   "Example 2"],
+    ["0a2b1c3", "0a1b2c3", "Example 3"],
+    ["1a23",    "",        "Example 4"],
+    ["ab123",   "1a2b3",   "Example 5"],
+];
+
+sub balance_string
+{
+    my $str = shift;
+
+    my @chars = sort split //, $str;
+    my @digits = sort grep { /\d/ } @chars;
+    my @letters = sort grep { /\D/ } @chars;
+    my $len_diff = @letters - @digits;
+    return "" if abs($len_diff) > 1;
+
+    my $letter_comes = $len_diff <= 0 ? 0 : 1;
+    my $result = "";
+    while (@letters || @digits) {
+        if ($letter_comes) {
+            $result .= shift @letters if @letters;
+        } else {
+            $result .= shift @digits if @digits;
+        }
+        $letter_comes = !$letter_comes;
+    }
+    return $result;
+}
+
+for (@$cases) {
+    is(balance_string($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
diff --git a/challenge-342/peter-meszaros/perl/ch-2.pl b/challenge-342/peter-meszaros/perl/ch-2.pl
new file mode 100755
index 0000000000..45d9ff4a9f
--- /dev/null
+++ b/challenge-342/peter-meszaros/perl/ch-2.pl
@@ -0,0 +1,94 @@
+#!/usr/bin/env perl
+#
+=head1 Task 2: Max Score
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string, $str, containing 0 and 1 only.
+
+Write a script to return the max score after splitting the string into two
+non-empty substrings. The score after splitting a string is the number of zeros
+in the left substring plus the number of ones in the right substring.
+
+=head2 Example 1
+
+    Input: $str = "0011"
+    Output: 4
+
+    1: left = "0", right = "011" => 1 + 2 => 3
+    2: left = "00", right = "11" => 2 + 2 => 4
+    3: left = "001", right = "1" => 2 + 1 => 3
+
+=head2 Example 2
+
+    Input: $str = "0000"
+    Output: 3
+
+    1: left = "0", right = "000" => 1 + 0 => 1
+    2: left = "00", right = "00" => 2 + 0 => 2
+    3: left = "000", right = "0" => 3 + 0 => 3
+
+=head2 Example 3
+
+    Input: $str = "1111"
+    Output: 3
+
+    1: left = "1", right = "111" => 0 + 3 => 3
+    2: left = "11", right = "11" => 0 + 2 => 2
+    3: left = "111", right = "1" => 0 + 1 => 1
+
+=head2 Example 4
+
+    Input: $str = "0101"
+    Output: 3
+
+    1: left = "0", right = "101" => 1 + 2 => 3
+    2: left = "01", right = "01" => 1 + 1 => 2
+    3: left = "010", right = "1" => 2 + 1 => 3
+
+=head2 Example 5
+
+    Input: $str = "011101"
+    Output: 5
+
+    1: left = "0", right = "11101" => 1 + 4 => 5
+    2: left = "01", right = "1101" => 1 + 3 => 4
+    3: left = "011", right = "101" => 1 + 2 => 3
+    4: left = "0111", right = "01" => 1 + 1 => 2
+    5: left = "01110", right = "1" => 2 + 1 => 3
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+
+my $cases = [
+    ["0011",   4, "Example 1"],
+    ["0000",   3, "Example 2"],
+    ["1111",   3, "Example 3"],
+    ["0101",   3, "Example 4"],
+    ["011101", 5, "Example 5"],
+];
+
+sub max_score
+{
+    my $str = shift;
+
+    my $max = 0;
+    for my $i (1 .. length($str) - 1) {
+        my $left  = substr($str, 0, $i);
+        my $right = substr($str, $i);
+        my $score = ($left =~ tr/0//) + ($right =~ tr/1//);
+        $max = $score if $score > $max;
+    }
+    return $max;
+}
+
+for (@$cases) {
+    is(max_score($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
diff --git a/challenge-342/peter-meszaros/tcl/ch-1.tcl b/challenge-342/peter-meszaros/tcl/ch-1.tcl
new file mode 100755
index 0000000000..66ff039d95
--- /dev/null
+++ b/challenge-342/peter-meszaros/tcl/ch-1.tcl
@@ -0,0 +1,127 @@
+#!/usr/bin/env tclsh
+#
+# Task 1: Balance String
+# 
+# Submitted by: Mohammad Sajid Anwar
+# 
+# You are given a string made up of lowercase English letters and digits only.
+# 
+# Write a script to format the give string where no letter is followed by another
+# letter and no digit is followed by another digit. If there are multiple valid
+# rearrangements, always return the lexicographically smallest one. Return empty
+# string if it is impossible to format the string.
+# 
+# Example 1
+# 
+#     Input: $str = "a0b1c2"
+#     Output: "0a1b2c"
+# 
+# Example 2
+# 
+#     Input: $str = "abc12"
+#     Output: "a1b2c"
+# 
+# Example 3
+# 
+#     Input: $str = "0a2b1c3"
+#     Output: "0a1b2c3"
+# 
+# Example 4
+# 
+#     Input: $str = "1a23"
+#     Output: ""
+# 
+# Example 5
+# 
+#     Input: $str = "ab123"
+#     Output: "1a2b3"
+# 
+
+package require tcltest
+
+set cases {
+    {"a0b1c2"  "0a1b2c"  "Example 1"}
+    {"abc12"   "a1b2c"   "Example 2"}
+    {"0a2b1c3" "0a1b2c3" "Example 3"}
+    {"1a23"    ""        "Example 4"}
+    {"ab123"   "1a2b3"   "Example 5"}
+}
+
+proc balance_string {str} {
+
+    set chars [split $str ""]
+    set digits [lsort [lmap c $chars {
+        if {![string is digit $c]} continue
+        set c
+    }]]
+    set letters [lsort [lmap c $chars {
+        if {[string is digit $c]} continue
+        set c
+    }]]
+    set len_diff [expr [llength $letters] - [llength $digits]]
+    if {abs($len_diff) > 1} {
+        return ""
+    }
+
+
+    set letter_comes [expr $len_diff <= 0 ? 0 : 1]
+    set result ""
+    while {[llength $letters] > 0 || [llength $digits] > 0} {
+        if {$letter_comes} {
+            if {[llength $letters] > 0} {
+                lappend result [lindex $letters 0]
+                set letters [lrange $letters 1 end]
+            }
+        } else {
+            if {[llength $digits] > 0} {
+                lappend result [lindex $digits 0]
+                set digits [lrange $digits 1 end]
+            }
+        }
+        set letter_comes [expr !$letter_comes]
+    }
+    set result [join $result ""]
+    return $result
+}
+
+tcltest::configure -verbose {pass}
+foreach case $cases {
+    tcltest::test [lindex $case 2] {} {
+        balance_string [lindex $case 0]
+    } [lindex $case 1]
+}
+
+exit 0
+
+
+
+sub balance_string
+{
+    my $str = shift;
+
+    my @chars = sort split //, $str;
+    my @digits = sort grep { /\d/ } @chars;
+    my @letters = sort grep { /\D/ } @chars;
+    my $len_diff = @letters - @digits;
+    return "" if abs($len_diff) > 1;
+
+    my $letter_comes = $len_diff <= 0 ? 0 : 1;
+    my $result = "";
+    while (@letters || @digits) {
+        if ($letter_comes) {
+            $result .= shift @letters if @letters;
+        } else {
+            $result .= shift @digits if @digits;
+        }
+        $letter_comes = !$letter_comes;
+    }
+    return $result;
+}
+
+for (@$cases) {
+    is(balance_string($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
+
diff --git a/challenge-342/peter-meszaros/tcl/ch-2.tcl b/challenge-342/peter-meszaros/tcl/ch-2.tcl
new file mode 100755
index 0000000000..91a4af6a1e
--- /dev/null
+++ b/challenge-342/peter-meszaros/tcl/ch-2.tcl
@@ -0,0 +1,92 @@
+#!/usr/bin/env tclsh
+#
+# Task 2: Max Score
+# 
+# Submitted by: Mohammad Sajid Anwar
+# 
+# You are given a string, $str, containing 0 and 1 only.
+# 
+# Write a script to return the max score after splitting the string into two
+# non-empty substrings. The score after splitting a string is the number of zeros
+# in the left substring plus the number of ones in the right substring.
+# 
+# Example 1
+# 
+#     Input: $str = "0011"
+#     Output: 4
+# 
+#     1: left = "0", right = "011" => 1 + 2 => 3
+#     2: left = "00", right = "11" => 2 + 2 => 4
+#     3: left = "001", right = "1" => 2 + 1 => 3
+# 
+# Example 2
+# 
+#     Input: $str = "0000"
+#     Output: 3
+# 
+#     1: left = "0", right = "000" => 1 + 0 => 1
+#     2: left = "00", right = "00" => 2 + 0 => 2
+#     3: left = "000", right = "0" => 3 + 0 => 3
+# 
+# Example 3
+# 
+#     Input: $str = "1111"
+#     Output: 3
+# 
+#     1: left = "1", right = "111" => 0 + 3 => 3
+#     2: left = "11", right = "11" => 0 + 2 => 2
+#     3: left = "111", right = "1" => 0 + 1 => 1
+# 
+# Example 4
+# 
+#     Input: $str = "0101"
+#     Output: 3
+# 
+#     1: left = "0", right = "101" => 1 + 2 => 3
+#     2: left = "01", right = "01" => 1 + 1 => 2
+#     3: left = "010", right = "1" => 2 + 1 => 3
+# 
+# Example 5
+# 
+#     Input: $str = "011101"
+#     Output: 5
+# 
+#     1: left = "0", right = "11101" => 1 + 4 => 5
+#     2: left = "01", right = "1101" => 1 + 3 => 4
+#     3: left = "011", right = "101" => 1 + 2 => 3
+#     4: left = "0111", right = "01" => 1 + 1 => 2
+#     5: left = "01110", right = "1" => 2 + 1 => 3
+# 
+
+package require tcltest
+
+set cases {
+    {"0011"   4 "Example 1"} 
+    {"0000"   3 "Example 2"} 
+    {"1111"   3 "Example 3"} 
+    {"0101"   3 "Example 4"} 
+    {"011101" 5 "Example 5"} 
+}
+
+proc max_score {str} {
+    set max 0
+    for {set i 1} {$i < [string length $str]} {incr i} {
+        set left [string range $str 0 [expr $i - 1]]
+        set right [string range $str $i end]
+        set score [expr [regexp -all {0} $left] + [regexp -all {1} $right]]
+        if {$score > $max} {
+            set max $score
+        }
+    }
+    return $max
+}
+
+tcltest::configure -verbose {pass}
+foreach case $cases {
+    tcltest::test [lindex $case 2] {} {
+        max_score [lindex $case 0]
+    } [lindex $case 1]
+}
+
+exit 0
+