challenge-289

4 files changed, 316 insertions, 0 deletions

diff --git a/challenge-289/peter-meszaros/perl/ch-1.pl b/challenge-289/peter-meszaros/perl/ch-1.pl
new file mode 100755
index 0000000000..68bec67d76
--- /dev/null
+++ b/challenge-289/peter-meszaros/perl/ch-1.pl
@@ -0,0 +1,65 @@
+#!/usr/bin/env perl
+#
+=head1 Task 1: Third Maximum
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints.
+
+Write a script to find the third distinct maximum in the given array. If third
+maximum doesn't exist then return the maximum number.
+
+=head2 Example 1
+
+    Input: @ints = (5, 6, 4, 1)
+    Output: 4
+
+    The first distinct maximum is 6.
+    The second distinct maximum is 5.
+    The third distinct maximum is 4.
+
+=head2 Example 2
+
+    Input: @ints = (4, 5)
+    Output: 5
+
+    In the given array, the third maximum doesn't exist therefore returns the
+    maximum.
+
+=head2 Example 3
+
+    Input: @ints =  (1, 2, 2, 3)
+    Output: 1
+
+    The first distinct maximum is 3.
+    The second distinct maximum is 2.
+    The third distinct maximum is 1.
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+use List::Util qw/uniqint/;
+
+my $cases = [
+    [[5, 6, 4, 1], 4, 'Example 1'],
+    [[4, 5],       5, 'Example 2'],
+    [[1, 2, 2, 3], 1, 'Example 3'],
+];
+
+sub third_maximum
+{
+    my $l = shift;
+
+    my @l = uniqint sort {$b <=> $a} @$l;
+    return $l[2] // $l[0];
+}
+
+for (@$cases) {
+    is(third_maximum($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
diff --git a/challenge-289/peter-meszaros/perl/ch-2.pl b/challenge-289/peter-meszaros/perl/ch-2.pl
new file mode 100755
index 0000000000..5b173883e7
--- /dev/null
+++ b/challenge-289/peter-meszaros/perl/ch-2.pl
@@ -0,0 +1,82 @@
+#!/usr/bin/env perl
+#
+=head1 Task 2: Jumbled Letters
+
+Submitted by: Ryan Thompson
+
+An Internet legend dating back to at least 2001 goes something like this:
+
+    Aoccdrnig to a rscheearch at Cmabrigde Uinervtisy, it deosn't mttaer in
+    waht oredr the ltteers in a wrod are, the olny iprmoetnt tihng is taht the
+    frist and lsat ltteer be at the rghit pclae. The rset can be a toatl mses
+    and you can sitll raed it wouthit porbelm. Tihs is bcuseae the huamn mnid
+    deos not raed ervey lteter by istlef, but the wrod as a wlohe.
+
+This supposed Cambridge research is unfortunately an urban legend. However, the
+effect has been studied. For example-and with a title that probably made the
+journal's editor a little nervous-Raeding wrods with jubmled lettres: there is
+a cost by Rayner, White, et. al. looked at reading speed and comprehension of
+jumbled text.
+
+Your task is to write a program that takes English text as its input and
+outputs a jumbled version as follows:
+
+    1. The first and last letter of every word must stay the same
+    2. The remaining letters in the word are scrambled in a random order (if
+       that happens to be the original order, that is OK).
+    3. Whitespace, punctuation, and capitalization must stay the same
+    4. The order of words does not change, only the letters inside the word
+
+So, for example, "Perl" could become "Prel", or stay as "Perl," but it could
+not become "Pelr" or "lreP".
+
+I don't know if this effect has been studied in other languages besides
+English, but please consider sharing your results if you try!
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+use List::Util qw/shuffle/;
+
+my $cases = [
+    ['But I must explain to you how all this mistaken idea of denouncing
+    pleasure and praising pain was born and I will give you a complete
+    account of the system, and expound the actual teachings of the great
+    explorer of the truth, the master-builder of human happiness. No one
+    rejects, dislikes, or avoids pleasure itself, because it is pleasure,
+    but because those who do not know how to pursue pleasure rationally
+    encounter consequences that are extremely painful. Nor again is there
+    anyone who loves or pursues or desires to obtain pain of itself,
+    because it is pain, but because occasionally circumstances occur in
+    which toil and pain can procure him some great pleasure. To take a
+    trivial example, which of us ever undertakes laborious physical
+    exercise, except to obtain some advantage from it? But who has any
+    right to find fault with a man who chooses to enjoy a pleasure that has
+    no annoying consequences, or one who avoids a pain that produces no
+    resultant pleasure?', undef, 'Example 1'],
+];
+
+sub jumbled_letters
+{
+    my $txt = shift;
+
+    my @words = split /\s+/, $txt;
+    for my $w (@words) {
+        next if length($w) == 1;
+        my @w = split('', $w);
+        my $i = ($w[-1] =~ /[\.!\?,:]/) ? 2 : 1;
+        $w = join '', $w[0], shuffle(@w[1 .. $#w-$i]), @w[$#w+1-$i .. $#w];
+    }
+    print join ' ', @words, "\n";
+    return undef;
+}
+
+for (@$cases) {
+    is(jumbled_letters($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
diff --git a/challenge-289/peter-meszaros/tcl/ch-1.tcl b/challenge-289/peter-meszaros/tcl/ch-1.tcl
new file mode 100755
index 0000000000..198801fe48
--- /dev/null
+++ b/challenge-289/peter-meszaros/tcl/ch-1.tcl
@@ -0,0 +1,65 @@
+#!/usr/bin/env tclsh
+#
+# Task 1: Third Maximum
+# 
+# Submitted by: Mohammad Sajid Anwar
+# 
+# You are given an array of integers, @ints.
+# 
+# Write a script to find the third distinct maximum in the given array. If third
+# maximum doesn’t exist then return the maximum number.
+# 
+# Example 1
+# 
+#     Input: @ints = (5, 6, 4, 1)
+#     Output: 4
+# 
+#     The first distinct maximum is 6.
+#     The second distinct maximum is 5.
+#     The third distinct maximum is 4.
+# 
+# Example 2
+# 
+#     Input: @ints = (4, 5)
+#     Output: 5
+# 
+#     In the given array, the third maximum doesn't exist therefore returns the
+#     maximum.
+# 
+# Example 3
+# 
+#     Input: @ints =  (1, 2, 2, 3)
+#     Output: 1
+# 
+#     The first distinct maximum is 3.
+#     The second distinct maximum is 2.
+#     The third distinct maximum is 1.
+# 
+
+package require tcltest
+
+set cases {
+    {{5 6 4 1} 4 "Example 1"}
+    {{4 5}     5 "Example 2"}
+    {{1 2 2 3} 1 "Example 3"}
+}
+
+proc third_maximum {l} {
+
+    set lsorted [lsort -integer -decreasing -unique $l]
+    set v [lindex $lsorted 2]
+    if {$v == {}} {
+        set v [lindex $lsorted 0]
+    }
+    return $v
+}
+
+tcltest::configure -verbose {pass}
+foreach case $cases {
+    tcltest::test [lindex $case 2] {} {
+       third_maximum [lindex $case 0]
+    } [lindex $case 1]
+}
+
+exit 0
+
diff --git a/challenge-289/peter-meszaros/tcl/ch-2.tcl b/challenge-289/peter-meszaros/tcl/ch-2.tcl
new file mode 100755
index 0000000000..ec4b9b7add
--- /dev/null
+++ b/challenge-289/peter-meszaros/tcl/ch-2.tcl
@@ -0,0 +1,104 @@
+#!/usr/bin/env tclsh
+#
+# Task 2: Jumbled Letters
+# 
+# Submitted by: Ryan Thompson
+# 
+# An Internet legend dating back to at least 2001 goes something like this:
+# 
+#     Aoccdrnig to a rscheearch at Cmabrigde Uinervtisy, it deosn’t mttaer in
+#     waht oredr the ltteers in a wrod are, the olny iprmoetnt tihng is taht the
+#     frist and lsat ltteer be at the rghit pclae. The rset can be a toatl mses
+#     and you can sitll raed it wouthit porbelm. Tihs is bcuseae the huamn mnid
+#     deos not raed ervey lteter by istlef, but the wrod as a wlohe.
+# 
+# This supposed Cambridge research is unfortunately an urban legend. However, the
+# effect has been studied. For example—and with a title that probably made the
+# journal’s editor a little nervous—Raeding wrods with jubmled lettres: there is
+# a cost by Rayner, White, et. al. looked at reading speed and comprehension of
+# jumbled text.
+# 
+# Your task is to write a program that takes English text as its input and
+# outputs a jumbled version as follows:
+# 
+#     1. The first and last letter of every word must stay the same
+#     2. The remaining letters in the word are scrambled in a random order (if
+#        that happens to be the original order, that is OK).
+#     3. Whitespace, punctuation, and capitalization must stay the same
+#     4. The order of words does not change, only the letters inside the word
+# 
+# So, for example, “Perl” could become “Prel”, or stay as “Perl,” but it could
+# not become “Pelr” or “lreP”.
+# 
+# I don’t know if this effect has been studied in other languages besides
+# English, but please consider sharing your results if you try!
+# 
+package require tcltest
+
+set cases {
+    {{But I must explain to you how all this mistaken idea of denouncing
+    pleasure and praising pain was born and I will give you a complete
+    account of the system, and expound the actual teachings of the great
+    explorer of the truth, the master-builder of human happiness. No one
+    rejects, dislikes, or avoids pleasure itself, because it is pleasure,
+    but because those who do not know how to pursue pleasure rationally
+    encounter consequences that are extremely painful. Nor again is there
+    anyone who loves or pursues or desires to obtain pain of itself,
+    because it is pain, but because occasionally circumstances occur in
+    which toil and pain can procure him some great pleasure. To take a
+    trivial example, which of us ever undertakes laborious physical
+    exercise, except to obtain some advantage from it? But who has any
+    right to find fault with a man who chooses to enjoy a pleasure that has
+    no annoying consequences, or one who avoids a pain that produces no
+    resultant pleasure?} {} "Example 1"}
+}
+
+proc shuffle {list} {
+    set n [llength $list]
+    for {set i 1} {$i < $n} {incr i} {
+        set j [expr {int(rand() * $n)}]
+        set temp [lindex $list $i]
+        lset list $i [lindex $list $j]
+        lset list $j $temp
+    }
+    return $list
+}
+
+proc jumbled_letters {txt} {
+
+    set words [regexp -inline -all -- {\S+} $txt]
+
+    for {set i 0} {$i < [llength $words]} {incr i} {
+        set w [lindex $words $i]
+        if {[string length $w] == 1} {
+            continue
+        }
+        set ll [split $w {}]
+        set lastl [lindex $ll end]
+
+        if [regexp {[\.!\?,:]} $lastl] {
+            set p 2
+        } else {
+            set p 1
+        }
+        set len [llength $ll]
+        incr len -1
+        lset words $i [join [list \
+                                [lindex $ll 0] \
+                                [join [shuffle [lrange $ll 1 [expr $len - $p]]] {}] \
+                                [join [lrange $ll [expr $len + 1 - $p] $len] {}]\
+                            ] {}]
+    }
+    puts [join $words]
+    return {}
+}
+
+tcltest::configure -verbose {pass}
+foreach case $cases {
+    tcltest::test [lindex $case 2] {} {
+       jumbled_letters [lindex $case 0]
+    } [lindex $case 1]
+}
+
+exit 0
+