Perl Weekly Challenge: Doodling with matches and prefixes

Posted on by

Even though Perl Weekly Challenge 352‘s tasks “Match String” and “Binary Prefix” ought to have been fertile ground for a musical theme related to the tasks, my brain was just too preoccupied with a certain someone’s 100th birthday celebration, I couldn’t think of any other music besides The Doodlin’ Song.

Task 1: Match String

You are given an array of strings.

Write a script to return all strings that are a substring of another word in the given array in the order they occur.

Example 1

Input: @words = ("cat", "cats", "dog", "dogcat", "dogcat", "rat", "ratcatdogcat")
Output: ("cat", "dog", "dogcat", "rat")

Example 2

Input: @words = ("hello", "hell", "world", "wor", "ellow", "elloworld")
Output: ("hell", "world", "wor", "ellow")

Example 3

Input: @words = ("a", "aa", "aaa", "aaaa")
Output: ("a", "aa", "aaa")

Example 4

Input: @words = ("flower", "flow", "flight", "fl", "fli", "ig", "ght")
Output: ("flow", "fl", "fli", "ig", "ght")

Example 5

Input: @words = ("car", "carpet", "carpenter", "pet", "enter", "pen", "pent")
Output: ("car", "pet", "enter", "pen", "pent")

Approach

I’m sure there’s a clever way to do this, but I’m going with the straight ahead double loop: loop over each word ($i), and have a nested loop within that looping over the words again ($j) that skips comparing when $i = $j so we don’t match strings against themselves. We’ll check to see if @words[$i] is a substring of @words[$j] using some kind of index function (a regular expression is too heavy a lift for just seeing whether one string is a substring of another), and, if it is, we push @words[$i] unto a result array and then skip the rest of the $j loop, since all we need is that it’s a substring of ONE of the other strings.

Raku

When I implemented it in Raku, I made a discovery: the first example yielded the results ("cat", "dog", "dogcat", "dogcat", "rat"). I realized that was because we matched "dogcat" as a result when $i = 3, $j = 4, we matched it again when $i = 4, $j = 3. Looking at the other examples, it was clear that the problem was supposed to match earlier elements, otherwise "hell" would never match as a substring of "hello". So I needed to keep track of words as I compared in the $i loop, and skip them if they came up again in the $i loop. That’s when I introduced lines 6, 9, & 10.

sub matchString(@words) {
  my @matches;
  my %seen;
  for 0..@words.end -> $i {
    my $substring = @words[$i];
    # skip if we've already considered this substring
    next if %seen{$substring}++;
    for 0..@words.end -> $j {
      # we're not matching substrings against themselves
      next if $i == $j;
      my $string = @words[$j];
      # skip $string if $substring doesn't match
      next if $string.index($substring) === Nil;
      # save the matched substring
      @matches.push($substring);
      # it matches at least one, we don't have to check the rest
      last;
    }
  }
  return @matches;
}

View the entire Raku script for this task on GitHub.

$ raku/ch-1.raku
Example 1:
Input: @words = ("cat", "cats", "dog", "dogcat", "dogcat", "rat",
"ratcatdogcat")
Output: ("cat", "dog", "dogcat", "rat")

Example 2:
Input: @words = ("hello", "hell", "world", "wor", "ellow", "elloworld")
Output: ("hell", "world", "wor", "ellow")

Example 3:
Input: @words = ("a", "aa", "aaa", "aaaa")
Output: ("a", "aa", "aaa")

Example 4:
Input: @words = ("flower", "flow", "flight", "fl", "fli", "ig", "ght")
Output: ("flow", "fl", "fli", "ig", "ght")

Example 5:
Input: @words = ("car", "carpet", "carpenter", "pet", "enter", "pen", "pent")
Output: ("car", "pet", "enter", "pen", "pent")

Perl

As usual, going from Raku to Perl was just fixing the for to foreach syntax, making the postfix method calls into standalone function calls, and converting the @arr[] to $arr[] and %hash{} to $hash{}.

sub matchString(@words) {
  my @matches;
  my %seen;
  foreach my $i ( 0 .. $#words ) {
    my $substring = $words[$i];
    # skip if we've already considered this substring
    next if $seen{$substring}++;
    foreach my $j ( 0 .. $#words ) {
      # we're not matching substrings against themselves
      next if $i == $j;
      my $string = $words[$j];
      # skip $string if $substring doesn't match
      next if index($string, $substring) < 0;
      # save the matched substring
      push @matches, $substring;
      # it matches at least one, we don't have to check the rest
      last;
    }
  }
  return @matches;
}

View the entire Perl script for this task on GitHub.

Python

