by Arne Sommer

Palin' Dot with Raku and Perl

 Published 2. January 2022.

This is my response to the Perl Weekly Challenge #145.

Challenge #145.1: Dot Product

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

File: dot-product
#! /usr/bin/env raku

unit sub MAIN (\$a = '1 2 3', \$b = '4 5 6');    # 

my @a = \$a.words;                              # 
my @b = \$b.words;                              # [2a]

die '@a and @b must have the same size' unless @a.elems == @b.elems;  # 

say (^@a.elems).map({ @a[\$_] * @b[\$_] }).sum;  # 

 Note the input format; two strings with space separated values.

 Get the individual values.

 Ensure that the two arrays have the same size. Note that a zero size is ok.

 For each index in the arrays ((^@a.elems)), get the sum of the field with that index in the two arrays and multiply them (.map({ @a[\$_] * @b[\$_] })). And finally get the sum of all those values (.sum).

Running it:

\$ ./dot-product
32

\$ ./dot-product "1 2 3" "4 5 6"
32

Using map on an index like this is perfectly fine, but we can do it much shorter with the infix zip operator Z (that merges the two lists). That would give us a list of Pair values, which we would need to multiply together before the final sum. But this operator has a meta version that uses the specified operator to reduce the Pair to a single value. Multiplication is just a matter of writing Z*.

File: dot-product-Z
#! /usr/bin/env raku

unit sub MAIN (\$a = '1 2 3', \$b = '4 5 6');

my @a = \$a.words;
my @b = \$b.words;

die '@a and @b must have the same size' unless @a.elems == @b.elems;

say (@a Z* @b).sum;

The result of running it is the same as the previous version:

\$ ./dot-product-Z "1 2 3" "4 5 6"
32

A Perl Version

This is straight forward translation of the first Raku version.

File: dot-product-perl
#! /usr/bin/env perl

use strict;
use warnings;
use feature 'say';
use List::Util 'sum';

my \$a = shift(@ARGV) // '1 2 3';
my \$b = shift(@ARGV) // '4 5 6';

my @a = split(/\s+/, \$a);
my @b = split(/\s+/, \$b);

die '@a and @b must have the same size' unless @a == @b;

say sum(map { \$a[\$_] * \$b[\$_] } (0 .. @a -1));

Running it gives the same result as the Raku versions:

\$ ./dot-product-perl "1 2 3" "4 5 6"
32

Challenge #145.2: Palindromic Tree

You are given a string \$s.

Write a script to create a Palindromic Tree for the given string.

I found this blog exaplaining Palindromic Tree in detail.

Example 1:
Input: \$s = 'redivider'
Output: r redivider e edivide d divid i ivi v
Example 2:
Input: \$s = 'deific'
Output: d e i ifi f c
Example 3:
Input: \$s = 'rotors'
Output: r rotor o oto t s
Example 4:
Input: \$s = 'challenge'
Output: c h a l ll e n g
Example 5:
Input: \$s = 'champion'
Output: c h a m p i o n
Example 6:
Input: \$s = 'christmas'
Output: c h r i s t m a

There are several ways of doing this. Let us start with a hard (and extremely stupid) way:

File: palindromic-tree
#! /usr/bin/env raku

unit sub MAIN (\$s is copy = 'redivider', :v(:\$verbose));

my @result;
my %seen;

while (\$s.chars)                                # 
{
my \$letter = \$s.substr(0,1);                  # 
@result.push: \$letter unless %seen{\$letter};  # [2a]
%seen{\$letter} = True;                        # 

last if \$s.chars == 1;                        # 

my \$is-palindromic = is-palindromic(\$s);      # 

if (\$is-palindromic)                          # 
{
my \$new = \$s.substr(0, \$is-palindromic);    # 
@result.push: \$new;                         # 

if (\$is-palindromic == \$s.chars)            # 
{
\$s = \$s.substr(1, \$is-palindromic -2);    # [12a]
}
else
{
\$s = \$s.substr(1, \$is-palindromic -1) ~ \$s.substr(\$is-palindromic);
}                                          # 
}
else
{
\$s = \$s.substr(1);                         # 
}

say "Result: @result[] | Todo: \$s" if \$verbose;
}

