Perl Weekly Challenge: Week 145

If you've had problems reading my blog entries of late, it's because something is going on with my server. It's been difficult troubleshooting especially with people not available during the holiday season but if you can read this it means I must have figured it out.

Challenge 1:

Dot Product

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

Write a script to implement Dot Product.

@a = (1, 2, 3);
@b = (4, 5, 6);

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

Raku makes this almost a one-liner. (In my solution I hard-coded the arrays @a and @b otherwise it would have been one.)

say  [+] (@a Z @b).map({ [*] $_; });

To break this down:

(@a Z @b)

Z is the zip operator. It takes the 0th element of @a and the 0th element of @b, the 1st elements of @a and @b and so on returning a list of two element lists.

map({ [*] $_; })

[*] multiplies the members of each of these two-element lists. We end up with a single list of values.


Sums that list giving the final dot product.


Of course, prints this value out.

(Full code on Github.)

Perl, alas, doesn't have all those fancy operators. Luckily I had already written code for previous challenges which I could use to fill the gap.

sub sum {
    my ($arr) = @_;
    my $total = 0;

    for my $elem (@{$arr}) {
        $total += $elem;

    return $total;

sum() replaces [+].

sub Zmultiply {
    my @a = @{ $_[0] };
    my @b = @{ $_[1] };

    my @result;
    for my $i (0 .. scalar @b - 1) {
        push @result, $a[$i] * $b[$i];
    return @result;

Zmultiply() combines the usage of Z and .map() in the Raku version.

These functions pass parameters as references so the final form of the Perl version is:

say sum([Zmultiply(\@a, \@b)]);

(Full code on Github.)

Challenge 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 explaining Palindromic Tree in detail.

Example 1
Input: $s = 'redivider'
Output: r redivider e edivide d divid i ivi v
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

At first this task seemed rather forbidding but once it clicked for me, it wasn't that bad.

The first thing I needed was a function that determines if a string is a palindrome.

sub isPalindrome(Str $word) {
    return $word eq $word.flip;

In earlier challenges, I had used more complicated schemes for determining thus but actually it's very simple in Raku; just use .flip() to reverse the string and see if it is equal to the original. This doesn't allow for spaces, punctuation, capitalization etc. but it was good enough for my purposes.

    my @palindromes;

Initially I was going to put palindromes in a proper tree structure classes for nodes and fields for children etc. like in the Java example from the linked blog but given the way the spec shows output it didn't seem necessary so I just use a list.

    for 0 ..^ $s.chars -> $i {
        if $s.substr($i, 1) ne @palindromes.any  {
            @palindromes.push($s.substr($i, 1));

We go through the word $s character by character looking for palindromes. Each character is a palindrome of length 1 so if it is not already there, we add it to the @palindromes list.

Longer palindromes are more interesting.

        my $distance = $s.chars - $i;

In order to get all the palindromes we have to look at every segment of the string. The distance from the end of the string gives us the longest possible length for each segment. In retrospect, I should have named this variable something like $segmentLength instead of $distance.

        while $distance > 1 {

We only care if a segment is 2 or more characters long, We already have the 1-length palindromes.

            my $part = $s.substr($i, $distance);

Noe we actually carve out the segment using substr(). Again hindsight tells me $segment would have been a better name for this variable than $part.

            if isPalindrome($part) && $part ne @palindromes.any {

If the segment is a palindrome and if it is not already in the @palindromes array it is added. We are at the tip of this branch of the tree so we can stop processing now.

            } else {

If it wasn't a palindrome or if it was one we had already recorded, the length of the segment is reduced by one and we can try again. } }

    say @palindromes.join(q{ });

Finally, we have a complete list of palindromes we can print.

(Full code on Github.)

Translating the Raku version into Perl was fairly straightforward.

sub isPalindrome {
    my ($word) = @_;

    return $word eq join q{}, reverse split //, $word;

To reverse a string there is no straightforward method like .flip() so I converted the string into a list of characters with .split() then reversed it with reverse() (because unfortunately it only works on lists.) and then joined it back up into a string with join().

my @palindromes;

for my $i (0 .. length($s) - 1) {

    my $char = substr $s, $i, 1;
    if (!scalar grep { $_ eq $char; } @palindromes) {
        push @palindromes, $char;

    my $distance = length($s) - $i;
    while ($distance > 1) {
        my $part = substr $s, $i, $distance;
        if (isPalindrome($part) && !scalar grep { $_ eq $part; } @palindromes) {
            push @palindromes, $part;
        } else {

say join q{ }, @palindromes;

(Full code on Github.)