Merge pull request #12075 from pme/challenge-322

challenge-322

4 files changed, 250 insertions, 0 deletions

diff --git a/challenge-322/peter-meszaros/perl/ch-1.pl b/challenge-322/peter-meszaros/perl/ch-1.pl
new file mode 100755
index 0000000000..e242906d2c
--- /dev/null
+++ b/challenge-322/peter-meszaros/perl/ch-1.pl
@@ -0,0 +1,60 @@
+#!/usr/bin/env perl
+#
+=head1 Task 1: String Format
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string and a positive integer.
+
+Write a script to format the string, removing any dashes, in groups of size
+given by the integer. The first group can be smaller than the integer but
+should have at least one character. Groups should be separated by dashes.
+
+=head2 Example 1
+
+    Input: $str = "ABC-D-E-F", $i = 3
+    Output: "ABC-DEF"
+
+=head2 Example 2
+
+    Input: $str = "A-BC-D-E", $i = 2
+    Output: "A-BC-DE"
+
+=head2 Example 3
+
+    Input: $str = "-A-B-CD-E", $i = 4
+    Output: "A-BCDE"
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+
+my $cases = [
+    [["ABC-D-E-F", 3], "ABC-DEF", "Example 1"],
+    [["A-BC-D-E",  2], "A-BC-DE", "Example 2"],
+    [["-A-B-CD-E", 4], "A-BCDE",  "Example 3"],
+];
+
+sub string_format
+{
+    my $str = $_[0]->[0];
+    my $i = $_[0]->[1];
+
+    $str =~ s/-//g;
+    my @res;
+    while ($str =~ s/.{1,$i}$//) {
+        unshift @res, $&;
+    }
+
+    return join('-', @res);
+}
+
+for (@$cases) {
+    is(string_format($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
diff --git a/challenge-322/peter-meszaros/perl/ch-2.pl b/challenge-322/peter-meszaros/perl/ch-2.pl
new file mode 100755
index 0000000000..915164a4de
--- /dev/null
+++ b/challenge-322/peter-meszaros/perl/ch-2.pl
@@ -0,0 +1,60 @@
+#!/usr/bin/env perl
+#
+=head1 Task 2: Rank Array
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers.
+
+Write a script to return an array of the ranks of each element: the lowest
+value has rank 1, next lowest rank 2, etc. If two elements are the same then
+they share the same rank.
+
+=head2 Example 1
+
+    Input: @ints = (55, 22, 44, 33)
+    Output: (4, 1, 3, 2)
+
+=head2 Example 2
+
+    Input: @ints = (10, 10, 10)
+    Output: (1, 1, 1)
+
+=head2 Example 3
+
+    Input: @ints = (5, 1, 1, 4, 3)
+    Output: (4, 1, 1, 3, 2)
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+
+my $cases = [
+    [[55, 22, 44, 33], [4, 1, 3, 2],    "Example 1"],
+    [[10, 10, 10],     [1, 1, 1],       "Example 2"],
+    [[5, 1, 1, 4, 3],  [4, 1, 1, 3, 2], "Example 3"],
+];
+
+sub rank_array
+{
+    my $ints = shift;
+
+    my @sorted = sort { $a <=> $b } @$ints;
+    my %rank;
+    my $rank = 1;
+    for my $i (@sorted) {
+        $rank{$i} = $rank++ unless exists $rank{$i};
+    }
+
+    return [@rank{@$ints}];
+}
+
+for (@$cases) {
+    is(rank_array($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
diff --git a/challenge-322/peter-meszaros/tcl/ch-1.tcl b/challenge-322/peter-meszaros/tcl/ch-1.tcl
new file mode 100755
index 0000000000..13509965a3
--- /dev/null
+++ b/challenge-322/peter-meszaros/tcl/ch-1.tcl
@@ -0,0 +1,65 @@
+#!/usr/bin/env tclsh
+#
+# Task 1: String Format
+# 
+# Submitted by: Mohammad Sajid Anwar
+# 
+# You are given a string and a positive integer.
+# 
+# Write a script to format the string, removing any dashes, in groups of size
+# given by the integer. The first group can be smaller than the integer but
+# should have at least one character. Groups should be separated by dashes.
+# 
+# Example 1
+# 
+#     Input: $str = "ABC-D-E-F", $i = 3
+#     Output: "ABC-DEF"
+# 
+# Example 2
+# 
+#     Input: $str = "A-BC-D-E", $i = 2
+#     Output: "A-BC-DE"
+# 
+# Example 3
+# 
+#     Input: $str = "-A-B-CD-E", $i = 4
+#     Output: "A-BCDE"
+# 
+
+package require tcltest
+
+set cases {
+    {{ABC-D-E-F 3} ABC-DEF {Example 1}}
+    {{A-BC-D-E  2} A-BC-DE {Example 2}}
+    {{-A-B-CD-E 4} A-BCDE  {Example 3}}
+}
+
+proc string_format {p} {
+    set str [lindex $p 0]
+    set i   [lindex $p 1]
+
+    regsub -all {\-} $str {} str
+
+    set res {}
+    set l [string length $str]
+    while {$l > 0} {
+        set s [string range $str [expr $l - $i] end]
+        set str [string replace $str [expr $l - $i] end {}]
+        set l [string length $str]
+        if {[string length $s] > 0} {
+            set res [linsert $res 0 $s]
+        }
+    }
+
+    return [join $res -]
+}
+
+tcltest::configure -verbose {pass}
+foreach case $cases {
+    tcltest::test [lindex $case 2] {} {
+       string_format [lindex $case 0]
+    } [lindex $case 1]
+}
+
+exit 0
+
diff --git a/challenge-322/peter-meszaros/tcl/ch-2.tcl b/challenge-322/peter-meszaros/tcl/ch-2.tcl
new file mode 100755
index 0000000000..741dcd732e
--- /dev/null
+++ b/challenge-322/peter-meszaros/tcl/ch-2.tcl
@@ -0,0 +1,65 @@
+#!/usr/bin/env tclsh
+#
+# Task 2: Rank Array
+# 
+# Submitted by: Mohammad Sajid Anwar
+# 
+# You are given an array of integers.
+# 
+# Write a script to return an array of the ranks of each element: the lowest
+# value has rank 1, next lowest rank 2, etc. If two elements are the same then
+# they share the same rank.
+# 
+# Example 1
+# 
+#     Input: @ints = (55, 22, 44, 33)
+#     Output: (4, 1, 3, 2)
+# 
+# Example 2
+# 
+#     Input: @ints = (10, 10, 10)
+#     Output: (1, 1, 1)
+# 
+# Example 3
+# 
+#     Input: @ints = (5, 1, 1, 4, 3)
+#     Output: (4, 1, 1, 3, 2)
+# 
+
+package require tcltest
+
+set cases {
+    {{55 22 44 33} {4 1 3 2}   "Example 1"}
+    {{10 10 10}    {1 1 1}     "Example 2"}
+    {{5 1 1 4 3}   {4 1 1 3 2} "Example 3"}
+}
+
+proc rank_array {ints} {
+
+    set sorted [lsort -integer $ints]
+    set rank {}
+    set rank_value 1
+
+    foreach i $sorted {
+        if {![dict exists $rank $i]} {
+            dict set rank $i $rank_value
+            incr rank_value
+        }
+    }
+
+    set result {}
+    foreach i $ints {
+        lappend result [dict get $rank $i]
+    }
+    return $result
+}
+
+tcltest::configure -verbose {pass}
+foreach case $cases {
+    tcltest::test [lindex $case 2] {} {
+        rank_array [lindex $case 0]
+    } [lindex $case 1]
+}
+
+exit 0
+