Merge pull request #10809 from pme/challenge-286

challenge-286

4 files changed, 319 insertions, 0 deletions

diff --git a/challenge-286/peter-meszaros/perl/ch-1.pl b/challenge-286/peter-meszaros/perl/ch-1.pl
new file mode 100755
index 0000000000..f8a701a77d
--- /dev/null
+++ b/challenge-286/peter-meszaros/perl/ch-1.pl
@@ -0,0 +1,51 @@
+#!/usr/bin/env perl
+#
+=head1 Task 1: Self Spammer
+
+Submitted by: David Ferrone
+
+Write a program which outputs one word of its own script / source code at
+random. A word is anything between whitespace, including symbols.
+
+=head2 Example 1
+
+If the source code contains a line such as: 'open my $fh, "<", "ch-1.pl" or
+die;' then the program would output each of the words { open, my, $fh,, "<",,
+"ch-1.pl", or, die; } (along with other words in the source) with some positive
+probability.
+
+=head2 Example 2
+
+Technically 'print(" hello ");' is *not* an example program, because it does
+not assign positive probability to the other two words in the script.  It will
+never display print(" or ");
+
+=head2 Example 3
+
+An empty script is one trivial solution, and here is another:
+echo "42" > ch-1.pl && perl -p -e '' ch-1.pl
+
+=cut
+
+use strict;
+use warnings;
+use Data::Dumper;
+
+sub self_spammer
+{
+    my $filename = shift;
+
+    open my $fh, '<', $filename or die "Error opening $filename: $!\n";
+    my $string = do { local $/; <$fh> };
+    close $fh;
+
+    $string =~ s/\R//g;
+    my @words = split /\s+/, $string;
+
+    my $i = int(rand(@words));
+    return $words[$i];
+}
+
+print self_spammer($0), "\n";
+
+exit 0;
diff --git a/challenge-286/peter-meszaros/perl/ch-2.pl b/challenge-286/peter-meszaros/perl/ch-2.pl
new file mode 100755
index 0000000000..168cf7a5cb
--- /dev/null
+++ b/challenge-286/peter-meszaros/perl/ch-2.pl
@@ -0,0 +1,113 @@
+#!/usr/bin/env perl
+#
+=head1 Task 2: Order Game
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints, whose length is a power of 2.
+
+Write a script to play the order game (min and max) and return the last
+element.
+
+=head2 Example 1
+
+    Input: @ints = (2, 1, 4, 5, 6, 3, 0, 2)
+    Output: 1
+
+    Operation 1:
+
+        min(2, 1) = 1
+        max(4, 5) = 5
+        min(6, 3) = 3
+        max(0, 2) = 2
+
+    Operation 2:
+
+        min(1, 5) = 1
+        max(3, 2) = 3
+
+    Operation 3:
+
+        min(1, 3) = 1
+
+=head2 Example 2
+
+    Input: @ints = (0, 5, 3, 2)
+    Output: 0
+
+    Operation 1:
+
+        min(0, 5) = 0
+        max(3, 2) = 3
+
+    Operation 2:
+
+        min(0, 3) = 0
+
+=head2 Example 3
+
+    Input: @ints = (9, 2, 1, 4, 5, 6, 0, 7, 3, 1, 3, 5, 7, 9, 0, 8)
+    Output: 2
+
+    Operation 1:
+
+        min(9, 2) = 2
+        max(1, 4) = 4
+        min(5, 6) = 5
+        max(0, 7) = 7
+        min(3, 1) = 1
+        max(3, 5) = 5
+        min(7, 9) = 7
+        max(0, 8) = 8
+
+    Operation 2:
+
+        min(2, 4) = 2
+        max(5, 7) = 7
+        min(1, 5) = 1
+        max(7, 8) = 8
+
+    Operation 3:
+
+        min(2, 7) = 2
+        max(1, 8) = 8
+
+    Operation 4:
+
+        min(2, 8) = 2
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+use List::Util qw/min max/;
+
+my $cases = [
+    [[2, 1, 4, 5, 6, 3, 0, 2],                         1, 'Example 1'],
+    [[0, 5, 3, 2],                                     0, 'Example 2'],
+    [[9, 2, 1, 4, 5, 6, 0, 7, 3, 1, 3, 5, 7, 9, 0, 8], 2, 'Example 3'],
+];
+
+sub order_game
+{
+    my $list = shift;
+
+    while (@$list != 1) {
+        my $l = [];
+        for (my $i=0; $i < @$list; $i+=2) {
+            push @$l, ($i / 2 % 2 ? max($list->[$i], $list->[$i+1])
+                                  : min($list->[$i], $list->[$i+1]));
+        }
+        $list = $l;
+    }
+    return $list->[0];
+}
+
+for (@$cases) {
+    is(order_game($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
diff --git a/challenge-286/peter-meszaros/tcl/ch-1.tcl b/challenge-286/peter-meszaros/tcl/ch-1.tcl
new file mode 100755
index 0000000000..6d199b04e2
--- /dev/null
+++ b/challenge-286/peter-meszaros/tcl/ch-1.tcl
@@ -0,0 +1,45 @@
+#!/usr/bin/env tclsh
+#
+# Task 1: Self Spammer
+# 
+# Submitted by: David Ferrone
+# 
+# Write a program which outputs one word of its own script / source code at
+# random. A word is anything between whitespace, including symbols.
+# 
+# Example 1
+# 
+# If the source code contains a line such as: 'open my $fh, "<", "ch-1.pl" or
+# die;' then the program would output each of the words { open, my, $fh,, "<",,
+# "ch-1.pl", or, die; } (along with other words in the source) with some positive
+# probability.
+# 
+# Example 2
+# 
+# Technically 'print(" hello ");' is *not* an example program, because it does
+# not assign positive probability to the other two words in the script.  It will
+# never display print(" or ");
+# 
+# Example 3
+# 
+# An empty script is one trivial solution, and here is another:
+# echo "42" > ch-1.pl && perl -p -e '' ch-1.pl
+# 
+
+package require tcltest
+
+proc self_spammer {filename} {
+
+    set fp [open $filename r]
+    set data [read $fp]
+    close $fp
+
+    set words [regexp -inline -all -- {\S+} $data]
+    
+    return [lindex $words [expr int(rand() * [llength $words])]]
+}
+
+puts [self_spammer $argv0]
+
+exit 0
+
diff --git a/challenge-286/peter-meszaros/tcl/ch-2.tcl b/challenge-286/peter-meszaros/tcl/ch-2.tcl
new file mode 100755
index 0000000000..a19d191260
--- /dev/null
+++ b/challenge-286/peter-meszaros/tcl/ch-2.tcl
@@ -0,0 +1,110 @@
+#!/usr/bin/env tclsh
+#
+# Task 2: Order Game
+# 
+# Submitted by: Mohammad Sajid Anwar
+# 
+# You are given an array of integers, @ints, whose length is a power of 2.
+# 
+# Write a script to play the order game (min and max) and return the last
+# element.
+# 
+# Example 1
+# 
+#     Input: @ints = (2, 1, 4, 5, 6, 3, 0, 2)
+#     Output: 1
+# 
+#     Operation 1:
+# 
+#         min(2, 1) = 1
+#         max(4, 5) = 5
+#         min(6, 3) = 3
+#         max(0, 2) = 2
+# 
+#     Operation 2:
+# 
+#         min(1, 5) = 1
+#         max(3, 2) = 3
+# 
+#     Operation 3:
+# 
+#         min(1, 3) = 1
+# 
+# Example 2
+# 
+#     Input: @ints = (0, 5, 3, 2)
+#     Output: 0
+# 
+#     Operation 1:
+# 
+#         min(0, 5) = 0
+#         max(3, 2) = 3
+# 
+#     Operation 2:
+# 
+#         min(0, 3) = 0
+# 
+# Example 3
+# 
+#     Input: @ints = (9, 2, 1, 4, 5, 6, 0, 7, 3, 1, 3, 5, 7, 9, 0, 8)
+#     Output: 2
+# 
+#     Operation 1:
+# 
+#         min(9, 2) = 2
+#         max(1, 4) = 4
+#         min(5, 6) = 5
+#         max(0, 7) = 7
+#         min(3, 1) = 1
+#         max(3, 5) = 5
+#         min(7, 9) = 7
+#         max(0, 8) = 8
+# 
+#     Operation 2:
+# 
+#         min(2, 4) = 2
+#         max(5, 7) = 7
+#         min(1, 5) = 1
+#         max(7, 8) = 8
+# 
+#     Operation 3:
+# 
+#         min(2, 7) = 2
+#         max(1, 8) = 8
+# 
+#     Operation 4:
+# 
+#         min(2, 8) = 2
+# 
+
+package require tcltest
+
+set cases {
+    {{2 1 4 5 6 3 0 2}                 1 "Example 1"}
+    {{0 5 3 2}                         0 "Example 2"}
+    {{9 2 1 4 5 6 0 7 3 1 3 5 7 9 0 8} 2 "Example 3"}
+}
+
+proc order_game {lst} {
+
+    while {[llength $lst] != 1} {
+        set l {}
+        for {set i 0} {$i < [llength $lst]} {incr i 2} {
+            set v [lsort [list [lindex $lst $i] [lindex $lst [expr $i + 1]]]]
+            lappend l [lindex $v [expr $i / 2 % 2]]
+        }
+        set lst $l
+    }
+    return [lindex $lst 0]
+}
+
+tcltest::configure -verbose {pass}
+foreach case $cases {
+    tcltest::test [lindex $case 2] {} {
+        order_game [lindex $case 0]
+    } [lindex $case 1]
+}
+
+exit 0
+
+