# Perl Weekly Challenge 216.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 216.

``````Submitted by: Mohammad S Anwar
You are given a list of words and a random registration number.

Write a script to find all the words in the given list that has
every letter in the given registration number.

Example 1
Input: @words = ('abc', 'abcd', 'bcd'), \$reg = 'AB1 2CD'
Output: ('abcd')

The only word that matches every alphabets in the given registration
number is 'abcd'.
Example 2
Input: @words = ('job', 'james', 'bjorg'), \$reg = '007 JB'
Output: ('job', 'bjorg')
Example 3
Input: @words = ('crack', 'road', 'rac'), \$reg = 'C7 RA2'
Output: ('crack', 'rac')
``````

To solve this problem I first extract the letters from the registration. Then I build a hash for each word to test if it contains any given letter. Finally, I check that all the letters in the registration are contained in the word, and use that within a `grep`. The code fits a noe-and-a-half-liner:

Example 1:

``````perl -MList::Util=all -E '@r=grep {/[a-z]/} split "", lc shift; @a=grep {
my %l; map {\$l{\$_}=1} split "", lc \$_; all{\$l{\$_}}@r} @ARGV; say "@a";
' 'AB1 2CD' abc abcd bcd
``````

Results:

``````abcd
``````

Example 2:

``````perl -MList::Util=all -E '@r=grep {/[a-z]/} split "", lc shift; @a=grep {
my %l; map {\$l{\$_}=1} split "", lc \$_; all{\$l{\$_}}@r} @ARGV; say "@a";
' '007 JB' job  james bjorg
``````

Results:

``````job bjorg
``````

Example 3:

``````perl -MList::Util=all -E '@r=grep {/[a-z]/} split "", lc shift; @a=grep {
my %l; map {\$l{\$_}=1} split "", lc \$_; all{\$l{\$_}}@r} @ARGV; say "@a";
' 'C7 RA2' crack road rac
``````

Results:

``````crack rac
``````

The full code is similar.

`````` 1  # Perl weekly challenge 216
2  # Task 1:  Registration Number
3  #
5  use v5.36;
6  use List::Util qw(all);
7  die <<~"FIN" unless @ARGV;
8      Usage: \$0 R W1 [W2...]
9      to select the words Wn that contain all the letters in the
10      registration number R.
11      FIN
12  my \$reg=shift;
13  my @words=@ARGV;
14  my @letters_reg=grep {/[a-z]/} split "", lc \$reg;
15  my @result=grep
16  {
17      my %letters;
18      map {\$letters{\$_}=1} split "", lc \$_;
19      all {\$letters{\$_}} @letters_reg
20  } @words;
21  say "Registration number: \$reg, words: @words, output: @result";
``````

Example:

``````./ch-1.pl 'AB1 2CD' abc abcd bcd
./ch-1.pl '007 JB' job  james bjorg
./ch-1.pl 'C7 RA2' crack road rac
``````

Results:

``````Registration number: AB1 2CD, words: abc abcd bcd, output: abcd
Registration number: 007 JB, words: job james bjorg, output: job bjorg
Registration number: C7 RA2, words: crack road rac, output: crack rac
``````

#+endsrc

``````Submitted by: Mohammad S Anwar
You are given a list of word stickers and a target word.

Write a script to find out how many word stickers is needed to make up
the given target word.

Example 1:
Input: @stickers = ('perl','raku','python'), \$word = 'peon'
Output: 2

We just need 2 stickers i.e. 'perl' and 'python'.
'pe' from 'perl' and
'on' from 'python' to get the target word.
Example 2:
Input: @stickers = ('love','hate','angry'), \$word = 'goat'
Output: 3

We need 3 stickers i.e. 'angry', 'love' and 'hate'.
'g' from 'angry'
'o' from 'love' and
'at' from 'hate' to get the target word.
Example 3:
Input: @stickers = ('come','nation','delta'), \$word = 'accommodation'
Output: 4

We just need 2 stickers of 'come' and one each of 'nation' & 'delta'.
'a' from 'delta'
'ccommo' from 2 stickers 'come'
'd' from the same sticker 'delta' and
'ation' from 'nation' to get the target word.
Example 4:
Input: @stickers = ('come','country','delta'), \$word = 'accommodation'
Output: 0

as there's no "i" in the inputs.
``````

To solve this task, I first map each letter to the stickers which may provide them. Then I call a recursive subroutine to find all possible solutions and choose the best. This subroutine has as inputs the currently available letters (none at the beginning), from stickers that have been already used, and the letters we still have to find from the given word. I provide as many letters as possible from the available letters. If they are insufficient, I choose in turn each of the stickers that provide a missing letter and recurse. The result is the number of stickers that are used or `undef` if there is no solution. From all the possible choices, I choose the best. The code fits an incomprehensible three liner and a better written full code below.

Example 1:

``````perl -MList::Util=min -E '
(\$w,@s)=@ARGV; for \$s(@s){push @{\$s{\$_}}, \$s for split "", lc \$s}; say 0+r({},[split "", lc \$w]);
sub r(\$a,\$l){@l=@\$l;%a=%\$a;my @r=grep{\$c=\$a{\$_};\$c&&\$a{\$_}--;!\$c}@l;@r||return 0;my @p;for(@{\$s{\$r[0]}})
{ %g=%a;\$g{\$_}++ for split "", lc \$_;push @p, r(\%g,\@r)}\$m=min grep{defined} @p;return 1+\$m if defined \$m;undef}
' peon perl raku python
``````

Results:

``````2
``````

Example 2:

``````perl -MList::Util=min -E '
(\$w,@s)=@ARGV; for \$s(@s){push @{\$s{\$_}}, \$s for split "", lc \$s}; say 0+r({},[split "", lc \$w]);
sub r(\$a,\$l){@l=@\$l;%a=%\$a;my @r=grep{\$c=\$a{\$_};\$c&&\$a{\$_}--;!\$c}@l;@r||return 0;my @p;for(@{\$s{\$r[0]}})
{ %g=%a;\$g{\$_}++ for split "", lc \$_;push @p, r(\%g,\@r)}\$m=min grep{defined} @p;return 1+\$m if defined \$m;undef}
' goat love hate angry
``````

Results:

``````3
``````

Example 3:

``````perl -MList::Util=min -E '
(\$w,@s)=@ARGV; for \$s(@s){push @{\$s{\$_}}, \$s for split "", lc \$s}; say 0+r({},[split "", lc \$w]);
sub r(\$a,\$l){@l=@\$l;%a=%\$a;my @r=grep{\$c=\$a{\$_};\$c&&\$a{\$_}--;!\$c}@l;@r||return 0;my @p;for(@{\$s{\$r[0]}})
{ %g=%a;\$g{\$_}++ for split "", lc \$_;push @p, r(\%g,\@r)}\$m=min grep{defined} @p;return 1+\$m if defined \$m;undef}
' accommodation come nation delta
``````

Results:

``````4
``````

Example 4:

``````perl -MList::Util=min -E '
(\$w,@s)=@ARGV; for \$s(@s){push @{\$s{\$_}}, \$s for split "", lc \$s}; say 0+r({},[split "", lc \$w]);
sub r(\$a,\$l){@l=@\$l;%a=%\$a;my @r=grep{\$c=\$a{\$_};\$c&&\$a{\$_}--;!\$c}@l;@r||return 0;my @p;for(@{\$s{\$r[0]}})
{ %g=%a;\$g{\$_}++ for split "", lc \$_;push @p, r(\%g,\@r)}\$m=min grep{defined} @p;return 1+\$m if defined \$m;undef}
' accommodation come country delta
``````

Results:

``````0
``````

Below is the commented full code:

`````` 1  # Perl weekly challenge 216
2  # Task 2:  Word Stickers
3  #
5  use v5.36;
6  use List::Util qw(min);
7  die <<~"FIN" unless @ARGV;
8      Usage: \$0 W S1 [S2...]
9      to find how many stickers S1 S2... are required to make the word W
10      FIN
11  my (\$word, @stickers)=@ARGV;
12  # Map letters to stickers
13  my %stickers_with_letter;
14  for my \$s(@stickers){
15      push @{\$stickers_with_letter{\$_}}, \$s for split "", lc \$s;
16  }
17  # At first there are no available letters and I have to provide all letters in word
18  my \$result=0+solve({}, [split "", lc \$word]);
19  # Print result
20  say "Word: \$word, stickers: @stickers, result: \$result";
21
22  sub solve(\$available, \$letters){
23      my @letters=@\$letters;
24      my %available=%\$available;
25      # Use as many available letters as possible to provide required letters
26      my @remaining=grep {my \$a=\$available{\$_}; \$available{\$_}-- if \$a; !\$a} @letters;
27      # Done?
28      return 0 unless @remaining;
29      my \$first=\$remaining[0];
30      my @possible_results;
31      # Iterate over all possible stickers that provide the first remaining letter
32      for(@{\$stickers_with_letter{\$first}}){
33          # Add sticker's letters to available set
34  	my %augmented=%available;
35  	\$augmented{\$_}++ for split "", lc \$_;
36          # solve recursively for the remaining letters
37  	push @possible_results, solve(\%augmented, \@remaining);
38      }
39      # Choose best solution
40      my \$best=min  grep {defined} @possible_results;
41      # Add the sticker used and return, if there is solution
42      return 1+\$best if defined \$min;
43      return undef;
44  }
45
``````

Examples:

``````./ch-2.pl peon perl raku python
./ch-2.pl goat love hate angry
./ch-2.pl accommodation come nation delta
./ch-2.pl accommodation come country delta
``````

Results:

``````Word: peon, stickers: perl raku python, result: 2
Word: goat, stickers: love hate angry, result: 3
Word: accommodation, stickers: come nation delta, result: 4
Word: accommodation, stickers: come country delta, result: 0
``````
Written on May 8, 2023