Going from Raku to Python was similarly easy: ditching all the sigils, remembering that declaring an empty array is [] not () (that’s a tuple), and making the postfix conditionals into normal conditionals. One thing that was good to know: while str.find() will return the kind of info Raku’s Str.index() does the documentation has a caveat:

The find() method should be used only if you need to know the position of sub. To check if sub is a substring or not, use the in operator:

'Py' in 'Python'
True
def match_string(words):
  matches = []
  seen = {}
  for i in range(len(words)):
    substring = words[i]
    # skip if we've already considered this substring
    if seen.get(substring): continue
    seen[substring] = 1 # can't test then update like in Perl
    for j in range(len(words)):
      # we're not matching substrings against themselves
      if i == j: continue
      string = words[j]
      # skip $string if $substring doesn't match
      if not substring in string: continue
      # save the matched substring
      matches.append(substring)
      # it matches at least one, we don't have to check the rest
      break
  return matches

View the entire Python script for this task on GitHub.

Elixir

And because we’re potentially bailing out of a loop early, in Elixir I had to implement the loops as recursive functions. I chose to use different names for the outer and inner loop functions: match_string/5 for the i loop, and match_substring/6 for the j loop.

The bailing out of the j loop happens in lines 18-20.

# we've looped over all the words using j
def match_substring(_, _, j, len, matches, seen)
when j == len, do: {matches, seen}

# we're not matching substrings against themselves
def match_substring(words, i, j, len, matches, seen)
when i == j do
  match_substring(words, i, j+1, len, matches, seen)
end

def match_substring(words, i, j, len, matches, seen) do
  substring = Enum.at(words, i)
  string    = Enum.at(words, j)
  if String.contains?(string, substring) do
    matches = matches ++ [substring]
    # it matches at least one, we don't have to check the rest
    {matches, seen}
  else
    match_substring(words, i, j+1, len, matches, seen)
  end
end

# we've looped over all the words using i
def match_string(_, i, len, matches, _)
when i==len, do: matches

def match_string(words, i, len, matches, seen) do
  substring = Enum.at(words, i)
  {matches, seen} = if Map.get(seen, substring) do
    # skip if we've already considered this substring
    match_substring(
      words, i+1, 0, len, matches, seen
    )
  else
    # add substring to seen for future iterations
    match_substring(
      words, i, 0, len, matches, Map.put(seen, substring, 1)
    )
  end
  match_string(words, i+1, len, matches, seen)
end

def match_string(words) do
  match_string(words, 0, length(words), [], %{})
end

View the entire Elixir script for this task on GitHub.

Task 2: Binary Prefix

You are given an array, @nums, where each element is either 0 or 1.

Define xi as the number formed by taking the first i+1 bits of @nums (from $nums[0] to $nums[i]) and interpreting them as a binary number, with $nums[0] being the most significant bit.

For example:

If @nums = (1, 0, 1), then:

x0 = 1 (binary 1)
x1 = 2 (binary 10)
x2 = 5 (binary 101)

For each i, check whether xi is divisible by 5.

Write a script to return an array @answer where $answer[i] is true if x<sub>i</sub> is divisible by 5, otherwise false.

Example 1

Input: @nums = (0,1,1,0,0,1,0,1,1,1)
Output: (true, false, false, false, false, true, true, false, false, false)

Binary numbers formed (decimal values):
         0: 0
        01: 1
       011: 3
      0110: 6
     01100: 12
    011001: 25
   0110010: 50
  01100101: 101
 011001011: 203
0110010111: 407

Example 2

Input: @num = (1,0,1,0,1,0)
Output: (false, false, true, true, false, false)

     1: 1
    10: 2
   101: 5
  1010: 10
 10101: 21
101010: 42

Example 3

Input: @num = (0,0,1,0,1)
Output: (true, true, false, false, true)

    0: 0
   00: 0
  001: 1
 0010: 2
00101: 5

Example 4

Input: @num = (1,1,1,1,1)
Output: (false, false, false, true, false)

    1: 1
   11: 3
  111: 7
 1111: 15
11111: 31

Example 5

Input: @num = (1,0,1,1,0,1,0,0,1,1)
Output: (false, false, true, false, false, true, true, true, false, false)

         1: 1
        10: 2
       101: 5
      1011: 11
     10110: 22
    101101: 45
   1011010: 90
  10110100: 180
 101101001: 361
1011010011: 723

Approach

Usually, the second task is harder than the first one, but I had an insight that made me realize it could be way easier: when we add another bit from @nums, the new number is just twice the old number plus the value of the bit. So I start off with an empty string ($bits) to represent the binary number, a numeric variable initialized to 0 ($num) to represent the decimal value, and then loop through @nums and do ($num * 2) + $bit and then append $bit to $bits, calculate whether $num is divisible by 5, and then push that onto a result array.