say @result.join(" ");                         # 

sub is-palindromic(\$string)                    # [5a]
{
for \$string.chars ... 2 -> \$end              # 
{
my \$partial = \$string.substr(0, \$end);     # 
return \$end if \$partial eq \$partial.flip;  # 
}
return 0;                                    # 
}

 As long as there are letters left in \$s. We chop off the first one in [12a],  and .

 The first letter in the current string (note the loop). Add it to the list if it is the first time we encounter it [2a].

 Now we have seen this letter.

 This one will actually kick in before the test in the while . We are done when we have reached the very last letter, as we need at least two letters to have a palindrome.

 Do we have a palindrome in the current string (or a part of it)?

 From the end,

 Get a substring, first the whole string and thereafter we chop off the last one - one by one.

 Return the length if we have a palindrome.

 No palindrome.

 We have a palindrome, get it.

 Add the palindrome to the list.

 Did the palindrome use all the characters? if so chop off the first and last character.

 If not, get rid of the palindrome part and add the rest of the string.

 Not palindromic, get rid of the first character.

 Print the result.

Running it:

\$ ./palindromic-tree redivider
r redivider e edivide d divid i ivi v

\$ ./palindromic-tree deific
d e i ifi f c

\$ ./palindromic-tree rotors
r rotor o oto t s

\$ ./palindromic-tree challenge
c h a l ll e n g

\$ ./palindromic-tree champion
c h a m p i o n

\$ ./palindromic-tree christmas
c h r i s t m a

Looking good.

We can simplify the program slightly, by replacing the housekeeping in [2a and 3] with unique on the resulting array:

File: palindromic-tree-unique
#! /usr/bin/env raku

unit sub MAIN (\$s is copy = 'redivider', :v(:\$verbose));

my @result;

while (\$s.chars)
{
my \$letter = \$s.substr(0,1);
@result.push: \$letter;

last if \$s.chars == 1;

my \$is-palindromic = is-palindromic(\$s);

if (\$is-palindromic)
{
my \$new = \$s.substr(0, \$is-palindromic);
@result.push: \$new;

if (\$is-palindromic == \$s.chars)
{
\$s = \$s.substr(1, \$is-palindromic -2);
}
else
{
\$s = \$s.substr(1, \$is-palindromic -1) ~ \$s.substr(\$is-palindromic);
}
}
else
{
\$s = \$s.substr(1);
}

say "Result: @result[] | Todo: \$s" if \$verbose;
}

say @result.unique.join(" ");

sub is-palindromic(\$string)
{
for \$string.chars ... 2 -> \$end
{
my \$partial = \$string.substr(0, \$end);
return \$end if \$partial eq \$partial.flip;
}
return 0;
}

Running it gives the same result.

We can indeed simplify this quite a lot. Here is a version that does what it should, as long as the order of the values does not matter:

File: palindromic-tree-unordered
#! /usr/bin/env raku

unit sub MAIN (\$s is copy = 'redivider', :v(:\$verbose));

my @result = \$s.comb;                                           # 
my \$length = \$s.chars;                                          # 

for 0 .. \$length -2 -> \$start                                   # 
{
for \$start +1 .. \$length -1 -> \$stop                          # 
{
my \$candidate = \$s.substr(\$start, \$stop - \$start +1);       # 
say ": [\$start,\$stop] \$candidate" if \$verbose;
@result.push: \$candidate if \$candidate.flip eq \$candidate;  # 
}
}

say @result.unique.join(" ");                                   # 

 All the single letters should end up in the result, so add them.

 We need this for the loops.

 Start at every possible character, excluding the very last one (so that we get at least two characters when we start at that position).

 Stop at the very next position, up to the very end.

 Get the substring.

 Add it to the result if it is palindromic.

 Print the result, excluding duplicates.

Running it gives the correct result, albeit in a different order:

