19 April 2024

Challenge 265

For Almost a Third Complete

• Task 1: 33% Appearance
• Task 2: Completing Word

Task 1: 33% Appearance

Submitted by: Mohammad Sajid Anwar

---

You are given an array of integers, @ints.

Write a script to find an integer in the given array that appeared 33% or more. If more than one found, return the smallest. If none found then return undef.

Example 1

Input: @ints = (1,2,3,3,3,3,4,2)
Output: 3

1 appeared 1 times.
2 appeared 2 times.
3 appeared 4 times.

3 appeared 50% (>33%) in the given array.

Example 2

Input: @ints = (1,1)
Output: 1

1 appeared 2 times.

1 appeared 100% (>33%) in the given array.

Example 3

Input: @ints = (1,2,3)
Output: 1

1 appeared 1 times.
2 appeared 1 times.
3 appeared 1 times.

Since all three appeared 33.3% (>33%) in the given array.
We pick the smallest of all.

---

Solution

This task can be solved in a single pass over the given numbers. As we know the size of the array, we also know the threshold for a 33 % appearance. So we just need to count each number and take the running minimum over the values having a count above the threshold.

use strict;
use warnings;
use List::Util 'reduce';

sub appearance33 {
    my %count;
    reduce {
        ++$count{$b} * 100 / @_ >= 33 && $b < ($a // 'inf') ? $b : $a;
    } undef, @_;
}

See the full solution.

Task 2: Completing Word

Submitted by: Mohammad Sajid Anwar — You are given a string, $str containing alphanumeric characters and array of strings (alphabetic characters only), @str.

Write a script to find the shortest completing word. If none found return empty string.

A completing word is a word that contains all the letters in the given string, ignoring space and number. If a letter appeared more than once in the given string then it must appear the same number or more in the word.

Example 1

Input: $str = 'aBc 11c'
       @str = ('accbbb', 'abc', 'abbc')
Output: 'accbbb'

The given string contains following, ignoring case and number:
a 1 times
b 1 times
c 2 times

The only string in the given array that satisfies the condition is 'accbbb'.

Example 2

Input: $str = 'Da2 abc'
       @str = ('abcm', 'baacd', 'abaadc')
Output: 'baacd'

The given string contains following, ignoring case and number:
a 2 times
b 1 times
c 1 times
d 1 times

The are 2 strings in the given array that satisfies the condition:
'baacd' and 'abaadc'.

Shortest of the two is 'baacd'

Example 3

Input: $str = 'JB 007'
       @str = ('jj', 'bb', 'bjb')
Output: 'bjb'

The given string contains following, ignoring case and number:
j 1 times
b 1 times

The only string in the given array that satisfies the condition is 'bjb'.

---

Solution

The task description and the corresponding examples are confusing me. There is “ignoring space and number” in the description and “ignoring case and number” in the examples. Finally, both are ignored in $str, whereas the strings in @str are all lower case. Is this a requirement? I’m not going to presume it.

Trying to build a regular expression from $str that matches every completing word. Taking all permutations of the letters within $str would be very inefficient as a matcher. But we can look for every required letter in its multitude individually using positive lookahead assertions. As these are zero-length, their order does not matter.

A string containing three qs can be matched with the regex

/(?=.*q.*q.*q)/

If the string shall contain two xs at the same time, in any order and possibly interleaved, we can match against

/(?=.*q.*q.*q)(?=.*x.*x)/

Thus we

• count every lower cased letter in $str
• create a positive look-ahead assertion for the found count of the lower cased letter
• concatenate all these assertions
• match the the given lower cased strings against the concatenated assertions and an “alpha” class match.
• take the string having the minimum length thereof. As there is no specification about the handling of same-length strings, we take whatever min_by returns.

use strict;
use warnings;
use List::AllUtils qw(pairmap min_by count_by);
use experimental 'signatures';

sub completing_word ($str, @str) {
    my $target = qr{
        ^
        @{[
            pairmap { '(?=' . ".*?$a" x $b . ')'}
            count_by {$_}
            lc($str) =~ /([[:alpha:]])/g
        ]}
        [[:alpha:]]*
        $
    }x;

    min_by {length} grep {lc =~ /$target/} @str;
}

See the full solution.