Perl Weekly Challenge: Now it’s the same old string, but with consistency since you’ve been gone…

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