Rosetta Code

Word ladder: Difference between revisions

Page Discussion

Word ladder (view source)

Revision as of 09:43, 11 June 2024

45 bytes removed ,  26 days ago
→‎{{header|Ada}}
Line 89:
 
=={{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;
Line 103 ⟶ 104:
subtype LC_Chars is Character range 'a' .. 'z';
 
type Word_Rec_TWord_Node_T is record
Parent, WordLevel : Unbounded_StringPositive;
Start,Word Target, Word : Unbounded_String;▼
end record;
 
package Word_Vectors is new Ada.Containers.Vectors (Positive, Unbounded_String);
package Used_VectorsDict_Vectors is new Ada.Containers.Vectors (Positive, BooleanUnbounded_String);
 
package Mutation_VectorsWord_Trees is new Ada.Containers.VectorsMultiway_Trees (Positive, Word_Rec_TWord_Node_T);
type Mutation_Arr is array (1 .. MAX_DEPTH) of Mutation_Vectors.Vector;
use Word_Trees;
Word_Tree : Mutation_ArrTree;▼
Solved : end ifBoolean;▼
Solution : Cursor;
 
function Load_Candidate_Words (Dict_Filename : String; Word_Len : Positive)
return Word_VectorsDict_Vectors.Vector is
Dict_File : File_Type;
Read_Word : Unbounded_String;
Cands : Word_VectorsDict_Vectors.Vector;
Valid : Boolean;
C : Character;
Line 137 ⟶ 143:
end Load_Candidate_Words;
 
function Mutate (Word : Unbounded_String; LenDict : Positive;in Dict :out Word_VectorsDict_Vectors.Vector)▼
function Create_Unused_Vec (Vec_Len : Positive)
return Used_Vectors.Vector is
Used : Used_Vectors.Vector;▼
begin▼
for i in 1 .. Vec_Len loop▼
Used.Append (False);
end loop;
return Used;
end Create_Unused_Vec;
 
▲ function Mutate (Word : Unbounded_String; Len : Positive; Dict : Word_Vectors.Vector)
return Word_Vectors.Vector is
Mutations : Word_Vectors.Vector;
Poss_Word : Unbounded_String;
begin
for Ix in 1 .. LenLength (Word) loop
for Letter in LC_Chars loop
if Letter /= Element (Word, Ix) then
Line 159 ⟶ 155:
if Dict.Contains (Poss_Word) then
Mutations.Append (Poss_Word);
Dict.Delete (Dict.Find_Index (Poss_Word));
end if;
end if;
Line 166 ⟶ 163:
end Mutate;
 
procedure LadderRecurse_Tree (Start_S, Target_SStart_Pos : String)Cursor; is
Level : Positive;
Dictionary : Word_Vectors.Vector;
Used Target : Used_Vectors.VectorUnbounded_String;
Dict : in out Dict_Vectors.Vector) is
▲ Word_Tree : Mutation_Arr;
LevelPos : PositiveCursor := 1Start_Pos;
Mutations : Word_Vectors.Vector;
Muts_VecNew_Node : Mutation_Vectors.VectorWord_Node_T;
▲ begin
Word_Rec : Word_Rec_T;
Foundwhile not Solved and then Pos :/= Boolean :=No_Element False;loop
if Element (Pos).Level = Level then
▲ Start, Target, Word : Unbounded_String;
Mutations := Mutate (Start,Element Start_S'Length(Pos).Word, DictionaryDict);▼
 
if not Word_Vectors.Is_Empty (Mutations) then
procedure Check_Mutations is
Ix for Word of :Mutations Positive;loop
WordNew_Node.Level := Word_Rec.ParentLevel + 1;▼
begin
for New_Node.Word of Mutations:= loopWord;
Ix := Word_Vectors.Find_Index Append_Child (DictionaryWord_Tree, Pos, WordNew_Node);
if notWord Used= (Ix)Target then
Used (Ix) Solved := True;
Word_Rec.Word Solution := WordPos;
Muts_Vec.Append (Word_Rec) end if;
▲ for i in 1 .. Vec_Len end loop;
end if;
end if Word = Target then;
if not Solved Found := True;then
Recurse_Tree (First_Child (Pos), returnLevel, Target, Dict);
end if;
endPos loop:= Next_Sibling (Pos);
end Check_Mutationsloop;
end Recurse_Tree;
 
procedure Ladder (Start_S, Target_S : String) is
▲ UsedDictionary : Used_VectorsDict_Vectors.Vector;
Level : Positive := exit1;▼
Word_Node : Word_Node_T;
Start, Target : Unbounded_String;
Start_Pos : end loopCursor;▼
Output : Check_MutationsUnbounded_String;▼
begin
if Start_S'Length /= Target_S'Length then
Line 199 ⟶ 206:
end if;
Dictionary := Load_Candidate_Words (DICT_FILENAME, Start_S'Length);
Used := Create_Unused_Vec (Positive (Word_Vectors.Length (Dictionary)));
Start := To_Unbounded_String (Start_S);
Target := To_Unbounded_String (Target_S);
whileSolved Level <= MAX_DEPTH and then not Found:= loopFalse;
Word_Node.Level := Muts_Vec.Clear1;
Word_Node.Word if Level := 1 thenStart;
Word_Tree (Level) := Muts_VecEmpty_Tree;▼
▲ Mutations := Mutate (Start, Start_S'Length, Dictionary);
Word_Tree.Insert_Child (Word_Tree.Root, No_Element, Word_Node);
Word_Rec.Parent := Start;
Start_Pos := Find (Word_Tree, Check_MutationsWord_Node);
while Level <= MAX_DEPTH and then not Solved loop
else
Recurse_Tree (Start_Pos, Level, Target, Dictionary);
for Parent_Rec of Word_Tree (Level - 1) loop
Mutations := Mutate (Parent_Rec.Word, Start_S'Length, Dictionary);
Word_Rec.Parent := Parent_Rec.Word;
▲ Check_Mutations;
▲ end loop;
▲ end if;
▲ Word_Tree (Level) := Muts_Vec;
Level := @ + 1;
end loop;
if not FoundSolved then
Put_Line (Start & " -> " & Target & " - No solution found at depth" & MAX_DEPTH'Image);
else
Wordwhile :=not Target;Is_Root (Solution) loop
for Lev in reverseWord_Node 1:= ..Element Level - 1 loop(Solution);
forOutput W_Ix:= inWord_Node.Word 1& .." Word_Tree-> (Lev).Length" & loopOutput;
Word_RecSolution := Word_Tree (Lev)(PositiveParent (W_Ix)Solution);
if Word_Rec.Word = Word then
Put (Word & " <- ");
▲ Word := Word_Rec.Parent;
▲ exit;
end if;
end loop;
end loop;
PutPut_Line (Start);Output New_Line& Target);
end if;
end Ladder;
Line 248 ⟶ 242:
As expected "ada" can become a "god", and "rust" can go to "hell" :-)
<pre>
manboy <-> maybay <-> baymay <-> boyman
ladygirl <-> lazygill <-> lazegall <-> gazegale <-> galegaze <-> galllaze <-> gilllazy <-> girllady
johnjane <-> cohncane <-> conncone <-> coneconn <-> canecohn <-> janejohn
child -> adult - No solution found at depth 50
godada <-> gadfda <-> fadfaa <-> faafad <-> fdagad <-> adagod
hellrust <-> bellbust <-> beltbest <-> bestbelt <-> bustbell <-> rusthell
</pre>
 
SMerrony
19

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/365197"