--This program was adapted from the example in Chapter 14 of
--   STL Tutorial and Reference Guide, 2nd ed.
--   Musser, Derge, and Saini
--
--The dictionary file for this program can be found at Musser's web site:
--
--  <http://www.cs.rpi.edu/~musser/stl-book/source/>
--
--The file name is "diction" or "diction.txt".
--

with Anagram_Types;  use Anagram_Types;
with Ada.Text_IO;  use Ada.Text_IO;
with Ada.Integer_Text_IO;  use Ada.Integer_Text_IO;
with Ada.Command_Line;  use Ada.Command_Line;
with Ada.Characters.Handling;  use Ada.Characters.Handling;
with Ada.Containers.Generic_Array_Sort;
with Ada.Strings.Less_Case_Insensitive;
with Ada.Strings.Equal_Case_Insensitive;
with Charles.Algorithms.Generic_Adjacent_Find;

procedure Anagram is

   V : Anagram_Types.Pair_Vectors.Vector;
   use Pair_Vectors;

   S : Set_Types.Set;
   use Set_Types;

   use Charles.Algorithms;
   use Ada.Containers;

begin

   if Argument_Count = 0 then
      Put_Line ("no dictionary specified");
      return;
   end if;

   declare
      function Less_Case_Insensitive (I, J : Character) return Boolean is
      begin
         return To_Lower (I) < To_Lower (J);
      end;

      procedure Sort is
         new Ada.Containers.Generic_Array_Sort
          (Positive,
           Character,
           String,
           "<" => Less_Case_Insensitive);

      File : File_Type;

      Line : String (1 .. 81);
      Last : Natural;
   begin
      Open (File, In_File, Argument (1));

      while not End_Of_File (File) loop

         Get_Line (File, Line, Last);
         pragma Assert (Last > 0);
         pragma Assert (Last < Line'Last);

         declare
            N    : constant Positive := Last - Line'First + 1;
            Pair : Pair_Type (Length => N);
         begin
            Pair.Word := Line (Line'First .. Last);
            Pair.Sorted := Pair.Word;
            Sort (Pair.Sorted);
            Append (V, New_Item => Pair);
         end;

      end loop;

      Close (File);
   end;

   Put ("dictionary has");
   Put (Count_Type'Image (Length (V)));
   Put_Line (" entries");
   New_Line;

   declare
      function "<" (L, R : Pair_Type) return Boolean is
         LS : String renames L.Sorted;
         RS : String renames R.Sorted;
      begin
         return Ada.Strings.Less_Case_Insensitive (LS, RS);
      end;

      procedure Sort is
         new Pair_Vectors.Generic_Sort;
   begin
      Sort (V);
   end;

   declare

      function Is_Equal (I, J : Positive) return Boolean is
         Result : Boolean;

         procedure Process_I (IE : Pair_Type) is
            procedure Process_J (JE : Pair_Type) is
            begin
               Result := Ada.Strings.Equal_Case_Insensitive (IE.Sorted, JE.Sorted);
            end;
         begin
            Query_Element (V, J, Process_J'Access);
         end;
      begin
         Query_Element (V, I, Process_I'Access);
         return Result;
      end;

      function Find is
         new Charles.Algorithms.Generic_Adjacent_Find
          (Positive,
           Integer'Succ);

      I : Positive := First_Index (V);
      J : constant Positive := Last_Index (V) + 1;
      K : Positive;

      C : Set_Types.Cursor;
      B : Boolean;

      --use Key_Insertion;

   begin

      loop

         I := Find (I, J);

         exit when I = J;

         K := I + 1;

         while K /= J
           and then Is_Equal (I, K)
         loop
            K := K + 1;
         end loop;

         declare
            E : constant Entry_Type :=
              (Index => K - I,
               Data  => Integer_Vectors.Empty_Vector);
         begin
            Insert (S, E, C, B);
         end;

         declare
            procedure Append (ME : in out Entry_Type) is
               MV : Integer_Vectors.Vector renames ME.Data;
               use Integer_Vectors;
            begin
               Append (MV, New_Item => I);
            end;
         begin
            Map_Types.Checked_Update_Element (S, C, Append'Access);
         end;

         I := K;

      end loop;

   end;

   Print_Results :
   declare

      procedure Print (E : Entry_Type) is
         procedure Process (IVC : Integer_Vectors.Cursor) is
            J : constant Positive := Integer_Vectors.Element (IVC);
            K : constant Positive := J + E.Index - 1;
         begin
            Put ("   ");

            for II in J .. K loop
               declare
                  procedure Put (Pair : Pair_Type) is
                  begin
                     Put (Pair.Word); Put (' ');
                  end;
               begin
                  Query_Element (V, II, Put'Access);
               end;
            end loop;

            New_Line;
         end Process;
      begin
         Integer_Vectors.Iterate (E.Data, Process'Access);
      end Print;

      I : Set_Types.Cursor := First (S);

   begin -- Print_Results

      while Has_Element (I) loop

         declare
            procedure Process (ME : Entry_Type) is
               use Integer_Vectors;
            begin
               Put ("There are");
               Put (Count_Type'Image (Length (ME.Data)));
               Put (" anagram group(s) of size ");
               Put (ME.Index, Width => 0);
               Put_Line (".");
               New_Line;

               if not Is_Empty (ME.Data) then
                  Print (ME);
                  New_Line;
               end if;
            end Process;
         begin
            Query_Element (I, Process'Access);
         end;

         Next (I);

      end loop;

   end Print_Results;

end Anagram;

