## Perl Weekly Challenge 216: Registration Number

These are some answers to the Week 216 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on May 14, 2023 at 23:59). This blog post offers some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

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

### Registration Number in Raku

We first store the letters of the registration number into a Set. Then, we convert each input word into a set of its letter and use the infix `(<=)` or infix `⊆` (is a subset of or is equal to) set operator to find whether the input word contains all letters of the registration number.

``````sub included (@words, \$reg) {
my \$letters = \$reg.lc.comb.grep({ /<[a..z]>/ }).Set;
my @result;
for @words -> \$wd {
push @result, \$wd if \$letters ⊆ \$wd.lc.comb.Set;
}
return @result;
}
my @tests =
{words => ('abc', 'abcd', 'bcd'), reg => 'AB1 2CD'},
{words => ('job', 'james', 'bjorg'), reg => '007 JB'},
{words => ('crack', 'road', 'rac'), reg => 'C7 RA2'};
for @tests -> %test {
printf "%-30s", "%test<words> - %test<reg> => ";
say included %test<words>, %test<reg>;
}
``````

This program displays the following output:

``````\$ raku ./registration-nr.raku
abc abcd bcd - AB1 2CD =>     [abcd]
job james bjorg - 007 JB =>   [job bjorg]
crack road rac - C7 RA2 =>    [crack rac]
``````

### Registration Number in Perl

This is essentially a port to Perl of the above Raku problem. Since Perl doesn’t have `Sets`, we use hashes instead, and we use a `grep` to find out whether there are letters of the registration number that do not belong to the letters of the input words.

``````use strict;
use warnings;
use feature 'say';

sub included {
my @words = @{\$_[0]};
my \$reg = lc \$_[1];
# say @words;
my @letters = grep { /[a-z]/ } split //, \$reg;
# say @letters;
my @result;
for my \$wd (@words) {
my %wd_lets = map { \$_ => 1 } split //, \$wd;
my @missing = grep { not exists \$wd_lets{\$_} } @letters;
push @result, \$wd if scalar @missing == 0;
}
return @result;
}
my @tests = (
{words => ['abc', 'abcd', 'bcd'], reg => 'AB1 2CD'},
{words => ['job', 'james', 'bjorg'], reg => '007 JB'},
{words => ['crack', 'road', 'rac'], reg => 'C7 RA2'}
);
for my \$test (@tests) {
printf "%-30s", "@{\$test->{words}} - \$test->{reg} => ";
say join " ", included \$test->{words}, \$test->{reg};
}
``````

This program displays the following output:

``````\$ perl ./registration.pl
abc abcd bcd - AB1 2CD =>     abcd
job james bjorg - 007 JB =>   job bjorg
crack road rac - C7 RA2 =>    crack rac
``````