Word ladder: Difference between revisions

← Older editNewer edit →
Content deleted Content added
SMerrony (talk | contribs)
19 edits
SMerrony (talk | contribs)
19 edits
Line 89: Line 89:


=={{header|Ada}}==
=={{header|Ada}}==
Changed my solution to use Multiway_Trees.

<syntaxhighlight lang="ada">
<syntaxhighlight lang="ada">
pragma Ada_2022;
pragma Ada_2022;
with Ada.Containers.Multiway_Trees;
with Ada.Containers.Vectors;
with Ada.Containers.Vectors;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
Line 103: Line 104:
subtype LC_Chars is Character range 'a' .. 'z';
subtype LC_Chars is Character range 'a' .. 'z';


type Word_Rec_T is record
type Word_Node_T is record
Parent, Word : Unbounded_String;
Level : Positive;
⚫
Word : Unbounded_String;
end record;
end record;


package Word_Vectors is new Ada.Containers.Vectors (Positive, Unbounded_String);
package Word_Vectors is new Ada.Containers.Vectors (Positive, Unbounded_String);
package Used_Vectors is new Ada.Containers.Vectors (Positive, Boolean);
package Dict_Vectors is new Ada.Containers.Vectors (Positive, Unbounded_String);

package Mutation_Vectors is new Ada.Containers.Vectors (Positive, Word_Rec_T);
package Word_Trees is new Ada.Containers.Multiway_Trees (Word_Node_T);
type Mutation_Arr is array (1 .. MAX_DEPTH) of Mutation_Vectors.Vector;
use Word_Trees;
⚫
Word_Tree : Tree;
⚫
Solved : Boolean;
Solution : Cursor;


function Load_Candidate_Words (Dict_Filename : String; Word_Len : Positive)
function Load_Candidate_Words (Dict_Filename : String; Word_Len : Positive)
return Word_Vectors.Vector is
return Dict_Vectors.Vector is
Dict_File : File_Type;
Dict_File : File_Type;
Read_Word : Unbounded_String;
Read_Word : Unbounded_String;
Cands : Word_Vectors.Vector;
Cands : Dict_Vectors.Vector;
Valid : Boolean;
Valid : Boolean;
C : Character;
C : Character;
Line 137: Line 143:
end Load_Candidate_Words;
end Load_Candidate_Words;


