Word ladder: Difference between revisions

m
m (→‎Breadth-first search: fixed a typo)
m (→‎{{header|Wren}}: Minor tidy)
 
(4 intermediate revisions by 4 users not shown)
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 113 ⟶ 383:
word_ladder(words, "bubble", "tickle");
return EXIT_SUCCESS;
}</langsyntaxhighlight>
 
{{out}}
Line 128 ⟶ 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 137 ⟶ 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 148 ⟶ 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 159 ⟶ 429:
=={{header|Go}}==
{{trans|Wren}}
<langsyntaxhighlight lang="go">package main
 
import (
Line 247 ⟶ 517:
wordLadder(words, pair[0], pair[1])
}
}</langsyntaxhighlight>
 
{{out}}
Line 261 ⟶ 531:
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.
 
<langsyntaxhighlight lang="haskell">import System.IO (readFile)
import Control.Monad (foldM)
import Data.List (intercalate)
Line 307 ⟶ 577:
showChain $ wordLadder dict "john" "jane"
showChain $ wordLadder dict "alien" "drool"
showChain $ wordLadder dict "child" "adult"</langsyntaxhighlight>
 
<pre>λ> lines <$> readFile "unixdict.txt" >>= print . wordLadders "boy" "man"
Line 328 ⟶ 598:
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.
 
<langsyntaxhighlight lang="haskell">wordLadders2 :: String -> String -> [String] -> [[String]]
wordLadders2 start end dict
| length start /= length end = []
Line 359 ⟶ 629:
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)</langsyntaxhighlight>
 
===Using A*-search===
See [[A*_search_algorithm#Haskell]]
 
<langsyntaxhighlight lang="haskell">import AStar (findPath, Graph(..))
import qualified Data.Map as M
 
Line 376 ⟶ 646:
g = Graph $ \w -> M.fromList [ (x, 1)
| x <- short_dict
, distance w x == 1 ]</langsyntaxhighlight>
 
<pre>λ> main
Line 385 ⟶ 655:
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 480 ⟶ 802:
wordLadder(words, "bubble", "tickle", 12);
}
}</langsyntaxhighlight>
{{out}}
<pre>boy -> bay -> may -> man
Line 493 ⟶ 815:
===Faster alternative===
{{trans|C++}}
<langsyntaxhighlight lang="java">import java.io.*;
import java.util.*;
 
Line 564 ⟶ 886:
System.out.printf("%s into %s cannot be done.\n", from, to);
}
}</langsyntaxhighlight>
 
{{out}}
Line 582 ⟶ 904:
{{works with|jq}}
'''Works with gojq, the Go implementation of jq'''
<langsyntaxhighlight lang="jq">def count(stream): reduce stream as $i (0; .+1);
 
def words: [inputs]; # one way to read the word list
Line 624 ⟶ 946:
words
| pairs as $p
| wordLadder($p[0]; $p[1])</langsyntaxhighlight>
 
{{out}}
Line 637 ⟶ 959:
 
=={{header|Julia}}==
<langsyntaxhighlight lang="julia">const dict = Set(split(read("unixdict.txt", String), r"\s+"))
 
function targeted_mutations(str::AbstractString, target::AbstractString)
Line 663 ⟶ 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 673 ⟶ 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 687 ⟶ 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 695 ⟶ 1,017:
 
=={{header|Nim}}==
<langsyntaxhighlight Nimlang="nim">import sets, strformat, strutils
 
 
Line 750 ⟶ 1,072:
echo &"No path from “{start}” to “{target}”."
else:
echo path.join(" → ")</langsyntaxhighlight>
 
{{out}}
Line 765 ⟶ 1,087:
===Direct translation===
{{trans|C++}}
<langsyntaxhighlight lang="perl">use strict;
use warnings;
 
Line 863 ⟶ 1,185:
word_ladder('lead', 'gold');
word_ladder('white', 'black');
word_ladder('bubble', 'tickle');</langsyntaxhighlight>
{{out}}
<pre>boy -> bay -> ban -> man
Line 876 ⟶ 1,198:
===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.
<langsyntaxhighlight lang="perl">use strict;
use warnings;
use feature 'say';
Line 926 ⟶ 1,248:
}
 
word_ladder(split) for 'boy man', 'girl lady', 'john jane', 'child adult';</langsyntaxhighlight>
Same style output.
 
=={{header|Phix}}==
<!--<langsyntaxhighlight Phixlang="phix">(phixonline)-->
<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 960 ⟶ 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 972 ⟶ 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 1,019 ⟶ 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 1,032 ⟶ 1,354:
=={{header|Racket}}==
 
<langsyntaxhighlight lang="racket">#lang racket
 
(define *unixdict* (delay (with-input-from-file "../../data/unixdict.txt"
Line 1,072 ⟶ 1,394:
(Word-ladder "john" "jane")
(Word-ladder "alien" "drool")
(Word-ladder "child" "adult"))</langsyntaxhighlight>
 
{{out}}
Line 1,123 ⟶ 1,445:
 
=={{header|Raku}}==
<syntaxhighlight lang="raku" perl6line>constant %dict = 'unixdict.txt'.IO.lines
.classify(*.chars)
.map({ .key => .value.Set });
Line 1,159 ⟶ 1,481:
say word_ladder($from, $to)
// "$from into $to cannot be done";
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,176 ⟶ 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 1,235 ⟶ 1,557:
end /*k*/
end /*i*/
$= $$; return ''</langsyntaxhighlight>
{{out|output|text=&nbsp; when using the default inputs:}}
<pre>
Line 1,290 ⟶ 1,612:
=={{header|Ruby}}==
{{trans|Raku}}
<langsyntaxhighlight lang="ruby">require "set"
 
Words = File.open("unixdict.txt").read.split("\n").
Line 1,332 ⟶ 1,654:
puts "#{from} into #{to} cannot be done"
end
end</langsyntaxhighlight>
 
{{Out}}
Line 1,342 ⟶ 1,664:
=={{header|Swift}}==
{{trans|Wren}}
<langsyntaxhighlight lang="swift">import Foundation
 
func oneAway(string1: [Character], string2: [Character]) -> Bool {
Line 1,402 ⟶ 1,724:
} catch {
print(error.localizedDescription)
}</langsyntaxhighlight>
 
{{out}}
Line 1,419 ⟶ 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 1,459 ⟶ 1,781:
["child", "adult"]
]
for (pair in pairs) wordLadder.call(pair[0], pair[1])</langsyntaxhighlight>
 
{{out}}
9,476

edits