6
$\begingroup$

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...

Thanks your help!


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

$\endgroup$
  • $\begingroup$ Uh, one other thing, that on the list max 2 are being paired, like chocolates, thocolates or nox, box $\endgroup$ – lewen Nov 21 '15 at 17:25
  • $\begingroup$ It seems we have 3 interpretations, could you say who has understood you well? $\endgroup$ – Kuba Nov 21 '15 at 19:12
  • $\begingroup$ If you only need the pairs of such words you can directly Select them Select[Tuples[words, 2], EditDistance[#[[1]], #[[2]]] <= 2 &] $\endgroup$ – mgamer Nov 23 '15 at 17:46
6
$\begingroup$
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
];

adjacencyGraph = AdjacencyGraph[words, adjacencyMatrix];

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"}}
$\endgroup$
4
$\begingroup$
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

enter image description here

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"}  *)
$\endgroup$
  • $\begingroup$ @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. $\endgroup$ – Bob Hanlon Nov 21 '15 at 18:48
  • $\begingroup$ 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. $\endgroup$ – gwr Nov 21 '15 at 19:13
2
$\begingroup$
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

enter image description here

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

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.