# Grouping words by their differences

I'm a new guy here and I face a problem. I should pair the following words according to the rule: pair the words, that differ by max. 2 characters, like:

{chocolate, chocolates, thocolates} or {fox, nox, box}:

The list to apply this rule to is:

horse, horses, morse, morses, norse, norses, fox, monses, goose, tool, goal, tools, gothe


I had an idea with EditDistance, but I can compare the words with only using a sample (e.g. comparing fox with the other words), but it seemed not good...

One more thing: one word can appear not only once in the list, beceause one word can differ from more than one word...

• Uh, one other thing, that on the list max 2 are being paired, like chocolates, thocolates or nox, box Commented Nov 21, 2015 at 17:25
• It seems we have 3 interpretations, could you say who has understood you well?
– Kuba
Commented Nov 21, 2015 at 19:12
• If you only need the pairs of such words you can directly Select them Select[Tuples[words, 2], EditDistance[#[[1]], #[[2]]] <= 2 &] Commented Nov 23, 2015 at 17:46

words = {"horse", "horses", "morse", "morses", "norse", "norses",
"fox", "monses", "goose", "tool", "goal", "tools", "gothe"}


I'm not very experienced with Graphs so any advice, how to make it shorter, is welcome.

adjacencyMatrix = Outer[
Boole@LessEqual[1, #, 2] &@*EditDistance,
words,
words
];



Edit:

So we have 3 interpretations, let's deal with them all.

1. Subsets of words where all elements are at most 2 EditDistance from each other:

cliques = FindClique[ adjacencyGraph, Infinity, All ]

{{"horse", "horses", "morse", "morses", "norse", "norses"},
{"horses", "morse", "morses", "norses", "monses"},
{"horse", "morse", "norse", "goose"},
{"goose", "gothe"},
{"tool", "tools"},
{"tool", "goal"},
{"fox"}}

2. Pairs of words that differ at most 2 EditDistance from each other:

List @@@ EdgeList@adjacencyGraph

{{"horse", "horses"}, {"horse", "morse"}, {"horse", "morses"},
{"horse", "norse"}, {"horse", "norses"}, {"horse", "goose"},
{"horses", "morse"}, {"horses", "morses"}, {"horses", "norse"},
{"horses", "norses"}, {"horses", "monses"}, {"morse", "morses"},
{"morse", "norse"}, {"morse", "norses"}, {"morse", "monses"},
{"morse", "goose"}, {"morses", "norse"}, {"morses", "norses"},
{"morses", "monses"}, {"norse", "norses"}, {"norse", "goose"},
{"norses", "monses"}, {"goose", "gothe"}, {"tool", "goal"},
{"tool", "tools"}}

3. Subsets of words where all elements differ from given word by at most 2 EditDistance:

# -> VertexComponent[adjacencyGraph, #, 1] & /@ VertexList[adjacencyGraph]

{"horse" -> {"horse", "horses", "morse", "morses", "norse", "norses",
"goose"},
"horses" -> {"horses", "horse", "morse", "morses", "norse", "norses",
"monses"},
"morse" -> {"morse", "horse", "horses", "morses", "norse", "norses",
"monses", "goose"},
"morses" -> {"morses", "horse", "horses", "morse", "norse", "norses",
"monses"},
"norse" -> {"norse", "horse", "horses", "morse", "morses", "norses",
"goose"},
"norses" -> {"norses", "horse", "horses", "morse", "morses", "norse",
"monses"}, "fox" -> {"fox"},
"monses" -> {"monses", "horses", "morse", "morses", "norses"},
"goose" -> {"goose", "horse", "morse", "norse", "gothe"},
"tool" -> {"tool", "goal", "tools"}, "goal" -> {"goal", "tool"},
"tools" -> {"tools", "tool"}, "gothe" -> {"gothe", "goose"}}

selector[str_String] :=
GroupBy[list, EditDistance[str, #] <= 2 &][True] /.
str -> Style[str, Red, Bold]

list = {"horse", "horses", "morse", "morses", "norse", "norses",
"fox", "monses", "goose", "tool", "goal", "tools", "gothe"};

selector /@ list


Alternatively,

selector2[str_String] :=
Thread[str -> GroupBy[list, 0 < EditDistance[str, #] <= 2 &][True]]

Flatten[selector2 /@ list] /. Missing[__] :> {}

(*  {"horse" -> "horses", "horse" -> "morse", "horse" -> "morses",
"horse" -> "norse", "horse" -> "norses", "horse" -> "goose",
"horses" -> "horse", "horses" -> "morse", "horses" -> "morses",
"horses" -> "norse", "horses" -> "norses", "horses" -> "monses",
"morse" -> "horse", "morse" -> "horses", "morse" -> "morses",
"morse" -> "norse", "morse" -> "norses", "morse" -> "monses",
"morse" -> "goose", "morses" -> "horse", "morses" -> "horses",
"morses" -> "morse", "morses" -> "norse", "morses" -> "norses",
"morses" -> "monses", "norse" -> "horse", "norse" -> "horses",
"norse" -> "morse", "norse" -> "morses", "norse" -> "norses",
"norse" -> "goose", "norses" -> "horse", "norses" -> "horses",
"norses" -> "morse", "norses" -> "morses", "norses" -> "norse",
"norses" -> "monses", "fox" -> {}, "monses" -> "horses", "monses" -> "morse",
"monses" -> "morses", "monses" -> "norses", "goose" -> "horse",
"goose" -> "morse", "goose" -> "norse", "goose" -> "gothe", "tool" -> "goal",
"tool" -> "tools", "goal" -> "tool", "tools" -> "tool", "gothe" -> "goose"}  *)

• @Kuba - I am confused by the wording of the question; however, my approach groups all words within EditDistance of 2 from the base (Red) word. Each word is taken as the starting base. Commented Nov 21, 2015 at 18:48
• My bad, I even changed the wording in my edit. I would think that @Kuba is right, because the originator also wondered about having to compare with one word only.
– gwr
Commented Nov 21, 2015 at 19:13
list =
{"horse", "horses", "morse", "morses", "norse", "norses",
"fox", "monses", "goose", "tool", "goal", "tools", "gothe"};

char = Characters /@ Subsets[list, {2}];

rev = Reverse /@ (SortBy[#, Length] & /@ char);

com = Complement @@@ rev;

pos = Position[com, a_List /; Length@a <= 2];

Map[StringJoin, Extract[rev, pos], {2}] // Sort // TableForm


• I'd say that fox and tool differ by 3 characters. p.s. you have a typo aster pos line.
– Kuba
Commented Nov 23, 2015 at 8:27
• Good point - I was thinking fox - o = fx = 2 chars difference. But with this logic all one and two letter words would qualify.
– eldo
Commented Nov 23, 2015 at 11:41