Word ladder: Difference between revisions

(+algol68)
(4 intermediate revisions by 4 users not shown)
Line 23:
{{trans|Nim}}
 
<langsyntaxhighlight lang="11l">F isOneAway(word1, word2)
V result = 0B
L(i) 0 .< word1.len
Line 74:
print(‘No path from "’start‘" to "’target‘".’)
E
print(path.join(‘ -> ’))</langsyntaxhighlight>
 
{{out}}
Line 86:
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.
<langsyntaxhighlight lang="algol68"># quick implementation of a stack of INT.
real program starts after it.
#
Line 268 ⟶ 430:
print(newline)
FI
OD</langsyntaxhighlight>
{{out}}
<pre>boy->bay->ban->man
Line 292 ⟶ 454:
=={{header|C++}}==
This borrows heavily from [[#Wren|Wren]] and a bit from [[#Raku|Raku]].
<langsyntaxhighlight lang="cpp">#include <algorithm>
#include <fstream>
#include <iostream>
Line 383 ⟶ 545:
word_ladder(words, "bubble", "tickle");
return EXIT_SUCCESS;
}</langsyntaxhighlight>
 
{{out}}
Line 398 ⟶ 560:
 
=={{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 407 ⟶ 569:
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 418 ⟶ 580:
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 429 ⟶ 591:
=={{header|Go}}==
{{trans|Wren}}
<langsyntaxhighlight lang="go">package main
 
import (
Line 517 ⟶ 679:
wordLadder(words, pair[0], pair[1])
}
}</langsyntaxhighlight>
 
{{out}}
Line 531 ⟶ 693:
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 577 ⟶ 739:
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 598 ⟶ 760:
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 629 ⟶ 791:
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 646 ⟶ 808:
g = Graph $ \w -> M.fromList [ (x, 1)
| x <- short_dict
, distance w x == 1 ]</langsyntaxhighlight>
 
<pre>λ> main
Line 655 ⟶ 817:
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 750 ⟶ 964:
wordLadder(words, "bubble", "tickle", 12);
}
}</langsyntaxhighlight>
{{out}}
<pre>boy -> bay -> may -> man
Line 763 ⟶ 977:
===Faster alternative===
{{trans|C++}}
<langsyntaxhighlight lang="java">import java.io.*;
import java.util.*;
 
Line 834 ⟶ 1,048:
System.out.printf("%s into %s cannot be done.\n", from, to);
}
}</langsyntaxhighlight>
 
{{out}}
Line 852 ⟶ 1,066:
{{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 894 ⟶ 1,108:
words
| pairs as $p
| wordLadder($p[0]; $p[1])</langsyntaxhighlight>
 
{{out}}
Line 907 ⟶ 1,121:
 
=={{header|Julia}}==
<langsyntaxhighlight lang="julia">const dict = Set(split(read("unixdict.txt", String), r"\s+"))
 
function targeted_mutations(str::AbstractString, target::AbstractString)
Line 933 ⟶ 1,147:
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 943 ⟶ 1,157:
=={{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 957 ⟶ 1,171:
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 965 ⟶ 1,179:
 
=={{header|Nim}}==
<langsyntaxhighlight Nimlang="nim">import sets, strformat, strutils
 
 
Line 1,020 ⟶ 1,234:
echo &"No path from “{start}” to “{target}”."
else:
echo path.join(" → ")</langsyntaxhighlight>
 
{{out}}
Line 1,035 ⟶ 1,249:
===Direct translation===
{{trans|C++}}
<langsyntaxhighlight lang="perl">use strict;
use warnings;
 
Line 1,133 ⟶ 1,347:
word_ladder('lead', 'gold');
word_ladder('white', 'black');
word_ladder('bubble', 'tickle');</langsyntaxhighlight>
{{out}}
<pre>boy -> bay -> ban -> man
Line 1,146 ⟶ 1,360:
===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 1,196 ⟶ 1,410:
}
 
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 1,230 ⟶ 1,444:
<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 1,242 ⟶ 1,456:
=={{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,289 ⟶ 1,503:
 
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,302 ⟶ 1,516:
=={{header|Racket}}==
 
<langsyntaxhighlight lang="racket">#lang racket
 
(define *unixdict* (delay (with-input-from-file "../../data/unixdict.txt"
Line 1,342 ⟶ 1,556:
(Word-ladder "john" "jane")
(Word-ladder "alien" "drool")
(Word-ladder "child" "adult"))</langsyntaxhighlight>
 
{{out}}
Line 1,393 ⟶ 1,607:
 
=={{header|Raku}}==
<syntaxhighlight lang="raku" perl6line>constant %dict = 'unixdict.txt'.IO.lines
.classify(*.chars)
.map({ .key => .value.Set });
Line 1,429 ⟶ 1,643:
say word_ladder($from, $to)
// "$from into $to cannot be done";
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,446 ⟶ 1,660:
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,505 ⟶ 1,719:
end /*k*/
end /*i*/
$= $$; return ''</langsyntaxhighlight>
{{out|output|text=&nbsp; when using the default inputs:}}
<pre>
Line 1,560 ⟶ 1,774:
=={{header|Ruby}}==
{{trans|Raku}}
<langsyntaxhighlight lang="ruby">require "set"
 
Words = File.open("unixdict.txt").read.split("\n").
Line 1,602 ⟶ 1,816:
puts "#{from} into #{to} cannot be done"
end
end</langsyntaxhighlight>
 
{{Out}}
Line 1,612 ⟶ 1,826:
=={{header|Swift}}==
{{trans|Wren}}
<langsyntaxhighlight lang="swift">import Foundation
 
func oneAway(string1: [Character], string2: [Character]) -> Bool {
Line 1,672 ⟶ 1,886:
} catch {
print(error.localizedDescription)
}</langsyntaxhighlight>
 
{{out}}
Line 1,689 ⟶ 1,903:
{{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,729 ⟶ 1,943:
["child", "adult"]
]
for (pair in pairs) wordLadder.call(pair[0], pair[1])</langsyntaxhighlight>
 
{{out}}
19

edits