laurent_r

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

Spoiler Alert: This weekly challenge deadline is due in a couple of days from now (on April 24, 2022 at 24:00). 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: Abecedarian Words

An abecedarian word is a word whose letters are arranged in alphabetical order. For example, “knotty” is an abecedarian word, but “knots” is not. Output or return a list of all abecedarian words in the dictionary, sorted in decreasing order of length.

Optionally, using only abecedarian words, leave a short comment in your code to make your reviewer smile.

Abecedarian Words in Raku

Here, we use some nice features of Raku. The 'dictionary.txt'.IO.lines construct returns all the lines of the input file one by one. Then we grep these lines and keep only those in which the letters are arranged in the lexicographic order using the [] meta-operator with the infix le less than or equal to operator. Since the comparison routine passed to sort (i.e. .chars) takes only one argument, this routine is automatically applied to both sides of the comparisons made for the purpose of sorting.

my @abecedarian =  'dictionary.txt'.IO.lines.grep({[le] .comb});
say (reverse sort {.chars}, @abecedarian)[0..25];

My original implementation was a one-liner, but I decided to break it into two lines for better readability.

This short program displays the following output:

$ raku ./abecedarian.raku
(knotty glossy floppy floors effort choppy choosy chintz chimps chilly chills cellos billow bellow begins almost accost access accept accent abhors mossy moors lorry loops hoops)

Abecedarian Words in Perl

This Perl program does essentially the same thing as the Raku program above, but we have to use two explicit nested loops.

my @abecedarian;
my $dict = "./dictionary.txt";
open my $IN, "<", $dict or die "Cannot open $dict $!";
WORD: while (my $word = <$IN>) {
    chomp $word;
    my $old = 'a';
    for my $char (split //, $word) {
        next WORD if $char lt $old;
        $old = $char;
    }
    push @abecedarian, $word;
}
my @out = sort { length $b <=> length $a } @abecedarian;
say $_ for @out[0..25];

This program displays the following output:

$ perl ./abecedarian.pl
abhors
accent
accept
access
accost
almost
begins
bellow
billow
cellos
chills
chilly
chimps
chintz
choosy
choppy
effort
floors
floppy
glossy
knotty
abbey
abbot
abhor
abort
adept

Task 2: Pangrams

A pangram is a sentence or phrase that uses every letter in the English alphabet at least once. For example, perhaps the most well known pangram is:

the quick brown fox jumps over the lazy dog

Using the provided dictionary, so that you don’t need to include individual copy, generate at least one pangram.

Your pangram does not have to be a syntactically valid English sentence (doing so would require far more work, and a dictionary of nouns, verbs, adjectives, adverbs, and conjunctions). Also note that repeated letters, and even repeated words, are permitted.

BONUS: Constrain or optimize for something interesting (completely up to you), such as:

* Shortest possible pangram (difficult)
* Pangram which contains only abecedarian words (see challenge 1)
* Pangram such that each word "solves" exactly one new letter. For example, such a pangram might begin with (newly solved letters in bold):
    a ah hi hid die ice tea ...
    What is the longest possible pangram generated with this method? (All solutions will contain 26 words, so focus on the letter count.)
* Pangrams that have the weirdest (PG-13) Google image search results
* Anything interesting goes!

Well, as for the bonus, sorry, this coming Sunday is the presidential election here in France. As a city counselor in my home town, I’m heavily involved in the election process from early morning to very late evening, and I will have no time to deal with the bonus.

Pangrams in Raku

We use a $seen SetHash to store the letters that we’ve already met. Then, for each word in the dictionary, we add it to the @pangram array if it has at least one new letter not in $seen. We stop the process when the $seen SetHash has 26 letters (i.e. we’ve seen all letters of the alphabet).

my  $seen = SetHash.new;
my @pangram;
for 'dictionary.txt'.IO.lines -> $word {
    my @new_letters = grep {not $seen{$_}}, $word.comb;
    next if @new_letters == 0;
    $seen ∪= @new_letters;      # set union operator
    push @pangram, $word;
    last if $seen.elems == 26;
}
say @pangram;

This program dispays the following output:

$ raku ./pangram.raku
[a aardvark aback abacus abacuses abandon abandoning abandonment abbey abdominal abhor abject ablaze abrupt acknowledge acquaint adrift affix]

Pangram in Perl

This Perl implementation is a port of the Raku program above. In Perl, we use a regular hash to store the letters already seen.

use strict;
use warnings;
use feature "say";

my  (%seen, @pangram);
my $dict = "./dictionary.txt";
open my $IN, "<", $dict or die "Cannot open $dict $!";
while (my $word = <$IN>) {
    chomp $word;
    my @new_letters = grep {not $seen{$_}} split //, $word;
    next if @new_letters == 0;
    $seen{$_} = 1 for @new_letters;
    push @pangram, $word;
    last if scalar keys %seen == 26;
}
say "@pangram";

This program displays the following output:

$ perl ./pangram.pl
a aardvark aback abacus abacuses abandon abandoning abandonment abbey abdominal abhor abject ablaze abrupt acknowledge acquaint adrift affix

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 1st, 2022. And, please, also spread the word about the Perl Weekly Challenge if you can.