### Perl Weekly Challenge: Week 265

#### Challenge 1:

33% Appearance

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.
``````

Like last week, no one-liners this week but we can manage a two-liner thanks to Raku's extensive and compact standard library and variety of operators.

Also like last week, `.classify()` does a lot of work for us. A hash called `%count` is created. Its' keys are numbers found in `@ints` and values are the occurrences of each number.

``````@ints.classify( { \$_}, :into(my %count));
``````

Then we sort the keys of `%count` in ascending numeric order with `.keys()` and `.sort()` and, using `.grep()` find the ones whose number of occurrences is greater than 33%. In case there is more than one such number, `.first()` will give us the smallest one. The final answer is then printed with `.say()`. If no number in the input was greater than 33%, `Nil` will be printed.

``````%count.keys.sort.grep({ %count{\$_}.elems / @ints.elems > 0.33 }).first.say;
``````

(Full code on Github.)

In Perl we don't have `.classify()` so instead we use a for loop to add keys and values to `%count`. One fortunate side effect of this is that we can just store the number of times a number occurres rather than the occurrences themselves which is all we really need.

``````my %count;
for my \$i (@ints) {
\$count{\$i}++;
}
``````

And therefore we do not need the Perl equivalent of `.elems()` for the values of each key of `%count` in this line. In the event no number in the input is greater than 33%, the word `undef` is printed out.

``````say ((grep { \$count{\$_} / scalar @ints > 0.33 } sort { \$a <=> \$b} keys %count)[0] // 'undef');
``````

(Full code on Github.)

#### Challenge 2:

Completing Word

You are given a string, `\$str` containing alphnumeric 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:

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'.
``````

The input consists of one word `\$str` and several other words `@str`. Such a naming convention is an accident waiting to happen in production code but we'll ignore that for now. The first step is to convert `\$str` into an array of letters. The spec says we can ignore digits, white space and the case of letters. So first we use `.lc()` to convert all the letters in the string to lower case. (We could have also used `.uc()` to convert them all to upper case; doesn't matter.) Then after splitting the string into a list of individual characters with `.comb()`, we extract only the letters with `.grep()`.

``````my @letters = \$str.lc.comb.grep({ \$_ ~~ <a> .. <z> });
``````

What the spec calls completing words are ons for which `@letters` is a subset. Luckily, Raku has excellent support for set operations. We can search for subsets in `@str` using `.grep()` but first we must convert `@letters` and the letters in each element of `@str` (split with `.comb()`) into Rakus' `Set` type. Actually not just the occurence of a character but the frequency with which it appears is important and `Set` doesn't store frequency. But the related `Bag` type does. Once we have two `Bag`s the `⊆` operator will return true if the former is a subset or equal to the latter. We `.sort()` the completed words we have found in order of length, shortest first, using `.chars()` and print the `.first()` (i.e. shortest) value with `.say()`.

``````@str.grep({ @letters.Bag ⊆ \$_.comb.Bag }).sort({ \$^a.chars <=> \$^b.chars }).first.say;
``````

(Full code on Github.)

Perl is lacking `Bag`s and set operators so we have to provide our own.

The first function I wrote is called `makeBag()`. It takes an array by reference and converts it into a hash whose keys are the number of unique elements in the array and whose values are the number of times that element occurred.

``````sub makeBag {
my (\$array) = @_;
my %bag;
for my \$c (@{\$array}) {
\$bag{\$c}++;
}

return %bag;
}
``````

`isSubset()` replaces the ⊆ operator. It takes two hashes of a type returned by `makeBag()` by reference and compares them. If all the keys in the first hash also occur in the second hash and all the values of those keys in the first hash are less than or equal to the corresponding values in the second, 1 is returned. If either condition is not met, `undef` is returned. Perl will treat these as true or false respectively.

``````sub isSubset {
my (\$a, \$b) = @_;

for my \$k (keys %{\$a}) {
unless (exists \$b->{\$k}) {
return undef;
}
if (\$a->{\$k} > \$b->{\$k}) {
return undef;
}
}

return 1;
}
``````

Now we can follow the same algorithm as the Raku version.

``````my (\$str, @str) = @ARGV;

my %letters = makeBag([grep { \$_ =~ /[a-z]/ } split //, lc \$str]);
``````

One modification we do have to make is to store the completed words we have found in an intermediate array as the kind of method chaining used in the Raku version proved to be rather unwieldy in Perl.

``````my @completed;

foreach my \$word (@str) {
my %wordBag = makeBag([split //, \$word]);
if (isSubset(\%letters, \%wordBag)) {
push @completed, \$word;
}
}

say ((sort { length \$a <=> length \$b } @completed)[0]);
``````

(Full code on Github.)