This is my response to the Perl Weekly Challenge #161.
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.
Let us start with the abecedarian words in alphabetical order, i.e. the same order as read from the dictionary;
File: abecedarian-words-alphabetically
#! /usr/bin/env raku
unit sub MAIN (:d(:$dictionary) where $dictionary.IO.r = 'dictionary.txt'); # [1]
$dictionary.IO.lines.map: { .say if $_ eq $_.comb.sort.join }; # [2]
[1] You can specify another dictionary file with the «-d» command line argument, if you want to. The default one is the one supplied by the challenge.
[2] For all the lines (i.e. words) in the file (IO.lines), apply the code
in(side) the curly brackets (done by the map). The bracketed code prints
the word if it is abecedarian - which we ascertain by splitting the word into a list
of single letters (with comb), sorting them alphabetically (with
sort), joining the sorted array into a word (with join) and
finally comparing the result with the original word. We have an abecedarian word if
they are equal.
Running it gives 319 words. Here is a short selection:
a
abbey
abbot
abet
abhor
abhors
ably
...
ox
pry
qt
x
xx
xxx
We can use grep instead of map:
#! /usr/bin/env raku
unit sub MAIN (:d(:$dictionary) where $dictionary.IO.r = 'dictionary.txt');
$dictionary.IO.lines.grep({ $_ eq $_.comb.sort.join })>>.say; # [1]
[1] Apply .say on all the elements in the list, with
>>.say.
We were asked to sort the words by length, with the shortest first. Let us do that:
File: abecedarian-words
#! /usr/bin/env raku
unit sub MAIN (:d(:$dictionary) where $dictionary.IO.r = 'dictionary.txt');
.say for $dictionary.IO.lines.grep( { $_ eq $_.comb.sort.join } )
.sort( { $^b.chars <=> $^a.chars } );
Note the .say for
this time, instead of the trailing >>.say in the previous
program - and the embedded .say inside the map in
the first one. The result will be the same.
Running it:
abhors
accent
accept
access
accost
almost
begins
...
ox
qt
xx
a
m
x
Note that «a» is a word, as it should be, «i» is missing, and «m» and «x» are included - even though they are not words! This is a strange dictionary... (The reason for the missing «I» may be a systematic filtering out of words containing uppercase letters.)
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.
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!
The plain program first, without bonuses:
File: pangrams
#! /usr/bin/env raku
unit sub MAIN (:d(:$dictionary) where $dictionary.IO.r = 'dictionary.txt');
my @dict = $dictionary.IO.lines; # [1]
my @sentence; # [2]
my %letters; # [3]
while %letters.keys.elems != 26 # [4]
{
my $word = @dict.pick; # [5]
@sentence.push: $word; # [6]
$word.comb.map({ %letters{$_} = True }); # [7]
}
say @sentence.join(" "); # [8]
[1] The dictionary as a list.
[2] The resulting sentence will end up here, as a list.
[3] A hash containing used letters (so far).
[4] Go on until we have used all 26 letters.
This will only work as long as the dictionary does not contain anything besides the 26 lowercase letters. (The supplied dictionary does not violate this rule, but beware of this if you supply a custom dictionary.)
[5] Pick a word (at random). Duplicates is possible, but that is ok.
See
docs.raku.org/routine/pick
for more information about pick.
[6] Add the new word to the sentence list.
[7] Add the letter in the word to the list of used letters, one at a time.
[8] Print the sentence, with a space between each word.
Running it (and shown with newlines to make the output readable):
$ ./pangrams
fiascoes probably timescales dioxide optic cowgirls safe priorities liable
drawbridges creatively rockers cancel x inalienable mattering maddest viola priceless
sea ranting reluctantly crowded composes attuning unskilled boiled distorts owl
bidding braise reprimanding monkey preceding launchers merrier fazes equine festoons
geniuses gloomy advent tonnages distillation refereeing softened profanities
overprice assumptions loophole terms workable woolliest flicks muddled boomed
refreshments maintenance cyanide servers disbanding spied mooned defensing gliders
skits zillions triangles pulmonary outing syntax pends cued matriculated stoked
measured decays brandished suspicious confounds shackled scorning deftly overcame
proportionals humor place once invisible stodgier swiped truncated snowplowed nylon
corsages demerit prospectuses pulsated astronauts lengthened washcloths con queued
puck jaywalk
$ ./pangrams
obliged conducting lyres mutiny supplanting splattered jilts dumber lubricates
commemorations charted scrupulously editors product purer comparing explanatory
thicker lumberjack doses additional gunfire briefcase funnel minuscule vomiting
flicked trusted specifying progressive pawnbrokers epidemics patty investigator
allaying disposing intimacy petition one expediting rocky predict checkpoint
proportional lyrical revenges influx unblocked culmination tally amiably vilest
sprinted encrypted lightest sicks contiguous swindles deflect friction adjustable
berthing clustering automatic stalemating despotic mathematicians closets
thirsting widowing submit attic hoarders submersion roar overloaded sandwiching
irritating snubbed embarks irreplaceable repugnant impedance adjectives
assassinate rectangular volunteering saleswoman gritty librarian premier true
waddles odometers descend researchers tapers thump creamier hazier electric
tundra grades dialog peddlers slinking arbitrated bankrupting arrogantly
bayoneting conceptions haul trespassing faggot specked retrospect justifiably
minuting spawn entrants hugest strewed anthems sickens smoothing ornate
defrauding undecideds scaffold flies verbally fumble telecommunications
instinctive stringent ascribing greasy separation engrossed acumen panicked
reckoned jails apostrophes preambling edict mining overnights unceasing complements
wavers offshoot perverts watchdogs bridegrooms index blasphemous rational gees
sponging treating tugged downright flagrantly ambiguity repents asymmetry
consistency themes behavioral waste salespersons gonna cybernetics casualty
consents untruest swooped tied grenades tiptoed outspoken wishes unwrap crisps
commits undergoing incoherence reformatted auctioned glassed spangling
predispositions bagging blunt forum leaving metal reincarnated considers
regretful credence chloroformed byways hyperbole smother seminar graphite buffet
matadors procure entrench brute practicals horsepower bow flightless diners
fusion spindliest sponsor disparaged wand plum aghast beseeches initially xxxi
mushing enterprises squeezing
This is OK, I hope. It is quite hard to check by hand.
Then let us add some bells and whistles:
#! /usr/bin/env raku
unit sub MAIN
(
:d(:$dictionary) where $dictionary.IO.r = 'dictionary.txt',
:a(:$abecedarian), # [1]
:o(:$one-new),
:s(:$stop-start)
);
my @dict = $abecedarian
?? $dictionary.IO.lines.grep({ $_ eq $_.comb.sort.join }) # [1a]
!! $dictionary.IO.lines; # [1b]
my @sentence;
my %letters;
while %letters.keys.elems != 26
{
my $word = @dict.pick;
if $one-new && $stop-start && @sentence.elems # [2]
{
$word = @dict.pick
until ($word.comb (-) %letters.keys).elems == 1 # [2a]
&& @sentence[*-1].substr(@sentence[*-1].chars -1) eq $word.substr(0,1);
}
elsif $one-new # [3]
{
$word = @dict.pick until ($word.comb (-) %letters.keys).elems == 1;
}
elsif $stop-start && @sentence.elems # [4]
{
$word = @dict.pick
until @sentence[*-1].substr(@sentence[*-1].chars -1)
eq $word.substr(0,1);
}
@sentence.push: $word;
$word.comb.map({ %letters{$_} = True });
}
say @sentence.join(" ");
[1] Usinga abecedarian words only is the easy one; we just use another dictionary (in [1a]) than the default (in [1b]).
[2] If one-new and stop-start (but not the very first word). Pick a word until we have one with exactly one new (unused) letter - and the first letter is the same as the last letter in the previous word.
[3] One new (alone, and with stop-start for the very first word).
[4] Stop-start only.
The «one new letter» code uses the Set Difference Operator (-).
It starts with the word (as a list of letters) and removes the letters used so far.
The result is a list with 1 element - if we have one new letter.
See docs.raku.org/language/setbagmix#Operators_with_set_semantics for a list of «Operators with set semantics».
Running it:
$ ./pangrams-extended
handing chieftain ale pillows beneficiary hitchhiker slighted tiling studied fathomed
installing mitigate grand reinstate gonna announcement thrashing motivated into
shiftier freckle looniest witticisms lymph lurked peopling wee hurdles sally ushering
invading prostituting soberest combs wheedle surface commiserating fingernails
subgroup calculated insuring bleated effigy punitive popped hospitalizing emailed
attracts squirreled thirteenth bandwidth frequenting incompatibly slummer objection
ingratitude clacks unconsciously intelligence wreaking snorkels creamy relinquished
blogging aliening pedestrian timed countenances straitjacketed discourtesy older
songs summoned envies assign nude monetary live clips pedestal planetariums
miscellany retail simplicity shortens farthest thoroughfare brace cottages certainly
abstracted brutalities bracing offers shavers superintendents lances lax
$ ./pangrams-extended -a
ivy ill hills deft firs ads adds by doors chilly ad floppy ado fill glory him cot
hiss amps afoot forty bossy an flop add beers cost cells hops mow dos abbot egos be
floppy accent forty alloy berry ins ahoy hiss qt goo deem air by beer blow iv xx x
air aces moors hint go hills filmy for flu not allot fit coop begs chips guy fly
almost lorry amp lops qt em access amps fly hoot it gist beefs fist know bit foot
hiss ails adds mow no alms how abort ails lop boot all egg boor buzz filmy ii berry
befit choosy bell dim gill films bet foxy bop dills fix eh dips dirty hills aims
nor inn ii ails fill ii hippy chip fist coops bop chill doors inns loss lorry deny
bins hip ail boy bet ivy flu fix adept billow moors adopt for bossy dills loot x
ass do dent affix fist billow hoop dins mu imp egg air got cell errs is moor lorry
buy annoy cell go cox any beefy joy
$ ./pangrams-extended -a -o
iii ill bill a m alms x bees imps loss abet accost egos flops moor inns filmy dim joy
hoot aglow fizz iv fuzz knotty qt
$ ./pangrams-extended -o -s
a an non nab bamboo oboe earn nooses spore ewes slops snowplowed dyed din nettles
spur relives southeastern nitrogen niece executing goalkeeper reinforced dejecting
generalized delinquent
$ ./pangrams-extended -a -o -s
^C
The last one does not work out (even with several tries), so I killed it. Too few words to choose from, and too many ways to hit a dead end I presume. The program does not backtrack.
And that's it.