The weekly challenge 216 - registration numbers

 1 #!/usr/bin/perl
 2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-216/#TASK1
 3 #
 4 # Task 1: Registration Number
 5 # ===========================
 6 #
 7 # You are given a list of words and a random registration number.
 8 #
 9 # Write a script to find all the words in the given list that has every letter
10 # in the given registration number.
11 #
12 ## Example 1
13 ##
14 ## Input: @words = ('abc', 'abcd', 'bcd'), $reg = 'AB1 2CD'
15 ## Output: ('abcd')
16 ##
17 ## The only word that matches every alphabets in the given registration number
18 ## is 'abcd'.
19 #
20 ## Example 2
21 ##
22 ## Input: @words = ('job', 'james', 'bjorg'), $reg = '007 JB'
23 ## Output: ('job', 'bjorg')
24 #
25 ## Example 3
26 ##
27 ## Input: @words = ('crack', 'road', 'rac'), $reg = 'C7 RA2'
28 ## Output: ('crack', 'rac')
29 #
30 ############################################################
31 ##
32 ## discussion
33 ##
34 ############################################################
35 #
36 # We have to check every word in the list whether it matches
37 # all alphabetical characters in the registration number. If
38 # it does, we put the word into the result list.
39 # To check a word, we split the registration number into its
40 # characters and check if each character is in the word. For that
41 # we skip numbers and whitespace, then we convert both the
42 # character and the word to lowercase and check if the character
43 # is in the word.
44 
45 use strict;
46 use warnings;
47 
48 registration_number('AB1 2CD', 'abc', 'abcd', 'bcd');
49 registration_number('007 JB', 'job', 'james', 'bjorg');
50 registration_number('C7 RA2', 'crack', 'road', 'rac');
51 
52 sub registration_number {
53    my ($reg, @words) = @_;
54    print "Input: (" . join(", ", @words) . ") - $reg\n";
55    my @result = ();
56    foreach my $word (@words) {
57       push @result, $word if word_matches_all_alphabet($reg, $word);
58    }
59    print "Output: (" . join(", ", @result) . ")\n";
60 }
61 
62 sub word_matches_all_alphabet {
63    my ($reg, $word) = @_;
64    my @letters = split //, $reg;
65    foreach my $letter (@letters) {
66       # skip numbers and whitespace
67       next if $letter =~ m/^\d$/;
68       next if $letter =~ m/^\s$/;
69       my $lc_letter = lc($letter);
70       return 0 unless lc($word) =~ m/$lc_letter/;
71    }
72    return 1;
73 }