challenge-313

challenge-313/peter-meszaros/perl/ch-1.pl

@@ -0,0 +1,75 @@
+#!/usr/bin/env perl
+#
+=head1 Task 1: Broken Keys
+
+Submitted by: Mohammad Sajid Anwar
+
+You have a broken keyboard which sometimes type a character more than once.
+
+You are given a string and actual typed string.
+
+Write a script to find out if the actual typed string is meant for the given
+string.
+
+=head2 Example 1
+
+    Input: $name = "perl", $typed = "perrrl"
+    Output: true
+
+    Here "r" is pressed 3 times instead of 1 time.
+
+=head2 Example 2
+
+    Input: $name = "raku", $typed = "rrakuuuu"
+    Output: true
+
+=head2 Example 3
+
+    Input: $name = "python", $typed = "perl"
+    Output: false
+
+=head2 Example 4
+
+    Input: $name = "coffeescript", $typed = "cofffeescccript"
+    Output: true
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+
+my $cases = [
+    [["perl",         "perrrl"],          1, "Example 1"],
+    [["raku",         "rrakuuuu"],        1, "Example 2"],
+    [["python",       "perl"],            0, "Example 3"],
+    [["coffeescript", "cofffeescccript"], 1, "Example 4"],
+];
+
+sub broken_keys
+{
+    my $name  = $_[0]->[0];
+    my $typed = $_[0]->[1];
+
+    my @name  = split //, $name;
+    my @typed = split //, $typed;
+
+    my $name_idx = 0;
+    for my $typed_idx (0 .. $#typed) {
+        if (!defined $name[$name_idx] or $name[$name_idx] ne $typed[$typed_idx]) {
+            next if $typed_idx > 0 && $typed[$typed_idx] eq $typed[$typed_idx - 1];
+            return 0;
+        } else {
+            $name_idx++;
+        }
+    }
+    return 1;
+}
+
+for (@$cases) {
+    is(broken_keys($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;

challenge-313/peter-meszaros/perl/ch-2.pl

@@ -0,0 +1,60 @@
+#!/usr/bin/env perl
+#
+=head1 Task 2: Reverse Letters
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string.
+
+Write a script to reverse only the alphabetic characters in the string.
+
+=head2 Example 1
+
+    Input: $str = "p-er?l"
+    Output: "l-re?p"
+
+=head2 Example 2
+
+    Input: $str = "wee-k!L-y"
+    Output: "yLk-e!e-w"
+
+=head2 Example 3
+
+    Input: $str = "_c-!h_all-en!g_e"
+    Output: "_e-!g_nel-la!h_c"
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+
+my $cases = [
+    ["p-er?l",           "l-re?p",           "Example 1"],
+    ["wee-k!L-y",        "yLk-e!e-w",        "Example 2"],
+    ["_c-!h_all-en!g_e", "_e-!g_nel-la!h_c", "Example 3"],
+];
+
+sub reverse_letters
+{
+    my $str = shift;
+
+    my @chars = split //, $str;
+    my @alphas = grep { $_ =~ /[a-z]/i } @chars;
+    my @reversed = reverse @alphas;
+
+    for (my $i = 0; $i < @chars; $i++) {
+        if ($chars[$i] =~ /[a-z]/i) {
+            $chars[$i] = shift @reversed;
+        }
+    }
+    return join '', @chars;
+}
+
+for (@$cases) {
+    is(reverse_letters($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;

challenge-313/peter-meszaros/tcl/ch-1.tcl

@@ -0,0 +1,75 @@
+#!/usr/bin/env tclsh
+#
+# Task 1: Broken Keys
+# 
+# Submitted by: Mohammad Sajid Anwar
+# 
+# You have a broken keyboard which sometimes type a character more than once.
+# 
+# You are given a string and actual typed string.
+# 
+# Write a script to find out if the actual typed string is meant for the given
+# string.
+# 
+# Example 1
+# 
+#     Input: $name = "perl", $typed = "perrrl"
+#     Output: true
+# 
+#     Here "r" is pressed 3 times instead of 1 time.
+# 
+# Example 2
+# 
+#     Input: $name = "raku", $typed = "rrakuuuu"
+#     Output: true
+# 
+# Example 3
+# 
+#     Input: $name = "python", $typed = "perl"
+#     Output: false
+# 
+# Example 4
+# 
+#     Input: $name = "coffeescript", $typed = "cofffeescccript"
+#     Output: true
+# 
+
+package require tcltest
+
+set cases {
+    {{"perl"         "perrrl"}          1 "Example 1"}
+    {{"raku"         "rrakuuuu"}        1 "Example 2"}
+    {{"python"       "perl"}            0 "Example 3"}
+    {{"coffeescript" "cofffeescccript"} 1 "Example 4"}
+}
+
+proc broken_keys {p} {
+    set name [lindex $p 0]
+    set typed [lindex $p 1]
+
+    set name_idx 0
+    set typed_idx 0
+    set name_len [string length $name]
+    set typed_len [string length $typed]
+
+    for {set typed_idx 0} {$typed_idx < $typed_len} {incr typed_idx} {
+        if {$name_idx >= $name_len || [string index $name $name_idx] ne [string index $typed $typed_idx]} {
+            if {$typed_idx > 0 && [string index $typed $typed_idx] eq [string index $typed [expr $typed_idx - 1]]} {
+                continue
+            }
+            return 0
+        }
+        incr name_idx
+    }
+    return 1
+}
+
+tcltest::configure -verbose {pass}
+foreach case $cases {
+    tcltest::test [lindex $case 2] {} {
+       broken_keys [lindex $case 0]
+    } [lindex $case 1]
+}
+
+exit 0
+

challenge-313/peter-meszaros/tcl/ch-2.tcl

@@ -0,0 +1,60 @@
+#!/usr/bin/env tclsh
+#
+# Task 2: Reverse Letters
+# 
+# Submitted by: Mohammad Sajid Anwar
+# 
+# You are given a string.
+# 
+# Write a script to reverse only the alphabetic characters in the string.
+# 
+# Example 1
+# 
+#     Input: $str = "p-er?l"
+#     Output: "l-re?p"
+# 
+# Example 2
+# 
+#     Input: $str = "wee-k!L-y"
+#     Output: "yLk-e!e-w"
+# 
+# Example 3
+# 
+#     Input: $str = "_c-!h_all-en!g_e"
+#     Output: "_e-!g_nel-la!h_c"
+# 
+
+package require tcltest
+
+set cases {
+    {"p-er?l"           "l-re?p"           "Example 1"}
+    {"wee-k!L-y"        "yLk-e!e-w"        "Example 2"}
+    {"_c-!h_all-en!g_e" "_e-!g_nel-la!h_c" "Example 3"}
+}
+
+proc reverse_letters {str} {
+    set chars [split $str ""]
+
+    set alphas [lmap v $chars { if {![string is alpha $v]} continue 
+                                set v 
+               }]
+    set reversed [lreverse $alphas]
+
+    for {set i 0} {$i < [llength $chars]} {incr i} {
+        if {[regexp -nocase {^[a-z]$} [lindex $chars $i]]} {
+            lset chars $i [lindex $reversed 0]
+            set reversed [lrange $reversed 1 end]
+        }
+    }
+    return [join $chars ""]
+}
+
+tcltest::configure -verbose {pass}
+foreach case $cases {
+    tcltest::test [lindex $case 2] {} {
+        reverse_letters [lindex $case 0]
+    } [lindex $case 1]
+}
+
+exit 0
+