Merge pull request #5433 from polettix/polettix/pwc145

Add polettix's solution to challenge-145

6 files changed, 197 insertions, 0 deletions

diff --git a/challenge-145/polettix/blog.txt b/challenge-145/polettix/blog.txt
new file mode 100644
index 0000000000..563b771133
--- /dev/null
+++ b/challenge-145/polettix/blog.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/12/29/pwc145-dot-product/
diff --git a/challenge-145/polettix/blog1.txt b/challenge-145/polettix/blog1.txt
new file mode 100644
index 0000000000..5157e0dec1
--- /dev/null
+++ b/challenge-145/polettix/blog1.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/12/30/pwc145-palindromic-tree/
diff --git a/challenge-145/polettix/perl/ch-1.pl b/challenge-145/polettix/perl/ch-1.pl
new file mode 100644
index 0000000000..f8ac6b62bb
--- /dev/null
+++ b/challenge-145/polettix/perl/ch-1.pl
@@ -0,0 +1,23 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+no warnings 'experimental::signatures';
+
+my $v = Vector->new(1, 2, 3);
+my $w = Vector->new(4, 5, 6);
+say $v . $w;
+
+package Vector;
+use v5.24;
+use experimental 'signatures';
+no warnings 'experimental::signatures';
+use overload
+   '.' => sub ($v, $w, @rest) {
+      die "size mismatch\n" unless $v->$#* == $w->$#*;
+      my $dp = 0;
+      $dp += $v->[$_] * $w->[$_] for 0 .. $v->$#*;
+      return $dp;
+   };
+
+sub new ($package, @a) { bless \@a, $package }
diff --git a/challenge-145/polettix/perl/ch-2.pl b/challenge-145/polettix/perl/ch-2.pl
new file mode 100644
index 0000000000..be2eff4c16
--- /dev/null
+++ b/challenge-145/polettix/perl/ch-2.pl
@@ -0,0 +1,84 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+no warnings 'experimental::signatures';
+
+my $string = shift // 'eertree';
+my $eertree = EertreE->new($string);
+say $eertree->dot;
+
+package EertreE;
+use v5.24;
+use warnings;
+use experimental 'signatures';
+no warnings 'experimental::signatures';
+
+sub new ($package, $string) {
+   my @suffixes = (
+      {            length => -1, pred => 0 },
+      {start => 0, length => 0,  pred => 0 },
+   );
+
+   for my $i (0 .. length($string) - 1) {
+      my $c = substr $string, $i, 1;
+
+      # find longest suffix Q such that cQc exists
+      my $Q = $suffixes[-1];
+      while ($Q->{length} >= 0) {
+         my $j = $i - $Q->{length} - 1; # "mirror" of $i
+         last if $j >= 0 && $c eq substr $string, $j, 1;
+         $Q = $suffixes[$Q->{pred}];
+      }
+
+      next if exists $Q->{expansion_for}{$c};
+
+      # adding a node as an expansion from $Q
+      push @suffixes, {
+         start  => $i - $Q->{length} - 1,
+         length => $Q->{length} + 2,
+         pred   => 1, # this is just an educated guess default
+      };
+      $Q->{expansion_for}{$c} = $#suffixes;
+      next if $Q->{length} < 0; # solitary, no further search needed
+
+      $Q = $suffixes[$Q->{pred}]; # start from the previous one
+      while ($Q->{length} >= 0) {
+         my $j = $i - $Q->{length} - 1; # "mirror" of $i
+         last if $j >= 0 && $c eq substr $string, $j, 1;
+         $Q = $suffixes[$Q->{pred}];
+      }
+      $suffixes[-1]{pred} = $Q->{expansion_for}{$c};
+   }
+
+   return bless {
+      string => $string,
+      suffixes => \@suffixes,
+   }, $package;
+}
+
+sub string_for ($self, $i) {
+   return '«-1»' if $i == 0;
+   my ($start, $length) = $self->{suffixes}[$i]->@{qw< start length >};
+   return q{'} . substr($self->{string}, $start, $length) . q{'};
+}
+
+sub dot ($self) {
+   my $suffixes = $self->{suffixes};
+   my @lines;
+   for my $i (0 .. $suffixes->$#*) {
+      my $name = $self->string_for($i);
+
+      my $suffix = $suffixes->[$i];
+      my $pred = $self->string_for($suffix->{pred});
+      push @lines, qq{"$name" -> "$pred" [color=blue]};
+
+      my $exp_for = $suffix->{expansion_for} or next;
+      while (my ($c, $tid) = each $exp_for->%*) {
+         my $target = $self->string_for($tid);
+         push @lines, qq{"$name" -> "$target" [color=black label="$c"]};
+      }
+   }
+   s{^}{   } for @lines;
+   return join "\n", 'digraph {', @lines, '}';
+}
diff --git a/challenge-145/polettix/raku/ch-1.raku b/challenge-145/polettix/raku/ch-1.raku
new file mode 100644
index 0000000000..503b7bb7cd
--- /dev/null
+++ b/challenge-145/polettix/raku/ch-1.raku
@@ -0,0 +1,11 @@
+#!/usr/bin/env raku
+use v6;
+
+class Vector { has @.v; method new (*@x) { self.bless(v => @x) } }
+sub infix:<·> (Vector:D $x, Vector:D $y) { ($x.v »*« $y.v).sum }
+
+sub MAIN {
+   my $a = Vector.new(1, 2, 3);
+   my $b = Vector.new(4, 5, 6);
+   put $a · $b;
+}
diff --git a/challenge-145/polettix/raku/ch-2.raku b/challenge-145/polettix/raku/ch-2.raku
new file mode 100644
index 0000000000..90ec345c4e
--- /dev/null
+++ b/challenge-145/polettix/raku/ch-2.raku
@@ -0,0 +1,77 @@
+#!/usr/bin/env raku
+use v6;
+
+class EertreE {
+   has $.string;
+   has @.suffixes;
+
+   method new ($string) {
+      my @suffixes =
+         hash(            'length', -1, 'pred', 0),
+         hash('start', 0, 'length', 0,  'pred', 0);
+
+      for 0 ..^ $string.chars -> $i {
+         my $c := $string.substr: $i, 1;
+
+         # find longest suffix Q such that cQc exists
+         my $Q = @suffixes[*-1];
+         while ($Q<length> >= 0) {
+            my $j = $i - $Q<length> - 1; # "mirror" of $i
+            last if $j >= 0 && $c eq $string.substr($j, 1);
+            $Q = @suffixes[$Q<pred>];
+         }
+
+         next if $Q<expansion-for>{$c}:exists;
+
+         # adding a node as an expansion from $Q
+         @suffixes.push: hash(
+            'start',  $i - $Q<length> - 1,
+            'length', $Q<length> + 2,
+            'pred',   1, # this is just an educated guess default
+         );
+         $Q<expansion-for>{$c} = @suffixes.end;
+         next if $Q<length> < 0; # solitary, no further search needed
+
+         $Q = @suffixes[$Q<pred>]; # start from the previous one
+         while ($Q<length> >= 0) {
+            my $j = $i - $Q<length> - 1; # "mirror" of $i
+            last if $j >= 0 && $c eq $string.substr($j, 1);
+            $Q = @suffixes[$Q<pred>];
+         }
+         @suffixes[*-1]<pred> = $Q<expansion-for>{$c};
+      }
+
+      self.bless(:$string, :@suffixes);
+   }
+
+   method string-for ($i) {
+      return '«-1»' if $i == 0;
+      my ($start, $length) = @.suffixes[$i]<start length>;
+      return q{'} ~ $.string.substr($start, $length) ~ q{'};
+   }
+
+   method dot () {
+      my @lines;
+      for ^@.suffixes -> $i {
+         my $name = self.string-for($i);
+
+         my $suffix = @.suffixes[$i];
+         my $pred = self.string-for($suffix<pred>);
+         @lines.push: qq{"$name" -> "$pred" [color=blue]};
+
+         my $exps = $suffix<expansion-for> or next;
+         for $exps.kv -> $c, $tid {
+            my $target = self.string-for($tid);
+            @lines.push: qq{"$name" -> "$target" [color=black label="$c"]};
+         }
+      }
+      s{^^} = '   ' for @lines;
+      return ('digraph {', @lines, '}').flat.join("\n");
+
+   }
+};
+
+sub MAIN (Str $string = 'eertree') {
+   my $eertree = EertreE.new($string);
+   $eertree.dot.say;
+}