Raku

To be honest, the Raku documentation didn’t make it easy to find the * formatting for sprintf; I had to resort to reading Perl’s sprintf documentation to find it (I knew there was a way to specify the width dynamically, I just couldn’t remember what character it was). Though, once I knew what I was looking for, I finally found it.

sub binaryPrefix(@nums) {
  my $bitwidth = @nums.elems;
  my $bits     = q{};
  my $num      = 0;
  my $explain  = q{};
  my @output;
  for @nums -> $bit {
    $num      = ($num * 2) + $bit;
    $bits    ~= $bit;
    $explain ~= sprintf("\n%*s: %d", $bitwidth, $bits, $num);
    @output.push($num % 5 == 0 ?? 'true' !! 'false');
  }
  return $explain, @output.join(", ");
}

View the entire Raku script for this task on GitHub.

$ raku/ch-2.raku
Example 1:
Input: @nums = (0, 1, 1, 0, 0, 1, 0, 1, 1, 1)
Output: (true, false, false, false, false, true, true, false, false,
false)

Binary numbers formed (decimal values):
         0: 0
        01: 1
       011: 3
      0110: 6
     01100: 12
    011001: 25
   0110010: 50
  01100101: 101
 011001011: 203
0110010111: 407

Example 2:
Input: @nums = (1, 0, 1, 0, 1, 0)
Output: (false, false, true, true, false, false)

Binary numbers formed (decimal values):
     1: 1
    10: 2
   101: 5
  1010: 10
 10101: 21
101010: 42

Example 3:
Input: @nums = (0, 0, 1, 0, 1)
Output: (true, true, false, false, true)

Binary numbers formed (decimal values):
    0: 0
   00: 0
  001: 1
 0010: 2
00101: 5

Example 4:
Input: @nums = (1, 1, 1, 1, 1)
Output: (false, false, false, true, false)

Binary numbers formed (decimal values):
    1: 1
   11: 3
  111: 7
 1111: 15
11111: 31

Example 5:
Input: @nums = (1, 0, 1, 1, 0, 1, 0, 0, 1, 1)
Output: (false, false, true, false, false, true, true, true, false,
false)

Binary numbers formed (decimal values):
         1: 1
        10: 2
       101: 5
      1011: 11
     10110: 22
    101101: 45
   1011010: 90
  10110100: 180
 101101001: 361
1011010011: 723

Perl

Even though I wrote this in Raku first, it was really already in Perl.

sub binaryPrefix(@nums) {
  my $bitwidth = @nums;
  my $bits     = q{};
  my $num      = 0;
  my $explain  = q{};
  my @output;
  foreach my $bit ( @nums ) {
    $num      = ($num * 2) + $bit;
    $bits    .= $bit;
    $explain .= sprintf("\n%*s: %d", $bitwidth, $bits, $num);
    push @output, ($num % 5 == 0 ? 'true' : 'false');
  }
  return $explain, join(", ", @output);
}

View the entire Perl script for this task on GitHub.

Python

Getting the dynamic width for the “Binary numbers formed” output was the big challenge here. As far as I can tell, there isn’t a way to pass it in as a parameter. So instead, I built a format string before my loop where the width of the bits is “hard coded” into the format string.

def binary_prefix(nums):
  fmt      = '\n{:>'+str(len(nums))+'}: {}'
  bits     = ''
  num      = 0
  explain  = ''
  output   = []
  for bit in nums:
    num      = (num * 2) + bit
    bits    += str(bit)
    explain += fmt.format(bits, num)
    output.append('true' if num % 5 == 0 else 'false')
  return explain, ", ".join(output)

View the entire Python script for this task on GitHub.

Elixir

Elixir, on the other hand, made right-justifying the bits easy: String.pad_leading/3. There’s only one recursive function, and I don’t need to bail from it early.

def binary_prefix([], _, _,_, explain, output),
do: {explain, Enum.join(output, ", ")}

def binary_prefix([bit | nums], bitwidth, bits, num,
                  explain, output)
do
  num     = (num * 2) + bit
  bits    = bits <> to_string(bit)
  padded  = String.pad_leading(bits, bitwidth)
  explain = explain <> "\n#{padded}: #{num}"
  value   = if rem(num,5) == 0, do: "true", else: "false"
  output  = output ++ [ value ]
  binary_prefix(nums, bitwidth, bits, num, explain, output)
end

def binary_prefix(nums) do
  binary_prefix(nums, length(nums), "", 0, "", [])
end

View the entire Elixir script for this task on GitHub.

Here’s all my solutions in GItHub: https://github.com/packy/perlweeklychallenge-club/tree/master/challenge-352/packy-anderson

Leave a Reply