Merge pull request #3058 from polettix/polettix/pwc092

Add polettix's solution to 092

4 files changed, 88 insertions, 0 deletions

diff --git a/challenge-092/polettix/blog.txt b/challenge-092/polettix/blog.txt
new file mode 100644
index 0000000000..4c10e5b4c9
--- /dev/null
+++ b/challenge-092/polettix/blog.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2020/12/22/pwc092-isomorphic-strings/
diff --git a/challenge-092/polettix/blog1.txt b/challenge-092/polettix/blog1.txt
new file mode 100644
index 0000000000..2bb6dd4cf4
--- /dev/null
+++ b/challenge-092/polettix/blog1.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2020/12/23/pwc092-insert-interval/
diff --git a/challenge-092/polettix/perl/ch-1.pl b/challenge-092/polettix/perl/ch-1.pl
new file mode 100644
index 0000000000..26c20085de
--- /dev/null
+++ b/challenge-092/polettix/perl/ch-1.pl
@@ -0,0 +1,24 @@
+#!/usr/bin/env perl
+use 5.024;
+use warnings;
+use experimental qw< postderef signatures >;
+no warnings qw< experimental::postderef experimental::signatures >;
+
+sub isomorphic_strings ($A, $B) {
+   return 0 if length($A) != length($B);
+   my (%A_for, %B_for);
+   for my $i (0 .. length($A) - 1) {
+      my ($cA, $cB) = map { substr $_, $i, 1 } ($A, $B);
+      return 0
+        if (exists($B_for{$cA}) && ($B_for{$cA} ne $cB))
+        || (exists($A_for{$cB}) && ($A_for{$cB} ne $cA));
+      $B_for{$A_for{$cB} = $cA} = $cB;
+   } ## end for my $i (0 .. length(...))
+   return 1;
+} ## end sub isomorphic_strings
+
+{
+   my $A = shift || 'abc';
+   my $B = shift || 'xyz';
+   say isomorphic_strings($A, $B);
+}
diff --git a/challenge-092/polettix/perl/ch-2.pl b/challenge-092/polettix/perl/ch-2.pl
new file mode 100644
index 0000000000..8011acd7e4
--- /dev/null
+++ b/challenge-092/polettix/perl/ch-2.pl
@@ -0,0 +1,62 @@
+#!/usr/bin/env perl
+use 5.024;
+use warnings;
+use experimental qw< postderef signatures >;
+no warnings qw< experimental::postderef experimental::signatures >;
+use List::Util qw< min max >;
+use Test::More;
+
+sub insert_interval ($S, $N) {
+   my @S = map { [$_->@*] } $S->@*;
+   my ($l, $h) = $N->@*;
+   my @retval;
+
+   # first of all, "transfer" all preceding intervals
+   push @retval, shift(@S) while @S && $S[0][1] < $l;
+   if (! @S) { # all intervals were preceding, easy
+      push @retval, [$l, $h];
+      return \@retval;
+   }
+
+   # now $S[0] might be after the new interval
+   if ($S[0][0] > $h) {
+      push @retval, [$l, $h], @S;
+      return \@retval;
+   }
+
+   # now there is some overlap between $S[0] and $N. We can fix the start
+   $l = min($l, $S[0][0]);
+
+   # ... and look for the end...
+   while (@S && $h >= $S[0][0]) {
+      $h = max($h, $S[0][1]);
+      shift @S;
+   }
+
+   push @retval, [$l, $h], @S;
+   return \@retval;
+}
+
+for my $test (
+   [
+      [[1, 4], [8, 10]],
+      [2, 6],
+      [[1, 6], [8, 10]],
+   ],
+   [
+      [[1, 2], [3, 7], [8, 10]],
+      [5,8],
+      [[1, 2], [3, 10]],
+   ],
+   [
+      [[1, 5], [7, 9]],
+      [10, 11],
+      [[1, 5], [7, 9], [10, 11]],
+   ]
+) {
+   my ($S, $N, $E) = $test->@*;
+   my $got = insert_interval($S, $N);
+   is_deeply($got, $E);
+}
+
+done_testing();