--This program was adapted from the example in Chapter 14 of
--   STL Tutorial and Reference Guide, 2nd ed.
--   Musser, Derge, and Saini
--
--The example in the book uses a map whose element type is a list.  The
--argument is that if you used a vector of lists, and you had to expand
--the vector, then you'd have to the copy the vector elements during the
--expansion.  The vector elements are potentially large lists, so the
--expansion is expensive.
--
--If you use a map, then there is no cost for expansion, since the list
--elements are stored on internal storage nodes, which just get rehashed
--onto the new hash table; there is no copying of list elements.
--
--However, the copying of elements in only done in the case of a definite
--vector.  When an indefinite vector is expanded, the internal element
--pointers simply slide up.  The vector elements (here, integer-element
--vectors instead of lists) are not copied.  In this sense an indefinite
--vector is very similar to a map.
--
--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.Strings.Less_Case_Insensitive;
with Ada.Strings.Equal_Case_Insensitive;
with Ada.Containers.Generic_Array_Sort;
with Charles.Algorithms.Generic_Adjacent_Find;

procedure Anagram is

   V : Anagram_Types.Pair_Vectors.Vector;
   use Pair_Vectors;

   M : Map_Types.Vector;
   use Map_Types;

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

   use Charles.Algorithms;
   use Ada.Containers;

begin

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

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

      N : Positive;

   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;

         N := K - I;

         if Last_Index (M) < N then

            --NOTE:
            --Expand the vector.  This does copy the existing
            --elements, because the internal pointers just
            --slide up.  See my comments at the top of this
            --module.
            --END NOTE.

            declare
               Count : constant Positive := N - Last_Index (M);
            begin
               Append (M, Integer_Vectors.Empty_Vector, Count_Type (Count));
            end;

         end if;

         declare
            procedure Append (V : in out Integer_Vectors.Vector) is
               use Integer_Vectors;
            begin
               Append (V, New_Item => I);
            end;
         begin
            Update_Element (M, N, Append'Access);
         end;

         I := K;

      end loop;

   end;

   for I in First_Index (M) .. Last_Index (M) loop

      declare
         procedure Process (C : Integer_Vectors.Cursor) is
            use Integer_Vectors;
            J : constant Positive := Element (C);
            K : constant Positive := J + I - 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;

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

            if not Is_Empty (ME) then
               Iterate (ME, Process'Access);
               New_Line;
            end if;
         end Process;

      begin
         Query_Element (M, I, Process'Access);
      end;

   end loop;

end Anagram;

