- Added solutions by Colin Crain.

3 files changed, 219 insertions, 0 deletions

diff --git a/challenge-145/colin-crain/perl/ch-1.pl b/challenge-145/colin-crain/perl/ch-1.pl
new file mode 100755
index 0000000000..4ddb80cc36
--- /dev/null
+++ b/challenge-145/colin-crain/perl/ch-1.pl
@@ -0,0 +1,66 @@
+#!/Users/colincrain/perl5/perlbrew/perls/perl-5.32.0/bin/perl

+#

+#       zip-ties-and-dotted-eyes.pl

+#

+#       Dot Product

+#         Submitted by: Mohammad S Anwar

+#         You are given 2 arrays of same size, @a and @b.

+# 

+#         Write a script to implement Dot Product.

+# 

+#         Example:

+#             @a = (1, 2, 3);

+#             @b = (4, 5, 6);

+# 

+#         $dot_product = (1 * 4) + (2 * 5) + (3 * 6) => 4 + 10 + 18 => 32

+#

+#       © 2021 colin crain

+## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##

+

+

+

+use warnings;

+use strict;

+use utf8;

+use feature ":5.26";

+use feature qw(signatures);

+no warnings 'experimental::signatures';

+

+

+sub dot ( $array1, $array2 ) {

+    return undef unless $array1->@* == $array2->@*;

+    my $out = 0;

+    while ( my ($k,$v) = each $array1->@*) {

+        $out += $v * $array2->[$k];

+    }

+    return $out;

+}

+

+sub dot_u ( $a1, $a2 ) {

+    use List::Util qw( zip sum );

+    return  sum 

+            map { $_->[0] * $_->[1] } 

+            zip( $a1, $a2 )

+

+}

+

+

+my $a1 = [ 1, 2, 3 ];

+my $a2 = [ 2, 4, 6 ];

+

+say dot( $a1, $a2);

+say dot_u( $a1, $a2);

+

+

+

+

+

+

+

+

+

+# use Test::More;

+# 

+# is 

+# 

+# done_testing();

diff --git a/challenge-145/colin-crain/perl/ch-2.pl b/challenge-145/colin-crain/perl/ch-2.pl
new file mode 100755
index 0000000000..3fbafe3621
--- /dev/null
+++ b/challenge-145/colin-crain/perl/ch-2.pl
@@ -0,0 +1,130 @@
+#!/Users/colincrain/perl5/perlbrew/perls/perl-5.32.0/bin/perl

+#

+#       a-palindrome-grows-in-brooklyn.pl

+#

+#       I think the result here, of a new tool to find out all things

+#       palindromic, is not really the most practical thing. However the

+#       algorithm used to get there is quite interesting and novel.

+# 

+#       I say the algorithm is novel, and I mean it: its only a few years

+#       old and represents a new data structure that solves the problem

+#       with a remarkably efficient computational complxity.

+# 

+#       Consider it as two interwoven trees, one containing palidromic

+#       segments and the other

+

+

+#         ref:

+#             https://www.geeksforgeeks.org/palindromic-tree-introduction-implementation/

+            

+#

+#       © 2021 colin crain

+## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##

+

+

+package PNode;

+use Moo;

+

+    has start       => ( is => 'rw' );

+    has end         => ( is => 'rw' );

+    has length      => ( is => 'rw' );

+    has insert_link => ( is => 'rw',

+                         default => sub { 

+                            return { map { $_, 0 } ('a'..'z') } } );

+    has suffix_link => ( is => 'rw' );

+

+

+### ### ### main body

+

+use warnings;

+use strict;

+use utf8;

+use feature ":5.26";

+use feature qw(signatures);

+no warnings 'experimental::signatures';

+

+package main;

+my $input = shift // 'amanaplanacanalpanama';  ## <-- input here

+my @s = split //, $input;

+

+my $root1 = PNode->new( length => -1, suffix_link => 1 );

+my $root2 = PNode->new( length =>  0, suffix_link => 1 );

