--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;

   M : Map_Types.Map;
   use Map_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_Upper (I) < To_Upper (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 : Map_Types.Cursor;
      B : Boolean;

   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;

         Insert (M, K - I, C, B);

         declare
            procedure Process
              (K  :        Map_Index_Subtype;
               ME : in out Integer_Vectors.Vector) is
            begin
               Integer_Vectors.Append (ME, New_Item => I);
            end;
         begin
            Map_Types.Update_Element (C, Process'Access);
         end;

         I := K;

      end loop;

   end;


   declare

      type Cursor_Array is
        array (Count_Type range <>) of Map_Types.Cursor;

      Cursors : Cursor_Array (1 .. Length (M));

   begin

      declare
         I : Count_Type := 0;

         procedure Process (C : Map_Types.Cursor) is
         begin
            I := I + 1;
            Cursors (I) := C;
         end;
      begin
         Map_Types.Iterate (M, Process'Access);
      end;

      declare
         function "<" (L, R : Map_Types.Cursor) return Boolean is
         begin
            return Key (L) < Key (R);
         end;

         procedure Sort is
            new Ada.Containers.Generic_Array_Sort
              (Count_Type,
               Map_Types.Cursor,
               Cursor_Array);
      begin
         Sort (Cursors);
      end;


      for Index in Cursors'Range loop

         declare

            C : constant Map_Types.Cursor := Cursors (Index);
            I : constant Positive := Key (C);

            procedure Process (VC : Integer_Vectors.Cursor) is
               J : constant Positive := Integer_Vectors.Element (VC);
               K : constant Positive := J + I - 1;
            begin
               Put ("   ");

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

               New_Line;
            end;

            procedure Process
              (K  : Map_Index_Subtype;
               ME : Integer_Vectors.Vector) is

               use Integer_Vectors;
               pragma Assert (not Is_Empty (ME));
            begin
               Put ("There are");
               Put (Count_Type'Image (Length (ME)));
               Put (" anagram group(s) of size ");
               Put (I, Width => 0);
               Put_Line (".");
               New_Line;
               Integer_Vectors.Iterate (ME, Process'Access);
               New_Line;
            end;

         begin
            Map_Types.Query_Element (C, Process'Access);
         end;

      end loop;

   end;


end Anagram;

