Week 257 solutions

3 files changed, 188 insertions, 3 deletions

diff --git a/challenge-257/bob-lied/README b/challenge-257/bob-lied/README
index a8ca38f546..b01628e413 100644
--- a/challenge-257/bob-lied/README
+++ b/challenge-257/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 256 by Bob Lied
+Solutions to weekly challenge 257 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-256/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-256/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-257/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-257/bob-lied
diff --git a/challenge-257/bob-lied/perl/ch-1.pl b/challenge-257/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..df079822da
--- /dev/null
+++ b/challenge-257/bob-lied/perl/ch-1.pl
@@ -0,0 +1,60 @@
+#!/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 257 Task 1 Smaller than Current
+#=============================================================================
+# You are given a array of integers, @ints.
+# Write a script to find out how many integers are smaller than current
+# i.e. foreach ints[i], count ints[j] < ints[i] where i != j.
+# Example 1 Input: @ints = (5, 2, 1, 6)
+#           Output: (2, 1, 0, 3)
+# Example 2 Input: @ints = (1, 2, 0, 3)
+#           Output: (1, 2, 0, 3)
+# Example 3 Input: @ints = (0, 1)
+#           Output: (0, 1)
+# Example 4 Input: @ints = (9, 4, 9, 2)
+#           Output: (2, 1, 2, 0)
+#=============================================================================
+
+use v5.38;
+
+use builtin qw/true false/; no warnings "experimental::builtin";
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+say "(", join(", ", stc(@ARGV)->@*), ")";
+
+sub stc(@ints)
+{
+    # Sort in descending order
+    my @sorted = sort { $b <=> $a } @ints;
+
+    my %smaller = map { $_ => 0 } @ints;
+    while ( defined(my $one = shift @sorted) )
+    {
+        # Skip over duplicate values;
+        while ( @sorted && $sorted[0] == $one ) { shift @sorted }
+        $smaller{$one} = scalar(@sorted);
+    }
+    return [ @smaller{ @ints } ];
+}
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( stc(5,2,1,6), [2,1,0,3], "Example 1");
+    is( stc(1,2,0,3), [1,2,0,3], "Example 2");
+    is( stc(0,1    ), [0,1    ], "Example 3");
+    is( stc(9,4,9,2), [2,1,2,0], "Example 4");
+    is( stc(9,9,9,9), [0,0,0,0], "All same");
+
+    done_testing;
+}
diff --git a/challenge-257/bob-lied/perl/ch-2.pl b/challenge-257/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..892f303164
--- /dev/null
+++ b/challenge-257/bob-lied/perl/ch-2.pl
@@ -0,0 +1,125 @@
+#!/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 257 Task 2 Reduced Row Echelon
+#=============================================================================
+# Given a matrix M, check whether the matrix is in reduced row echelon form.
+# A matrix must have the following properties to be in reduced row echelon form:
+# 1. If a row does not consist entirely of zeros, then the first
+#    nonzero number in the row is a 1. We call this the leading 1.
+# 2. If there are any rows that consist entirely of zeros, then
+#    they are grouped together at the bottom of the matrix.
+# 3. In any two successive rows that do not consist entirely of zeros,
+#    the leading 1 in the lower row occurs farther to the right than
+#    the leading 1 in the higher row.
+# 4. Each column that contains a leading 1 has zeros everywhere else
+#    in that column.
+# For more information check out this wikipedia article.
+# https://en.wikipedia.org/wiki/Row_echelon_form
+
+#=============================================================================
+
+use v5.38;
+use builtin qw/true false/; no warnings "experimental::builtin";
+
+use List::Util qw/any all/;
+use List::MoreUtils qw/first_index/;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+sub rre($m)
+{
+    my @pivotCol = map { first_index { $_ != 0 } $_->@* } $m->@*;
+
+    # Rows without a pivot should be at the bottom of the matrix.
+    my $zeroRow = first_index {$_ == -1} @pivotCol;
+    if ( $zeroRow > -1 )
+    {
+        return false if ( any {$_ != -1} @pivotCol[ $zeroRow .. $#pivotCol ] );
+
+        # Eliminate zero rows from further consideration
+        splice(@pivotCol, $zeroRow);
+    }
+
+    # All pivots must be 1
+    for my $row ( 0 .. $#pivotCol )
+    {
+        return false if $m->[$row][$pivotCol[$row]] != 1;
+    }
+
+    # Pivot columns must be in strictly increasing order
+    for ( my ($i, $j) = (0, 1); $j <= $#pivotCol; $i++, $j++ )
+    {
+        return false if ( $pivotCol[$i] >= $pivotCol[$j] );
+    }
+
+    # There must be zeroes above all the pivots.
+    my $maxPivot = $pivotCol[-1];
+    for my $row ( 1 .. ($#pivotCol) )
+    {
+        my $col = $pivotCol[$row];
+        return false if any { $_ != 0 }
+                    map { $_->[$col] } $m->@[0 .. $row-1]
+    }
+    return true;
+}
+
+sub runTest
+{
+    use Test2::V0;
+    use builtin qw/true false/; no warnings "experimental::builtin";
+    my $matrix = [
+                   [1,0,0,1],
+                   [0,1,0,2],
+                   [0,0,1,3]
+                 ];
+    is( rre($matrix), true, "Example 0");
+
+    $matrix = [
+                [1, 1, 0],
+                [0, 1, 0],
+                [0, 0, 0]
+              ];
+    is( rre($matrix), false, "Example 1");
+
+    $matrix = [ [0, 1,-2, 0, 1],
+                [0, 0, 0, 1, 3],
+                [0, 0, 0, 0, 0],
+                [0, 0, 0, 0, 0]
+              ];
+    is( rre($matrix), true, "Example 2");
+
+    $matrix = [ [1, 0, 0, 4],
+                [0, 1, 0, 7],
+                [0, 0, 1,-1]
+              ];
+    is( rre($matrix), true, "Example 3");
+
+    $matrix = [ [0, 1,-2, 0, 1],
+                [0, 0, 0, 0, 0],
+                [0, 0, 0, 1, 3],
+                [0, 0, 0, 0, 0]
+              ];
+    is( rre($matrix), false, "Example 4");
+
+    $matrix = [ [0, 1, 0],
+                [1, 0, 0],
+                [0, 0, 0]
+              ];
+    is( rre($matrix), false, "Example 5");
+
+    $matrix = [ [4, 0, 0, 0],
+                [0, 1, 0, 7],
+                [0, 0, 1,-1]
+              ];
+    is( rre($matrix), false, "Example 6");
+
+    done_testing;
+}