Perl Weekly Challenge 161.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 161.
Task 1: Abecedarian Words
Submitted by: Ryan J Thompson
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.
This task is simply solved by establishing a pipeline: we read all words, split into characters, order them and join them into words again, select those that don’t change after this process, order them and print them. This fits into a simple oneliner:
perl -E 'say join "\n", sort {length $b <=> length $a} grep
{$_ eq join "", sort {$a cmp $b} split "", $_} map {chomp; $_} <>' dictionary.txt
The results are (after some formating):
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 adopt affix
afoot aglow allot allow alloy annoy beefs beefy beers befit
begin bells belly below berry bills boors boost booty bossy
cello cells chill chimp chins chips chops coops deems deeps
deity dills dirty ditty doors empty fills filly films filmy
first floor flops floss forty ghost gills glory gloss hills
hilly hippy hoops loops lorry moors mossy abet ably aces adds
ahoy ails aims airs airy ally alms amps beef been beer bees
beet begs bell belt bent best bill bins blot blow boor boos
boot boss buzz cell cent chin chip chop chow city clot coop
coos cops copy cost crux deem deep deer deft defy dens dent
deny dill dims dins dips dirt door eels eggs egos elms envy
errs fill film fins firs fist fizz flop flow flux foot fort
foxy fuzz gill gilt gins gist glow gory hill hilt hims hint
hips hiss hoop hoot hops host ills imps inns knot know loop
loot lops loss lost moor moos moot mops moss most nosy ace act
add ado ads ago ail aim air all amp ant any apt art ass bee
beg bet bin bit boo bop bow box boy buy chi coo cop cot cow
cox coy cry den dew dim din dip dos dot dry eel egg ego elm
err fin fir fit fix flu fly for fox fry gin gnu goo got guy
him hip his hit hop hot how iii ill imp inn ins ivy jot joy
lop lot low moo mop mow nor not now opt pry xxx ad ah am an as
at ax be by cc cs do eh em go hi ho ii in is it iv ix ms mu my
no or ox qt xx a m x
There are not that many!
The last part of the challenge seems more difficult.
lost chimp, deer in hill, forty chilly beers below mossy empty box in first floor, beg him for best gin, add a berry, cry
The full version of the program would be:
1 # Perl weekly challenge 161
2 # Task 1: Abecedarian words
3 #
4 # See https://wlmb.github.io/2022/04/11/PWC160/#task-1-abecedarian-words
5 use v5.12;
6 use warnings;
7 use Text::Wrap qw(wrap $columns $break);
8 die "Usage: ./ch-1.pl dictionary\n".
9 "to find all abecedarian words in the given dictionary..."
10 unless @ARGV==1;
11 die "Can't read dictionary" unless -r $ARGV[0];
12 $columns=62; $break=qr/\s/;
13 # Read the comments from the bottom up
14 say wrap "", "", # pretty print
15 join " ", # join into line
16 sort {length $b <=> length $a} # sort by decreasing length
17 grep {$_ eq # compare to original word and filter
18 join "", # join into new word
19 sort {$a cmp $b} # sort them
20 split "", $_} # separate letters
21 map {chomp; $_} # Remove line end
22 <>; # Read all the dictionary, one word per line
Run it:
./ch-1.pl dictionary.txt
Results:
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 adopt affix afoot aglow allot allow alloy annoy beefs
beefy beers befit begin bells belly below berry bills boors
boost booty bossy cello cells chill chimp chins chips chops
coops deems deeps deity dills dirty ditty doors empty fills
filly films filmy first floor flops floss forty ghost gills
glory gloss hills hilly hippy hoops loops lorry moors mossy
abet ably aces adds ahoy ails aims airs airy ally alms amps
beef been beer bees beet begs bell belt bent best bill bins
blot blow boor boos boot boss buzz cell cent chin chip chop
chow city clot coop coos cops copy cost crux deem deep deer
deft defy dens dent deny dill dims dins dips dirt door eels
eggs egos elms envy errs fill film fins firs fist fizz flop
flow flux foot fort foxy fuzz gill gilt gins gist glow gory
hill hilt hims hint hips hiss hoop hoot hops host ills imps
inns knot know loop loot lops loss lost moor moos moot mops
moss most nosy ace act add ado ads ago ail aim air all amp
ant any apt art ass bee beg bet bin bit boo bop bow box boy
buy chi coo cop cot cow cox coy cry den dew dim din dip dos
dot dry eel egg ego elm err fin fir fit fix flu fly for fox
fry gin gnu goo got guy him hip his hit hop hot how iii ill
imp inn ins ivy jot joy lop lot low moo mop mow nor not now
opt pry xxx ad ah am an as at ax be by cc cs do eh em go hi
ho ii in is it iv ix ms mu my no or ox qt xx a m x
Task 2: Pangrams
Submitted by: Ryan J Thompson
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!
As a first attempt, I simply add random dictionary words until all letters are included.
perl -MList::Util=notall -E '@a=map {chomp; $_} <>; while(notall {$l{$_}} a..z){
$p.=" ".($w=$a[rand @a]); ++$l{$_} for split "", $w;} say $p;
' dictionary.txt
Results:
grannies knead doping emphasizes purchased electrocute authenticate skirts brunettes
dazzling roomed nasty countrysides drawers subprogram instilled semicircles ruckuses
occupying probing sheaths sanatoriums smuggest blobs pepping reneging roadblocked spas
sallow saintlier adores trade ancient wrongest astuter recentest strayed orphanage
filaments bleeds cluster manures bride predominating peeved beyond darts scruffs scallops
idealizes waits bleaching wrinkle ethical ministering charted committed utmost erase
supplanting brakes cocoon comestibles twittering goddesses fattening grub riles wilier
concurrence chubbiest tumults expansive burnishing tributes cocks elbows advertising
intersections pupping unchanged administer anchors lopped dampening eulogies enunciating
names gray solidified chummier storms vigilante delegating solved it booze tutor blanks
jog delusions rightmost abandoned based courage veto ambushed bogus flakiest headaches
artistically acquiring
It worked, but the pangram turned out somewhat long and some letters appeared up to 100 times (like e) while others only 1 (like q). Thus, I generate a slightly more sophisticated solution below. I make a hash mapping each letter to all the words in which it appears. Then, for any missing letter I chose a random word that contains it and iterate until done.
perl -MList::Util=notall,uniq,shuffle,first -E '
@a=map {chomp; $_} <>; for $w(@a){push @{$wl{$_}},$w for uniq split "", $w}
while(notall {$l{$_}} a..z){$l=first{!$l{$_}} shuffle a..z;$w=${$wl{$l}}[rand @{$wl{$l}}];
$p.=" ".$w;++$l{$_} for split "", $w;} say $p; ' dictionary.txt
Results of several runs:
injuries decks mothers radial jinxing permeated mobilization conquer fan alleys silvers unlawful
revered imploring sexes equalize vineyards tank projections orthopedics underworlds cornflakes bitter
polishes acquiescence row juicy spooks stratifying blindfolded carving lazy monopoly excommunications
putty disclosures softball sequin weekending emphasized injections asphyxiating conveyed
I can join this program with that of task one to obtain a solution with abecedarian words only.
perl -MList::Util=notall,uniq,shuffle,first -E '@a=grep {$_ eq join "",
sort {$a cmp $b} split "", $_} map {chomp; $_} <>; for $w(@a){push @{$wl{$_}},$w
for uniq split "", $w} while(notall {$l{$_}} a..z){$l=first{!$l{$_}} shuffle a..z;
$w=${$wl{$l}}[rand @{$wl{$l}}]; $p.=" ".$w;++$l{$_} for split "", $w;} say $p; ' dictionary.txt
Results:
chins ditty lot jot amp deep qt ivy fix egos fizz buy know airs
The full version is:
1 # Perl weekly challenge 161
2 # Task 2: Pangrams
3 #
4 # See https://wlmb.github.io/2022/04/11/PWC160/#task-2-pangrams
5 use v5.12;
6 use warnings;
7 use List::Util qw(notall uniq shuffle first);
8 die "Usage: ./ch-2.pl dictionary\n".
9 "to find an abedecedarian pangram from the given dictionary..."
10 unless @ARGV==1;
11 die "Can't read dictionary" unless -r $ARGV[0];
12 my @dictionary=map {chomp; $_} <>; # read the dictionary
13 my @abecedarian=grep {$_ eq join "", sort {$a cmp $b} split "", $_} @dictionary;
14 my %words_with; # maps letters to words containing them
15 for my $word(@abecedarian){
16 push @{$words_with{$_}},$word for uniq split "", $word;
17 }
18 my %letters;
19 my $pangram;
20 my @all_letters='a'..'z';
21 while(notall {$letters{$_}} @all_letters){
22 my $letter=first {!$letters{$_}} shuffle @all_letters; # random missing letter
23 my @possible_words=@{$words_with{$letter}}; # words containing letter
24 my $word=$possible_words[rand @possible_words]; # choose a random one
25 $pangram.=" ".$word; # add to output phrase
26 ++$letters{$_} for split "", $word; # update used letters
27 }
28 say $pangram;
Examples:
./ch-2.pl dictionary.txt
./ch-2.pl dictionary.txt
./ch-2.pl dictionary.txt
./ch-2.pl dictionary.txt
./ch-2.pl dictionary.txt
Results:
art fist beer ado ivy knotty hip loot clot chintz crux ago qt elm flow jot
dips know got fills begins crux joy qt fuzz envy accept em chop
joy imps aglow ax buzz for chins defy knot envy qt
amps hilly ivy em buzz lorry den flux cops dirt begs jot qt mow knot
know xxx jot elm qt deeps best ivy goo hit fin cop flux pry fizz abhor
Written on April 18, 2022