Tonight’s musical accompaniment was Billy Joel: The 100th – Live at Madison Square Garden. Without being interrupted in the middle of Piano Man.

So, let’s hope we don’t break away to out local affiliate before the end of this week’s Perl Weekly Challenge!

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

Approach

Ok, we’re counting how many times individual integers appear in an array. That sounds like a hash to me. Make a pass through the array, counting the occurrences of each integer, and when we’re done we divide by the number of elements in the array to get percentages. We could then use something like min to find the smallest.

BUT… we know before we loop through the array how many times an integer will have to appear to meet the threshold. We’re not looking for the integer that occurred the most times, only for the smallest one that occurred at least 1/3 of the time. So we pre-calculate the 1/3 value, and as we’re counting, if the count for an integer is greater than the 1/3 value and smaller than the last integer whose count was greater than the 1/3 value, we save it as the output value.

Raku

sub oneThirdAppearance(@ints) {
  my Int $smallest;
  my Rat $oneThird = @ints.elems / 3;
  my Int %seen;
  for @ints -> $i {
    if (++%seen{$i} >= $oneThird) {
      if (! $smallest.defined || $i < $smallest) {
        $smallest = $i;
      }
    }
  }
  return $smallest;
}

$ raku/ch-1.raku
Example 1:
Input: @ints = (1, 2, 3, 3, 3, 3, 4, 2)
Output: 3

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

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

View the entire Raku script for this task on GitHub.

Perl

Because an array evaluated in a scalar context returns the size of the array, all we need to determine the oneThird threshold is to fivide the array by 3:

sub oneThirdAppearance(@ints) {
  my $smallest;
  my $oneThird = @ints / 3;
  my %seen;
  foreach my $i ( @ints ) {
    if (++$seen{$i} >= $oneThird) {
      if (! defined($smallest) || $i < $smallest) {
        $smallest = $i;
      }
    }
  }
  return $smallest;
}

View the entire Perl script for this task on GitHub.

Python

As always, when I’m counting things in Python, I use the Counter type in the collections module.

from collections import Counter

def oneThirdAppearance(ints):
  smallest = None
  oneThird = len(ints) / 3
  seen = Counter()
  for i in ints:
    seen[i] += 1
    if seen[i] >= oneThird:
      if smallest is None or i < smallest:
        smallest = i
  return smallest

View the entire Python script for this task on GitHub.

Task 2: Completing Word

You are given a string, $str, containing alphanumeric characters and an 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'.

Approach

I’m sure there’s a clever way to accomplish this, but I’m just going to plow through a straightforward way. Counting the letters again seems like a job for a hash, and we’re going to have to generate this hash not only for $str but for each string in @str, so it seems useful to make a function for generating the hash. Then we compare the hash generated by $str against the hashes for each of the strings in @str: if there’s any letters missing, or if a letter in the string doesn’t occur at least as many times it does in the target, the string is disqualified. Finally, we only keep the shortest string that met the criteria.

Raku

Last week, reading laurent_r’s solutions for PWC 264’s task 1, I saw a couple of things what I wanted to take note of: rather than using .split('', :skip-empty) to split a string into a list of characters, he used .comb. Also, he used grep with a lower case character class to filter out just the lower case characters in the input. If we pass $str.lc.comb into the grep, we’ll just get back just the letters, regardless of case.

sub letterCounts($str) {
  my %counts;
  map { %counts{$_}++ }, (grep { / <lower> / }, $str.lc.comb);
  return %counts;
}

sub completingWord($str, @str) {
  my %target = letterCounts($str);
  my $shortest;
  CANDIDATE: for @str -> $s {
    my %candidate = letterCounts($s);
    for %target.kv -> $c, $i {
      next CANDIDATE # skip this candidate
        unless %candidate{$c}:exists # this letter exists
            && %candidate{$c} >= $i; # at least as many times
    }
    if (! $shortest.defined || $s.chars < $shortest.chars) {
      $shortest = $s;
    }
  }
  return $shortest // q{};
}

$ raku/ch-2.raku
Example 1:
Input: $str = 'aBc 11c'
       @str = ('accbbb', 'abc', 'abbc')
Output: 'accbbb'

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

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

View the entire Raku script for this task on GitHub.

Perl

My first instinct was to use each %target in Perl the same way I used %target.kv, but when I tried, I discovered that I’d forgotten a big caveat of each:

The iterator used by each is attached to the hash or array, and is shared between all iteration operations applied to the same hash or array. Thus all uses of each on a single hash or array advance the same iterator location. All uses of each are also subject to having the iterator reset by any use of keys or values on the same hash or array, or by the hash (but not array) being referenced in list context. This makes each-based loops quite fragile: it is easy to arrive at such a loop with the iterator already part way through the object, or to accidentally clobber the iterator state during execution of the loop body. It’s easy enough to explicitly reset the iterator before starting a loop, but there is no way to insulate the iterator state used by a loop from the iterator state used by anything else that might execute during the loop body. To avoid these problems, use a foreach loop rather than while–each.

When I had while ( my($c, $i) = each %target ), it would only loop through %target once, and for subsequent candidates it would skip the loop entirely.

sub letterCounts($str) {
  my %counts;
  map { $counts{$_}++ } grep { /[a-z]/ } split //, lc($str);
  return %counts;
}

sub completingWord($str, @str) {
  my %target = letterCounts($str);
  my $shortest;
  CANDIDATE: foreach my $s ( @str ) {
    my %candidate = letterCounts($s);
    foreach my $c ( keys %target ) {
      my $i = $target{$c};
      next CANDIDATE # skip this candidate
        unless exists $candidate{$c} # this letter exists
            && $candidate{$c} >= $i; # at least as many times
    }
    if (! defined($shortest) || length($s) < length($shortest)) {
      $shortest = $s;
    }
  }
  return $shortest // q{};
}

View the entire Perl script for this task on GitHub.

Python

In Python, we can make the string all lowercase with lower() and filter for just letters by using isalpha(). Because we can’t break out to an outer loop from inside an inner loop, I’m using an isCandidate boolean flag to track whether a candidate is still valid to be considered the shortest candidate.

from collections import Counter

def letterCounts(strVal):
  counts = Counter()
  for c in strVal.lower():
    if c.isalpha():
      counts[c] += 1
  return counts

def completingWord(targetStr, candidateStrs):
  targetCounts = letterCounts(targetStr)
  shortest = None
  for s in candidateStrs:
    candidateCounts = letterCounts(s)
    isCandidate = True
    for c, i in targetCounts.items():
      #    this letter does not exist
      if ( not c in candidateCounts
           or # occurs fewer times
           candidateCounts[c] < i): 
         isCandidate = False
    if (isCandidate and 
        (shortest is None or len(s) < len(shortest))):
      shortest = s
  return shortest

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-265/packy-anderson

Packy’s Place

Packy's just 'zis guy, you know?

Perl Weekly Challenge: Completing a Third of an Appearance

Task 1: 33% Appearance

Approach

Raku

Perl

Python

Task 2: Completing Word

Approach

Raku

Perl

Python

Related