Word ladder: Difference between revisions

m
(→‎{{header|Wren}}: Slightly simpler.)
m (→‎{{header|Wren}}: Minor tidy)
 
(23 intermediate revisions by 12 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
 
For the wokes,A john can be made into a jane: john -> cohn -> conn -> cone -> cane -> jane
 
A child can not be turned into an adult.
Line 19:
{{Template:Strings}}
<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|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|C++}}==
This borrows heavily from [[#Wren|Wren]] and a bit from [[#Raku|Raku]].
<langsyntaxhighlight lang="cpp">#include <algorithm>
#include <fstream>
#include <iostream>
Line 59 ⟶ 329:
}
return result;
}
 
// Return true if v contains e.
template <typename vector_type, typename element_type>
bool contains(const vector_type& v, const element_type& e) {
return std::find(v.begin(), v.end(), e) != v.end();
}
 
Line 79 ⟶ 343:
auto curr = queue.front();
queue.erase(queue.begin());
for (auto i = poss.begin(); i != poss.end();) {
std::vector<std::string> next;
for (const std::string& str :if poss(!one_away(*i, curr.back())) {
if (one_away(str, curr.back())) ++i;
next.push_back(str)continue;
}
if (contains(next, to) == *i) {
curr.push_back(to);
std::cout << join(curr.begin(), curr.end(), " -> ") << '\n';
return true;
}
poss.erase(std::remove_if(poss.begin(), poss.end(),
[&next](const std::string& str) {
return contains(next, str);
}),
poss.end());
for (const auto& str : next) {
std::vector<std::string> temp(curr);
temp.push_back(str*i);
queue.push_back(std::move(temp));
i = poss.erase(i);
}
}
Line 124 ⟶ 383:
word_ladder(words, "bubble", "tickle");
return EXIT_SUCCESS;
}</langsyntaxhighlight>
 
{{out}}
Line 139 ⟶ 398:
 
=={{header|F_Sharp|F#}}==
<langsyntaxhighlight lang="fsharp">
// 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 ⟶ 407:
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>
</lang>
{{out}}
<pre>
Line 159 ⟶ 418:
The bad news is evil can not be turned into good, but the good news is god can become man.
 
<langsyntaxhighlight lang="fsharp">
[("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>
</lang>
{{out}}
<pre>
Line 167 ⟶ 426:
god -> gad -> mad -> man
</pre>
 
=={{header|Go}}==
{{trans|Wren}}
<syntaxhighlight lang="go">package main
 
import (
"bytes"
"fmt"
"io/ioutil"
"log"
"strings"
)
 
func contains(a []string, s string) bool {
for _, e := range a {
if e == s {
return true
}
}
return false
}
 
func oneAway(a, b string) bool {
sum := 0
for i := 0; i < len(a); i++ {
if a[i] != b[i] {
sum++
}
}
return sum == 1
}
 
func wordLadder(words []string, a, b string) {
l := len(a)
var poss []string
for _, word := range words {
if len(word) == l {
poss = append(poss, word)
}
}
todo := [][]string{{a}}
for len(todo) > 0 {
curr := todo[0]
todo = todo[1:]
var next []string
for _, word := range poss {
if oneAway(word, curr[len(curr)-1]) {
next = append(next, word)
}
}
if contains(next, b) {
curr = append(curr, b)
fmt.Println(strings.Join(curr, " -> "))
return
}
for i := len(poss) - 1; i >= 0; i-- {
if contains(next, poss[i]) {
copy(poss[i:], poss[i+1:])
poss[len(poss)-1] = ""
poss = poss[:len(poss)-1]
}
}
for _, s := range next {
temp := make([]string, len(curr))
copy(temp, curr)
temp = append(temp, s)
todo = append(todo, temp)
}
}
fmt.Println(a, "into", b, "cannot be done.")
}
 
func main() {
b, err := ioutil.ReadFile("unixdict.txt")
if err != nil {
log.Fatal("Error reading file")
}
bwords := bytes.Fields(b)
words := make([]string, len(bwords))
for i, bword := range bwords {
words[i] = string(bword)
}
pairs := [][]string{
{"boy", "man"},
{"girl", "lady"},
{"john", "jane"},
{"child", "adult"},
}
for _, pair := range pairs {
wordLadder(words, pair[0], pair[1])
}
}</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.
</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}}==
<langsyntaxhighlight lang="java">import java.io.IOException;
import java.nio.file.Files;
import java.nio.file.Path;
Line 262 ⟶ 802:
wordLadder(words, "bubble", "tickle", 12);
}
}</langsyntaxhighlight>
{{out}}
<pre>boy -> bay -> may -> man
Line 272 ⟶ 812:
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}}==
{{trans|Wren}}
{{works with|jq}}
'''Works with gojq, the Go implementation of jq'''
<syntaxhighlight lang="jq">def count(stream): reduce stream as $i (0; .+1);
 
