Merge pull request #10842 from boblied/w286

Week 286 solutions from Bob Lied

3 files changed, 226 insertions, 3 deletions

diff --git a/challenge-286/bob-lied/README b/challenge-286/bob-lied/README
index 804bf87a0f..30177c17b1 100644
--- a/challenge-286/bob-lied/README
+++ b/challenge-286/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 285 by Bob Lied
+Solutions to weekly challenge 286 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-285/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-285/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-286/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-286/bob-lied
diff --git a/challenge-286/bob-lied/perl/ch-1.pl b/challenge-286/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..b823ae8ad8
--- /dev/null
+++ b/challenge-286/bob-lied/perl/ch-1.pl
@@ -0,0 +1,38 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2024, Bob Lied
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge 286 Task 1 Self Spammer
+#=============================================================================
+# 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
+#   'print(" hello ");' is *not* an solution program, because it always
+#   prints "hello" but 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
+#=============================================================================
+
+use v5.40;
+use English qw/$PROGRAM_NAME/;
+use FindBin qw/$Bin/;
+use File::Spec;
+use File::Slurper qw/read_text/;
+
+# my $path = File::Spec->catfile($Bin, $PROGRAM_NAME);
+# my $text = read_text($path);
+# my @word = split(" ", $text);
+# my $pick = int(rand(@word));
+# say $word[$pick];
+
+my @word = split(" ", read_text( File::Spec->catfile($Bin, $PROGRAM_NAME)));
+say $word[ int(rand(@word)) ];
diff --git a/challenge-286/bob-lied/perl/ch-2.pl b/challenge-286/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..4db6601e7b
--- /dev/null
+++ b/challenge-286/bob-lied/perl/ch-2.pl
@@ -0,0 +1,185 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2024, Bob Lied
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge 286 Task 2 Order Game
+#=============================================================================
+# 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
+#=============================================================================
+
+use v5.40;
+
+use List::Util qw/min max/;
+
+use Getopt::Long;
+my $Verbose = false;
+my $DoTest  = false;
+my $Benchmark = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$Benchmark);
+exit(!runTest()) if $DoTest;
+exit( runBenchmark($Benchmark) ) if $Benchmark;
+
+say orderGame(@ARGV);
+
+sub orderGame($ints)
+{
+    my $length = scalar(@{$ints});
+    return undef if ($length & ($length-1)) != 0;
+
+    while ( $#{$ints} > 0 )
+    {
+        my @list;
+        foreach ( 0 .. int($#{$ints}/2) )
+        {
+            push @list, ( $_ % 2 == 0 )
+                    ? ($ints->[$_] < $ints->[$_+1] ? $ints->[$_] : $ints->[$_+1])
+                    : ($ints->[$_] > $ints->[$_+1] ? $ints->[$_] : $ints->[$_+1]) 
+        }
+        $ints = \@list;
+    }
+    return $ints->[0] // undef;
+}
+
+sub og2($ints)
+{
+    my $length = scalar(@{$ints});
+    return undef if ($length & ($length-1)) != 0;
+
+    my $op = 0;
+    while ( $ints->$#* > 0 )
+    {
+        $ints = [ map  {
+                ($op = !$op)
+                    ? ($ints->[$_] < $ints->[$_+1] ? $ints->[$_] : $ints->[$_+1])
+                    : ($ints->[$_] > $ints->[$_+1] ? $ints->[$_] : $ints->[$_+1]) 
+                } 0 .. (($ints->$#* / 2)) ];
+    }
+    return $ints->[0] // undef;
+}
+
+sub og3($ints)
+{
+    use List::MoreUtils qw/natatime/;
+    my $length = scalar(@{$ints});
+    return undef if ($length & ($length-1)) != 0;
+    my $op = 1;
+    while ( $ints->$#* > 0 )
+    {
+        my @list;
+        my $iter = natatime 2, @{$ints};
+        while ( my @pair = $iter->() )
+        {
+            push @list, ($op ? min(@pair) : max(@pair));
+            $op = !$op
+        }
+        $ints = \@list;
+    }
+    return $ints->[0] // undef;
+}
+
+sub og4($ints)
+{
+    my $length = scalar(@{$ints});
+    return undef if ($length & ($length-1)) != 0;
+
+    my $op = 0;
+    while ( scalar(@{$ints}) > 1 )
+    {
+        my @list;
+        foreach my ($i, $j) ( $ints->@* )
+        {
+            push @list, (( $op = !$op ) ? min($i,$j) : max($i,$j));
+        }
+        $ints = \@list;
+    }
+    return $ints->[0] // undef;
+}
+
+sub og5($ints)
+{
+    my $length = scalar(@{$ints});
+    return undef if ($length & ($length-1)) != 0;
+    my $op = 0;
+    while ( @{$ints} > 1 )
+    {
+        for ( 0 ..  int($#{$ints}/2) )
+        {
+            splice @$ints, $_, 2,
+                 (( $op = !$op )
+                    ? ($ints->[$_] < $ints->[$_+1] ? $ints->[$_] : $ints->[$_+1])
+                    : ($ints->[$_] > $ints->[$_+1] ? $ints->[$_] : $ints->[$_+1]) ) 
+        }
+    }
+    return $ints->[0] // undef;
+}
+
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( orderGame([8,3]),             3,                 "One pair");
+    is( orderGame([2,1,4,5,6,3,0,2]), 1,                 "Example 1");
+    is( orderGame([0,5,3,2]),         0,                 "Example 2");
+    is( orderGame([9,2,1,4,5,6,0,7,3,1,3,5,7,9,0,8]), 2, "Example 3");
+
+    is( orderGame([]),    undef, "Empty list");
+    is( orderGame([1,2,3]), undef, "Length != 2^x");
+
+    is( og2([8,3]),             3,                 "One pair");
+    is( og2([2,1,4,5,6,3,0,2]), 1,                 "Example 1");
+    is( og2([0,5,3,2]),         0,                 "Example 2");
+    is( og2([9,2,1,4,5,6,0,7,3,1,3,5,7,9,0,8]), 2, "Example 3");
+
+    is( og3([8,3]),             3,                 "One pair");
+    is( og3([2,1,4,5,6,3,0,2]), 1,                 "Example 1");
+    is( og3([0,5,3,2]),         0,                 "Example 2");
+    is( og3([9,2,1,4,5,6,0,7,3,1,3,5,7,9,0,8]), 2, "Example 3");
+
+    is( og4([8,3]),             3,                 "One pair");
+    is( og4([2,1,4,5,6,3,0,2]), 1,                 "Example 1");
+    is( og4([0,5,3,2]),         0,                 "Example 2");
+    is( og4([9,2,1,4,5,6,0,7,3,1,3,5,7,9,0,8]), 2, "Example 3");
+
+    is( og5([8,3]),             3,                 "One pair");
+    is( og5([2,1,4,5,6,3,0,2]), 1,                 "Example 1");
+    is( og5([0,5,3,2]),         0,                 "Example 2");
+    is( og5([9,2,1,4,5,6,0,7,3,1,3,5,7,9,0,8]), 2, "Example 3");
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    my @ints = ( int(rand(10) ) x 512 );
+
+    cmpthese($repeat, {
+        basic    => sub { orderGame(\@ints) },
+        map      => sub { og2(\@ints) },
+        natatime => sub { og3(\@ints) },
+        foreach  => sub { og4(\@ints) },
+        splice   => sub { og5(\@ints) },
+    });
+}