This week’s Perl Weekly Challenge tasks reminded me of It’s the Same Old Song.
I want to add Elixir to the guest languages I’m implementing these in, but it’s a busy week, due to the new job and theatrical tech evenings. Maybe next week.
Task 1: Same String
You are given two arrays of strings.
Write a script to find out if the word created by concatenating the array elements is the same.
Example 1
Input: @arr1 = ("ab", "c")
@arr2 = ("a", "bc")
Output: true
Using @arr1, word1 => "ab" . "c" => "abc"
Using @arr2, word2 => "a" . "bc" => "abc"
Example 2
Input: @arr1 = ("ab", "c")
@arr2 = ("ac", "b")
Output: false
Using @arr1, word1 => "ab" . "c" => "abc"
Using @arr2, word2 => "ac" . "b" => "acb"
Example 3
Input: @arr1 = ("ab", "cd", "e")
@arr2 = ("abcde")
Output: true
Using @arr1, word1 => "ab" . "cd" . "e" => "abcde"
Using @arr2, word2 => "abcde"
Approach
This is a pretty straightforward task: accept two arrays of strings, concatenate each of the arrays until they produce a single string, and then compare whether the strings are the same. In fact, this reminds me of Raku’s Reduction Metaoperator, [ ]
, so I think I’ll do that code first:
Raku
sub sameString(@arr1, @arr2) {
my $words = "";
my $word1 = [~] @arr1;
$words ~= "\n" ~ 'Using @arr1, word1 => "'
~ @arr1.join('" . "')
~ '" => "' ~ $word1 ~ '"';
my $word2 = [~] @arr2;
$words ~= "\n" ~ 'Using @arr2, word2 => "'
~ @arr2.join("' . '")
~ '" => "' ~ $word2 ~ '"';
my $same = $word1 eq $word2;
return($same, $words);
}
Ugh. That’s too much repeated code.
sub concatString($num, @arr) {
my $word = [~] @arr;
my $words = "\nUsing \@arr$num, word$num => \""
~ @arr.join('" . "')
~ '" => "' ~ $word ~ '"';
return ($word, $words);
}
sub sameString(@arr1, @arr2) {
my ($word1, $words1) = concatString(1, @arr1);
my ($word2, $words2) = concatString(2, @arr2);
return($word1 eq $word2, $words1 ~ $words2);
}
There. Much better. View the entire Raku script for this task on GitHub.
Perl
Really, the only changes I need to make to back-port the Raku to Perl is
- Use List::Util::reduce to replace Raku’s reduction metaoperator
- Use array references instead of array objects
- Swap Raku’s
~
string concatenation operator for Perl’s.
string concatenation operator
use List::Util qw( reduce );
sub concatString {
my($num, $arr) = @_;
my $word = reduce { $a . $b } @$arr;
my $words = "\nUsing \@arr$num, word$num => \""
. join('" . "', @$arr)
. '" => "' . $word . '"';
return ($word, $words);
}
sub sameString {
my ($arr1, $arr2) = @_;
my ($word1, $words1) = concatString(1, $arr1);
my ($word2, $words2) = concatString(2, $arr2);
return($word1 eq $word2, $words1 . $words2);
}
And that’s it. As you can see on on GitHub, the rest of the script is identical.
Python
Similarly, Python has a functools.reduce function:
from functools import reduce
def concatString(num, arr):
word = reduce(lambda a, b: a + b, arr)
words = (
f'\nUsing @arr{num}, word{num} => "' +
"' . '".join(arr) +
f'" => "{word}"'
)
return word, words
def sameString(arr1, arr2):
word1, words1 = concatString(1, arr1)
word2, words2 = concatString(2, arr2)
return(word1 == word2, words1 + words2)
View the entire Python script for this task on GitHub.
Task 2: Consistent Strings
You are given an array of strings and allowed string having distinct characters.
A string is consistent if all characters in the string appear in the string allowed.
Write a script to return the number of consistent strings in the given array.
Example 1
Input: @str = ("ad", "bd", "aaab", "baa", "badab")
$allowed = "ab"
Output: 2
Strings "aaab" and "baa" are consistent since they only contain characters 'a' and 'b'.
Example 2
Input: @str = ("a", "b", "c", "ab", "ac", "bc", "abc")
$allowed = "abc"
Output: 7
Example 3
Input: @str = ("cc", "acd", "b", "ba", "bac", "bad", "ac", "d")
$allowed = "cad"
Output: 4
Strings "cc", "acd", "ac", and "d" are consistent.
Approach
I’m not reproducing the explanatory text this time. So, we’re given a list of characters that are allowed, and we need to count the strings in an array that only use those characters. This feels to me a lot like regular expression character classes! The “allowed” parameter defines the characters in the class, and we count the strings in @str
that consist entirely of those characters.
Raku
sub consistentCount($allowed, @str) {
my $regex = '^ <[' ~ $allowed ~ ']>+ $';
my $count = 0;
for @str -> $s {
$count++ if $s.match: / <$regex> /;
}
return $count;
}
View the entire Raku script for this task on GitHub.
Perl
Again, the only changes I need to make to back-port the Raku to Perl is
- Switch to Perl’s regular expression format and matching operators
- Use array references instead of array objects
- Swap Raku’s
~
string concatenation operator for Perl’s.
string concatenation operator
sub consistentCount {
my($allowed, $str) = @_;
my $regex = '^[' . $allowed . ']+$';
my $count = 0;
foreach my $s ( @$str ) {
$count++ if $s =~ /$regex/;
}
return $count;
}
Again, that’s it. As you can see on on GitHub, the rest of the script is identical.
Python
For Python, we need to import
the regular expression library, but the syntax of the regular expression itself is the same as Perl.
import re
def consistentCount(allowed, str):
regex = re.compile('^[' + allowed + ']+$')
count = 0
for s in str:
if regex.match(s):
count += 1
return count
View the entire Python script for this task on GitHub.
Here’s all my solutions in GItHub: https://github.com/packy/perlweeklychallenge-club/tree/master/challenge-239/packy-anderson