RosettaCodeData/Task/Word-ladder/Mathematica/word-ladder.math
2026-02-01 16:33:20 -08:00

14 lines
773 B
Text

words = ReadList["unixdict.txt", Word];
wordLadder[words_, start_, target_] := Module[{wordSelection, graph, path, noSolution = "impossible"},
If[StringLength[start] != StringLength[target], Return[noSolution]];
wordSelection = Select[words, StringLength[#] == StringLength[start]&];
graph = UndirectedEdge @@@ Select[Subsets[wordSelection, {2}], HammingDistance @@ # == 1 &];
If[! SubsetQ[VertexList[graph], {start, target}], Return[noSolution]];
path = FindShortestPath[graph, start, target];
If[path == {}, Return[noSolution]];
path];
tests = {{"boy", "man"}, {"girl", "lady"}, {"john", "jane"}, {"child", "adult"}};
Map[{#[[1]] <> " -> " <> #[[2]] <> ": ", wordLadder[words, #[[1]], #[[2]]]}&, tests] //
TableForm[#, TableDepth -> 2]&