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,
@aand@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
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.
say
Of course, prints this value out.
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)]);
Challenge 2:
Palindromic Tree
You are given a string
$s.Write a script to create a
Palindromic Treefor the given string.I found this blog explaining
Palindromic Treein detail.
Example 1
Input: $s = 'redivider'
Output: r redivider e edivide d divid i ivi v
Example2
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 {
@palindromes.push($part);
last;
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 {
$distance--;
}
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.
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;
last;
} else {
$distance--;
}
}
}
say join q{ }, @palindromes;