Peter Campbell Smith

Alphabetical exercises

Weekly challenge 216 — 8 May 2023

Week 216 - 8 May 2023

Task 1

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.


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 

Words - example: job, james, bjorg

Reg - example: 007 JJB



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:

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])))));


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: ()