2 files changed, 106 insertions, 0 deletions
diff --git a/challenge-257/e-choroba/perl/ch-1.pl b/challenge-257/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..af176d8cc3
--- /dev/null
+++ b/challenge-257/e-choroba/perl/ch-1.pl
@@ -0,0 +1,27 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+sub smaller_than_current(@ints) {
+    my @sorted = sort { $a <=> $b } @ints;
+    my %dense_rank;
+    my $r = 0;
+    for my $i (0 .. $#sorted) {
+        ++$r if $sorted[ $i - 1 ] < $sorted[$i];  # Never true for $i = 0,
+                                                  # because sorted.
+        $dense_rank{ $sorted[$i] } = $r;
+    }
+    return [map $dense_rank{$_}, @ints]
+}
+
+use Test2::V0;
+plan 4 + 2;
+
+is smaller_than_current(5, 2, 1, 6), [2, 1, 0, 3], 'Example 1';
+is smaller_than_current(1, 2, 0, 3), [1, 2, 0, 3], 'Example 2';
+is smaller_than_current(0, 1),       [0, 1],       'Example 3';
+is smaller_than_current(9, 4, 9, 2), [2, 1, 2, 0], 'Example 4';
+
+is smaller_than_current(1, 0, 0, 2), [1, 0, 0, 2], 'Duplicate at the beginning';
+is smaller_than_current(7, 7, 2, 8), [1, 1, 0, 2], 'Duplicate in the middle';
diff --git a/challenge-257/e-choroba/perl/ch-2.pl b/challenge-257/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..47584e8f8f
--- /dev/null
+++ b/challenge-257/e-choroba/perl/ch-2.pl
@@ -0,0 +1,79 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+use List::Util qw{ first max };
+
+sub reduced_row_echelon($m) {
+    my $previous_pos = -1;
+    for my $row (@$m) {
+        my $f = first { $row->[$_] } 0 .. $#$row;
+        # Leading 1.
+        return 0 if defined $f && $row->[$f] != 1;
+
+        # We don't check the zeroes are at the bottom, because we pretend
+        # they have 1s past the end of each row.
+        $f //= 1 + max($previous_pos, $#$row);
+
+        # Leading 1 farther right.
+        return 0 if $f <= $previous_pos;
+
+        $previous_pos = $f;
+
+        # Single 1 in a column.
+        return 0 if $f < $#$row && 1 < grep $_->[$f], @$m;
+    }
+    return 1
+}
+
+use Test::More tests => 7 + 1;
+
+is reduced_row_echelon([
+    [1,0,0,1],
+    [0,1,0,2],
+    [0,0,1,3]
+]), 1, 'Example 0';
+
+is reduced_row_echelon([
+    [1, 1, 0],
+    [0, 1, 0],
+    [0, 0, 0]
+]), 0, 'Example 1';
+
+is reduced_row_echelon([
+    [0, 1,-2, 0, 1],
+    [0, 0, 0, 1, 3],
+    [0, 0, 0, 0, 0],
+    [0, 0, 0, 0, 0]
+]), 1, 'Example 2';
+
+is reduced_row_echelon([
+    [1, 0, 0, 4],
+    [0, 1, 0, 7],
+    [0, 0, 1,-1]
+]), 1, 'Example 3';
+
+is reduced_row_echelon([
+    [0, 1,-2, 0, 1],
+    [0, 0, 0, 0, 0],
+    [0, 0, 0, 1, 3],
+    [0, 0, 0, 0, 0]
+]), 0, 'Example 4';
+
+is reduced_row_echelon([
+    [0, 1, 0],
+    [1, 0, 0],
+    [0, 0, 0]
+]), 0, 'Example 5';
+
+is reduced_row_echelon([
+    [4, 0, 0, 0],
+    [0, 1, 0, 7],
+    [0, 0, 1,-1]
+]), 0, 'Example 6';
+
+is reduced_row_echelon([
+    [0, 0, 0],
+    [0, 0, 0]
+]), 1, 'All zeros';