Skip to content

Commit 08c8db1

Browse files
pmepme
committed
challenge-313
1 parent b9e610b commit 08c8db1

File tree

4 files changed

+270
-0
lines changed

4 files changed

+270
-0
lines changed

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

+75
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,75 @@
1+
#!/usr/bin/env perl
2+
#
3+
=head1 Task 1: Broken Keys
4+
5+
Submitted by: Mohammad Sajid Anwar
6+
7+
You have a broken keyboard which sometimes type a character more than once.
8+
9+
You are given a string and actual typed string.
10+
11+
Write a script to find out if the actual typed string is meant for the given
12+
string.
13+
14+
=head2 Example 1
15+
16+
Input: $name = "perl", $typed = "perrrl"
17+
Output: true
18+
19+
Here "r" is pressed 3 times instead of 1 time.
20+
21+
=head2 Example 2
22+
23+
Input: $name = "raku", $typed = "rrakuuuu"
24+
Output: true
25+
26+
=head2 Example 3
27+
28+
Input: $name = "python", $typed = "perl"
29+
Output: false
30+
31+
=head2 Example 4
32+
33+
Input: $name = "coffeescript", $typed = "cofffeescccript"
34+
Output: true
35+
36+
=cut
37+
38+
use strict;
39+
use warnings;
40+
use Test2::V0 -no_srand => 1;
41+
use Data::Dumper;
42+
43+
my $cases = [
44+
[["perl", "perrrl"], 1, "Example 1"],
45+
[["raku", "rrakuuuu"], 1, "Example 2"],
46+
[["python", "perl"], 0, "Example 3"],
47+
[["coffeescript", "cofffeescccript"], 1, "Example 4"],
48+
];
49+
50+
sub broken_keys
51+
{
52+
my $name = $_[0]->[0];
53+
my $typed = $_[0]->[1];
54+
55+
my @name = split //, $name;
56+
my @typed = split //, $typed;
57+
58+
my $name_idx = 0;
59+
for my $typed_idx (0 .. $#typed) {
60+
if (!defined $name[$name_idx] or $name[$name_idx] ne $typed[$typed_idx]) {
61+
next if $typed_idx > 0 && $typed[$typed_idx] eq $typed[$typed_idx - 1];
62+
return 0;
63+
} else {
64+
$name_idx++;
65+
}
66+
}
67+
return 1;
68+
}
69+
70+
for (@$cases) {
71+
is(broken_keys($_->[0]), $_->[1], $_->[2]);
72+
}
73+
done_testing();
74+
75+
exit 0;

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

+60
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,60 @@
1+
#!/usr/bin/env perl
2+
#
3+
=head1 Task 2: Reverse Letters
4+
5+
Submitted by: Mohammad Sajid Anwar
6+
7+
You are given a string.
8+
9+
Write a script to reverse only the alphabetic characters in the string.
10+
11+
=head2 Example 1
12+
13+
Input: $str = "p-er?l"
14+
Output: "l-re?p"
15+
16+
=head2 Example 2
17+
18+
Input: $str = "wee-k!L-y"
19+
Output: "yLk-e!e-w"
20+
21+
=head2 Example 3
22+
23+
Input: $str = "_c-!h_all-en!g_e"
24+
Output: "_e-!g_nel-la!h_c"
25+
26+
=cut
27+
28+
use strict;
29+
use warnings;
30+
use Test2::V0 -no_srand => 1;
31+
use Data::Dumper;
32+
33+
my $cases = [
34+
["p-er?l", "l-re?p", "Example 1"],
35+
["wee-k!L-y", "yLk-e!e-w", "Example 2"],
36+
["_c-!h_all-en!g_e", "_e-!g_nel-la!h_c", "Example 3"],
37+
];
38+
39+
sub reverse_letters
40+
{
41+
my $str = shift;
42+
43+
my @chars = split //, $str;
44+
my @alphas = grep { $_ =~ /[a-z]/i } @chars;
45+
my @reversed = reverse @alphas;
46+
47+
for (my $i = 0; $i < @chars; $i++) {
48+
if ($chars[$i] =~ /[a-z]/i) {
49+
$chars[$i] = shift @reversed;
50+
}
51+
}
52+
return join '', @chars;
53+
}
54+
55+
for (@$cases) {
56+
is(reverse_letters($_->[0]), $_->[1], $_->[2]);
57+
}
58+
done_testing();
59+
60+
exit 0;

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

