by Arne Sommer

# Palin' Dot with Raku and Perl

[163] 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'); # [1] my @a = \$a.words; # [2] my @b = \$b.words; # [2a] die '@a and @b must have the same size' unless @a.elems == @b.elems; # [3] say (^@a.elems).map({ @a[\$_] * @b[\$_] }).sum; # [4] ```

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

[2] Get the individual values.

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

[4] 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*`.

See docs.raku.org/routine/Z for more information about the infix zip operator `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) # [1] { my \$letter = \$s.substr(0,1); # [2] @result.push: \$letter unless %seen{\$letter}; # [2a] %seen{\$letter} = True; # [3] last if \$s.chars == 1; # [4] my \$is-palindromic = is-palindromic(\$s); # [5] if (\$is-palindromic) # [6] { my \$new = \$s.substr(0, \$is-palindromic); # [10] @result.push: \$new; # [11] if (\$is-palindromic == \$s.chars) # [12] { \$s = \$s.substr(1, \$is-palindromic -2); # [12a] } else { \$s = \$s.substr(1, \$is-palindromic -1) ~ \$s.substr(\$is-palindromic); } # [13] } else { \$s = \$s.substr(1); # [14] } say "Result: @result[] | Todo: \$s" if \$verbose; } say @result.join(" "); # [15] sub is-palindromic(\$string) # [5a] { for \$string.chars ... 2 -> \$end # [6] { my \$partial = \$string.substr(0, \$end); # [7] return \$end if \$partial eq \$partial.flip; # [8] } return 0; # [9] } ```

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

[2] 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].

[3] Now we have seen this letter.

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

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

[6] From the end,

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

[8] Return the length if we have a palindrome.

[9] No palindrome.

[10] We have a palindrome, get it.

[11] Add the palindrome to the list.

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

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

[14] Not palindromic, get rid of the first character.

[15] 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; # [1] my \$length = \$s.chars; # [2] for 0 .. \$length -2 -> \$start # [3] { for \$start +1 .. \$length -1 -> \$stop # [4] { my \$candidate = \$s.substr(\$start, \$stop - \$start +1); # [5] say ": [\$start,\$stop] \$candidate" if \$verbose; @result.push: \$candidate if \$candidate.flip eq \$candidate; # [6] } } say @result.unique.join(" "); # [7] ```

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

[2] We need this for the loops.

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

[4] Stop at the very next position, up to the very end.

[5] Get the substring.

[6] Add it to the result if it is palindromic.

[7] 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[0] // '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.)