aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data update

Browse source
This commit is contained in:
Ingy döt Net 2026-02-01 16:33:20 -08:00
parent 5150844a7d
commit 4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
Download patch file Download diff file Expand all files Collapse all files

146
Task/Word-ladder/Ada/word-ladder.ada
View file

@ -1,146 +0,0 @@
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;

25
Task/Word-ladder/Mathematica/word-ladder.math
View file

@ -1,15 +1,14 @@
db=DeleteDuplicates[RemoveDiacritics[ToLowerCase[Select[DictionaryLookup[],StringLength/*EqualTo[3]]]]];
sel=Select[Subsets[db,{2}],HammingDistance[#[[1]],#[[2]]]==1&];
g=Graph[db,UndirectedEdge@@@sel];
FindShortestPath[g,"boy","man"]
words = ReadList["unixdict.txt", Word];
db=DeleteDuplicates[RemoveDiacritics[ToLowerCase[Select[DictionaryLookup[],StringLength/*EqualTo[4]]]]];
sel=Select[Subsets[db,{2}],HammingDistance[#[[1]],#[[2]]]==1&];
g=Graph[db,UndirectedEdge@@@sel];
FindShortestPath[g,"girl","lady"]
FindShortestPath[g,"john","jane"]
wordLadder[words_, start_, target_] := Module[{wordSelection, graph, path, noSolution = "impossible"},
If[StringLength[start] != StringLength[target], Return[noSolution]];
wordSelection = Select[words, StringLength[#] == StringLength[start]&];
graph = UndirectedEdge @@@ Select[Subsets[wordSelection, {2}], HammingDistance @@ # == 1 &];
If[! SubsetQ[VertexList[graph], {start, target}], Return[noSolution]];
path = FindShortestPath[graph, start, target];
If[path == {}, Return[noSolution]];
path];
db=DeleteDuplicates[RemoveDiacritics[ToLowerCase[Select[DictionaryLookup[],StringLength/*EqualTo[5]]]]];
sel=Select[Subsets[db,{2}],HammingDistance[#[[1]],#[[2]]]==1&];
g=Graph[db,UndirectedEdge@@@sel];
FindShortestPath[g,"child","adult"]
tests = {{"boy", "man"}, {"girl", "lady"}, {"john", "jane"}, {"child", "adult"}};
Map[{#[[1]] <> " -> " <> #[[2]] <> ": ", wordLadder[words, #[[1]], #[[2]]]}&, tests] //
TableForm[#, TableDepth -> 2]&