Perl Weekly Challenge 166.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 166.
Task 1: Hexadecimal Words
Submitted by: Ryan J Thompson
As an old systems programmer, whenever I needed to come up
with a 32-bit number, I would reach for the tired old examples
like 0xDeadBeef and 0xC0dedBad. I want more!
Write a program that will read from a dictionary and find 2-
to 8-letter words that can be “spelled” in hexadecimal, with
the addition of the following letter substitutions:
o ⟶ 0 (e.g., 0xf00d = “food”)
l ⟶ 1
i ⟶ 1
s ⟶ 5
t ⟶ 7
You can use your own dictionary or you can simply open
../../../data/dictionary.txt (relative to your script’s
location in our GitHub repository) to access the dictionary of
common words from Week #161.
Optional Extras (for an 0xAddedFee, of course!)
Limit the number of “special” letter substitutions in any one
result to keep that result at least somewhat
comprehensible. (0x51105010 is an actual example from my
sample solution you may wish to avoid!)
Find phrases of words that total 8 characters in length (e.g.,
0xFee1Face), rather than just individual words.
The task without extras is quite straightforward: filter the dictionary words according to word length and letters contained. Then, transliterate non-hexadecimal characters. A oneliner solution is:
perl -ne 'next unless 2<=length($_)<=8 and /^\s*[0-9a-folist]+\s*$/;
tr/olist/01157/; print;' dictionary.txt |fmt
Results:
a aba7e aba7ed aba7e5 abb07 abb075 abe7 abe75 abe77ed ab1de ab1de5 ab1e
ab1e57 ab0de ab0de5 ab5ce55 accede acceded accede5 acce55 acc057 acc0575
ace aced ace5 ac1d ac1d5 ac7 ac7ed ac75 ad add added add1c7 add1c75
add5 ad0 ad0be ad0be5 ad5 affab1e affec7 affec75 aff11c7 af1e1d af10a7
af007 a1d a1de a1ded a1de5 a1d5 a11 a11ed a115 a151e a151e5 a1a5 a1be17
a1e a1e5 a11a5 a11a5ed a11a5e5 a11b1 a11b1ed a11b15 a11 a111ed a111e5
a1107 a11075 a10f7 a100f a150 a170 a1705 a5 a5ce71c a51de a51de5 a55
a55a11 a55a115 a55e5 a55e55 a55e7 a55e75 a55157 a551575 a7 a7e a71a5
a71a5e5 a77e57 a77e575 a771c a771c5 babb1e babb1ed babb1e5 babe babe5
bab1ed bab1e5 bab1e57 bad badde57 bade baff1e baff1ed baff1e5 ba11 ba11ed
ba115 ba17 ba17ed ba175 ba1d ba1ded ba1de57 ba1d5 ba1e ba1ed ba1e5 ba11
ba11ad ba11ad5 ba11a57 ba11ed ba11e7 ba11e75 ba1107 ba11075 ba115 ba5e
ba5ed ba5e5 ba5e57 ba51c ba51c5 ba511 ba515 ba55 ba55e5 ba57e ba57ed
ba57e5 ba7 ba75 ba77ed ba771e ba771ed ba771e5 be bead beaded bead5 bea57
bea575 bea7 bea75 bed bedded bed5 bed51de bee beef beefed beef5 bee5
bee7 bee71e bee71ed bee71e5 bee75 befa11 befa115 befe11 bef17 bef175
be1a7ed be11e be11ed be11ef be11ef5 be11e5 be11 be11ed be111ed be111e5
be115 be17 be17ed be175 be5e7 be5e75 be51de be51de5 be57 be57ed be571a1
be575 be7 be7a be75 b1a5 b1a5ed b1a5e5 b1b b1b1e b1b5 b1d b1de b1de5 b1d5
b11e b111 b111ed b1115 b15ec7 b15ec75 b17 b17e b17e5 b175 b1ab b1abbed
b1ab5 b1ade b1ade5 b1a57 b1a57ed b1a575 b1ea7 b1ea7ed b1ea75 b1ed b1eed
b1eed5 b1e55 b1e55ed b1e55e5 b1155 b10b b10bbed b10b5 b10c b10c5 b100d
b100ded b100d5 b107 b1075 b1077ed b0a b0a5 b0a57 b0a57ed b0a575 b0a7
b0a7ed b0a75 b0b b0bbed b0bca7 b0bca75 b0b5 b0b51ed b0de b0ded b0de5
b0d1ce b0d1ce5 b0d1e5 b011 b011ed b0115 b01d b01de57 b017 b017ed b0175
b00 b00ed b005 b0057 b0057ed b00575 b007 b007ed b007ee b007ee5 b0071e5
b0075 b055 b055ed b055e5 b0771e b0771ed b0771e5 cab cabbed cab1e cab1ed
cab1e5 cab005e cab5 caca0 caca05 cac71 cad cadd1e cadd1ed cadd1e5 cade7
cade75 ca1f ca11c0 ca11 ca11ed ca115 ca5cade ca5e ca5ed ca5e5 ca57 ca57e
ca57e5 ca571e ca571ed ca571e5 ca570ff ca575 ca7 ca7ca11 ca75 ca771e cc
cea5e cea5ed cea5e5 cede ceded cede5 ce11 ce11157 ce110 ce1105 ce115
c17e c17ed c17e5 c171e5 c1ad c1a55 c1a55ed c1a55e5 c1a551c c1ea7 c1ea75
c1ef c1ef5 c1ef7 c1ef75 c11ff c11ff5 c111 c10d c10d5 c105e c105ed c105e5
c105e57 c105e7 c105e75 c107 c1075 c1077ed c0a1 c0a1ed c0a15 c0a57 c0a57a1
c0a57ed c0a575 c0a7 c0a7ed c0a75 c0b c0ba17 c0bb1e c0b5 c0c0a c0c0a5
c0d c0dded c0de c0ded c0de5 c0d5 c0ffee c0ffee5 c011 c011ed c0115 c01
c01d c01de57 c01d5 c011c c011a7e c011ec7 c0111de c0111e c0111e5 c017
c0175 c00 c00ed c001 c001ed c001e57 c0015 c005 c057 c057ed c0575 c07
c075 c5 dab dabbed dabb1e dabb1ed dabb1e5 dab5 dad dadd1e5 dad5 daf7
da111e5 da15 da15e5 da151e5 da111ed da111e5 da7a da7e da7ed da7e5 dead
deade57 deaf deafe57 dea1 dea15 dea17 deba5e deba5ed deba5e5 deba7e
deba7ed deba7e5 deb17 deb17ed deb175 deb7 deb75 decade decade5 decea5e
dece17 dece175 dec1be1 dec1de dec1ded dec1de5 dec0de dec0ded dec0de5
deed deeded deed5 deface defaced deface5 defea7 defea75 defec7 defec75
def1c17 def1ed def1e5 def11e def11ed def11e5 def1a7e def1ec7 def7 def7e57
de1f1ed de1f1e5 de171e5 de1e7e de1e7ed de1e7e5 de11 de115 de17a de17a5
de5157 de51575 de7a11 de7a115 de7ec7 de7ec75 de7e57 de7e575 d1a1 d1a1ec7
d1a1ed d1a15 d1ce d1ced d1ce5 d1c7a7e d1d d1e d1ed d1e5 d1e5e1 d1e5e15
d1e7 d1e7ed d1e75 d11a7e d11a7ed d11a7e5 d111 d1115 d10ce5e d15ab1e d15c
d15c0 d15c05 d15c5 d15ea5e d155ec7 d157111 d1771e5 d1770 d1770ed d17705
d0 d0c11e d0d0 d0e d0e5 d0111e5 d01e d01ed d01e5 d011 d011ed d0111e5
d0115 d00d1e d00d1ed d00d1e5 d05 d05e d05ed d05e5 d07 d07e d07ed d07e5
d075 d077ed ea5e ea5ed ea5e1 ea5e15 ea5e5 ea51e57 ea57 ea7 ea75 ebb ebbed
ebb5 edd1ed edd1e5 ed1b1e ed1b1e5 ed1c7 ed1c75 ed1f1ce ed17 ed17ed ed175
ee1 ee15 effec7 effec75 e1a571c e1de57 e1ec7 e1ec7ed e1ec75 e1f e11c17
e11c175 e117e e117e5 e117157 e15e e57a7e e57a7e5 fab1e fab1e5 facade
facade5 face faced face5 face7 face7ed face75 fac1a1 fac1a15 fac11e
fac7 fac75 fad fade faded fade5 fad5 fa11 fa11ed fa115 fa11 fa115 fa15e
fa15e57 fa5c157 fa57 fa57ed fa57e57 fa575 fa7 fa7a1 fa7e fa7ed fa7e5 fa75
fa77e57 fa771e5 fea57 fea57ed fea575 fea7 fea75 fece5 fed fed5 fee feeb1e
feed feed5 fee1 fee15 fee5 fee7 fe11 fe11ed fe11e57 fe115 fe17 fe17ed
fe175 fe7a1 fe7ed fe71d f1a5c0 f1b f1bbed f1b5 f1dd1e f1dd1ed f1dd1e5
f1e1d f1e1ded f1e1d5 f1e57a f1e57a5 f1f71e5 f11e f11ed f11e5 f11e7 f111
f111ed f111e7 f111e75 f1111e5 f1115 f15ca1 f15ca15 f157 f1575 f17 f175
f177ed f177e57 f1a11 f1a11ed f1a115 f1a7 f1a75 f1a77ed f1ea f1ea5 f1ed
f1ee f1eece f1eeced f1eece5 f1ee5 f1ee7 f1ee7ed f1ee75 f11ed f11e5 f11e57
f117 f1175 f1177ed f10a7 f10a7ed f10a75 f100d f100ded f100d5 f1055 f1055ed
f1055e5 f0a1 f0a1ed f0a15 f0ca1 f0e f0e5 f01b1e f01b1e5 f011 f011ed f0115
f0157 f0157ed f01575 f01d f01ded f01d5 f0111e5 f00d f00d5 f001 f001ed
f0015 f007 f007ed f0075 f05511 f055115 fe7e fe7e5 1ce 1ced 1ce5 1c1c1e
1c1c1e5 1c1e57 1d 1dea 1dea1 1dea15 1dea5 1d107 1d1071c 1d1075 1d1e 1d1ed
1d1e5 1d1e57 1d01 1d015 1f 1f5 11 111 111 1111c17 1115 107a 107a5 15 151e
151e5 1501a7e 17 17a11c 17a11c5 175 175e1f 1ab 1abe1 1abe1ed 1abe15 1ab5
1ace 1aced 1ace5 1ac1e57 1ad 1ade 1aded 1ade5 1ad1e5 1ad1e 1ad1ed 1ad1e5
1ad5 1a1d 1a55 1a55e5 1a57 1a57ed 1a575 1a7e 1a7e57 1a771ce 1ead 1eaded
1ead5 1eaf 1eafed 1eaf1e7 1eaf5 1ea5e 1ea5ed 1ea5e5 1ea57 1ed 1ee 1ef7
1ef7e57 1ef75 1e55 1e57 1e7 1e75 11ab1e 11be1 11be1ed 11be15 11ce 11d
11d5 11e 11ed 11e5 11fe 11f7 11f7ed 11f75 111 111ac 111ac5 1111e5 1117
1117ed 11175 1157 1157ed 11575 117 11771e 10ad 10aded 10ad5 10af 10afed
10af5 10b 10bbed 10bb1ed 10bb1e5 10be 10be5 10b5 10ca1 10ca1e 10ca1e5
10ca15 10ca7e 10ca7ed 10ca7e5 10f7 10f7ed 10f75 1011 1011ed 10115 1005e
1005ed 1005e5 1005e57 1007 1007ed 10075 105e 105e5 1055 1055e5 1057 107
1075 0af 0af5 0a5e5 0a515 0be5e 0b0e 0b0e5 0b5e55 0c7a1 0dd 0dde57 0dd5
0de 0de5 0f 0ff 0ffbea7 0ffed 0ff1ce 0ff1ce5 0ff10ad 0ff5 0ff5e7 0ff5e75
011 011ed 0111e57 0115 01d 01de57 00d1e5 5ac 5ac5 5ad 5adde57 5add1e
5add1ed 5add1e5 5ade5 5ad157 5ad1575 5afe 5afe5 5afe57 5a1d 5a11 5a11ed
5a115 5a1ab1e 5a1ad 5a1ad5 5a1e 5a1e5 5a17 5a17ed 5a17e57 5a175 5a7 5cab
5cabbed 5cab5 5ca1d 5ca1ded 5ca1d5 5ca1e 5ca1ed 5ca1e5 5c0ff 5c0ffed
5c0ff5 5c01d 5c01ded 5c01d5 5c007 5c007ed 5c0075 5ea 5eaf00d 5ea1 5ea1ed
5ea15 5ea5 5ea51de 5ea7 5ea7ed 5ea75 5ec 5ecede 5eceded 5ecede5 5ec7
5ec75 5eda7e 5eda7ed 5eda7e5 5ee 5eed 5eeded 5eed5 5ee5 5e1ec7 5e1ec75
5e1f 5e11 5e115 5e7 5e75 5e771e 5e771ed 5e771e5 51c 51c5 51de 51ded
51de5 51d1e 51d1ed 51d1e5 51e57a 51e57a5 51f7 51f7ed 51f75 5111 51111e5
51115 5110 51105 5117 5117ed 51175 51551e5 517 517e 517ed 517e5 5175
51ab 51abbed 51ab5 51a7 51a7e 51a7ed 51a7e5 51a75 51ed 51edded 51ed5
51ee7 51ee7ed 51ee75 511ce 511ced 511ce5 511d 511de 511de5 511e57 5117
51175 510b 510b5 5107 51075 51077ed 50 50b 50bbed 50b5 50c1a1 50c1a15
50d 50da 50da5 50dded 50d5 50fa 50fa5 50f7 50f7e57 5011 5011ed 50115
501ace 501aced 501ace5 501d 501e 501ed 501e5 5011c17 5011d 5011d5 5010
5010ed 5010157 50105 5007 57ab 57abbed 57ab1e 57ab1ed 57ab1e5 57ab5
57aff 57affed 57aff5 57a1d 57a1e 57a1ed 57a1e5 57a1e57 57a11 57a11ed
57a115 57a7e 57a7ed 57a7e5 57a71c 57ea1 57ea15 57ee1 57ee1ed 57ee15
571ff 571ffed 571ff5 571f1e 571f1ed 571f1e5 57111 57111ed 571115 57117ed
5701ca1 5701e 5701e5 57011d 5700d 57001 570015 7ab 7abbed 7abb1e5 7ab1e
7ab1ed 7ab1e5 7ab1e7 7ab1e75 7ab101d 7ab00 7ab00ed 7ab005 7ab5 7ac17 7ac0
7ac05 7ac7 7ac71c 7ac71c5 7a11 7a11ed 7a115 7a1c 7a1e 7a1e5 7a11 7a11e57
7a111ed 7a111e5 7a55e1 7a55e15 7a57e 7a57ed 7a57e5 7a771e 7a771ed 7a771e5
7a7700 7a77005 7ea 7ea5 7ea5e 7ea5ed 7ea5e5 7ea7 7ea75 7ee 7eed 7ee5 7e11
7e115 7e57 7e57ed 7e57e5 7e5715 7e575 71da1 71db17 71db175 71de 71ded
71de5 71d1ed 71d1e5 71d1e57 71e 71ed 71e5 71ff 71ffed 71ff5 711de 711e
711ed 711e5 7111 7111ed 71115 7117 7117ed 71175 717 7171e 7171ed 7171e5
7175 70 70ad 70ad5 70a57 70a57ed 70a575 70bacc0 70dd1e 70dd1ed 70dd1e5
70e 70ed 70e5 70ffee 70ffee5 7011 7011ed 7011e7 7011e75 70115 701d 7011
7011ed 70115 700 7001 7001ed 70015 7007 7007ed 70075 7055 7055ed 7055e5
707 707a1 707a1ed 707a15 707e 707ed 707e5 7075 7077ed
I can count the words instead of printing them.
perl -ne 'next unless 2<=length($_)<=8 and /^\s*[0-9a-folist]+\s*$/;
tr/olist/01157/; print;' dictionary.txt |wc
perl -ne 'next unless /^\s*[0-9a-folist]+\s*$/; tr/olist/01157/; print;' dictionary.txt |wc
Results:
1300 1300 8172
1609 1609 11174
So I found 1300 of these words, 1609 if I remove the length constrains.
The first extra task can be done by using the output of the transliteration, the number of actual transliterations, and rejecting words with too many. For example, there are 46 words with no transliterations,
perl -ne 'next unless 2<=length($_)<=8 and /^\s*[0-9a-folist]+\s*$/;
next unless tr/olist/01157/ <= 0; print;' dictionary.txt | fmt
perl -ne 'next unless 2<=length($_)<=8 and /^\s*[0-9a-folist]+\s*$/;
next unless tr/olist/01157/ <= 0; print;' dictionary.txt | wc
a accede acceded ace aced ad add added babe bad bade be bead beaded bed
bedded bee beef beefed cab cabbed cad cc cede ceded dab dabbed dad dead
deaf decade deed deeded deface defaced ebb ebbed facade face faced fad
fade faded fed fee feed
46 46 239
and 238 words with at most 1 transliteration.
perl -ne 'next unless 2<=length($_)<=8 and /^\s*[0-9a-folist]+\s*$/;
next unless tr/olist/01157/ <= 1; print;' dictionary.txt | fmt
perl -ne 'next unless 2<=length($_)<=8 and /^\s*[0-9a-folist]+\s*$/;
next unless tr/olist/01157/ <= 1; print;' dictionary.txt | wc
a aba7e aba7ed abe7 ab1de ab1e ab0de accede acceded accede5 ace aced
ace5 ac1d ac7 ac7ed ad add added add5 ad0 ad0be ad5 affab1e affec7 a1d
a1de a1ded a1e a5 a7 a7e babb1e babb1ed babe babe5 bab1ed bad bade baff1e
baff1ed ba1d ba1ded ba1e ba1ed ba5e ba5ed ba7 be bead beaded bead5 bea7
bed bedded bed5 bee beef beefed beef5 bee5 bee7 be7 be7a b1b b1d b1de b1ab
b1abbed b1ade b1ed b1eed b0a b0b b0bbed b0de b0ded cab cabbed cab1e cab1ed
cab5 caca0 cad cadd1e cadd1ed cade7 ca1f ca5cade ca5e ca5ed ca7 cc cea5e
cea5ed cede ceded cede5 c1ad c1ef c0b c0d c0dded c0de c0ded c0ffee c5 dab
dabbed dabb1e dabb1ed dab5 dad dad5 daf7 da7a da7e da7ed dead deaf dea1
deba5e deba5ed deba7e deba7ed deb7 decade decade5 decea5e dec1de dec1ded
dec0de dec0ded deed deeded deed5 deface defaced deface5 defea7 defec7
def1ed def7 d1ce d1ced d1d d1e d1ed d0 d0e ea5e ea5ed ea7 ebb ebbed ebb5
edd1ed ee1 effec7 e1f fab1e facade facade5 face faced face5 face7 face7ed
fac7 fad fade faded fade5 fad5 fa7 fa7e fa7ed fea7 fece5 fed fed5 fee
feeb1e feed feed5 fee1 fee5 fee7 fe7ed f1b f1bbed f1ea f1ed f1ee f1eece
f1eeced f0e fe7e 1ce 1ced 1d 1dea 1f 1ab 1ace 1aced 1ad 1ade 1aded 1ead
1eaded 1eaf 1eafed 1ed 1ee 0af 0dd 0de 0f 0ff 0ffed 5ac 5ad 5afe 5cab
5cabbed 5ea 5ec 5ecede 5eceded 5ee 5eed 5eeded 7ab 7abbed 7ea 7ee 7eed
238 238 1300
For the second extra task, to get hexadecimal phrases with exactly 8 characters (regardless of grammar or meaning) I keep the list of smaller words in memory and concatenate them until I reach the desired length. The problem is that the list of produced phrases would be huge. Thus, I pick only a random sample.
perl -nE 'chomp; next unless 1<length($_)<7 and /^\s*[0-9a-folist]+\s*$/;
next unless tr/olist/01157/ <= 1; push @{$w[length($_)]}, $_;
END{for(1..100){ $r=""; while($l=length($r)<8){ $s=$w[2+rand(8-length($r))];
$r.=ucfirst $s->[rand @$s]; $r="" if length($r)>8} say $r; }}' dictionary.txt |fmt
Results:
5eeC5Ad0 BadEa5ed Ebb5Fade CededAce Dad1aced CededEa7 Fee5Dad5 Deed0f1d
Effec7A5 Ba5ed0af Bee5Ad1d A5Face1f BeBadD0e BeefedCc Ba7B1eed C1efBade
Ca1fF1ed C5C0ffee AceA1ded Ab0deCa7 Fade5Ba7 BeC0dded C5Cabbed DeededCc
Cede5Ac7 Ab1e1d1d Deed1ace A7F1bbed Cea5eCad Cab1edCc 0fBeD1ed 0fCa5eA5
Affec70f Face7Fad Dabb1eC5 Bead5Fee Ea7Fece5 0deCede5 B1edD1ed Fed1dBed
AdDef1ed C1efDeb7 7abFa7Cc CcCcDea1 Deed50de D00dd1ab BeefedAd Ba1dCcC5
Fed5D1ce Affec7Cc D01dA50f Ab1eAdC5 Babb1eA7 Defea7Ad 0fDabb1e 7eaFa7ed
1dC5F1ee Def1edD0 FadCade7 CedeCcA5 Cab1ed1f 1acedEbb Accede0f A5AdC5A7
5eeded1f Da7e0fA7 DeededC5 5eaDeed5 Fece5Add AccedeD0 DabAc70f D0Dea10f
DeedCa5e Cea5ed1f BeFac70f C5Cabbed Babb1eAd 1dDec1de DecadeD0 C1efFed5
BadCade7 C0dedEe1 1fDabb1e 1eadDea1 Fa70ffed 7abCeded C0ddedC5 1eeFa7ed
A5Facade Dabbed1d Da7edFa7 D1d5ecC5 BeEffec7 A71fBade Face5Fad Bad0f0dd
Affec7A5 A57eaB0b BeefedAd DeededC5
The full code is:
1 # Perl weekly challenge 166
2 # Task 1: hexadecimal words
3 #
4 # See https://wlmb.github.io/2022/05/25/PWC166/#task-1-hexadecimal-words
5 use v5.12;
6 use warnings;
7 # Parameters
8 my $N_phrases=100; # number of desird phrases
9 my $phrase_size=8;
10 my $max_trans=1; # maximum characters to transliterate
11 my $min_size=2; # bounds on word size
12 my $max_size=$phrase_size-$min_size;
13
14 my @words; # set of sets of words, one for each size
15 while(<>){ # read dictionary words, one perl line
16 chomp;
17 # discard words too small, too large or with non-hex-like characters
18 next unless $min_size <= length($_) <= $max_size and /^\s*[0-9a-folist]+\s*$/;
19 next unless tr/olist/01157/ <= $max_trans; # transliterate letters, but too many
20 push @{$words[length($_)]}, $_; # found a word? save it
21 }
22 for(1..$N_phrases){
23 my $phrase="";
24 while(length($phrase)<$phrase_size){
25 my $size=$min_size+rand($max_size+1-length($phrase));# choose size of next word
26 my $chosen=$words[$size]; # array of words with chosen size
27 $phrase.=ucfirst $chosen->[rand @$chosen]; # add random word of given length
28 $phrase="" if length($phrase)>$phrase_size; # restart if overshoot
29 }
30 say $phrase;
31 }
I run it:
./ch-1.pl dictionary.txt | fmt
Results:
Dabbed1d Dec0deC5 A55eeded Faced0dd D1d0f7ab 1fBa7Fee F0eFade5 Affec70f
5eed0fD0 Cab1eBad D1ceAdA5 A5Bade0f Fece5Ac7 Fed5A5C5 5eedA51d 1dEffec7
FacadeA5 A7AceFad CcFe7eD0 C0ddedCc Babb1eBe CededD0e Affec7Cc AdBeaded
AceFace7 Cea5eCa7 Deba7eC5 5acFece5 BeadedC5 0fDa7eC5 0ddCcF1b Ba1dedC5
BeddedA5 FacadeAd C0bAba7e FacedCab 5acD1e1d DefaceC5 CcFed50f Ac1d7eed
Cede5Dad Fe7e5eed Ad0be7ab Ab1eBe7a 1fCea5ed 1ed1edC5 Fe7edB0b AccedeCc
Bab1ed1f 7ab1f5ee 1dA71dAd Fab1eB0b B0bbed1d A7C0ffee Ac1dF1ea Ab1eDa7e
Ea5edB1d 0deA1eA5 DecadeC5 CcDefea7 Add7eaAd Ba1edB0b B1dA7A1e Fee7Da7e
A1eBed0f BeddedC5 D1cedEbb Cea5ed0f D0Aba7ed Dec1deA5 Cab1edD0 D1edFad5
DefaceCc Cab1eBa7 1deaBeC5 Deba7eAd F1bAdAd0 Dad5Deed 1cedD0C5 FacadeCc
DeedA7Cc Ca7Ad0Be B0deAdA5 B1bDeed5 Feeb1eA5 C5DeedA7 Baff1e1f Cab5C51d
1d1cedAd Ea5ed5ec 1ead0f0f 1dF1eece 1adeBade Ba1dBead Deed1fA5 B0ded1ab
D0F1eece FadeFa7e C1ef1d1d BadeC51d
Notice that I allowed more than 2 words in a phrase, as in Ca7Ad0Be, but I chose the minimum size as 2, as otherwise, the word only 1-lettered word A would be too strongly over-represented. Thus, I might overshoot the desired phrase length. For example, if I want an 8 letter phrase and I choose a first word with 5 letters, the next word could be of 3 letters, completing the phrase, or 2 letters, in which case I would need a 1-letter word to complete the phrase, but the smallest word is 2-letter. Although inefficient, when I overshoot, I simply start over again building the phrase.
Task 2: K-Directory Diff
Submitted by: Ryan J Thompson
Given a few (three or more) directories (non-recursively),
display a side-by-side difference of files that are missing
from at least one of the directories. Do not display files
that exist in every directory.
Since the task is non-recursive, if you encounter a
subdirectory, append a /, but otherwise treat it the same as a
regular file.
Example
Given the following directory structure:
dir_a:
Arial.ttf Comic_Sans.ttf Georgia.ttf Helvetica.ttf
Impact.otf Verdana.ttf Old_Fonts/
dir_b:
Arial.ttf Comic_Sans.ttf Courier_New.ttf Helvetica.ttf
Impact.otf Tahoma.ttf Verdana.ttf
dir_c:
Arial.ttf Courier_New.ttf Helvetica.ttf Impact.otf
Monaco.ttf Verdana.ttf
The output should look similar to the following:
| dir_a | dir_b | dir_c |
|----------------+-----------------+-----------------|
| Comic_Sans.ttf | Comic_Sans.ttf | |
| | Courier_New.ttf | Courier_New.ttf |
| Georgia.ttf | | |
| | | Monaco.ttf |
| Old_Fonts/ | | |
| | Tahoma.ttf | |
First I recreate the directory structure of the example in the current directory.
mkdir dir_a dir_b dir_c
for i in Arial.ttf Comic_Sans.ttf Georgia.ttf Helvetica.ttf Impact.otf Verdana.ttf;
do touch dir_a/$i; done
mkdir dir_a/Old_Fonts
for i in Arial.ttf Comic_Sans.ttf Courier_New.ttf Helvetica.ttf Impact.otf Tahoma.ttf Verdana.ttf;
do touch dir_b/$i; done
for i in Arial.ttf Courier_New.ttf Helvetica.ttf Impact.otf Monaco.ttf Verdana.ttf;
do touch dir_c/$i; done
Then I check that it has been correctly reproduced:
ls dir*
dir_a:
Arial.ttf
Comic_Sans.ttf
Georgia.ttf
Helvetica.ttf
Impact.otf
Old_Fonts
Verdana.ttf
dir_b:
Arial.ttf
Comic_Sans.ttf
Courier_New.ttf
Helvetica.ttf
Impact.otf
Tahoma.ttf
Verdana.ttf
dir_c:
Arial.ttf
Courier_New.ttf
Helvetica.ttf
Impact.otf
Monaco.ttf
Verdana.ttf
Now I iterate over the directories provided in the command line and read their contents while building a data hash with the value 1 for each pair file-directory after flagging files that are also directories by appending a slash. I ignore files associated with all directories. For the rest, I output a blank field or the filename for each directory where it appears. I print the output in a format that may be interpreted as an org-mode table and formatted by the Emacs editor.
perl -E 'for(@ARGV){ opendir $g, $_; while($n=readdir $g){ $n.="/" if -d "$_/$n"; $h{$n}{$_}=1;}}
say join "|", "", @ARGV, ""; say "|-"; for(sort keys %h){ next if (keys %{$h{$_}}==@ARGV);
print "|"; foreach $d(@ARGV){print $h{$_}{$d}?"$_|":"|";} say "";}' dir_a dir_b dir_c
Results:
| dir_a | dir_b | dir_c |
|----------------+-----------------+-----------------|
| Comic_Sans.ttf | Comic_Sans.ttf | |
| | Courier_New.ttf | Courier_New.ttf |
| Georgia.ttf | | |
| | | Monaco.ttf |
| Old_Fonts/ | | |
| | Tahoma.ttf | |
The full commented version is:
1 # Perl weekly challenge 166
2 # Task 2: K-directory diff
3 #
4 # See https://wlmb.github.io/2022/05/25/PWC166/#task-2-k-directory-diff
5 use v5.12;
6 use warnings;
7 use autodie; # so I don't have to check for failures
8 use List::Util qw(uniq);
9
10 die "Usage: ./ch-2.pl a [b [c ..]]\nto compare directories a b..." unless @ARGV;
11 my %present;
12 # Prepare data
13 foreach(@ARGV){ # iterate over provided directories
14 opendir(my $dir_handle, $_);
15 while(my $file_name=readdir $dir_handle){ # iterate over directory content
16 $file_name.="/" if -d "$_/$file_name"; # flag file if it is a nested directory
17 $present{$file_name}{$_}=1; # $file_name is present in directory $_
18 }
19 }
20 # Output results
21 say join "|", "", @ARGV, ""; # output row of directories
22 say "|-"; # separator line
23 foreach (sort keys %present){
24 next if (keys %{$present{$_}}==uniq @ARGV); # skip files present everywhere
25 print "| "; # start a row
26 foreach my $directory(@ARGV){
27 print $present{$_}{$directory} ? "$_ |" : " |"; # filename if present, blank if not
28 }
29 say "";
30 }
Example:
./ch-2.pl dir_a dir_b dir_c
Results (after automatic formatting in Emacs, which I’m using to write this entry) :
| dir_a | dir_b | dir_c |
|----------------+-----------------+-----------------|
| Comic_Sans.ttf | Comic_Sans.ttf | |
| | Courier_New.ttf | Courier_New.ttf |
| Georgia.ttf | | |
| | | Monaco.ttf |
| Old_Fonts/ | | |
| | Tahoma.ttf | |
Example with only one directory:
./ch-2.pl dir_a
Results:
| dir_a |
|-------|
| |
As expected, there is no output.
Example with only repeated directories:
./ch-2.pl dir_a dir_a dir_a
Results:
| dir_a | dir_a | dir_a |
|-------+-------+-------|
| | | |
As expected, in this case the results are also empty. Notice
that the program would have failed had I not used the unique
function from the List::Util package in line 24, as the
number of arguments and the cardinality of the set of
directory names may differ.
Written on May 25, 2022