4
$\begingroup$

Cross post here


A word path means the last character of the last word is same to the first character of the next word.And the path have no duplicated word.If I have $55$ words,I can find it with this method.

Build a graph

SeedRandom[2]
string = Select[ToLowerCase[RandomSample[DictionaryLookup[]]], 
   3 < StringLength[#] < 5 &];
g = RelationGraph[StringTake[#, -1] == StringTake[#2, 1] &, 
  string[[;; 55]], VertexLabels -> "Name"]

Mathematica graphics

Find a longest word path by Jason's answer here

allPaths = 
  FindPath[g, #2, #1, Infinity, All] & @@@ 
    Subsets[VertexList[g], {2}] // Apply[Join];
First[TakeLargestBy[allPaths, Length@Union@# &, 1]]

{calm,muir,reef,fray,yaws,seed,deaf,fnma,axis,stow,waft,tint,trig,good,duns,sill,loge,etch,hill,lath,howl}

Well I have to say this is a very very slow solution.I even cannot find more than $60$ words.Actually I want to find Length[DictionaryLookup[]]=92518 words. It seem I still have a long way to go.Do any suggestion can give?

$\endgroup$
  • $\begingroup$ This is probably obvious, but in order to be precise I am going to ask anyway -- I assume the path does not have loops (cannot intersect itself)? $\endgroup$ – Anton Antonov Jun 1 '17 at 19:18
  • $\begingroup$ @AntonAntonov Yes,the expected path have no loops. $\endgroup$ – yode Jun 1 '17 at 19:42
  • $\begingroup$ One solution is to use a branch-and-bound algorithm design. At each step (branching node) we look at smaller sub-graphs and have heuristics for selecting the sub-graphs that would be more likely to produce longer paths. $\endgroup$ – Anton Antonov Jun 2 '17 at 14:08
  • $\begingroup$ While the final path will not have loops, the complete graph is cyclical. Look up the "Approximation" section here: en.wikipedia.org/wiki/Longest_path_problem I think the best solution will not only use graph theory, but will also use the understanding of the language and problem itself. E.g. some letters have an extremely low probability of survivorship, others have much higher. Many words begin and end with the same letters, which means that your question is guaranteed to have multiple answers as those words get interchanged. $\endgroup$ – Gregory Klopper Jun 15 '17 at 15:04
  • $\begingroup$ @GregoryKlopper Thanks.And I just want to find "a" longest path(though the longest path have many interchanged case maybe.) $\endgroup$ – yode Jun 15 '17 at 16:40
2
$\begingroup$

Still slow, but you can get some speeding up by eliminating some path findings:

SeedRandom[2]
string = Select[ToLowerCase[RandomSample[DictionaryLookup[]]], 
   3 < StringLength[#] < 5 &];
g = RelationGraph[StringTake[#, -1] == StringTake[#2, 1] &, 
   string[[;; 57]], VertexLabels -> "Name"];

(clength = Max[DeleteCases[Flatten[GraphDistanceMatrix[g]], Infinity]];
  (
     spath = FindShortestPath[g, #2, #1];
     slength = Length[spath];
     If[slength > 0,
      clength = Max[clength, slength];
      paths = FindPath[g, #2, #1, {clength, Infinity}, All]; 
      If[Length[paths] > 0, 
       path = First[TakeLargestBy[paths, Length@Union@# &, 1]]; 
       clength = Length[path]]
      ]) & @@@ Subsets[VertexList[g], {2}]; {clength, 
   path}) // AbsoluteTiming

{1.53982, {23, {"calm", "muir", "reef", "fray", "yaws", "seed",
"deaf", "fnma", "axis", "sill", "loge", "eyed", "duns", "stow",
"wart", "tint", "trig", "good", "dune", "etch", "hill", "lath",
"howl"}}}

(allPaths = 
   FindPath[g, #2, #1, Infinity, All] & @@@ 
     Subsets[VertexList[g], {2}] // Apply[Join];
  First[TakeLargestBy[allPaths, Length@Union@# &, 
    1]]) // AbsoluteTiming

{21.6151, {"calm", "muir", "reef", "fray", "yaws", "seed", "deaf",
"fnma", "axis", "sill", "loge", "eyed", "duns", "stow", "wart",
"tint", "trig", "good", "dune", "etch", "hill", "lath", "howl"}}

and another heuristic approach:

pseudoorder = 
  VertexList[
    g][[Ordering[
     Last /@ GraphEmbedding[g, "LayeredDigraphEmbedding"]]]];

MaximalBy[
  FindPath[g, Last[pseudoorder], #, Infinity, All][[-1]] & /@ 
   Take[pseudoorder, 3], Length] // First
$\endgroup$
  • $\begingroup$ Though I have upvoted it.But it seem there is a long way to go.. $\endgroup$ – yode Jun 1 '17 at 18:26
2
$\begingroup$

This is really a comment and suggestion, but too long to put in a comment format (so please don't down-vote this).


I would speed the search by grouping words into the $26 \cdot 26$ classes that have the same first and last letters, i.e., $a..a$, $a..b$, $a..c$, $a..z$, $b..a$, $b..b$, $b..d$, etc. $z..z$.

Then notice the 26 groups that begin and end with the same letter, e.g.,

$\{ "alba", "arena", ... \}$, $\{ "barb", "bib", ...\}$, etc. If any words in these sets appear in the longest chain, then all do, linked together like a chain, and their order is irrelevant. Thus eliminate all but one word in each set, which remains as a "representative" word. Later, you can insert the full chain for the set for the representative in your final search results.

Consider the remaining classes, e.g., words beginning with "c" and ending with "t" (e.g., $\{ "cat", "cot", carrot", ...\}$. Naive search tries to find a path through each word, but they are all functionally equivalent. Thus force the search to use the words in a given order (e.g., alphabetical). That will cut down your search by several orders of magnitude in time.

A large part of the computational problem is searching paths through "equivalent" words, i.e., those having the same first and last letters, such as "cat" and "cut". The best approach, then, is to employ a dual representation: create a multi-graph with just 26 nodes, "a", "b", ... "z", representing the linking of words. Then each word is now represented by a link or edge, so "cat" would be a directed edge between the $c$ vertex and $a$ vertex. Now in this much smaller directed multi-graph, you search for the longest path. Once you have it you can insert whichever of the "equivalent" words you like in the links in that longest path. This represents a combinatorial speedup.

A teeny speedup: I would also ensure the graph has no self loops (words linking to themselves) before searching.

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