def words: [inputs]; # one way to read the word list
 
def oneAway($a; $b):
($a|explode) as $ax
| ($b|explode) as $bx
| 1 == count(range(0; $a|length) | select($ax[.] != $bx[.]));
 
# input: the word list
def wordLadder($a; $b):
($a|length) as $len
| { poss: map(select(length == $len)), # the relevant words
todo: [[$a]] # possible chains
}
| until ( ((.todo|length) == 0) or .solution;
.curr = .todo[0]
| .todo |= .[1:]
| .curr[-1] as $c
| (.poss | map(select( oneAway(.; $c) ))) as $next
| if ($b | IN($next[]))
then .curr += [$b]
| .solution = (.curr|join(" -> "))
else .poss = (.poss - $next)
| .curr as $curr
| .todo = (reduce range(0; $next|length) as $i (.todo;
. + [$curr + [$next[$i] ]] ))
end )
| if .solution then .solution
else "There is no ladder from \($a) to \($b)."
end ;
def pairs:
["boy", "man"],
["girl", "lady"],
["john", "jane"],
["child", "adult"],
["word", "play"]
;
 
words
| pairs as $p
| wordLadder($p[0]; $p[1])</syntaxhighlight>
 
{{out}}
Invocation: jq -nr -R -f word-ladder.jq unixdict.txt
<pre>
boy -> bay -> ban -> man
girl -> gill -> gall -> gale -> gaze -> laze -> lazy -> lady
john -> cohn -> conn -> cone -> cane -> jane
There is no ladder from child to adult.
word -> ford -> form -> foam -> flam -> clam -> clay -> play
</pre>
 
=={{header|Julia}}==
<langsyntaxhighlight lang="julia">const dict = Set(split(read("unixdict.txt", String), r"\s+"))
 
