Word ladder: Difference between revisions
Content deleted Content added
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 |
type Word_Node_T is record |
||
Level : Positive; |
|||
⚫ | |||
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 |
package Dict_Vectors is new Ada.Containers.Vectors (Positive, Unbounded_String); |
||
package |
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; |
|||
⚫ | |||
⚫ | |||
Solution : Cursor; |
|||
function Load_Candidate_Words (Dict_Filename : String; Word_Len : Positive) |
function Load_Candidate_Words (Dict_Filename : String; Word_Len : Positive) |
||
return |
return Dict_Vectors.Vector is |
||
Dict_File : File_Type; |
Dict_File : File_Type; |
||
Read_Word : Unbounded_String; |
Read_Word : Unbounded_String; |
||
Cands : |
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 Create_Unused_Vec (Vec_Len : Positive) |
|||
return Used_Vectors.Vector is |
|||
⚫ | |||
⚫ | |||
⚫ | |||
Used.Append (False); |
|||
end loop; |
|||
return Used; |
|||
end Create_Unused_Vec; |
|||
⚫ | |||
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 .. |
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 |
procedure Recurse_Tree (Start_Pos : Cursor; |
||
Level : Positive; |
|||
Dictionary : Word_Vectors.Vector; |
|||
Target : Unbounded_String; |
|||
Dict : in out Dict_Vectors.Vector) is |
|||
⚫ | |||
Pos : Cursor := Start_Pos; |
|||
Mutations : Word_Vectors.Vector; |
Mutations : Word_Vectors.Vector; |
||
New_Node : Word_Node_T; |
|||
⚫ | |||
Word_Rec : Word_Rec_T; |
|||
while not Solved and then Pos /= No_Element loop |
|||
if Element (Pos).Level = Level then |
|||
⚫ | |||
⚫ | |||
if not Word_Vectors.Is_Empty (Mutations) then |
|||
procedure Check_Mutations is |
|||
for Word of Mutations loop |
|||
⚫ | |||
begin |
|||
New_Node.Word := Word; |
|||
Append_Child (Word_Tree, Pos, New_Node); |
|||
if |
if Word = Target then |
||
Solved := True; |
|||
Solution := Pos; |
|||
end if; |
|||
⚫ | |||
end if; |
end if; |
||
end if; |
|||
if not Solved then |
|||
Recurse_Tree (First_Child (Pos), Level, Target, Dict); |
|||
end if; |
|||
Pos := Next_Sibling (Pos); |
|||
end |
end loop; |
||
end Recurse_Tree; |
|||
procedure Ladder (Start_S, Target_S : String) is |
|||
⚫ | |||
⚫ | |||
Word_Node : Word_Node_T; |
|||
Start, Target : 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); |
||
Solved := False; |
|||
Word_Node.Level := 1; |
|||
Word_Node.Word := Start; |
|||
⚫ | |||
⚫ | |||
Word_Tree.Insert_Child (Word_Tree.Root, No_Element, Word_Node); |
|||
Word_Rec.Parent := Start; |
|||
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; |
|||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
Level := @ + 1; |
Level := @ + 1; |
||
end loop; |
end loop; |
||
if not |
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 |
||
while not Is_Root (Solution) loop |
|||
Word_Node := Element (Solution); |
|||
Output := Word_Node.Word & " -> " & Output; |
|||
Solution := Parent (Solution); |
|||
if Word_Rec.Word = Word then |
|||
Put (Word & " <- "); |
|||
⚫ | |||
⚫ | |||
end if; |
|||
end loop; |
|||
end loop; |
end loop; |
||
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> |
||
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 |
child -> adult - No solution found at depth 50 |
||
ada -> fda -> faa -> fad -> gad -> god |
|||
rust -> bust -> best -> belt -> bell -> hell |
|||
</pre> |
</pre> |
||