The weekly challenge 265 - Task 2: Completing Word

  1 #!/usr/bin/env perl
  2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-265/#TASK2
  3 #
  4 # Task 2: Completing Word
  5 # =======================
  6 #
  7 # You are given a string, $str containing alphnumeric characters and array of
  8 # strings (alphabetic characters only), @str.
  9 #
 10 # Write a script to find the shortest completing word. If none found return
 11 # empty string.
 12 #
 13 ## A completing word is a word that contains all the letters in the given
 14 ## string, ignoring space and number. If a letter appeared more than once in
 15 ## the given string then it must appear the same number or more in the word.
 16 #
 17 ## Example 1
 18 ##
 19 ## Input: $str = 'aBc 11c'
 20 ##        @str = ('accbbb', 'abc', 'abbc')
 21 ## Output: 'accbbb'
 22 ##
 23 ## The given string contains following, ignoring case and number:
 24 ## a 1 times
 25 ## b 1 times
 26 ## c 2 times
 27 ##
 28 ## The only string in the given array that satisfies the condition is 'accbbb'.
 29 #
 30 ## Example 2
 31 ##
 32 ## Input: $str = 'Da2 abc'
 33 ##        @str = ('abcm', 'baacd', 'abaadc')
 34 ## Output: 'baacd'
 35 ##
 36 ## The given string contains following, ignoring case and number:
 37 ## a 2 times
 38 ## b 1 times
 39 ## c 1 times
 40 ## d 1 times
 41 ##
 42 ## The are 2 strings in the given array that satisfies the condition:
 43 ## 'baacd' and 'abaadc'.
 44 ##
 45 ## Shortest of the two is 'baacd'
 46 #
 47 ## Example 3
 48 ##
 49 ## Input: $str = 'JB 007'
 50 ##        @str = ('jj', 'bb', 'bjb')
 51 ## Output: 'bjb'
 52 ##
 53 ## The given string contains following, ignoring case and number:
 54 ## j 1 times
 55 ## b 1 times
 56 ##
 57 ## The only string in the given array that satisfies the condition is 'bjb'.
 58 #
 59 ############################################################
 60 ##
 61 ## discussion
 62 ##
 63 ############################################################
 64 #
 65 # First, split $str into its characters, counting the occurences of each one.
 66 # Then do the same for all elements of @str
 67 # Walk through those elements ordered by length. If a word completes $str,
 68 # we can stop processing since we already found the shortest one.
 69 
 70 use strict;
 71 use warnings;
 72 
 73 completing_word('aBc 11c', ['accbbb', 'abc', 'abbc']);
 74 completing_word('Da2 abc', ['abcm', 'baacd', 'abaadc']);
 75 completing_word('JB 007', ['jj', 'bb', 'bjb']);
 76 completing_word('FooBar', ['foo', 'bar', 'baz']);
 77 
 78 sub completing_word {
 79    my $str = shift;
 80    my @str = @{$_[0]};
 81    print "Input: '$str'\n";
 82    print "       (" . join(", ", map { "'$_'" } @str) . ")\n";
 83    my $in_data;
 84    my $candidates = {};
 85    foreach my $c (split//, $str) {
 86       next unless $c =~ m/[a-zA-Z]/; # only use characters a-z in lower- and upper case
 87       $in_data->{ lc($c) }++;
 88    }
 89    foreach my $s (@str) {
 90       $candidates->{$s}->{len} = length($s);
 91       foreach my $c (split//, $s) {
 92          $candidates->{$s}->{chars}->{$c}++;
 93       }
 94    }
 95    my $found = 0;
 96    foreach my $candidate (sort { $candidates->{$a}->{len} <=> $candidates->{$b}->{len} } keys %$candidates) {
 97       my $possible = 1;
 98       foreach my $c (keys %$in_data) {
 99          $candidates->{$candidate}->{chars}->{$c} //= 0;
100          $possible = 0 if $in_data->{$c} > $candidates->{$candidate}->{chars}->{$c};
101       }
102       if($possible) {
103          $found = 1;
104          print "Output: '$candidate'\n";
105          last;
106       }
107    }
108    print "Output: ''\n" unless $found;
109 }