Task — Registration number

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.

Analysis

My solution to this challenge relies on a one-line subroutine, sort_word, which takes an input word and returns the unique characters, sorted alphaberically and lower cased:

return join('', sort(uniq(split('', lc($_[0])))));

It is then just a case of looping over @words, creating sort_word($word), removing from it all the letters that don't appear in sort_word($reg), and comparing the result to sort_word($reg). If they are equal, the word meets the criterion, and if not it doesn't.

The only edge case is where $reg contains no alphabetic characters - eg 12345. In that case, no word will satisfy the criterion, but it has to be treated separately because s|[^]|| doesn't compile.

Try it 

Script

#!/usr/bin/perl

use v5.16;    # The Weekly Challenge - 2023-05-08
use utf8;     # Week 216 task 1 - Registration number
use strict;   # Peter Campbell Smith
use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

use List::Uniq 'uniq';

registration_number(['job', 'james', 'bjorg'], '007 JB');
registration_number(['crack', 'road', 'rac'], 'C7 RA2');
registration_number(['superlative', 'reply', 'parallel', 'ppeerrll',
    'pert', 'earl'], 'PERL 216');
registration_number(['none', 'of', 'these', 'should', 'work'], '12345');

sub registration_number {
    
    my (@words, $reg_no, $sorted_reg_no, $word, $sorted_word, $rubric);
    
    # initialise
    @words = @{$_[0]};
    $reg_no = $_[1];
    
    # sort, eliminate non-letters, make unique and lower case $reg_no
    $reg_no =~ s|[^a-z]||ig;
    $sorted_reg_no = sort_word($reg_no);
    $rubric = '';
    
    # nothing will match if $sorted_reg_no is empty (eg $reg_no == '12345')
    if ($sorted_reg_no) {
        
        # loop over words
        for $word (@words) {
            $sorted_word = sort_word($word);
            
            # remove from $sorted_word any letter not in reg_no
            $sorted_word =~ s|[^$sorted_reg_no]||gi;
            
            # and we have a result if $sorted_word and $sorted_reg_no are the same
            $rubric .= qq['$word', ] 
                if ($sorted_word eq $sorted_reg_no);
        }
    }
    
    say qq[\nInput:  \@words = ('] . join(q[', '], @words) . qq['), \$reg = '$_[1]'];
    say qq[Output: (] . substr($rubric, 0, -2) . q[)];
}

sub sort_word {
    
    # returns unique letters in word, sorted and lower-cased
    
    return join('', sort(uniq(split('', lc($_[0])))));
}

Output

Input:  @words = ('job', 'james', 'bjorg'), $reg = '007 JB'
Output: ('job', 'bjorg')

Input:  @words = ('crack', 'road', 'rac'), $reg = 'C7 RA2'
Output: ('crack', 'rac')

Input:  @words = ('superlative', 'reply', 'parallel', 'ppeerrll', 'pert', 'earl'), $reg = 'PERL 216'
Output: ('superlative', 'reply', 'parallel', 'ppeerrll')

Input:  @words = ('none', 'of', 'these', 'should', 'work'), $reg = '12345'
Output: ()