Word ladder: Difference between revisions
Content deleted Content added
SqrtNegInf (talk | contribs) →{{header|Perl}}: translation of the translation |
Not a robot (talk | contribs) Add APL |
||
(21 intermediate revisions by 11 users not shown) | |||
Line 2:
Yet another shortest path problem. Given two words of equal length the task is to transpose the first into the second.
Only one letter may be changed at a time and the change must result in a word in [http://wiki.puzzlers.org/pub/wordlists/unixdict.txt unixdict], the minimum number of intermediate words should be used.
Demonstrate the following:
Line 10:
With a little more difficulty a girl can be made into a lady: girl -> gill -> gall -> gale -> gaze -> laze -> lazy -> lady
A child can not be turned into an adult.
Line 20:
<br><br>
=={{header|11l}}==
{{trans|Nim}}
<syntaxhighlight lang="11l">F isOneAway(word1, word2)
V result = 0B
L(i) 0 .< word1.len
I word1[i] != word2[i]
I result
R 0B
E
result = 1B
R result
DefaultDict[Int, [String]] words
L(word) File(‘unixdict.txt’).read().split("\n")
words[word.len] [+]= word
F find_path(start, target)
V lg = start.len
assert(target.len == lg, ‘Source and destination must have same length.’)
assert(start C :words[lg], ‘Source must exist in the dictionary.’)
assert(target C :words[lg], ‘Destination must exist in the dictionary.’)
V currPaths = [[start]]
V pool = copy(:words[lg])
L
[[String]] newPaths
[String] added
L(candidate) pool
L(path) currPaths
I isOneAway(candidate, path.last)
V newPath = path [+] [candidate]
I candidate == target
R newPath
E
newPaths.append(newPath)
added.append(candidate)
L.break
I newPaths.empty
L.break
currPaths = move(newPaths)
L(w) added
pool.remove(w)
R [String]()
L(start, target) [(‘boy’, ‘man’), (‘girl’, ‘lady’), (‘john’, ‘jane’), (‘child’, ‘adult’), (‘cat’, ‘dog’), (‘lead’, ‘gold’), (‘white’, ‘black’), (‘bubble’, ‘tickle’)]
V path = find_path(start, target)
I path.empty
print(‘No path from "’start‘" to "’target‘".’)
E
print(path.join(‘ -> ’))</syntaxhighlight>
{{out}}
<pre>
boy -> bay -> ban -> man
girl -> gill -> gall -> gale -> gaze -> laze -> lazy -> lady
john -> cohn -> conn -> cone -> cane -> jane
No path from "child" to "adult".
cat -> cot -> cog -> dog
lead -> load -> goad -> gold
white -> whine -> chine -> chink -> clink -> blink -> blank -> black
bubble -> babble -> gabble -> garble -> gargle -> gaggle -> giggle -> jiggle -> jingle -> tingle -> tinkle -> tickle
</pre>
=={{header|Ada}}==
Changed my solution to use Multiway_Trees.
<syntaxhighlight lang="ada">
pragma Ada_2022;
with Ada.Containers.Multiway_Trees;
with Ada.Containers.Vectors;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Text_IO.Unbounded_IO; use Ada.Text_IO.Unbounded_IO;
procedure Word_Ladder is
DICT_FILENAME : constant String := "unixdict.txt";
MAX_DEPTH : constant Positive := 50;
subtype LC_Chars is Character range 'a' .. 'z';
type Word_Node_T is record
Level : Positive;
Word : Unbounded_String;
end record;
package Word_Vectors is new Ada.Containers.Vectors (Positive, Unbounded_String);
package Dict_Vectors is new Ada.Containers.Vectors (Positive, Unbounded_String);
package Word_Trees is new Ada.Containers.Multiway_Trees (Word_Node_T);
use Word_Trees;
Word_Tree : Tree;
Solved : Boolean;
Solution : Cursor;
function Load_Candidate_Words (Dict_Filename : String; Word_Len : Positive)
return Dict_Vectors.Vector is
Dict_File : File_Type;
Read_Word : Unbounded_String;
Cands : Dict_Vectors.Vector;
Valid : Boolean;
C : Character;
begin
Open (File => Dict_File, Mode => In_File, Name => Dict_Filename);
while not End_Of_File (Dict_File) loop
Read_Word := Get_Line (Dict_File);
if Length (Read_Word) = Word_Len then
Valid := True;
for Ix in 1 .. Word_Len loop
C := Element (Read_Word, Ix);
Valid := C in LC_Chars;
exit when not Valid;
end loop;
if Valid then Cands.Append (Read_Word); end if;
end if;
end loop;
Close (Dict_File);
return Cands;
end Load_Candidate_Words;
function Mutate (Word : Unbounded_String; Dict : in out Dict_Vectors.Vector)
return Word_Vectors.Vector is
Mutations : Word_Vectors.Vector;
Poss_Word : Unbounded_String;
begin
for Ix in 1 .. Length (Word) loop
for Letter in LC_Chars loop
if Letter /= Element (Word, Ix) then
Poss_Word := Word;
Replace_Element (Poss_Word, Ix, Letter);
if Dict.Contains (Poss_Word) then
Mutations.Append (Poss_Word);
Dict.Delete (Dict.Find_Index (Poss_Word));
end if;
end if;
end loop;
end loop;
return Mutations;
end Mutate;
procedure Recurse_Tree (Start_Pos : Cursor;
Level : Positive;
Target : Unbounded_String;
Dict : in out Dict_Vectors.Vector) is
Pos : Cursor := Start_Pos;
Mutations : Word_Vectors.Vector;
New_Node : Word_Node_T;
begin
while not Solved and then Pos /= No_Element loop
if Element (Pos).Level = Level then
Mutations := Mutate (Element (Pos).Word, Dict);
if not Word_Vectors.Is_Empty (Mutations) then
for Word of Mutations loop
New_Node.Level := Level + 1;
New_Node.Word := Word;
Append_Child (Word_Tree, Pos, New_Node);
if Word = Target then
Solved := True;
Solution := Pos;
end if;
end loop;
end if;
end if;
if not Solved then
Recurse_Tree (First_Child (Pos), Level, Target, Dict);
end if;
Pos := Next_Sibling (Pos);
end loop;
end Recurse_Tree;
procedure Ladder (Start_S, Target_S : String) is
Dictionary : Dict_Vectors.Vector;
Level : Positive := 1;
Word_Node : Word_Node_T;
Start, Target : Unbounded_String;
Start_Pos : Cursor;
Output : Unbounded_String;
begin
if Start_S'Length /= Target_S'Length then
Put_Line ("ERROR: Start and Target words must be same length.");
return;
end if;
Dictionary := Load_Candidate_Words (DICT_FILENAME, Start_S'Length);
Start := To_Unbounded_String (Start_S);
Target := To_Unbounded_String (Target_S);
Solved := False;
Word_Node.Level := 1;
Word_Node.Word := Start;
Word_Tree := Empty_Tree;
Word_Tree.Insert_Child (Word_Tree.Root, No_Element, Word_Node);
Start_Pos := Find (Word_Tree, Word_Node);
while Level <= MAX_DEPTH and then not Solved loop
Recurse_Tree (Start_Pos, Level, Target, Dictionary);
Level := @ + 1;
end loop;
if not Solved then
Put_Line (Start & " -> " & Target & " - No solution found at depth" & MAX_DEPTH'Image);
else
while not Is_Root (Solution) loop
Word_Node := Element (Solution);
Output := Word_Node.Word & " -> " & Output;
Solution := Parent (Solution);
end loop;
Put_Line (Output & Target);
end if;
end Ladder;
begin
Ladder ("boy", "man");
Ladder ("girl", "lady");
Ladder ("jane", "john");
Ladder ("child", "adult");
Ladder ("ada", "god");
Ladder ("rust", "hell");
end Word_Ladder;
</syntaxhighlight>
{{out}}
As expected "ada" can become a "god", and "rust" can go to "hell" :-)
<pre>
boy -> bay -> may -> man
girl -> gill -> gall -> gale -> gaze -> laze -> lazy -> lady
jane -> cane -> cone -> conn -> cohn -> john
child -> adult - No solution found at depth 50
ada -> fda -> faa -> fad -> gad -> god
rust -> bust -> best -> belt -> bell -> hell
</pre>
=={{header|ALGOL 68}}==
With ''a68g'' use option <code>--storage 2</code>, otherwise it runs out of memory.
<syntaxhighlight lang="algol68"># quick implementation of a stack of INT.
real program starts after it.
#
MODE STACK = STRUCT (INT top, FLEX[1:0]INT data, INT increment);
PROC makestack = (INT increment)STACK: (1, (), increment);
PROC pop = (REF STACK s)INT: ( top OF s -:= 1; (data OF s)[top OF s] );
PROC push = (REF STACK s, INT n)VOID:
BEGIN
IF top OF s > UPB data OF s THEN
[ UPB data OF s + increment OF s ]INT tmp;
tmp[1 : UPB data OF s] := data OF s;
data OF s := tmp
FI;
(data OF s)[top OF s] := n;
top OF s +:= 1
END;
PROC empty = (REF STACK s)BOOL: top OF s <= 1;
PROC contents = (REF STACK s)[]INT: (data OF s)[:top OF s - 1];
# start solution #
[]STRING words = BEGIN # load dictionary file into array #
FILE f;
BOOL eof := FALSE;
open(f, "unixdict.txt", stand in channel);
on logical file end(f, (REF FILE f)BOOL: eof := TRUE);
INT idx := 1;
FLEX [1:0] STRING words;
STRING word;
WHILE NOT eof DO
get(f, (word, newline));
IF idx > UPB words THEN
HEAP [1 : UPB words + 10000]STRING tmp;
tmp[1 : UPB words] := words;
words := tmp
FI;
words[idx] := word;
idx +:= 1
OD;
words[1:idx-1]
END;
INT nwords = UPB words;
INT max word length = (INT mwl := 0;
FOR i TO UPB words DO
IF mwl < UPB words[i] THEN mwl := UPB words[i] FI
OD;
mwl);
[nwords]FLEX[0]INT neighbors;
[max word length]BOOL precalculated by length;
FOR i TO UPB precalculated by length DO precalculated by length[i] := FALSE OD;
# precalculating neighbours takes time, but not doing it is even slower... #
PROC precalculate neighbors = (INT word length)VOID:
BEGIN
[nwords]REF STACK stacks;
FOR i TO UPB stacks DO stacks[i] := NIL OD;
FOR i TO UPB words DO
IF UPB words[i] = word length THEN
IF REF STACK(stacks[i]) :=: NIL THEN stacks[i] := HEAP STACK := makestack(10) FI;
FOR j FROM i + 1 TO UPB words DO
IF UPB words[j] = word length THEN
IF neighboring(words[i], words[j]) THEN
push(stacks[i], j);
IF REF STACK(stacks[j]) :=: NIL THEN stacks[j] := HEAP STACK := makestack(10) FI;
push(stacks[j], i)
FI
FI
OD
FI
OD;
FOR i TO UPB neighbors DO
IF REF STACK(stacks[i]) :/=: NIL THEN
neighbors[i] := contents(stacks[i])
FI
OD;
precalculated by length [word length] := TRUE
END;
PROC neighboring = (STRING a, b)BOOL: # do a & b differ in just 1 char? #
BEGIN
INT diff := 0;
FOR i TO UPB a DO IF a[i] /= b[i] THEN diff +:= 1 FI OD;
diff = 1
END;
PROC word ladder = (STRING from, STRING to)[]STRING:
BEGIN
IF UPB from /= UPB to THEN fail FI;
INT word length = UPB from;
IF word length < 1 OR word length > max word length THEN fail FI;
IF from = to THEN fail FI;
INT start := 0;
INT destination := 0;
FOR i TO UPB words DO
IF UPB words[i] = word length THEN
IF words[i] = from THEN start := i
ELIF words[i] = to THEN destination := i
FI
FI
OD;
IF destination = 0 OR start = 0 THEN fail FI;
IF NOT precalculated by length [word length] THEN
precalculate neighbors(word length)
FI;
STACK stack := makestack(1000);
[nwords]INT distance;
[nwords]INT previous;
FOR i TO nwords DO distance[i] := nwords+1; previous[i] := 0 OD;
INT shortest := nwords+1;
distance[start] := 0;
push(stack, start);
WHILE NOT empty(stack)
DO
INT curr := pop(stack);
INT dist := distance[curr];
IF dist < shortest - 1 THEN
# find neighbors and add them to the stack #
FOR i FROM UPB neighbors[curr] BY -1 TO 1 DO
INT n = neighbors[curr][i];
IF distance[n] > dist + 1 THEN
distance[n] := dist + 1;
previous[n] := curr;
IF n = destination THEN
shortest := dist + 1
ELSE
push(stack, n)
FI
FI
OD;
IF curr = destination THEN shortest := dist FI
FI
OD;
INT length = distance[destination] + 1;
IF length > nwords THEN fail FI;
[length]STRING result;
INT curr := destination;
FOR i FROM length BY -1 TO 1
DO
result[i] := words[curr];
curr := previous[curr]
OD;
result EXIT
fail: LOC [0] STRING
END;
[][]STRING pairs = (("boy", "man"), ("bed", "cot"),
("old", "new"), ("dry", "wet"),
("girl", "lady"), ("john", "jane"),
("lead", "gold"), ("poor", "rich"),
("lamb", "stew"), ("kick", "goal"),
("cold", "warm"), ("nude", "clad"),
("child", "adult"), ("white", "black"),
("bread", "toast"), ("lager", "stout"),
("bride", "groom"), ("table", "chair"),
("bubble", "tickle"));
FOR i TO UPB pairs
DO
STRING from = pairs[i][1], to = pairs[i][2];
[]STRING ladder = word ladder(from, to);
IF UPB ladder = 0
THEN print(("No solution for """ + from + """ -> """ + to + """", newline))
ELSE FOR j TO UPB ladder DO print(((j > 1 | "->" | ""), ladder[j])) OD;
print(newline)
FI
OD</syntaxhighlight>
{{out}}
<pre>boy->bay->ban->man
bed->bad->bat->cat->cot
old->odd->ode->one->nne->nee->new
dry->dey->bey->bet->wet
girl->gill->gall->gale->gaze->laze->lazy->lady
john->cohn->conn->cone->cane->jane
lead->load->goad->gold
poor->boor->book->bock->rock->rick->rich
lamb->lame->laue->laud->saud->spud->sped->spew->stew
kick->dick->dock->cock->cook->cool->coal->goal
cold->cord->card->ward->warm
nude->node->bode->bole->bold->gold->goad->glad->clad
No solution for "child" -> "adult"
white->whine->chine->chink->clink->blink->blank->black
bread->break->bleak->bleat->blest->blast->boast->toast
lager->hager->hagen->haven->raven->ravel->navel->novel->hovel->hotel->motel->monel->money->honey->haney->handy->dandy->danny->denny->penny->peony->phony->phone->shone->shore->short->shout->stout
bride->brice->brick->brock->brook->broom->groom
No solution for "table" -> "chair"
bubble->babble->gabble->garble->gargle->gaggle->giggle->jiggle->jingle->tingle->tinkle->tickle</pre>
=={{header|APL}}==
{{works with|Dyalog APL}}
<syntaxhighlight lang="apl">wordladder←{
from to←⍵
dict←((≢¨⍺)=≢to)/⍺
dict{
match←(⊂to)≡¨⊃∘⌽¨⍵
∨/match:⊃match/⍵
0∊≢¨⍺⍵:⍬
word←⊃⌽ladder←⊃⍵
next←(1=⍺+.≠¨⊂word)/⍺
(⍺~next)∇(1↓⍵),(⊂ladder),¨⊂¨next
}⊂⊂from
}
task←{
dict←(~dict∊⎕TC)⊆dict←⊃⎕NGET'unixdict.txt'
pairs←('boy' 'man')('girl' 'lady')('john' 'jane')('child' 'adult')
⎕←↑↑{
hdr←⍺,' → ',⍵,': '
ladder←dict wordladder ⍺ ⍵
0=≢ladder:hdr,'impossible'
hdr,1↓∊'→',¨ladder
}/¨pairs
}</syntaxhighlight>
{{out}}
<pre>boy → man: boy→bay→ban→man
girl → lady: girl→gill→gall→gale→gaze→laze→lazy→lady
john → jane: john→cohn→conn→cone→cane→jane
child → adult: impossible </pre>
=={{header|C++}}==
This borrows heavily from [[#Wren|Wren]] and a bit from [[#Raku|Raku]].
<
#include <fstream>
#include <iostream>
Line 59 ⟶ 521:
}
return result;
}
Line 79 ⟶ 535:
auto curr = queue.front();
queue.erase(queue.begin());
for (auto i = poss.begin(); i != poss.end();) {
}
if (
curr.push_back(to);
std::cout << join(curr.begin(), curr.end(), " -> ") << '\n';
return true;
}
std::vector<std::string> temp(curr);
temp.push_back(
queue.push_back(std::move(temp));
i = poss.erase(i);
}
}
Line 124 ⟶ 575:
word_ladder(words, "bubble", "tickle");
return EXIT_SUCCESS;
}</
{{out}}
Line 139 ⟶ 590:
=={{header|F_Sharp|F#}}==
<
// Word ladder: Nigel Galloway. June 5th., 2021
let fG n g=n|>List.partition(fun n->2>Seq.fold2(fun z n g->z+if n=g then 0 else 1) 0 n g)
Line 148 ⟶ 599:
let i,e=fG dict n in match i with Done i->Some([n;g]) |_->wL(i|>List.map(fun g->[g;n])) [] e
[("boy","man");("girl","lady");("john","jane");("child","adult")]|>List.iter(fun(n,g)->printfn "%s" (match wL n g with Some n->n|>String.concat " -> " |_->n+" into "+g+" can't be done"))
</syntaxhighlight>
{{out}}
<pre>
Line 159 ⟶ 610:
The bad news is evil can not be turned into good, but the good news is god can become man.
<
[("evil","good");("god","man")]|>List.iter(fun(n,g)->printfn "%s" (match wL n g with Some n->n|>String.concat " -> " |_->n+" into "+g+" can't be done"))
</syntaxhighlight>
{{out}}
<pre>
Line 170 ⟶ 621:
=={{header|Go}}==
{{trans|Wren}}
<
import (
Line 258 ⟶ 709:
wordLadder(words, pair[0], pair[1])
}
}</
{{out}}
Line 267 ⟶ 718:
child into adult cannot be done.
</pre>
=={{header|Haskell}}==
=== Breadth-first search===
The function first expands a ball around the starting word in the space of possible words, until the ball surface touches the goal (if ever). After that it performs depth-first path-finding from the goal back to the center.
<syntaxhighlight lang="haskell">import System.IO (readFile)
import Control.Monad (foldM)
import Data.List (intercalate)
import qualified Data.Set as S
distance :: String -> String -> Int
distance s1 s2 = length $ filter not $ zipWith (==) s1 s2
wordLadders :: [String] -> String -> String -> [[String]]
wordLadders dict start end
| length start /= length end = []
| otherwise = [wordSpace] >>= expandFrom start >>= shrinkFrom end
where
wordSpace = S.fromList $ filter ((length start ==) . length) dict
expandFrom s = go [[s]]
where
go (h:t) d
| S.null d || S.null f = []
| end `S.member` f = [h:t]
| otherwise = go (S.elems f:h:t) (d S.\\ f)
where
f = foldr (\w -> S.union (S.filter (oneStepAway w) d)) mempty h
shrinkFrom = scanM (filter . oneStepAway)
oneStepAway x = (1 ==) . distance x
scanM f x = fmap snd . foldM g (x,[x])
where g (b, r) a = (\x -> (x, x:r)) <$> f b a
wordLadder :: [String] -> String -> String -> [String]
wordLadder d s e = case wordLadders d s e of
[] -> []
h:_ -> h
showChain [] = putStrLn "No chain"
showChain ch = putStrLn $ intercalate " -> " ch
main = do
dict <- lines <$> readFile "unixdict.txt"
showChain $ wordLadder dict "boy" "man"
showChain $ wordLadder dict "girl" "lady"
showChain $ wordLadder dict "john" "jane"
showChain $ wordLadder dict "alien" "drool"
showChain $ wordLadder dict "child" "adult"</syntaxhighlight>
<pre>λ> lines <$> readFile "unixdict.txt" >>= print . wordLadders "boy" "man"
[["boy","bay","ban","man"],["boy","bon","ban","man"],["boy","bay","may","man"]]
λ> lines <$> readFile "unixdict.txt" >>= print . wordLadders "girl" "lady"
[["girl","gill","gall","gale","gaze","laze","lazy","lady"]]
λ> lines <$> readFile "unixdict.txt" >>= print . wordLadders "child" "adult"
[]
λ> main
boy -> bay -> ban -> man
girl -> gill -> gall -> gale -> gaze -> laze -> lazy -> lady
john -> cohn -> conn -> cone -> cane -> jane
alien -> alden -> alder -> alter -> aster -> ester -> eater -> bater -> bator -> baton -> baron -> boron -> moron -> moran -> moral -> morel -> monel -> money -> monty -> month -> mouth -> south -> sooth -> sloth -> slosh -> slash -> flash -> flask -> flank -> blank -> bland -> blend -> bleed -> breed -> bread -> tread -> triad -> trial -> trill -> drill -> droll -> drool
No chain</pre>
=== Two-sided breadth-first search ===
Performs searching from both ends. This solution is much faster for cases with no chains, and for for short chains. In case of long chains looses its' efficiency.
<syntaxhighlight lang="haskell">wordLadders2 :: String -> String -> [String] -> [[String]]
wordLadders2 start end dict
| length start /= length end = []
| otherwise = pure wordSpace >>= expand start end >>= shrink end
where
wordSpace = S.fromList $ filter ((length start ==) . length) dict
expand s e d = tail . map S.elems <$> go [S.singleton s] [S.singleton e] d
where
go (hs:ts) (he:te) d
| S.null d || S.null fs || S.null fe = []
| not $ S.null f1 = [reverse (f1:te) ++ hs:ts]
| not $ S.null f2 = [reverse (he:te) ++ f2:ts]
| not $ S.null f3 = [reverse (he:te) ++ f3:hs:ts]
| otherwise = go (fs:hs:ts) (fe:he:te) (d S.\\ hs S.\\ he)
where
fs = front hs
fe = front he
f1 = fs `S.intersection` he
f2 = fe `S.intersection` hs
f3 = fs `S.intersection` fe
front = S.foldr (\w -> S.union (S.filter (oneStepAway w) d)) mempty
shrink = scanM (findM . oneStepAway)
oneStepAway x = (1 ==) . distance x
scanM f x = fmap snd . foldM g (x,[x])
where g (b, r) a = (\x -> (x, x:r)) <$> f b a
findM p = msum . map (\x -> if p x then pure x else mzero)</syntaxhighlight>
===Using A*-search===
See [[A*_search_algorithm#Haskell]]
<syntaxhighlight lang="haskell">import AStar (findPath, Graph(..))
import qualified Data.Map as M
distance :: String -> String -> Int
distance s1 s2 = length $ filter not $ zipWith (==) s1 s2
wordLadder :: [String] -> String -> String -> [String]
wordLadder dict start end = findPath g distance start end
where
short_dict = filter ((length start ==) . length) dict
g = Graph $ \w -> M.fromList [ (x, 1)
| x <- short_dict
, distance w x == 1 ]</syntaxhighlight>
<pre>λ> main
boy -> bay -> ban -> man
girl -> gird -> bird -> bard -> lard -> lark -> lack -> lacy -> lady
john -> cohn -> conn -> cone -> cane -> jane
alien -> alden -> alder -> alter -> aster -> ester -> eater -> bater -> bator -> baton -> baron -> boron -> moron -> moran -> moral -> morel -> monel -> money -> monty -> month -> mouth -> south -> sooth -> sloth -> slosh -> slash -> flash -> flask -> flank -> blank -> bland -> blend -> bleed -> breed -> bread -> tread -> triad -> trial -> trill -> drill -> droll -> drool
No chain</pre>
Works much faster when compiled.
=={{header|J}}==
Here we use a double ended breadth first search (starting from each end). This tends to give us several options where they meet in the middle, so we pick a shortest example from those.
<syntaxhighlight lang="j">extend=: {{
j=. {:y
l=. <:{:$m
<y,"1 0 I.l=m+/ .="1 j{m
}}
wlad=: {{
l=. #x assert. l=#y
words=. >(#~ l=#@>) cutLF fread 'unixdict.txt'
ix=. ,:words i.x assert. ix<#words
iy=. ,:words i.y assert. iy<#words
while. -. 1 e. ix e.&, iy do.
if. 0 e. ix,&# iy do. EMPTY return. end.
ix=. ; words extend"1 ix
if. -. 1 e. ix e.&, iy do.
iy=. ; words extend"1 iy
end.
end.
iy=. |."1 iy
r=. ix,&,iy
for_jk.(ix,&#iy)#:I.,ix +./@e."1/ iy do.
ixj=. ({.jk){ix
iyk=. ({:jk){iy
for_c. ixj ([-.-.) iyk do.
path=. (ixj{.~ixj i.c) , iyk}.~ iyk i.c
if. path <&# r do. r=. path end.
end.
end.
}.,' ',.r{words
}}</syntaxhighlight>
Task examples:<syntaxhighlight lang="j"> 'boy' wlad 'man'
boy bay ban man
'girl' wlad 'lady'
girl gill gall gale gaze laze lazy lady
'john' wlad 'jane'
john cohn conn cone cane jane
'child' wlad 'adult'
'cat' wlad 'dog'
cat cot cog dog
'lead' wlad 'gold'
lead load goad gold
'white' wlad 'black'
white whine chine chink clink blink blank black
'bubble' wlad 'tickle'
bubble babble gabble garble gargle gaggle giggle jiggle jingle tingle tinkle tickle</syntaxhighlight>
=={{header|Java}}==
<
import java.nio.file.Files;
import java.nio.file.Path;
Line 362 ⟶ 994:
wordLadder(words, "bubble", "tickle", 12);
}
}</
{{out}}
<pre>boy -> bay -> may -> man
Line 372 ⟶ 1,004:
white -> whine -> chine -> chink -> clink -> blink -> blank -> black
bubble -> babble -> gabble -> garble -> gargle -> gaggle -> waggle -> wangle -> tangle -> tingle -> tinkle -> tickle</pre>
===Faster alternative===
{{trans|C++}}
<syntaxhighlight lang="java">import java.io.*;
import java.util.*;
public class WordLadder {
public static void main(String[] args) {
try {
Map<Integer, List<String>> words = new HashMap<>();
try (BufferedReader reader = new BufferedReader(new FileReader("unixdict.txt"))) {
String line;
while ((line = reader.readLine()) != null)
words.computeIfAbsent(line.length(), k -> new ArrayList<String>()).add(line);
}
wordLadder(words, "boy", "man");
wordLadder(words, "girl", "lady");
wordLadder(words, "john", "jane");
wordLadder(words, "child", "adult");
wordLadder(words, "cat", "dog");
wordLadder(words, "lead", "gold");
wordLadder(words, "white", "black");
wordLadder(words, "bubble", "tickle");
} catch (Exception e) {
e.printStackTrace();
}
}
// Returns true if strings s1 and s2 differ by one character.
private static boolean oneAway(String s1, String s2) {
if (s1.length() != s2.length())
return false;
boolean result = false;
for (int i = 0, n = s1.length(); i != n; ++i) {
if (s1.charAt(i) != s2.charAt(i)) {
if (result)
return false;
result = true;
}
}
return result;
}
// If possible, print the shortest chain of single-character modifications that
// leads from "from" to "to", with each intermediate step being a valid word.
// This is an application of breadth-first search.
private static void wordLadder(Map<Integer, List<String>> words, String from, String to) {
List<String> w = words.get(from.length());
if (w != null) {
Deque<String> poss = new ArrayDeque<>(w);
Deque<String> f = new ArrayDeque<String>();
f.add(from);
Deque<Deque<String>> queue = new ArrayDeque<>();
queue.add(f);
while (!queue.isEmpty()) {
Deque<String> curr = queue.poll();
for (Iterator<String> i = poss.iterator(); i.hasNext(); ) {
String str = i.next();
if (!oneAway(str, curr.getLast()))
continue;
if (to.equals(str)) {
curr.add(to);
System.out.println(String.join(" -> ", curr));
return;
}
Deque<String> temp = new ArrayDeque<>(curr);
temp.add(str);
queue.add(temp);
i.remove();
}
}
}
System.out.printf("%s into %s cannot be done.\n", from, to);
}
}</syntaxhighlight>
{{out}}
<pre>
boy -> bay -> ban -> man
girl -> gill -> gall -> gale -> gaze -> laze -> lazy -> lady
john -> cohn -> conn -> cone -> cane -> jane
child into adult cannot be done.
cat -> cot -> cog -> dog
lead -> load -> goad -> gold
white -> whine -> chine -> chink -> clink -> blink -> blank -> black
bubble -> babble -> gabble -> garble -> gargle -> gaggle -> giggle -> jiggle -> jingle -> tingle -> tinkle -> tickle
</pre>
=={{header|jq}}==
Line 377 ⟶ 1,096:
{{works with|jq}}
'''Works with gojq, the Go implementation of jq'''
<
def words: [inputs]; # one way to read the word list
Line 419 ⟶ 1,138:
words
| pairs as $p
| wordLadder($p[0]; $p[1])</
{{out}}
Line 432 ⟶ 1,151:
=={{header|Julia}}==
<
function targeted_mutations(str::AbstractString, target::AbstractString)
Line 458 ⟶ 1,177:
println("john to jane: ", targeted_mutations("john", "jane"))
println("child to adult: ", targeted_mutations("child", "adult"))
</
<pre>
boy to man: [["boy", "bay", "may", "man"], ["boy", "bay", "ban", "man"], ["boy", "bon", "ban", "man"]]
Line 468 ⟶ 1,187:
=={{header|Mathematica}} / {{header|Wolfram Language}}==
{{incorrect|Mathmatica|The requirement is to find the shortest path other examples do John to Jane with 4 intermediate words. Also an impossible example is required: child to adult.}}
<
sel=Select[Subsets[db,{2}],HammingDistance[#[[1]],#[[2]]]==1&];
g=Graph[db,UndirectedEdge@@@sel];
Line 482 ⟶ 1,201:
sel=Select[Subsets[db,{2}],HammingDistance[#[[1]],#[[2]]]==1&];
g=Graph[db,UndirectedEdge@@@sel];
FindShortestPath[g,"child","adult"]</
{{out}}
<pre>{"boy", "bay", "ban", "man"}
Line 490 ⟶ 1,209:
=={{header|Nim}}==
<
Line 545 ⟶ 1,264:
echo &"No path from “{start}” to “{target}”."
else:
echo path.join(" → ")</
{{out}}
Line 560 ⟶ 1,279:
===Direct translation===
{{trans|C++}}
<
use warnings;
Line 658 ⟶ 1,377:
word_ladder('lead', 'gold');
word_ladder('white', 'black');
word_ladder('bubble', 'tickle');</
{{out}}
<pre>boy -> bay -> ban -> man
Line 670 ⟶ 1,389:
===Idiomatic version===
<b>Exactly</b> the same algorithm, written in a more Perl-ish style. Is this better, or worse? Maybe both. Interestingly, runs 1/
<
use warnings;
use feature 'say';
Line 687 ⟶ 1,406:
sub distance {
my($w1,$w2) = @_;
my $
substr($w1, $_, 1)
return $
}
Line 702 ⟶ 1,421:
say 'Nothing like that in dictionary.' and return unless $dict{length $fw};
my @poss = @{ $dict{length $fw} };
my @queue = [$fw];
while (@queue) {
my $curr_ref = shift @queue;
my $last = $curr_ref->[-1];
my @next;
Line 721 ⟶ 1,440:
}
word_ladder(
Same style output.
=={{header|Phix}}==
<!--<
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">words</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">unix_dict</span><span style="color: #0000FF;">()</span>
Line 755 ⟶ 1,474:
<span style="color: #000000;">word_ladder</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"john"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"jane"</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">word_ladder</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"child"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"adult"</span><span style="color: #0000FF;">)</span>
<!--</
<small>Aside: an initial poss = filter(poss,"out",{a}) might be prudent, but would only prevent a single next:={} step, at about the same cost as the initial filter anyway.</small>
{{out}}
Line 767 ⟶ 1,486:
=={{header|Python}}==
The function ''cache'' is not part of the algorithm but avoid re-download and map re-computing at each re-run.
<
def h ( str,x=9 ):
Line 814 ⟶ 1,533:
for w in ('boy man','girl lady','john jane','alien drool','child adult'):
print( find_path( cache( build_map,load_dico( dico_url )),*w.split()))</
{{out}}
Line 827 ⟶ 1,546:
=={{header|Racket}}==
<
(define *unixdict* (delay (with-input-from-file "../../data/unixdict.txt"
Line 867 ⟶ 1,586:
(Word-ladder "john" "jane")
(Word-ladder "alien" "drool")
(Word-ladder "child" "adult"))</
{{out}}
Line 918 ⟶ 1,637:
=={{header|Raku}}==
<syntaxhighlight lang="raku"
.classify(*.chars)
.map({ .key => .value.Set });
Line 954 ⟶ 1,673:
say word_ladder($from, $to)
// "$from into $to cannot be done";
}</
{{out}}
<pre>
Line 961 ⟶ 1,680:
(john cohn conn cone cane jane)
child into adult cannot be done</pre>
=={{header|Refal}}==
This program needs to be run with <tt>refal -l48</tt> to allocate enough memory for it to run.
<syntaxhighlight lang="refal">$ENTRY Go {
, <ReadFile 1 'unixdict.txt'>: e.Dict
= <DisplayLadder (e.Dict) ('boy') ('man')>
<DisplayLadder (e.Dict) ('girl') ('lady')>
<DisplayLadder (e.Dict) ('john') ('jane')>
<DisplayLadder (e.Dict) ('child') ('adult')>;
};
DisplayLadder {
(e.Dict) (e.From) (e.To),
e.From ' -> ' e.To ': ': e.Header,
<Ladder (e.Dict) (e.From) (e.To)>: {
Impossible = <Prout e.Header 'impossible'>;
Result e.Words = <Prout e.Header <Join ('->') e.Words>>;
};
};
Join {
(e.Join) = ;
(e.Join) (e.Word) = e.Word;
(e.Join) (e.Word) e.Words = e.Word e.Join <Join (e.Join) e.Words>;
};
ReadFile {
s.Chan e.File =
<Open 'r' s.Chan e.File>
<ReadFile (s.Chan)>;
(s.Chan), <Get s.Chan>: {
0 = ;
e.Line = (e.Line) <ReadFile (s.Chan)>;
};
};
Filter {
(e.Fn) = ;
(e.Fn) t.Item e.Items, <Mu e.Fn t.Item>: {
True = t.Item <Filter (e.Fn) e.Items>;
False = <Filter (e.Fn) e.Items>;
};
};
SameLen {
(e.Word1) (e.Word2),
<Lenw e.Word1>: s.Len e.Word1,
<Lenw e.Word2>: s.Len e.Word2 = True;
(e.Word1) (e.Word2) = False;
};
Diffs {
() () = 0;
(s.X e.Word1) (s.X e.Word2) = <Diffs (e.Word1) (e.Word2)>;
(s.X e.Word1) (s.Y e.Word2) = <+ 1 <Diffs (e.Word1) (e.Word2)>>;
};
OneDiff {
t.Word1 t.Word2, <Diffs t.Word1 t.Word2>: {
1 = True;
s.Diffs = False;
};
};
Ladder {
(e.Dict) t.From t.To,
<Filter (SameLen t.From) e.Dict>: e.Dict2 =
<Ladder2 ((t.From)) (e.Dict2) t.To>;
};
Ladder2 {
(e.Ladders) (e.Dict) t.To,
e.Ladders: e.X (e.Words t.To) e.Y = Result e.Words t.To;
(e.Ladders) () t.To = Impossible;
() (e.Dict) t.To = Impossible;
((e.Ladder) e.Ladders) (e.Dict) t.To,
e.Ladder: e.1 t.Last,
<Filter (OneDiff t.Last) e.Dict>: e.NextWords,
<RemoveAll (e.NextWords) e.Dict>: e.NextDict,
<AddAll (e.Ladder) e.NextWords>: e.NextLadders
= <Ladder2 (e.Ladders e.NextLadders) (e.NextDict) t.To>;
};
RemoveAll {
(e.Remove) = ;
(e.Remove) t.Word e.Words, e.Remove: {
e.X t.Word e.Y = <RemoveAll (e.Remove) e.Words>;
e.Remove = t.Word <RemoveAll (e.Remove) e.Words>;
};
};
AddAll {
(e.Ladder) = ;
(e.Ladder) t.Word e.Words =
(e.Ladder t.Word) <AddAll (e.Ladder) e.Words>;
};</syntaxhighlight>
{{out}}
<pre>boy -> man: boy->bay->ban->man
girl -> lady: girl->gill->gall->gale->gaze->laze->lazy->lady
john -> jane: john->cohn->conn->cone->cane->jane
child -> adult: impossible</pre>
=={{header|REXX}}==
Line 971 ⟶ 1,793:
Programming note: this REXX program uses the '''lower''' BIF which Regina has).
<br>If your REXX doesn't support that BIF, here is an equivalent function:
<
return translate(a, @, @u)</
<
parse arg base targ iFID . /*obtain optional arguments from the CL*/
if base=='' | base=="," then base= 'boy' /*Not specified? Then use the default.*/
Line 1,030 ⟶ 1,852:
end /*k*/
end /*i*/
$= $$; return ''</
{{out|output|text= when using the default inputs:}}
<pre>
Line 1,082 ⟶ 1,904:
no word ladder solution possible for child ──► adult
</pre>
=={{header|Ruby}}==
{{trans|Raku}}
<syntaxhighlight lang="ruby">require "set"
Words = File.open("unixdict.txt").read.split("\n").
group_by { |w| w.length }.map { |k, v| [k, Set.new(v)] }.
to_h
def word_ladder(from, to)
raise "Length mismatch" unless from.length == to.length
sized_words = Words[from.length]
work_queue = [[from]]
used = Set.new [from]
while work_queue.length > 0
new_q = []
work_queue.each do |words|
last_word = words[-1]
new_tails = Enumerator.new do |enum|
("a".."z").each do |replacement_letter|
last_word.length.times do |i|
new_word = last_word.clone
new_word[i] = replacement_letter
next unless sized_words.include? new_word and
not used.include? new_word
enum.yield new_word
used.add new_word
return words + [new_word] if new_word == to
end
end
end
new_tails.each do |t|
new_q.push(words + [t])
end
end
work_queue = new_q
end
end
[%w<boy man>, %w<girl lady>, %w<john jane>, %w<child adult>].each do |from, to|
if ladder = word_ladder(from, to)
puts ladder.join " → "
else
puts "#{from} into #{to} cannot be done"
end
end</syntaxhighlight>
{{Out}}
<pre>boy → bay → may → man
girl → gill → gall → gale → gaze → laze → lazy → lady
john → cohn → conn → cone → cane → jane
child into adult cannot be done</pre>
=={{header|SETL}}==
<syntaxhighlight lang="setl">program word_ladder;
dict := read_dictionary("unixdict.txt");
testpairs := [['boy', 'man'], ['girl', 'lady'], ['john', 'jane'], ['child', 'adult']];
loop for [fromWord, toWord] in testpairs do
l := ladder(dict, fromWord, toWord);
if l = om then
print(fromWord, '->', toWord, 'impossible');
else
print(fromWord, '->', toWord, l);
end if;
end loop;
proc ladder(dict, fromWord, toWord);
dict := {word : word in dict | #word = #fromWord};
ladders := [[fromWord]];
dict less:= fromWord;
loop while ladders /= [] do
l fromb ladders;
next := {word : word in onediff(dict, l(#l))};
dict -:= next;
nextls := [l + [word] : word in next];
if exists l in nextls | l(#l) = toWord then
return l;
end if;
ladders +:= nextls;
end loop;
return om;
end proc;
proc onediff(rw dict, word);
return {other : other in dict | #other = #word and diffs(word, other) = 1};
end proc;
proc diffs(word1, word2);
return +/[if word1(i) = word2(i) then 0 else 1 end : i in [1..#word1]];
end proc;
proc read_dictionary(file);
dictfile := open(file, 'r');
dict := {getline(dictfile) : until eof(dictfile)};
close(dictfile);
return dict;
end proc;
end program;</syntaxhighlight>
{{out}}
<pre>boy -> man [boy bay ban man]
girl -> lady [girl gill gall gale gaze laze lazy lady]
john -> jane [john cohn conn cone cane jane]
child -> adult impossible</pre>
=={{header|Swift}}==
{{trans|Wren}}
<
func oneAway(string1:
if string1.count != string2.count {
return false
}
var result = false
var i = 0
while i <
if string1[i] != string2[i] {
if result {
return false
Line 1,099 ⟶ 2,026:
result = true
}
i += 1
}
return result
}
func wordLadder(words: [
var poss = words.filter{$0.count == fromCh.count}
var queue: [[[Character]]] = [[fromCh]]
while !queue.isEmpty {
var curr = queue[0]
Line 1,111 ⟶ 2,041:
queue.removeFirst()
let next = poss.filter{oneAway(string1: $0, string2: last)}
if next.contains(
curr.append(
print(curr.map{String($0)}.joined(separator: " -> "))
return
}
Line 1,130 ⟶ 2,060:
.components(separatedBy: "\n")
.filter{!$0.isEmpty}
.map{Array($0)}
wordLadder(words: words, from: "man", to: "boy")
wordLadder(words: words, from: "girl", to: "lady")
wordLadder(words: words, from: "john", to: "jane")
wordLadder(words: words, from: "child", to: "adult")
wordLadder(words: words, from: "cat", to: "dog")
wordLadder(words: words, from: "lead", to: "gold")
wordLadder(words: words, from: "white", to: "black")
wordLadder(words: words, from: "bubble", to: "tickle")
} catch {
print(error.localizedDescription)
}</
{{out}}
Line 1,144 ⟶ 2,079:
john -> cohn -> conn -> cone -> cane -> jane
child into adult cannot be done.
cat -> cot -> cog -> dog
lead -> load -> goad -> gold
white -> whine -> chine -> chink -> clink -> blink -> blank -> black
bubble -> babble -> gabble -> garble -> gargle -> gaggle -> giggle -> jiggle -> jingle -> tingle -> tinkle -> tickle
</pre>
Line 1,149 ⟶ 2,088:
{{trans|Phix}}
{{libheader|Wren-sort}}
<
import "./sort" for Find
var words = File.read("unixdict.txt").trim().split("\n")
Line 1,189 ⟶ 2,128:
["child", "adult"]
]
for (pair in pairs) wordLadder.call(pair[0], pair[1])</
{{out}}
|