+75
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,75 @@
1+
#!/usr/bin/env tclsh
2+
#
3+
# Task 1: Broken Keys
4+
#
5+
# Submitted by: Mohammad Sajid Anwar
6+
#
7+
# You have a broken keyboard which sometimes type a character more than once.
8+
#
9+
# You are given a string and actual typed string.
10+
#
11+
# Write a script to find out if the actual typed string is meant for the given
12+
# string.
13+
#
14+
# Example 1
15+
#
16+
# Input: $name = "perl", $typed = "perrrl"
17+
# Output: true
18+
#
19+
# Here "r" is pressed 3 times instead of 1 time.
20+
#
21+
# Example 2
22+
#
23+
# Input: $name = "raku", $typed = "rrakuuuu"
24+
# Output: true
25+
#
26+
# Example 3
27+
#
28+
# Input: $name = "python", $typed = "perl"
29+
# Output: false
30+
#
31+
# Example 4
32+
#
33+
# Input: $name = "coffeescript", $typed = "cofffeescccript"
34+
# Output: true
35+
#
36+
37+
package require tcltest
38+
39+
set cases {
40+
{{"perl" "perrrl"} 1 "Example 1"}
41+
{{"raku" "rrakuuuu"} 1 "Example 2"}
42+
{{"python" "perl"} 0 "Example 3"}
43+
{{"coffeescript" "cofffeescccript"} 1 "Example 4"}
44+
}
45+
46+
proc broken_keys {p} {
47+
set name [lindex $p 0]
48+
set typed [lindex $p 1]
49+
50+
set name_idx 0
51+
set typed_idx 0
52+
set name_len [string length $name]
53+
set typed_len [string length $typed]
54+
55+
for {set typed_idx 0} {$typed_idx < $typed_len} {incr typed_idx} {
56+
if {$name_idx >= $name_len || [string index $name $name_idx] ne [string index $typed $typed_idx]} {
57+
if {$typed_idx > 0 && [string index $typed $typed_idx] eq [string index $typed [expr $typed_idx - 1]]} {
58+
continue
59+
}
60+
return 0
61+
}
62+
incr name_idx
63+
}
64+
return 1
65+
}
66+
67+
tcltest::configure -verbose {pass}
68+
foreach case $cases {
69+
tcltest::test [lindex $case 2] {} {
70+
broken_keys [lindex $case 0]
71+
} [lindex $case 1]
72+
}
73+
74+
exit 0
75+

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

+60
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,60 @@
1+
#!/usr/bin/env tclsh
2+
#
3+
# Task 2: Reverse Letters
4+
#
5+
# Submitted by: Mohammad Sajid Anwar
6+
#
7+
# You are given a string.
8+
#
9+
# Write a script to reverse only the alphabetic characters in the string.
10+
#
11+
# Example 1
12+
#
13+
# Input: $str = "p-er?l"
14+
# Output: "l-re?p"
15+
#
16+
# Example 2
17+
#
18+
# Input: $str = "wee-k!L-y"
19+
# Output: "yLk-e!e-w"
20+
#
21+
# Example 3
22+
#
23+
# Input: $str = "_c-!h_all-en!g_e"
24+
# Output: "_e-!g_nel-la!h_c"
25+
#
26+
27+
package require tcltest
28+
29+
set cases {
30+
{"p-er?l" "l-re?p" "Example 1"}
31+
{"wee-k!L-y" "yLk-e!e-w" "Example 2"}
32+
{"_c-!h_all-en!g_e" "_e-!g_nel-la!h_c" "Example 3"}
33+
}
34+
35+
proc reverse_letters {str} {
36+
set chars [split $str ""]
37+
38+
set alphas [lmap v $chars { if {![string is alpha $v]} continue
39+
set v
40+
}]
41+
set reversed [lreverse $alphas]
42+
43+
for {set i 0} {$i < [llength $chars]} {incr i} {
44+
if {[regexp -nocase {^[a-z]$} [lindex $chars $i]]} {
45+
lset chars $i [lindex $reversed 0]
46+
set reversed [lrange $reversed 1 end]
47+
}
48+
}
49+
return [join $chars ""]
50+
}
51+
52+
tcltest::configure -verbose {pass}
53+
foreach case $cases {
54+
tcltest::test [lindex $case 2] {} {
55+
reverse_letters [lindex $case 0]
56+
} [lindex $case 1]
57+
}
58+
59+
exit 0
60+

0 commit comments

Comments
 (0)