function targeted_mutations(str::AbstractString, target::AbstractString)
Line 300 ⟶ 985:
println("john to jane: ", targeted_mutations("john", "jane"))
println("child to adult: ", targeted_mutations("child", "adult"))
</langsyntaxhighlight>{{out}}
<pre>
boy to man: [["boy", "bay", "may", "man"], ["boy", "bay", "ban", "man"], ["boy", "bon", "ban", "man"]]
Line 310 ⟶ 995:
=={{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.}}
<langsyntaxhighlight Mathematicalang="mathematica">db=DeleteDuplicates[RemoveDiacritics[ToLowerCase[Select[DictionaryLookup[],StringLength/*EqualTo[3]]]]];
sel=Select[Subsets[db,{2}],HammingDistance[#[[1]],#[[2]]]==1&];
g=Graph[db,UndirectedEdge@@@sel];
Line 324 ⟶ 1,009:
sel=Select[Subsets[db,{2}],HammingDistance[#[[1]],#[[2]]]==1&];
g=Graph[db,UndirectedEdge@@@sel];
FindShortestPath[g,"child","adult"]</langsyntaxhighlight>
{{out}}
<pre>{"boy", "bay", "ban", "man"}
Line 332 ⟶ 1,017:
 
=={{header|Nim}}==
<langsyntaxhighlight Nimlang="nim">import sets, strformat, strutils
 
 
Line 387 ⟶ 1,072:
echo &"No path from “{start}” to “{target}”."
else:
echo path.join(" → ")</langsyntaxhighlight>
 
{{out}}
Line 400 ⟶ 1,085:
 
=={{header|Perl}}==
===Direct translation===
{{trans|C++}}
<langsyntaxhighlight lang="perl">use strict;
use warnings;
 
Line 499 ⟶ 1,185:
word_ladder('lead', 'gold');
word_ladder('white', 'black');
word_ladder('bubble', 'tickle');</langsyntaxhighlight>
{{out}}
<pre>boy -> bay -> ban -> man
Line 509 ⟶ 1,195:
white -> whine -> chine -> chink -> clink -> blink -> blank -> black
bubble -> babble -> gabble -> garble -> gargle -> gaggle -> giggle -> jiggle -> jingle -> tingle -> tinkle -> tickle</pre>
 
===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/3-rd faster.
<syntaxhighlight lang="perl">use strict;
use warnings;
use feature 'say';
 
my %dict;
open my $handle, '<', 'ref/unixdict.txt';
while (my $word = <$handle>) {
chomp $word;
my $l = length $word;
if ($dict{$l}) { push @{ $dict{$l} }, $word }
else { $dict{$l} = \@{[$word]} }
}
close $handle;
 
sub distance {
my($w1,$w2) = @_;
my $d;
substr($w1, $_, 1) eq substr($w2, $_, 1) or $d++ for 0 .. length($w1) - 1;
return $d // 0;
}
 
sub contains {
my($aref,$needle) = @_;
$needle eq $_ and return 1 for @$aref;
return 0;
}
 
sub word_ladder {
my($fw,$tw) = @_;
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;
distance($last, $_) == 1 and push @next, $_ for @poss;
push(@$curr_ref, $tw) and say join ' -> ', @$curr_ref and return if contains \@next, $tw;
 
for my $word (@next) {
$word eq $poss[$_] and splice(@poss, $_, 1) and last for 0 .. @poss - 1;
}
push @queue, \@{[@{$curr_ref}, $_]} for @next;
}
 
say "Cannot change $fw into $tw";
}
 
word_ladder(split) for 'boy man', 'girl lady', 'john jane', 'child adult';</syntaxhighlight>
Same style output.
 
=={{header|Phix}}==
<!--<langsyntaxhighlight Phixlang="phix">(notonlinephixonline)-->
<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;">get_text</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"demo/unixdict.txt"</span><span style="color: #0000FF;">,</span><span style="color: #004600;">GT_LF_STRIPPED</span><span style="color: #0000FF;">)</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>
<span style="color: #008080;">function</span> <span style="color: #000000;">right_length</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">word</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">l</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">return</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">word</span><span style="color: #0000FF;">)=</span><span style="color: #000000;">l</span> <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">one_away</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">return</span> <span style="color: #7060A8;">sum</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">sq_ne</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span><span style="color: #000000;">b</span><span style="color: #0000FF;">))=</span><span style="color: #000000;">1</span> <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">dca</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">return</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">deep_copy</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">),</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">word_ladder</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">)</span>
Line 526 ⟶ 1,270:
<span style="color: #004080;">sequence</span> <span style="color: #000000;">next</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">filter</span><span style="color: #0000FF;">(</span><span style="color: #000000;">poss</span><span style="color: #0000FF;">,</span><span style="color: #000000;">one_away</span><span style="color: #0000FF;">,</span><span style="color: #000000;">curr</span><span style="color: #0000FF;">[$])</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">b</span><span style="color: #0000FF;">,</span><span style="color: #000000;">next</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%s\n"</span><span style="color: #0000FF;">,{</span><span style="color: #7060A8;">join</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">deep_copy</span><span style="color: #0000FF;">(</span><span style="color: #000000;">curr</span><span style="color: #0000FF;">),</span><span style="color: #000000;">b</span><span style="color: #0000FF;">),</span><span style="color: #008000;">"-&gt;"</span><span style="color: #0000FF;">)})</span>
<span style="color: #008080;">return</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">poss</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">filter</span><span style="color: #0000FF;">(</span><span style="color: #000000;">poss</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"out"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">next</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">todo</span> <span style="color: #0000FF;">&=</span> <span style="color: #7060A8;">apply</span><span style="color: #0000FF;">(</span><span style="color: #004600;">true</span><span style="color: #0000FF;">,</span><span style="color: #7060A8000000;">appenddca</span><span style="color: #0000FF;">,{{</span><span style="color: #000000;">curr</span><span style="color: #0000FF;">},</span><span style="color: #000000;">next</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%s into %s cannot be done\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span><span style="color: #000000;">b</span><span style="color: #0000FF;">})</span>
Line 538 ⟶ 1,282:
<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>
<!--</langsyntaxhighlight>-->
<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 550 ⟶ 1,294:
=={{header|Python}}==
The function ''cache'' is not part of the algorithm but avoid re-download and map re-computing at each re-run.
<langsyntaxhighlight lang="python">import os,sys,zlib,urllib.request
 
def h ( str,x=9 ):
Line 597 ⟶ 1,341:
 
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()))</langsyntaxhighlight>
 
{{out}}
Line 607 ⟶ 1,351:
child can not be turned into adult
</pre>
 
=={{header|Racket}}==
 
<syntaxhighlight lang="racket">#lang racket
 
(define *unixdict* (delay (with-input-from-file "../../data/unixdict.txt"
(compose list->set port->lines))))
 
(define letters-as-strings (map string (string->list "abcdefghijklmnopqrstuvwxyz")))
 
(define ((replace-for-c-at-i w i) c)
(string-append (substring w 0 i) c (substring w (add1 i))))
 
(define (candidates w)
(for*/list (((i w_i) (in-parallel (string-length w) w))
(r (in-value (replace-for-c-at-i w i)))
(c letters-as-strings)
#:unless (char=? w_i (string-ref c 0)))
(r c)))
 
(define (generate-candidates word.path-hash)
(for*/hash (((w p) word.path-hash)
(w′ (candidates w)))
(values w′ (cons w p))))
 
(define (hash-filter-keys keep-key? h)
(for/hash (((k v) h) #:when (keep-key? k)) (values k v)))
 
(define (Word-ladder src dest (words (force *unixdict*)))
(let loop ((edge (hash src null)) (unused (set-remove words src)))
(let ((cands (generate-candidates edge)))
(if (hash-has-key? cands dest)
(reverse (cons dest (hash-ref cands dest)))
(let ((new-edge (hash-filter-keys (curry set-member? unused) cands)))
(if (hash-empty? new-edge)
`(no-path-between ,src ,dest)
(loop new-edge (set-subtract unused (list->set (hash-keys new-edge))))))))))
 
(module+ main
(Word-ladder "boy" "man")
(Word-ladder "girl" "lady")
(Word-ladder "john" "jane")
(Word-ladder "alien" "drool")
(Word-ladder "child" "adult"))</syntaxhighlight>
 
{{out}}
<pre>'("boy" "bay" "may" "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-path-between "child" "adult")</pre>
 
=={{header|Raku}}==
<syntaxhighlight lang="raku" perl6line>constant %dict = 'unixdict.txt'.IO.lines
.classify(*.chars)
.map({ .key => .value.Set });
Line 645 ⟶ 1,481:
say word_ladder($from, $to)
// "$from into $to cannot be done";
}</langsyntaxhighlight>
{{out}}
<pre>
Line 662 ⟶ 1,498:
Programming note: &nbsp; &nbsp; this REXX program uses the &nbsp; '''lower''' &nbsp; BIF &nbsp; which Regina has).
<br>If your REXX doesn't support that BIF, &nbsp; here is an equivalent function:
<langsyntaxhighlight lang="rexx">lower: procedure; parse arg a; @= 'abcdefghijklmnopqrstuvwxyz'; @u= @; upper @u
return translate(a, @, @u)</langsyntaxhighlight>
<langsyntaxhighlight lang="rexx">/*REXX program finds words (within an identified dict.) to solve a word ladder puzzle.*/
parse arg base targ iFID . /*obtain optional arguments from the CL*/
if base=='' | base=="," then base= 'boy' /*Not specified? Then use the default.*/
Line 721 ⟶ 1,557:
end /*k*/
end /*i*/
$= $$; return ''</langsyntaxhighlight>
{{out|output|text=&nbsp; when using the default inputs:}}
<pre>
Line 773 ⟶ 1,609:
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|Swift}}==
{{trans|Wren}}
<langsyntaxhighlight lang="swift">import Foundation
 
func oneAway(string1: String[Character], string2: String[Character]) -> Bool {
if string1.count != string2.count {
return false
}
var result = false
var i = 0
for (c1, c2) in zip(string1, string2) {
while i < if c1 != c2string1.count {
if string1[i] != string2[i] {
if result {
return false
Line 790 ⟶ 1,679:
result = true
}
i += 1
}
return result
}
 
func wordLadder(words: [String[Character]], from: String, to: String) {
varlet possfromCh = words.filter{$0.count == Array(from.count})
varlet queue: [[String]]toCh = [[from]]Array(to)
var poss = words.filter{$0.count == fromCh.count}
var queue: [[[Character]]] = [[fromCh]]
while !queue.isEmpty {
var curr = queue[0]
Line 802 ⟶ 1,694:
queue.removeFirst()
let next = poss.filter{oneAway(string1: $0, string2: last)}
if next.contains(totoCh) {
curr.append(totoCh)
print(curr.map{String($0)}.joined(separator: " -> "))
return
}
Line 821 ⟶ 1,713:
.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)
}</langsyntaxhighlight>
 
{{out}}
Line 835 ⟶ 1,732:
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 840 ⟶ 1,741:
{{trans|Phix}}
{{libheader|Wren-sort}}
<langsyntaxhighlight ecmascriptlang="wren">import "io" for File
import "./sort" for Find
 
var words = File.read("unixdict.txt").trim().split("\n")
Line 880 ⟶ 1,781:
["child", "adult"]
]
for (pair in pairs) wordLadder.call(pair[0], pair[1])</langsyntaxhighlight>
 
{{out}}
9,476

edits