Add polettix's solution to challenge-111

4 files changed, 78 insertions, 0 deletions

diff --git a/challenge-111/polettix/blog.txt b/challenge-111/polettix/blog.txt
new file mode 100644
index 0000000000..f233a9718f
--- /dev/null
+++ b/challenge-111/polettix/blog.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/05/05/pwc111-search-matrix/
diff --git a/challenge-111/polettix/blog1.txt b/challenge-111/polettix/blog1.txt
new file mode 100644
index 0000000000..555211a42b
--- /dev/null
+++ b/challenge-111/polettix/blog1.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/05/06/ordered-letters/
diff --git a/challenge-111/polettix/perl/ch-1.pl b/challenge-111/polettix/perl/ch-1.pl
new file mode 100644
index 0000000000..ea77031359
--- /dev/null
+++ b/challenge-111/polettix/perl/ch-1.pl
@@ -0,0 +1,42 @@
+#!/usr/bin/env perl
+use 5.024;
+use warnings;
+use experimental qw< postderef signatures >;
+no warnings qw< experimental::postderef experimental::signatures >;
+
+sub search_matrix ($M, $x) {
+   my $n_rows = $M->@*      or return 0;
+   my $n_cols = $M->[0]->@* or return 0;
+   my ($lo, $hi) = (0, $n_rows * $n_cols - 1);
+   while ('necessary') {
+      my $mid = int(($lo + $hi) / 2);
+      my $v   = $M->[$mid / $n_cols][$mid % $n_cols];
+      return 1 if $v == $x;
+      return 0 if $lo == $hi;
+      if ($v < $x) { $lo = ($mid == $lo) ? $lo + 1 : $mid }
+      else         { $hi = $mid }
+   } ## end while ('necessary')
+} ## end sub search_matrix
+
+my @matrix = (
+   [1,  2,  3,  5,  7],
+   [9,  11, 15, 19, 20],
+   [23, 24, 25, 29, 31],
+   [32, 33, 39, 40, 42],
+   [45, 47, 48, 49, 50],
+);
+
+my $target = shift || 35;
+say search_matrix(\@matrix, $target)
+  ? "$target is present"
+  : "$target is absent";
+
+sub matrix_searcher ($M) {
+    my %is_item = map { map { $_ => 1 } $_->@* } $M->@*;
+    return sub ($x) { return $is_item{$x} ? 1 : 0 };
+}
+
+#...
+
+my $ms = matrix_searcher(\@matrix);
+say $ms->($_) ? "$_ is present" : "$_ is absent" for ($target, @ARGV);
diff --git a/challenge-111/polettix/perl/ch-2.pl b/challenge-111/polettix/perl/ch-2.pl
new file mode 100644
index 0000000000..d80fe1b180
--- /dev/null
+++ b/challenge-111/polettix/perl/ch-2.pl
@@ -0,0 +1,34 @@
+#!/usr/bin/env perl
+use utf8;                     # so literals and identifiers can be in UTF-8
+use v5.24;
+use strict;                   # quote strings, declare variables
+use warnings;                 # on by default
+use warnings qw(FATAL utf8);  # fatalize encoding glitches
+use open qw(:std :utf8);      # undeclared streams in UTF-8
+use experimental qw< postderef signatures >;
+no warnings qw< experimental::postderef experimental::signatures >;
+
+use Unicode::Normalize;
+use Unicode::Collate;
+use Encode qw(decode_utf8);
+
+@ARGV = map { decode_utf8($_, 1) } @ARGV;
+
+my @pairs;
+while (<>) {
+   my $pair = check_ordered(NFD($_)) // next;
+   push @pairs, $pair;
+}
+say for reverse map { $_->[1] } sort { $a->[0] <=> $b->[0] } @pairs;
+
+sub check_ordered ($x) {
+   state $coll = Unicode::Collate->new(level => 1);
+   state $es = Unicode::Collate->new(level => 1, normalization => undef);
+   my @chars = $x =~ m{(\X)}gmxs;
+   shift @chars while @chars && $chars[0] =~ m{[\h\v]}mxs;
+   pop @chars   while @chars && $chars[-1] =~ m{[\h\v]}mxs;
+   my $original   = join '', @chars;
+   my $rearranged = join '', $coll->sort(@chars);
+   return [scalar(@chars), $original] if $es->eq($original, $rearranged);
+   return;
+} ## end sub check_ordered ($x)