\$ ./palindromic-tree-unordered redivider
r e d i v redivider edivide divid ivi

\$ ./palindromic-tree-unordered deific
d e i f c ifi

\$ ./palindromic-tree-unordered rotors
r o t s rotor oto

\$ ./palindromic-tree-unordered challenge
c h a l e n g ll

\$ ./palindromic-tree-unordered champion
c h a m p i o n

\$ ./palindromic-tree-unordered christmas
c h r i s t m a

We can fix the order, by moving the push of the individual letters inside the first loop:

File: palindromic-tree-reordered
#! /usr/bin/env raku

unit sub MAIN (\$s is copy = 'redivider', :v(:\$verbose));

my @result;
my \$length = \$s.chars;

for 0 .. \$length -> \$start
{
@result.push: \$s.substr(\$start,1);

next if \$start > \$length -2;

for \$start +1 .. \$length -1 -> \$stop
{
my \$candidate = \$s.substr(\$start, \$stop - \$start +1);
say ": [\$start,\$stop] \$candidate" if \$verbose;
@result.push: \$candidate if \$candidate.flip eq \$candidate;
}
}

say @result.unique.join(" ");

Running it gives the output in the required order:

\$ ./palindromic-tree-reordered redivider
r redivider e edivide d divid i ivi v

\$ ./palindromic-tree-reordered deific
d e i ifi f c

\$ ./palindromic-tree-reordered rotors
r rotor o oto t s

\$ ./palindromic-tree-reordered challenge
c h a l ll e n g

\$ ./palindromic-tree-reordered champion
c h a m p i o n

\$ ./palindromic-tree-reordered christmas
c h r i s t m a

Verbose mode gives the substrings, if you want to have a closer look at what is going on:

\$ ./palindromic-tree-reordered -v
: [0,1] re
: [0,2] red
: [0,3] redi
: [0,4] rediv
: [0,5] redivi
: [0,6] redivid
: [0,7] redivide
: [0,8] redivider
: [1,2] ed
: [1,3] edi
: [1,4] ediv
: [1,5] edivi
: [1,6] edivid
: [1,7] edivide
: [1,8] edivider
: [2,3] di
: [2,4] div
: [2,5] divi
: [2,6] divid
: [2,7] divide
: [2,8] divider
: [3,4] iv
: [3,5] ivi
: [3,6] ivid
: [3,7] ivide
: [3,8] ivider
: [4,5] vi
: [4,6] vid
: [4,7] vide
: [4,8] vider
: [5,6] id
: [5,7] ide
: [5,8] ider
: [6,7] de
: [6,8] der
: [7,8] er
r redivider e edivide d divid i ivi v

Perl

This is a straight forward translation of the last Raku version.

File: palindromic-tree-perl
#! /usr/bin/env perl

use strict;
use warnings;
use feature 'say';
use Getopt::Long;
use List::Util 'uniq';

my \$verbose = 0;

GetOptions("verbose" => \\$verbose);

my \$s = \$ARGV // 'redivider';

my @result;
my \$length = length(\$s);

for my \$start (0 .. \$length)
{
push(@result, substr(\$s, \$start, 1));

next if \$start > \$length -2;

for my \$stop (\$start +1 .. \$length -1)
{
my \$candidate = substr(\$s, \$start, \$stop - \$start +1);
say ": [\$start,\$stop] \$candidate" if \$verbose;
push(@result, \$candidate) if reverse(\$candidate) eq \$candidate;
}
}

say join(" ", uniq @result);

Running it gives the expected result:

\$ ./palindromic-tree-perl redivider
r redivider e edivide d divid i ivi v

\$ ./palindromic-tree-perl deific
d e i ifi f c

\$ ./palindromic-tree-perl rotors
r rotor o oto t s

\$ ./palindromic-tree-perl challenge
c h a l ll e n g

\$ ./palindromic-tree-perl champion
c h a m p i o n

\$ ./palindromic-tree-perl christmas
c h r i s t m a

And that's it. (Happy new year.)