+

+our @tree = ( undef, $root1, $root2 );

+

+our $curr_node = 1;

+our $node_ptr  = 2;

+

+## traverse the string and insert each character into the structure

+insert( $_ ) for keys @s;

+  

+## output 

+say "all distinct palindromic substrings for ", @s, " : \n";

+for my $i (3..$node_ptr) {

+    print  $i-2, ") ";

+    say substr $input, $tree[$i]->start, $tree[$i]->length;

+}

+

+ 

+  

+sub insert( $idx ) {

+## FIND MAX PALINDROME AT $idx  

+    ## search for a node containing a substring such that the character at

+    ## the current index plus the substring defined by the located node,

+    ## plus the character again, is the maximum palindrome at idx:

+    ## $s[$idx].X.$s[$idx] We iterate down the suffix link chain from

+    ## $curr_node to find X 

+    my $tmp = $curr_node;

+    while (1) {

+        my $curr_length = $tree[$tmp]->length;

+        last if ($idx - $curr_length >= 1 and $s[$idx] eq $s[$idx - $curr_length - 1]) ;

+        $tmp = $tree[$tmp]->suffix_link;

+    }

+  

+    ## check to see whether palindrome string $s[$idx].X.$s[$idx] 

+    ## already exists or not 

+    if( $tree[$tmp]->insert_link->{ $s[$idx] } != 0 ) {

+        ## substring already exists in the tree

+        $curr_node = $tree[$tmp]->insert_link->{ $s[$idx] };

+        return;

+    }

+  

+  

+## ADD NEW NODE AS CHILD OF X:

+    ## parent link to new node position, weight as $s[$idx]

+    $tree[$tmp]->insert_link->{ $s[$idx] } = ++$node_ptr ;

+

+    ## create new node: start, end, length of substring

+    $tree[$node_ptr] = PNode->new(

+        length  => $tree[$tmp]->length + 2 ,

+        end     => $idx ,

+        start   => $idx - ($tree[$tmp]->length + 2)  + 1 ,

+    );

+  

+

+## SET SUFFIX EDGE FOR NEW NODE

+    ## Find some string Y such that

+    ## $s[$idx].Y.$s[$idx] is longest possible

+    ## palindromic suffix for newly created Node.

+  

+    $tmp = $tree[$tmp]->suffix_link;

+  

+    ## making new Node as current Node

+    $curr_node = $node_ptr;

+    if ($tree[$curr_node]->length == 1) {

+        ## if new palindrome's lengthgth is 1

+        ## making its suffix link to be null string

+        $tree[$curr_node]->suffix_link( 2 );

+        return;

+    }

+    while (1) {

+        my $curr_lengthgth = $tree[$tmp]->length;

+        last if ($idx - $curr_lengthgth >= 1 and $s[$idx] eq $s[$idx-$curr_lengthgth-1]) ;

+        $tmp = $tree[$tmp]->suffix_link;

+    }

+  

+    ## linking current PNode suffix_link with $s[$idx].Y.$s[$idx]

+    $tree[$curr_node]->suffix_link( $tree[$tmp]->insert_link->{ $s[$idx] } );

+}

+  

+

diff --git a/challenge-145/colin-crain/raku/ch-1.raku b/challenge-145/colin-crain/raku/ch-1.raku
new file mode 100755
index 0000000000..5af30936af
--- /dev/null
+++ b/challenge-145/colin-crain/raku/ch-1.raku
@@ -0,0 +1,23 @@
+#!/usr/bin/env perl6
+#
+#
+#       zip-ties-and-dotted-eyes.raku
+#
+#
+#
+#       © 2021 colin crain
+## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
+
+
+
+unit sub MAIN () ;
+
+sub dot ( @a1, @a2 ) {
+    [+] [Z*] @a1, @a2;
+}
+
+
+
+say my @a1 = 1, 2, 3;
+say my @a2 = 2, 4, 6;   ## a1 • a2 = 28
+say dot( @a1, @a2 );