Merge pull request #11527 from pme/challenge-307

challenge-307

4 files changed, 256 insertions, 0 deletions

diff --git a/challenge-307/peter-meszaros/perl/ch-1.pl b/challenge-307/peter-meszaros/perl/ch-1.pl
new file mode 100755
index 0000000000..aa7ada0f97
--- /dev/null
+++ b/challenge-307/peter-meszaros/perl/ch-1.pl
@@ -0,0 +1,71 @@
+#!/usr/bin/env perl
+#
+=head1 Task 1: Check Order
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints.
+
+Write a script to re-arrange the given array in an increasing order and return
+the indices where it differs from the original array.
+
+=head2 Example 1
+
+    Input: @ints = (5, 2, 4, 3, 1)
+    Output: (0, 2, 3, 4)
+
+    Before: (5, 2, 4, 3, 1)
+    After : (1, 2, 3, 4, 5)
+
+    Difference at indices: (0, 2, 3, 4)
+
+=head2 Example 2
+
+    Input: @ints = (1, 2, 1, 1, 3)
+    Output: (1, 3)
+
+    Before: (1, 2, 1, 1, 3)
+    After : (1, 1, 1, 2, 3)
+
+    Difference at indices: (1, 3)
+
+=head2 Example 3
+
+    Input: @ints = (3, 1, 3, 2, 3)
+    Output: (0, 1, 3)
+
+    Before: (3, 1, 3, 2, 3)
+    After : (1, 2, 3, 3, 3)
+
+    Difference at indices: (0, 1, 3)
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+
+my $cases = [
+    [[5, 2, 4, 3, 1], [0, 2, 3, 4], 'Example 1'],
+    [[1, 2, 1, 1, 3], [1, 3],       'Example 2'],
+    [[3, 1, 3, 2, 3], [0, 1, 3],    'Example 3'],
+];
+
+sub check_order
+{
+    my $list = shift;
+    my @sorted = sort { $a <=> $b } @$list;
+    my @diff;
+    for my $i (0..$#sorted) {
+        push @diff, $i if $list->[$i] != $sorted[$i];
+    }
+    return \@diff;
+}
+
+for (@$cases) {
+    is(check_order($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
diff --git a/challenge-307/peter-meszaros/perl/ch-2.pl b/challenge-307/peter-meszaros/perl/ch-2.pl
new file mode 100755
index 0000000000..a60b9465c3
--- /dev/null
+++ b/challenge-307/peter-meszaros/perl/ch-2.pl
@@ -0,0 +1,60 @@
+#!/usr/bin/env perl
+#
+=head1 Task 2: Find Anagrams
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a list of words, @words.
+
+Write a script to find any two consecutive words and if they are anagrams, drop
+the first word and keep the second. You continue this until there is no more
+anagrams in the given list and return the count of final list.
+
+=head2 Example 1
+
+    Input: @words = ("acca", "dog", "god", "perl", "repl")
+    Output: 3
+
+    Step 1: "dog" and "god" are anagrams, so dropping "dog" and keeping "god" => ("acca", "god", "perl", "repl")
+    Step 2: "perl" and "repl" are anagrams, so dropping "perl" and keeping "repl" => ("acca", "god", "repl")
+
+=head2 Example 2
+
+    Input: @words = ("abba", "baba", "aabb", "ab", "ab")
+    Output: 2
+
+    Step 1: "abba" and "baba" are anagrams, so dropping "abba" and keeping "baba" => ("baba", "aabb", "ab", "ab")
+    Step 2: "baba" and "aabb" are anagrams, so dropping "baba" and keeping "aabb" => ("aabb", "ab", "ab")
+    Step 3: "ab" and "ab" are anagrams, so dropping "ab" and keeping "ab" => ("aabb", "ab")
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+
+my $cases = [
+    [["acca", "dog", "god", "perl", "repl"], 3, "Example 1"],
+    [["abba", "baba", "aabb", "ab", "ab"],   2, "Example 2"],
+];
+
+sub find_anagrams
+{
+    my $words = shift;
+    my @sorted = map { join '', sort split // } @$words;
+
+    for my $i (0 .. $#$words-1) {
+        if ($sorted[$i] eq $sorted[$i+1]) {
+            $words->[$i] = undef;
+        }
+    }
+    return scalar grep { defined } @$words;
+}
+
+for (@$cases) {
+    is(find_anagrams($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
diff --git a/challenge-307/peter-meszaros/tcl/ch-1.tcl b/challenge-307/peter-meszaros/tcl/ch-1.tcl
new file mode 100755
index 0000000000..13624145f2
--- /dev/null
+++ b/challenge-307/peter-meszaros/tcl/ch-1.tcl
@@ -0,0 +1,69 @@
+#!/usr/bin/env tclsh
+#
+# Task 1: Check Order
+# 
+# Submitted by: Mohammad Sajid Anwar
+# 
+# You are given an array of integers, @ints.
+# 
+# Write a script to re-arrange the given array in an increasing order and return
+# the indices where it differs from the original array.
+# 
+# Example 1
+# 
+#     Input: @ints = (5, 2, 4, 3, 1)
+#     Output: (0, 2, 3, 4)
+# 
+#     Before: (5, 2, 4, 3, 1)
+#     After : (1, 2, 3, 4, 5)
+# 
+#     Difference at indices: (0, 2, 3, 4)
+# 
+# Example 2
+# 
+#     Input: @ints = (1, 2, 1, 1, 3)
+#     Output: (1, 3)
+# 
+#     Before: (1, 2, 1, 1, 3)
+#     After : (1, 1, 1, 2, 3)
+# 
+#     Difference at indices: (1, 3)
+# 
+# Example 3
+# 
+#     Input: @ints = (3, 1, 3, 2, 3)
+#     Output: (0, 1, 3)
+# 
+#     Before: (3, 1, 3, 2, 3)
+#     After : (1, 2, 3, 3, 3)
+# 
+#     Difference at indices: (0, 1, 3)
+# 
+
+package require tcltest
+
+set cases {
+    {{5 2 4 3 1} {0 2 3 4} "Example 1"}
+    {{1 2 1 1 3} {1 3}     "Example 2"}
+    {{3 1 3 2 3} {0 1 3}   "Example 3"}
+}
+
+proc check_order {l} {
+    set sorted [lsort -integer $l]
+    set diff {}
+    for {set i 0} {$i < [llength $sorted]} {incr i} {
+        if {[lindex $l $i] != [lindex $sorted $i]} {
+            lappend diff $i
+        }
+    }
+    return $diff
+}
+
+tcltest::configure -verbose {pass}
+foreach case $cases {
+    tcltest::test [lindex $case 2] {} {
+       check_order [lindex $case 0]
+    } [lindex $case 1]
+}
+
+exit 0
diff --git a/challenge-307/peter-meszaros/tcl/ch-2.tcl b/challenge-307/peter-meszaros/tcl/ch-2.tcl
new file mode 100755
index 0000000000..6d48000e82
--- /dev/null
+++ b/challenge-307/peter-meszaros/tcl/ch-2.tcl
@@ -0,0 +1,56 @@
+#!/usr/bin/env tclsh
+#
+# Task 2: Find Anagrams
+# 
+# Submitted by: Mohammad Sajid Anwar
+# 
+# You are given a list of words, @words.
+# 
+# Write a script to find any two consecutive words and if they are anagrams, drop
+# the first word and keep the second. You continue this until there is no more
+# anagrams in the given list and return the count of final list.
+# 
+# Example 1
+# 
+#     Input: @words = ("acca", "dog", "god", "perl", "repl")
+#     Output: 3
+# 
+#     Step 1: "dog" and "god" are anagrams, so dropping "dog" and keeping "god" => ("acca", "god", "perl", "repl")
+#     Step 2: "perl" and "repl" are anagrams, so dropping "perl" and keeping "repl" => ("acca", "god", "repl")
+# 
+# Example 2
+# 
+#     Input: @words = ("abba", "baba", "aabb", "ab", "ab")
+#     Output: 2
+# 
+#     Step 1: "abba" and "baba" are anagrams, so dropping "abba" and keeping "baba" => ("baba", "aabb", "ab", "ab")
+#     Step 2: "baba" and "aabb" are anagrams, so dropping "baba" and keeping "aabb" => ("aabb", "ab", "ab")
+#     Step 3: "ab" and "ab" are anagrams, so dropping "ab" and keeping "ab" => ("aabb", "ab")
+# 
+
+package require tcltest
+
+set cases {
+    {{"acca" "dog" "god" "perl" "repl"} 3 "Example 1"}
+    {{"abba" "baba" "aabb" "ab" "ab"}   2 "Example 2"}
+}
+
+proc find_anagrams {l} {
+    set sorted [lmap w $l {join [lsort [split $w ""]] ""}]
+    for {set i 0} {$i < [llength $l]-1} {incr i} {
+        if {[lindex $sorted $i] eq [lindex $sorted [expr {$i+1}]]} {
+            lset l $i {}
+        }
+    }
+    return [llength [lsearch -all -inline -not -exact $l {}]]
+}
+
+tcltest::configure -verbose {pass}
+foreach case $cases {
+    tcltest::test [lindex $case 2] {} {
+       find_anagrams [lindex $case 0]
+    } [lindex $case 1]
+}
+
+exit 0
+