5
$\begingroup$

I want a function f that takes a word (like those listed in WordList[]) and returns a pattern best described by examples like these: f[“book”]=abbc; f[“settings”]=abccdefa; and f[“moving”]=abcdef.

Then I want a second function, f2, that searches a list of words for words that have the same pattern, returning a list of them; for example f2[WordList[],abcdefabgd]={liberalize, roisterous, stochastic}

The motive is to write a program that solves substitution ciphers, but could have other uses too!

$\endgroup$
  • $\begingroup$ Can you explain what you are looking for? What is the logic behind "book" equalling abba? $\endgroup$ – bill s Feb 23 '17 at 20:03
  • $\begingroup$ @bills probably book -> abbc ? $\endgroup$ – yarchik Feb 23 '17 at 20:09
  • $\begingroup$ yes, sorry for the typo; book->abbc $\endgroup$ – donsiano Feb 23 '17 at 20:37
5
$\begingroup$

You can split the string and turn it into a pattern like this:

makePattern[word_String] := StringExpression @@ Map[
  With[{s = Symbol @ #}, Pattern[s, Blank[]]] &,
  Characters[word]];

findMatches[word_String, list_List : WordList[]] := 
  Select[list, StringMatchQ[makePattern @ word]];

Which gives you

findMatches @ "settings"

{"diffused", "golliwog", "greening", "greeting", "grooming", "grooving", "guzzling", "littoral", "rollover", "succubus", "suppress", "syllabus"}

$\endgroup$
3
$\begingroup$
f1 = "" <> Alphabet[][[ArrayComponents @ Characters @ #]] &;

f2 = GroupBy[f1];

Use:

f1 /@ {"book", "settings", "moving"}
{"abbc", "abccdefa", "abcdef"}
allwords = DictionaryLookup[];

find = f2[allwords];  (* cache lookup table for all patterns *)

find["abcdefabgd"]
{"liberalize", "stochastic"}

(I don't have WordList in v10.1.0 so I substituted DictionaryLookup.)

Although it is much better to cache find as shown above this works without f2:

DictionaryLookup[x__ /; f1[x] === "abcdefabgd"]
{"liberalize", "stochastic"}

Performance

Although it should not matter if you only build find once as shown, ArrayComponents proves to be a bottleneck in my f1 code. Here is a more verbose equivalent that is an order of magnitude faster, should it matter.

f1fast =
  With[{cc = ToCharacterCode @ #},
    cc
      // DeleteDuplicates
      // AssociationThread[# -> Take[Alphabet[], Length@#]] &
      // Lookup[cc]
      // StringJoin
  ] &;
$\endgroup$
2
$\begingroup$

Here's a slightly more robust variation of mvonh's fine answer which uses Unique to ensure that the symbols used to mark patterns don't collide with variables that have values.

makePattern[word_String] :=
 With[{chars = Characters@word},
  Apply[
   StringExpression, 
   chars /. 
    AssociationMap[With[{s = Unique@#}, Pattern[s, Blank[]]] &, 
     DeleteDuplicates@chars]]];
$\endgroup$
2
$\begingroup$

Define a function to code the words:

code[word_] := Module[{},
  split = Characters[word];
  numLetters = Length@Tally[split];
  subs = Thread[Tally[split][[All, 1]] -> Range[numLetters]];
  subs2 = Thread[Range[numLetters] -> CharacterRange["a", "z"][[1 ;; numLetters]]];
  StringJoin[split /. subs /. subs2]]

So for example

code["abandonment"]
"abacdecfgch"

Then we can search the dictionary using Nearest with a custom distance function:

dist[w1_, w2_] := EditDistance[code[w1], code[w2]];

allWords = WordList[];
Nearest[allWords, "abandonment", 5, DistanceFunction -> dist]   

{"abandonment", "analogously", "condensing", "consenting", "nonadjacent"}

Showing that these are the 5 nearest words to "abandonment" using the code notion of distance. Or, if you want only those that have exactly the same form,

Select[WordList[], code[#] == code["settings"] &]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.