Merge pull request #12282 from pme/challenge-328

challenge-328

4 files changed, 290 insertions, 0 deletions

diff --git a/challenge-328/peter-meszaros/perl/ch-1.pl b/challenge-328/peter-meszaros/perl/ch-1.pl
new file mode 100755
index 0000000000..8b6e966f6d
--- /dev/null
+++ b/challenge-328/peter-meszaros/perl/ch-1.pl
@@ -0,0 +1,72 @@
+#!/usr/bin/env perl
+#
+=head1 Task 1: Replace all ?
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string containing only lower case English letters and ?.
+
+Write a script to replace all ? in the given string so that the string doesn't
+contain consecutive repeating characters.
+
+=head2 Example 1
+
+    Input: $str = "a?z"
+    Output: "abz"
+
+    There can be many strings, one of them is "abz".
+    The choices are 'a' to 'z' but we can't use either 'a' or 'z' to replace
+    the '?'.
+
+=head2 Example 2
+
+    Input: $str = "pe?k"
+    Output: "peak"
+
+=head2 Example 3
+
+    Input: $str = "gra?te"
+    Output: "grabte"
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+
+my $cases = [
+    ["a?z",    "abz",    "Example 1"],
+    ["pe?k",   "peak",   "Example 2"],
+    ["gra?te", "grabte", "Example 3"],
+];
+
+sub replace_all_questionmark {
+    my $str = shift;
+    my @chars = split //, $str;
+    my $len = @chars;
+
+    for (my $i = 0; $i < $len; $i++) {
+        if ($chars[$i] eq '?') {
+            my %used;
+            $used{$chars[$i - 1]} = 1 if $i > 0 && $chars[$i - 1] ne '?';
+            $used{$chars[$i + 1]} = 1 if $i < $len - 1 && $chars[$i + 1] ne '?';
+
+            for my $c ('a' .. 'z') {
+                if (!$used{$c}) {
+                    $chars[$i] = $c;
+                    last;
+                }
+            }
+        }
+    }
+
+    return join '', @chars;
+}
+
+for (@$cases) {
+    is(replace_all_questionmark($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
diff --git a/challenge-328/peter-meszaros/perl/ch-2.pl b/challenge-328/peter-meszaros/perl/ch-2.pl
new file mode 100755
index 0000000000..9673c768c5
--- /dev/null
+++ b/challenge-328/peter-meszaros/perl/ch-2.pl
@@ -0,0 +1,72 @@
+#!/usr/bin/env perl
+#
+=head1 Task 2: Good String
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string made up of lower and upper case English letters only.
+
+Write a script to return the good string of the given string. A string is
+called good string if it doesn't have two adjacent same characters, one in
+upper case and other is lower case.
+
+UPDATE [2025-07-01]: Just to be explicit, you can only remove pair if they are
+same characters, one in lower case and other in upper case, order is not
+important.
+
+=head2 Example 1
+
+    Input: $str = "WeEeekly"
+    Output: "Weekly"
+
+    We can remove either, "eE" or "Ee" to make it good.
+
+=head2 Example 2
+
+    Input: $str = "abBAdD"
+    Output: ""
+
+    We remove "bB" first: "aAdD"
+    Then we remove "aA": "dD"
+    Finally remove "dD".
+
+=head2 Example 3
+
+    Input: $str = "abc"
+    Output: "abc"
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+
+my $cases = [
+    ["WeEeekly", "Weekly", "Example 1"],
+    ["abBAdD",   "",       "Example 2"],
+    ["abc",      "abc",    "Example 3"],
+];
+
+sub good_string
+{
+    my $str = shift;
+    my @stack;
+
+    for my $char (split //, $str) {
+        if (@stack && lc($char) eq lc($stack[-1]) && $char ne $stack[-1]) {
+            pop @stack;
+        } else {
+            push @stack, $char;
+        }
+    }
+
+    return join('', @stack);
+}
+
+for (@$cases) {
+    is(good_string($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
diff --git a/challenge-328/peter-meszaros/tcl/ch-1.tcl b/challenge-328/peter-meszaros/tcl/ch-1.tcl
new file mode 100755
index 0000000000..7a2b968e08
--- /dev/null
+++ b/challenge-328/peter-meszaros/tcl/ch-1.tcl
@@ -0,0 +1,75 @@
+#!/usr/bin/env tclsh
+#
+# Task 1: Replace all ?
+# 
+# Submitted by: Mohammad Sajid Anwar
+# 
+# You are given a string containing only lower case English letters and ?.
+# 
+# Write a script to replace all ? in the given string so that the string doesn't
+# contain consecutive repeating characters.
+# 
+# Example 1
+# 
+#     Input: $str = "a?z"
+#     Output: "abz"
+# 
+#     There can be many strings, one of them is "abz".
+#     The choices are 'a' to 'z' but we can't use either 'a' or 'z' to replace
+#     the '?'.
+# 
+# Example 2
+# 
+#     Input: $str = "pe?k"
+#     Output: "peak"
+# 
+# Example 3
+# 
+#     Input: $str = "gra?te"
+#     Output: "grabte"
+# 
+
+package require tcltest
+
+set cases {
+    {"a?z"    "abz"    "Example 1"}
+    {"pe?k"   "peak"   "Example 2"}
+    {"gra?te" "grabte" "Example 3"}
+}
+
+proc replace_all_questionmark {str} {
+    set chars [split $str ""]
+    set len [llength $chars]
+
+    for {set i 0} {$i < $len} {incr i} {
+        if {[lindex $chars $i] eq "?"} {
+            set used {}
+            if {$i > 0 && [lindex $chars [expr {$i - 1}]] ne "?"} {
+                lappend used [lindex $chars [expr {$i - 1}]]
+            }
+            if {$i < $len - 1 && [lindex $chars [expr {$i + 1}]] ne "?"} {
+                lappend used [lindex $chars [expr {$i + 1}]]
+            }
+
+            for {set o 97} {$o <= 122} {incr o} { # a .. z
+                set c [format "%c" $o]
+                if {[lsearch -exact $used $c] == -1} {
+                    set chars [lreplace $chars $i $i $c]
+                    break
+                }
+            }
+        }
+    }
+
+    return [join $chars ""]
+}
+
+tcltest::configure -verbose {pass}
+foreach case $cases {
+    tcltest::test [lindex $case 2] {} {
+        replace_all_questionmark [lindex $case 0]
+    } [lindex $case 1]
+}
+
+exit 0
+
diff --git a/challenge-328/peter-meszaros/tcl/ch-2.tcl b/challenge-328/peter-meszaros/tcl/ch-2.tcl
new file mode 100755
index 0000000000..b532691edd
--- /dev/null
+++ b/challenge-328/peter-meszaros/tcl/ch-2.tcl
@@ -0,0 +1,71 @@
+#!/usr/bin/env tclsh
+#
+# Task 2: Good String
+# 
+# Submitted by: Mohammad Sajid Anwar
+# 
+# You are given a string made up of lower and upper case English letters only.
+# 
+# Write a script to return the good string of the given string. A string is
+# called good string if it doesn't have two adjacent same characters, one in
+# upper case and other is lower case.
+# 
+# UPDATE [2025-07-01]: Just to be explicit, you can only remove pair if they are
+# same characters, one in lower case and other in upper case, order is not
+# important.
+# 
+# Example 1
+# 
+#     Input: $str = "WeEeekly"
+#     Output: "Weekly"
+# 
+#     We can remove either, "eE" or "Ee" to make it good.
+# 
+# Example 2
+# 
+#     Input: $str = "abBAdD"
+#     Output: ""
+# 
+#     We remove "bB" first: "aAdD"
+#     Then we remove "aA": "dD"
+#     Finally remove "dD".
+# 
+# Example 3
+# 
+#     Input: $str = "abc"
+#     Output: "abc"
+# 
+
+package require tcltest
+
+set cases {
+    {"WeEeekly" "Weekly" "Example 1"}
+    {"abBAdD"   ""       "Example 2"}
+    {"abc"      "abc"    "Example 3"}
+}
+
+proc good_string {str} {
+    set stack {}
+
+    foreach char [split $str ""] {
+        if {[llength $stack] > 0 && \
+            [string tolower $char] eq [string tolower [lindex $stack end]] && \
+            $char ne [lindex $stack end]} {
+            set stack [lrange $stack 0 end-1]
+        } else {
+            lappend stack $char
+        }
+    }
+
+    return [join $stack ""]
+}
+
+tcltest::configure -verbose {pass}
+foreach case $cases {
+    tcltest::test [lindex $case 2] {} {
+        good_string [lindex $case 0]
+    } [lindex $case 1]
+}
+
+exit 0
+