Data update

Task/Word-ladder/APL/word-ladder.apl

@@ -0,0 +1,23 @@
+wordladder←{
+    from to←⍵
+    dict←((≢¨⍺)=≢to)/⍺
+
+    dict{
+        match←(⊂to)≡¨⊃∘⌽¨⍵
+        ∨/match:⊃match/⍵
+        0∊≢¨⍺⍵:⍬
+        word←⊃⌽ladder←⊃⍵
+        next←(1=⍺+.≠¨⊂word)/⍺
+        (⍺~next)∇(1↓⍵),(⊂ladder),¨⊂¨next
+    }⊂⊂from
+}
+task←{
+    dict←(~dict∊⎕TC)⊆dict←⊃⎕NGET'unixdict.txt'
+    pairs←('boy' 'man')('girl' 'lady')('john' 'jane')('child' 'adult')
+    ⎕←↑↑{
+        hdr←⍺,' → ',⍵,': '
+        ladder←dict wordladder ⍺ ⍵
+        0=≢ladder:hdr,'impossible'
+        hdr,1↓∊'→',¨ladder
+    }/¨pairs
+}

Task/Word-ladder/Ada/word-ladder.ada

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

Task/Word-ladder/Refal/word-ladder.refal

@@ -0,0 +1,95 @@
+$ENTRY Go {
+    , <ReadFile 1 'unixdict.txt'>: e.Dict
+    = <DisplayLadder (e.Dict) ('boy') ('man')>
+      <DisplayLadder (e.Dict) ('girl') ('lady')>
+      <DisplayLadder (e.Dict) ('john') ('jane')>
+      <DisplayLadder (e.Dict) ('child') ('adult')>;
+};
+
+DisplayLadder {
+    (e.Dict) (e.From) (e.To),
+        e.From ' -> ' e.To ': ': e.Header,
+        <Ladder (e.Dict) (e.From) (e.To)>: {
+            Impossible = <Prout e.Header 'impossible'>;
+            Result e.Words = <Prout e.Header <Join ('->') e.Words>>;
+    };
+};
+
+Join {
+    (e.Join) = ;
+    (e.Join) (e.Word) = e.Word;
+    (e.Join) (e.Word) e.Words = e.Word e.Join <Join (e.Join) e.Words>;
+};
+
+ReadFile {
+    s.Chan e.File =
+        <Open 'r' s.Chan e.File>
+        <ReadFile (s.Chan)>;
+    (s.Chan), <Get s.Chan>: {
+        0 = ;
+        e.Line = (e.Line) <ReadFile (s.Chan)>;
+    };
+};
+
+Filter {
+    (e.Fn) = ;
+    (e.Fn) t.Item e.Items, <Mu e.Fn t.Item>: {
+        True = t.Item <Filter (e.Fn) e.Items>;
+        False = <Filter (e.Fn) e.Items>;
+    };
+};
+
+SameLen {
+    (e.Word1) (e.Word2),
+        <Lenw e.Word1>: s.Len e.Word1,
+        <Lenw e.Word2>: s.Len e.Word2 = True;
+    (e.Word1) (e.Word2) = False;
+};
+
+Diffs {
+    () () = 0;
+    (s.X e.Word1) (s.X e.Word2) = <Diffs (e.Word1) (e.Word2)>;
+    (s.X e.Word1) (s.Y e.Word2) = <+ 1 <Diffs (e.Word1) (e.Word2)>>;
+};
+
+OneDiff {
+    t.Word1 t.Word2, <Diffs t.Word1 t.Word2>: {
+        1 = True;
+        s.Diffs = False;
+    };
+};
+
+Ladder {
+    (e.Dict) t.From t.To,
+        <Filter (SameLen t.From) e.Dict>: e.Dict2 =
+        <Ladder2 ((t.From)) (e.Dict2) t.To>;
+};
+
+Ladder2 {
+    (e.Ladders) (e.Dict) t.To,
+        e.Ladders: e.X (e.Words t.To) e.Y = Result e.Words t.To;
+
+    (e.Ladders) () t.To = Impossible;
+    () (e.Dict) t.To = Impossible;
+
+    ((e.Ladder) e.Ladders) (e.Dict) t.To,
+        e.Ladder: e.1 t.Last,
+        <Filter (OneDiff t.Last) e.Dict>: e.NextWords,
+        <RemoveAll (e.NextWords) e.Dict>: e.NextDict,
+        <AddAll (e.Ladder) e.NextWords>: e.NextLadders
+        = <Ladder2 (e.Ladders e.NextLadders) (e.NextDict) t.To>;
+};
+
+RemoveAll {
+    (e.Remove) = ;
+    (e.Remove) t.Word e.Words, e.Remove: {
+        e.X t.Word e.Y = <RemoveAll (e.Remove) e.Words>;
+        e.Remove = t.Word <RemoveAll (e.Remove) e.Words>;
+    };
+};
+
+AddAll {
+    (e.Ladder) = ;
+    (e.Ladder) t.Word e.Words =
+        (e.Ladder t.Word) <AddAll (e.Ladder) e.Words>;
+};

Task/Word-ladder/SETL/word-ladder.setl

@@ -0,0 +1,45 @@
+program word_ladder;
+    dict := read_dictionary("unixdict.txt");
+    testpairs := [['boy', 'man'], ['girl', 'lady'], ['john', 'jane'], ['child', 'adult']];
+
+    loop for [fromWord, toWord] in testpairs do
+        l := ladder(dict, fromWord, toWord);
+        if l = om then
+            print(fromWord, '->', toWord, 'impossible');
+        else
+            print(fromWord, '->', toWord, l);
+        end if;
+    end loop;
+
+    proc ladder(dict, fromWord, toWord);
+        dict := {word : word in dict | #word = #fromWord};
+        ladders := [[fromWord]];
+        dict less:= fromWord;
+        loop while ladders /= [] do
+            l fromb ladders;
+            next := {word : word in onediff(dict, l(#l))};
+            dict -:= next;
+            nextls := [l + [word] : word in next];
+            if exists l in nextls | l(#l) = toWord then
+                return l;
+            end if;
+            ladders +:= nextls;
+        end loop;
+        return om;
+    end proc;
+
+    proc onediff(rw dict, word);
+        return {other : other in dict | #other = #word and diffs(word, other) = 1};
+    end proc;
+
+    proc diffs(word1, word2);
+        return +/[if word1(i) = word2(i) then 0 else 1 end : i in [1..#word1]];
+    end proc;
+
+    proc read_dictionary(file);
+        dictfile := open(file, 'r');
+        dict := {getline(dictfile) : until eof(dictfile)};
+        close(dictfile);
+        return dict;
+    end proc;
+end program;