laurent_r

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.

Task 1: 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.

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

Task 2: Word Stickers

I don’t have time right now for this second task. I may be doing it later.

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on May 21, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.