⚫
function Mutate (Word : Unbounded_String; Dict : in out Dict_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
return Word_Vectors.Vector is
Mutations : Word_Vectors.Vector;
Mutations : Word_Vectors.Vector;
Poss_Word : Unbounded_String;
Poss_Word : Unbounded_String;
begin
begin
for Ix in 1 .. Len loop
for Ix in 1 .. Length (Word) loop
for Letter in LC_Chars loop
for Letter in LC_Chars loop
if Letter /= Element (Word, Ix) then
if Letter /= Element (Word, Ix) then
Line 159: Line 155:
if Dict.Contains (Poss_Word) then
if Dict.Contains (Poss_Word) then
Mutations.Append (Poss_Word);
Mutations.Append (Poss_Word);
Dict.Delete (Dict.Find_Index (Poss_Word));
end if;
end if;
end if;
end if;
Line 166: Line 163:
end Mutate;
end Mutate;


procedure Ladder (Start_S, Target_S : String) is
procedure Recurse_Tree (Start_Pos : Cursor;
Level : Positive;
Dictionary : Word_Vectors.Vector;
Used : Used_Vectors.Vector;
Target : Unbounded_String;
Dict : in out Dict_Vectors.Vector) is
⚫
Word_Tree : Mutation_Arr;
Level : Positive := 1;
Pos : Cursor := Start_Pos;
Mutations : Word_Vectors.Vector;
Mutations : Word_Vectors.Vector;
Muts_Vec : Mutation_Vectors.Vector;
New_Node : Word_Node_T;
⚫
begin
Word_Rec : Word_Rec_T;
Found : Boolean := False;
while not Solved and then Pos /= No_Element loop
if Element (Pos).Level = Level then
⚫
Start, Target, Word : Unbounded_String;
⚫
Mutations := Mutate (Element (Pos).Word, Dict);

if not Word_Vectors.Is_Empty (Mutations) then
procedure Check_Mutations is
Ix : Positive;
for Word of Mutations loop
⚫
New_Node.Level := Level + 1;
begin
for Word of Mutations loop
New_Node.Word := Word;
Ix := Word_Vectors.Find_Index (Dictionary, Word);
Append_Child (Word_Tree, Pos, New_Node);
if not Used (Ix) then
if Word = Target then
Used (Ix) := True;
Solved := True;
Word_Rec.Word := Word;
Solution := Pos;
Muts_Vec.Append (Word_Rec);
end if;
⚫
end loop;
end if;
end if;
if Word = Target then
end if;
Found := True;
if not Solved then
return;
Recurse_Tree (First_Child (Pos), Level, Target, Dict);
end if;
end if;
end loop;
Pos := Next_Sibling (Pos);
end Check_Mutations;
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
begin
if Start_S'Length /= Target_S'Length then
if Start_S'Length /= Target_S'Length then
Line 199: Line 206:
end if;
end if;
Dictionary := Load_Candidate_Words (DICT_FILENAME, Start_S'Length);
Dictionary := Load_Candidate_Words (DICT_FILENAME, Start_S'Length);
Used := Create_Unused_Vec (Positive (Word_Vectors.Length (Dictionary)));
Start := To_Unbounded_String (Start_S);
Start := To_Unbounded_String (Start_S);
Target := To_Unbounded_String (Target_S);
Target := To_Unbounded_String (Target_S);
while Level <= MAX_DEPTH and then not Found loop
Solved := False;
Muts_Vec.Clear;
Word_Node.Level := 1;
if Level = 1 then
Word_Node.Word := Start;
⚫
Word_Tree := Empty_Tree;
⚫
Mutations := Mutate (Start, Start_S'Length, Dictionary);
Word_Tree.Insert_Child (Word_Tree.Root, No_Element, Word_Node);
Word_Rec.Parent := Start;
Check_Mutations;
Start_Pos := Find (Word_Tree, Word_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;
Level := @ + 1;
end loop;
end loop;
if not Found then
if not Solved then
Put_Line (Start & " -> " & Target & " - No solution found at depth" & MAX_DEPTH'Image);
Put_Line (Start & " -> " & Target & " - No solution found at depth" & MAX_DEPTH'Image);
else
else
Word := Target;
while not Is_Root (Solution) loop
for Lev in reverse 1 .. Level - 1 loop
Word_Node := Element (Solution);
for W_Ix in 1 .. Word_Tree (Lev).Length loop
Output := Word_Node.Word & " -> " & Output;
Word_Rec := Word_Tree (Lev)(Positive (W_Ix));
Solution := Parent (Solution);
if Word_Rec.Word = Word then
Put (Word & " <- ");
⚫
Word := Word_Rec.Parent;
⚫
exit;
end if;
end loop;
end loop;
end loop;
Put (Start); New_Line;
Put_Line (Output & Target);
end if;
end if;
end Ladder;
end Ladder;
Line 248: Line 242:
As expected "ada" can become a "god", and "rust" can go to "hell" :-)
As expected "ada" can become a "god", and "rust" can go to "hell" :-)
<pre>
<pre>
man <- may <- bay <- boy
boy -> bay -> may -> man
lady <- lazy <- laze <- gaze <- gale <- gall <- gill <- girl
girl -> gill -> gall -> gale -> gaze -> laze -> lazy -> lady
john <- cohn <- conn <- cone <- cane <- jane
jane -> cane -> cone -> conn -> cohn -> john
child -> adult - No solution found at depth 50
child -> adult - No solution found at depth 50
god <- gad <- fad <- faa <- fda <- ada
ada -> fda -> faa -> fad -> gad -> god
hell <- bell <- belt <- best <- bust <- rust
rust -> bust -> best -> belt -> bell -> hell
</pre>
</pre>


Retrieved from "https://rosettacode.org/wiki/Word_ladder"