This is my response to The Weekly Challenge #216.
Input: @words = ('abc', 'abcd', 'bcd'), $reg = 'AB1 2CD'
Output: ('abcd')
The only word that matches every alphabets in the given registration
number is 'abcd'.
Input: @words = ('job', 'james', 'bjorg'), $reg = '007 JB'
Output: ('job', 'bjorg')
Input: @words = ('crack', 'road', 'rac'), $reg = 'C7 RA2'
Output: ('crack', 'rac')
File: registration-number
#! /usr/bin/env raku
unit sub MAIN (:r(:$reg) where $reg.chars >= 3; # [1]
*@words where @words.elems > 0
&& all(@words) ~~ /^<[a..z]>+$/, # [2]
:v(:$verbose));
my @reg = $reg.comb.grep({ $_ eq any('A' .. 'Z') })>>.lc; # [3]
say ": Reg chars: { @reg.map({ "'" ~ $_ ~ "'" }).join(", ") } " if $verbose;
my @matches; # [4]
for @words -> $word # [5]
{
my @word = $word.comb; # [6]
print ": Word '$word' chars: { @word.map({ "'" ~ $_ ~ "'" }).join(", ") }"
if $verbose;
if @reg (<=) @word # [7]
{
say " -> subset" if $verbose;
@matches.push: $word; # [8]
}
elsif $verbose
{
say "";
}
}
say "(" ~ @matches.map({ "'" ~ $_ ~ "'" }) ~ ")"; # [9]
[1] A named argument for the registration number, with at least 3 characters.
[2] A slurpy array for the words, with a minimum of 1. They can only contain the letters a - z, with at least one letter in each word.
[3] Get a list of the (uppercase) letters in the registration number, coerced to lowercase. Note that any lowercase letters in the registration number will be ignored, without complaint.
[4] The matching words will end up here.
[5] Iterate over the words.
[6] Get the individual letters.
[7] Is the registration number letters a subset (or equal) to the word?
See
docs.raku.org/language/operators infix (<=)
for more information about the subset or equal to operator (<=).
[8] If so, add the word to the result.
[9] Print the result, exactly as specified in the challenge. (Pedantically exact, perhaps.)
Running it:
$ ./registration-number -r="AB1 2CD" abc abcd bcd
('abcd')
$ ./registration-number -r="007 JB" job james bjorg
('job' 'bjorg')
$ ./registration-number -r="C7 RA2" crack road rac
('crack' 'rac')
Looking good.
With verbose mode:
$ ./registration-number -v -r="AB1 2CD" abc abcd bcd
: Reg chars: 'a', 'b', 'c', 'd'
: Word 'abc' chars: 'a', 'b', 'c'
: Word 'abcd' chars: 'a', 'b', 'c', 'd' -> subset
: Word 'bcd' chars: 'b', 'c', 'd'
('abcd')
$ ./registration-number -v -r="007 JB" job james bjorg
: Reg chars: 'j', 'b'
: Word 'job' chars: 'j', 'o', 'b' -> subset
: Word 'james' chars: 'j', 'a', 'm', 'e', 's'
: Word 'bjorg' chars: 'b', 'j', 'o', 'r', 'g' -> subset
('job' 'bjorg')
$ ./registration-number -v -r="C7 RA2" crack road rac
: Reg chars: 'c', 'r', 'a'
: Word 'crack' chars: 'c', 'r', 'a', 'c', 'k' -> subset
: Word 'road' chars: 'r', 'o', 'a', 'd'
: Word 'rac' chars: 'r', 'a', 'c' -> subset
('crack' 'rac')
What about repetitions?
Let us check (with two As):
$ ./registration-number -v -r="AA1 2CD" abc abcd bcd
: Reg chars: 'a', 'a', 'c', 'd'
: Word 'abc' chars: 'a', 'b', 'c'
: Word 'abcd' chars: 'a', 'b', 'c', 'd' -> subset
: Word 'bcd' chars: 'b', 'c', 'd'
('abcd')
Not so good...
One can argue that the challenge is ambigous on this point («every letter in the given registration number»), so that the program can be considered giving the correct result.
On the other hand, exactly the same problem occurs in the second part of this challenge, and there we will not get away with this creative interpretation. So let us fix it here and now...
File: registration-number-bag
#! /usr/bin/env raku
unit sub MAIN (:r(:$reg) where $reg.chars >= 3;
*@words where @words.elems > 0
&& all(@words) ~~ /^<[a..z]>+$/,
:v(:$verbose));
my @reg = $reg.comb.grep({ $_ eq any('A' .. 'Z') })>>.lc;
say ": Reg chars: { @reg.map({ "'" ~ $_ ~ "'" }).join(", ") } " if $verbose;
my @matches;
for @words -> $word
{
my @word = $word.comb;
print ": Word '$word' chars: { @word.map({ "'" ~ $_ ~ "'" }).join(", ") }"
if $verbose;
if @reg.Bag (<=) @word.Bag # [1]
{
say " -> subset" if $verbose;
@matches.push: $word;
}
elsif $verbose
{
say "";
}
}
say "(" ~ @matches.map({ "'" ~ $_ ~ "'" }) ~ ")";
[1] By coercing the arrays to the Bag type, we avoid the default
coersion to a Set. The latter type has a count (or weight) for
the values, and the (<=) operator happily works with
Bags.
Running it:
$ ./registration-number-bag -v -r="AA1 2CD" abc abcd bcd
: Reg chars: 'a', 'a', 'c', 'd'
: Word 'abc' chars: 'a', 'b', 'c'
: Word 'abcd' chars: 'a', 'b', 'c', 'd'
: Word 'bcd' chars: 'b', 'c', 'd'
()
$ ./registration-number-bag -v -r="AA1 2CD" abc abcd bcd aabcd
: Reg chars: 'a', 'a', 'c', 'd'
: Word 'abc' chars: 'a', 'b', 'c'
: Word 'abcd' chars: 'a', 'b', 'c', 'd'
: Word 'bcd' chars: 'b', 'c', 'd'
: Word 'aabcd' chars: 'a', 'a', 'b', 'c', 'd' -> subset
('aabcd')
$ ./registration-number-bag -v -r="AB1 2CD" abc abcd bcd
: Reg chars: 'a', 'b', 'c', 'd'
: Word 'abc' chars: 'a', 'b', 'c'
: Word 'abcd' chars: 'a', 'b', 'c', 'd' -> subset
: Word 'bcd' chars: 'b', 'c', 'd'
('abcd')
Looking really good...
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.
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.
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.
Input: @stickers = ('come','country','delta'), $word = 'accommodation'
Output: 0
as there's no "i" in the inputs.
#! /usr/bin/env raku
unit sub MAIN (:w(:$word) where $word.chars >= 1
&& $word ~~ /^<[a..z]>+$/; # [1]
*@stickers where @stickers.elems > 0
&& all(@stickers) ~~ /^<[a..z]>+$/, # [2]
:v(:$verbose));
my @word = $word.comb; # [3]
say ": Word: { @word.sort.join(",") } " if $verbose;
for @stickers.combinations(1 .. Inf) -> @combination # [4]
{
my $stickers = @combination.elems; # [5]
my @stickers = @combination.join.comb; # [6]
say ": $stickers Sticker(s) ({ @combination.join(",") }) \
- Letters: { @stickers.sort.join(",") }" if $verbose;
if @word.Bag (<=) @stickers.Bag # [7]
{
say $stickers; # [7a]
exit; # [7b]
}
}
say 0; # [8]
[1] The word must have one or more letters a-z, and nothing else.
[2] The stickers, one or more, with the letters a-z only (one or more).
[3] Get a list of letters in the target word.
[4] Iterate over the combinations (with
combinations. The first combination is an empty list, and we
avoid that by specifying the number of combined stickers in the result
(1 and more).
See
docs.raku.org/routine/combinations
for more information about combinations.
[5] The number of combined stickers in the current combination.
[6] Add the words (in the current combination) together, split them into a list of individual characters.
[7] Note the Bag trick from the first part of the challenge. If
we have a match, we print the number of required stickers [7a] and finish [7b].
[8] No match? Then we have failed. Say so.
Running it:
$ ./word-stickers -w=peon perl raku python
2
$ ./word-stickers -w=goat love hate angry
3
$ ./word-stickers -w=accomodation come nation delta
0
$ ./word-stickers -w=accommodation come country delta
0
With verbose mode, before we have a go at the problem with the third example:
$ ./word-stickers -v -w=peon perl raku python
: Word: e,n,o,p
: 1 Sticker(s) (perl) - Letters: e,l,p,r
: 1 Sticker(s) (raku) - Letters: a,k,r,u
: 1 Sticker(s) (python) - Letters: h,n,o,p,t,y
: 2 Sticker(s) (perl,raku) - Letters: a,e,k,l,p,r,r,u
: 2 Sticker(s) (perl,python) - Letters: e,h,l,n,o,p,p,r,t,y
2
$ ./word-stickers -v -w=goat love hate angry
: Word: a,g,o,t
: 1 Sticker(s) (love) - Letters: e,l,o,v
: 1 Sticker(s) (hate) - Letters: a,e,h,t
: 1 Sticker(s) (angry) - Letters: a,g,n,r,y
: 2 Sticker(s) (love,hate) - Letters: a,e,e,h,l,o,t,v
: 2 Sticker(s) (love,angry) - Letters: a,e,g,l,n,o,r,v,y
: 2 Sticker(s) (hate,angry) - Letters: a,a,e,g,h,n,r,t,y
: 3 Sticker(s) (love,hate,angry) - Letters: a,a,e,e,g,h,l,n,o,r,t,v,y
3
$ ./word-stickers -v -w=accommodation come nation delta
: Word: a,a,c,c,d,i,m,m,n,o,o,o,t
: 1 Sticker(s) (come) - Letters: c,e,m,o
: 1 Sticker(s) (nation) - Letters: a,i,n,n,o,t
: 1 Sticker(s) (delta) - Letters: a,d,e,l,t
: 2 Sticker(s) (come,nation) - Letters: a,c,e,i,m,n,n,o,o,t
: 2 Sticker(s) (come,delta) - Letters: a,c,d,e,e,l,m,o,t
: 2 Sticker(s) (nation,delta) - Letters: a,a,d,e,i,l,n,n,o,t,t
: 3 Sticker(s) (come,nation,delta) - Letters: a,a,c,d,e,e,i,l,m,n,n,o,o,t,t
0
$ ./word-stickers -v -w=accommodation come country delta
: Word: a,a,c,c,d,i,m,m,n,o,o,o,t
: 1 Sticker(s) (come) - Letters: c,e,m,o
: 1 Sticker(s) (country) - Letters: c,n,o,r,t,u,y
: 1 Sticker(s) (delta) - Letters: a,d,e,l,t
: 2 Sticker(s) (come,country) - Letters: c,c,e,m,n,o,o,r,t,u,y
: 2 Sticker(s) (come,delta) - Letters: a,c,d,e,e,l,m,o,t
: 2 Sticker(s) (country,delta) - Letters: a,c,d,e,l,n,o,r,t,t,u,y
: 3 Sticker(s) (come,country,delta) - Letters: a,c,c,d,e,e,l,m,n,o,o,r,t,t,u,y
0
Back to the third example. The problem is that we should allow multiple copies of stickers. Right.
Ok. Let us add a number of duplicates of each sticker. The chosen number is the number of characters in the word, so that this worst case example will pan out:
$ ./word-stickers-multi -v -w=cccp captain dog quiz
: Word: c,c,c,p
: 1 Sticker(s) (captain) - Letters: a,a,c,i,n,p,t
: 1 Sticker(s) (dog) - Letters: d,g,o
: 1 Sticker(s) (quiz) - Letters: i,q,u,z
: 2 Sticker(s) (captain,dog) - Letters: a,a,c,d,g,i,n,o,p,t
: 2 Sticker(s) (captain,quiz) - Letters: a,a,c,i,i,n,p,q,t,u,z
: 2 Sticker(s) (captain,captain) - Letters: a,a,a,a,c,c,i,i,n,n,p,p,t,t
: 2 Sticker(s) (dog,quiz) - Letters: d,g,i,o,q,u,z
: 2 Sticker(s) (dog,dog) - Letters: d,d,g,g,o,o
: 2 Sticker(s) (quiz,quiz) - Letters: i,i,q,q,u,u,z,z
: 3 Sticker(s) (captain,dog,quiz) - Letters: a,a,c,d,g,i,i,n,o,p,q,t,u,z
: 3 Sticker(s) (captain,dog,captain) - Letters: a,a,a,a,c,c,d,g,i,i,n,n,o,p,p,t,t
: 3 Sticker(s) (captain,dog,dog) - Letters: a,a,c,d,d,g,g,i,n,o,o,p,t
: 3 Sticker(s) (captain,quiz,captain) - Letters: a,a,a,a,c,c,i,i,i,n,n,p,p,q,t,t,u,z
: 3 Sticker(s) (captain,quiz,quiz) - Letters: a,a,c,i,i,i,n,p,q,q,t,u,u,z,z
: 3 Sticker(s) (captain,captain,captain) - \
Letters: a,a,a,a,a,a,c,c,c,i,i,i,n,n,n,p,p,p,t,t,t
3
The program:
File: word-stickers-mult
#! /usr/bin/env raku
unit sub MAIN (:w(:$word) where $word.chars >= 1
&& $word ~~ /^<[a..z]>+$/;
*@stickers where @stickers.elems > 0
&& all(@stickers) ~~ /^<[a..z]>+$/,
:v(:$verbose));
my @word = $word.comb;
say ": Word: { @word.sort.join(",") } " if $verbose;
for (@stickers xx $word.chars).flat \ # [1]
.combinations(1 .. Inf).unique(:as(&bag)) -> @combination # [2]
{
my $stickers = @combination.elems;
my @stickers = @combination.join.comb;
say ": $stickers Sticker(s) ({ @combination.join(",") }) - \
Letters: { @stickers.sort.join(",") }" if $verbose;
if @word.Bag (<=) @stickers.Bag
{
say $stickers;
exit;
}
}
say 0;
[1] We take all the stickers and use the List Repetition Operator
xx to get as many copies of each one as the length of the word.
See
docs.raku.org/routine/xx
for more information about the list repetition operator xx.
[2] The repetions above will result in a lot of duplicates,
which we can (and absolutely should) get rid of with unique. But
we have to tell Raku how to treat the values whilst comparing them, and we do
this with the :as parameter - coercing the values to a bag.
See
docs.raku.org/routine/unique
for more information about unique.
The third example works out now:
$ ./word-stickers-multi -v -w=accommodation come nation delta
: Word: a,a,c,c,d,i,m,m,n,o,o,o,t
: 1 Sticker(s) (come) - Letters: c,e,m,o
: 1 Sticker(s) (nation) - Letters: a,i,n,n,o,t
: 1 Sticker(s) (delta) - Letters: a,d,e,l,t
: 2 Sticker(s) (come,nation) - Letters: a,c,e,i,m,n,n,o,o,t
: 2 Sticker(s) (come,delta) - Letters: a,c,d,e,e,l,m,o,t
: 2 Sticker(s) (come,come) - Letters: c,c,e,e,m,m,o,o
: 2 Sticker(s) (nation,delta) - Letters: a,a,d,e,i,l,n,n,o,t,t
: 2 Sticker(s) (nation,nation) - Letters: a,a,i,i,n,n,n,n,o,o,t,t
: 2 Sticker(s) (delta,delta) - Letters: a,a,d,d,e,e,l,l,t,t
: 3 Sticker(s) (come,nation,delta) - Letters: a,a,c,d,e,e,i,l,m,n,n,o,o,t,t
: 3 Sticker(s) (come,nation,come) - Letters: a,c,c,e,e,i,m,m,n,n,o,o,o,t
: 3 Sticker(s) (come,nation,nation) - Letters: a,a,c,e,i,i,m,n,n,n,n,o,o,o,t,t
: 3 Sticker(s) (come,delta,come) - Letters: a,c,c,d,e,e,e,l,m,m,o,o,t
: 3 Sticker(s) (come,delta,delta) - Letters: a,a,c,d,d,e,e,e,l,l,m,o,t,t
: 3 Sticker(s) (come,come,come) - Letters: c,c,c,e,e,e,m,m,m,o,o,o
: 3 Sticker(s) (nation,delta,nation) - Letters: a,a,a,d,e,i,i,l,n,n,n,n,o,o,t,t,t
: 3 Sticker(s) (nation,delta,delta) - Letters: a,a,a,d,d,e,e,i,l,l,n,n,o,t,t,t
: 3 Sticker(s) (nation,nation,nation) - Letters: a,a,a,i,i,i,n,n,n,n,n,n,o,o,o,t,t,t
: 3 Sticker(s) (delta,delta,delta) - Letters: a,a,a,d,d,d,e,e,e,l,l,l,t,t,t
: 4 Sticker(s) (come,nation,delta,come) - Letters: a,a,c,c,d,e,e,e,i,l,m,m,n,n,o,o,o,t,t
4
Note that we can end up with a very
long list of combinations before unique trims it down. This may result
in high memory usage and execution time. But we will get the correct (lowest)
result.
And that's it.