Perl Weekly Challenge: Week 352

Challenge 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")

First we create an array to hold any valid substrings we may have found.

my @substrings;

Then we go through @words in a double loop comparing each word against the others. Possibly a more elegant way to do this would be with .combinations(2) or sets or something but this is simple and it works.

for 0 .. @words.end -> $i {
    for 0 .. @words.end -> $j {

We have to take care we are not comparing the word against itself and then test to see if it is a substring of the word we are matching with. I could have used regular expressions to do the test but I chose .index() because...I don't know why exactly, I just did. One little problem I ran into is if there is no match, Raku returns Nil from this function which I wasn't expecting as a Perl user.

        if $i != $j && @words[$j].index(@words[$i]) !~~ Nil {

If there was a match, the word is added to @substrings. There may be more matches but we don't care for this problem so we just break out of the loop and continue to the next word.

            @substrings.push(@words[$i]);
            last;
        }
    }
}

Finally, we print @substrings. There may be duplicates (As in example 1 for instance) so we run it through .unique() first to filter those out. The rest of the code on this line is merely to show the output in the same style as in the spec.

say q{(}, @substrings.unique.map({ "\"$_\"" }).join(q{, }), q{)};

(Full code on Github.)

For Perl, we have to provide our own unique() function. I had one but it had the unexpected flaw that it does not maintain the order of the array it is filtering and the spec says we should keep that.

my @substrings;

for my $i (0 .. scalar @words - 1) {
    for my $j (0 .. scalar @words - 1) {

(Sidenote: In Perl, index() returns -1 on no match as God and BSD intended.)

        if ($i != $j && index($words[$j], $words[$i]) != -1) {

So instead of using unique() I just make sure the word is not already in @substrings before adding it.

            unless (grep { $_ eq $words[$i] } @substrings) {
                push @substrings, $words[$i];
                last;
            }
        }
    }
}

say q{(}, (join q{, }, map { "\"$_\"" } @substrings), q{)};

(Full code on Github.)

Challenge 2:

Binary Prefix

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

Define x(i) 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:

x(0) = 1 (binary 1)
x(1) = 2 (binary 10)
x<(2) = 5 (binary 101)

For each i, check whether x(i) is divisible by 5.

Write a script to return an array @answer where $answer[i] is true if x(i) 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

Again we need to define a place to hold our results.

my @results;

We will also need to store the binary number buit up from @nums.

my $str = "";

As we go through each element of @nums...

for @nums -> $num {

...we append it to $str.

    $str ~= $num;

Then $str is parsed as a binary number and checked to see if it is evenly divisible by 5 with the %% operator. The result, whether true or false, is added to @results.

    @results.push($str.parse-base(2) %% 5);
}

Finally, @results is output.

say q{(}, @results.join(q{, }), q{)};

(Full code on Github.)

The Perl version is mostly the same with only a couple of quirks.

my @results;

Binary numeric literals in Perl start with 0b (or now just b which was a recent change I think.)

my $str = "0b";

for my $num (@nums) {
    $str .= $num;

To parse a binary number back to decimal we have to use the unintuitively named oct() function. And in the absence of %% we use modulus and a comparison to 0 instead.

    push @results, oct($str) % 5 == 0;
}

say q{(}, (join q{, }, map { $_ ? 'true' : 'false' } @results), q{)};

(Full code on Github.)