with Charles.Algorithms.Generic_Binary_Search;
with Ada.Numerics.Discrete_Random;
with Integer_Sets;  use Integer_Sets;
with Integer_Vectors;  use Integer_Vectors;
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.Containers;  use Ada.Containers;

procedure Test_Sets is

--     procedure Print (S : in Set_Type) is
--        procedure Process (C : Cursor_Type) is
--        begin
--           Put (Element (C), Width => 0);
--           Put (' ');
--        end;

--        procedure Iterate is
--           new Integer_Sets.Generic_Iteration;
--     begin
--        Iterate (S);
--        New_Line;
--     end Print;


   package Count_IO is
      new Ada.Text_IO.Integer_IO (Ada.Containers.Count_Type);

   use Count_IO;

   subtype Element_Subtype is Natural range 0 .. 999;


   procedure Vet (S : in Set) is
      E : Integer := -1;
      C : Integer_Sets.Cursor := First (S);
      N : Count_Type'Base := 0;
   begin
      --Check_Invariant (S);

      while Has_Element (C) loop
         pragma Assert (Element (C) > E);
         E := Element (C);
         Next (C);
         N := N + 1;
      end loop;

      pragma Assert (N = Length (S));

      N := 0;
      C := Last (S);
      E := Element_Subtype'Last + 1;

      while Has_Element (C) loop
         pragma Assert (Element (C) < E);
         E := Element (C);
         Previous (C);
         N := N + 1;
      end loop;

      pragma Assert (N = Length (S));
   end Vet;

   function "=" (S : Set; V : Vector) return Boolean is
      I : Integer_Sets.Cursor := First (S);
   begin
      if Length (S) /= Length (V) then
         return False;
      end if;

      for Index in First_Index (V) .. Last_Index (V) loop
         if Element (V, Index) /= Element (I) then
            return False;
         end if;

         Next (I);
      end loop;

      pragma Assert (not Has_Element (I));
      return True;
   end "=";

   function Binary_Search
     (V : Vector;
      E : Integer) return Integer_Vectors.Cursor is

      function Is_Less
        (C : Integer_Vectors.Cursor;
         E : Integer) return Boolean is
      begin
         return Element (C) < E;
      end Is_Less;

      function Is_Greater
        (C : Integer_Vectors.Cursor;
         E : Integer) return Boolean is
      begin
         return Element (C) > E;
      end;

      function "+"
        (L : Integer_Vectors.Cursor;
         R : Integer'Base) return Integer_Vectors.Cursor is
      begin
         return To_Cursor (V, To_Index (L) + R);
      end;

      function "-" (L, R : Integer_Vectors.Cursor) return Integer'Base is
         LI : Integer'Base;
         RI : Integer'Base;
      begin
         if Has_Element (L) then
            LI := To_Index (L);
         else
            LI := Last_Index (V) + 1;
         end if;

         if Has_Element (R) then
            RI := To_Index (R);
         else
            RI := Last_Index (V) + 1;
         end if;

         return LI - RI;
      end "-";

      function Binary_Search is
         new Charles.Algorithms.Generic_Binary_Search
            (Iterator_Type => Integer_Vectors.Cursor,
             Offset_Type   => Integer,
             Element_Type  => Integer);

      Back : constant Integer_Vectors.Cursor :=
        Integer_Vectors.No_Element;
   begin
      return Binary_Search (First (V), Back, Item => E);
   end;

   function Is_In (E : Integer; V : Vector) return Boolean is
   begin
      return Binary_Search (V, E) /= Integer_Vectors.No_Element;
   end;

   procedure Sort is
      new Integer_Vectors.Generic_Sort;

   package Random_Integers is
      new Ada.Numerics.Discrete_Random (Element_Subtype);

   G : Random_Integers.Generator;
   use Random_Integers;

   S, S2 : Set;
   E : Natural;
   C, C2 : Integer_Sets.Cursor;
   B : Boolean;
   N : Natural;
   V : Vector;
   CV : Integer_Vectors.Cursor;

   Seed : Integer := 0;

begin

   if Argument_Count > 0 then

      begin
         Seed := Integer'Value (Argument (1));
      exception
         when others =>
            null;
      end;

   end if;

   Put ("seed=");
   Put (Seed, Width => 0);
   New_Line (2);

   Reset (G, Seed);

   Vet (S);

   for I in 0 .. 1000 loop

      if I mod 100 = 0 then
         Put ("I=");
         Put (I, Width => 0);
         Put (" S.Length=");
         Put (Length (S), Width => 0);
         New_Line;
      end if;

--        if Length (S) mod 100 = 0 then   --spurious GNAT warning??
--            Put (Length (S), Width => 0);
--            New_Line;
--        end if;

--        Print (S);
--        New_Line;
      S2 := S;
      pragma Assert (S2 = S);

      E := Random (G);

      C2 := Find (S, E);

      Insert (S, E, C, B);
      pragma Assert (Element (C) = E);

      if B then

         if Length (S) = 1 then
            pragma Assert (First (S) = C);
            pragma Assert (Last (S) = C);
            null;
         end if;

         pragma Assert (not Has_Element (C2));
         Append (V, New_Item => E);
         Sort (V);
      else
         pragma Assert (C2 = C);
         null;
      end if;

      pragma Assert (Contains (S, E));

      C := Ceiling (S, E);
      pragma Assert (Element (C) = E);

      C := Floor (S, E);
      pragma Assert (Element (C) = E);

      pragma Assert (Is_In (E, V));

      Vet (S);
      pragma Assert (S = V);
      pragma Assert (Next (Last (S)) = Integer_Sets.No_Element);
      pragma Assert (Previous (First (S)) = Integer_Sets.No_Element);

   end loop;

   pragma Assert (Length (S) = Length (V));

   New_Line;

   while not Is_Empty (S) loop

      if Length (S) mod 50 = 0 then
         Put ("S.Length=");
         Put (Length (S), Width => 0);
         New_Line;
      end if;

      S2 := S;
      pragma Assert (S2 = S);

      N := Random (G) mod Count_Type'Pos (Length (S));
      C := First (S);

      for I in 1 .. N loop
         Next (C);
      end loop;

      pragma Assert (Has_Element (C));

      E := Element (C);

      CV := Binary_Search (V, E);
      pragma Assert (Has_Element (CV));

      declare
         --CC : Integer_Sets.Cursor := C;
      begin
         Delete (S, C);
         pragma Assert (not Contains (S, E));
         --Delete (S, CC);  --should raise PE
      end;

      C := Ceiling (S, E);
      pragma Assert (C = Integer_Sets.No_Element
                       or else Element (C) /= E);

      C := Floor (S, E);
      pragma Assert (C = Integer_Sets.No_Element
                       or else Element (C) /= E);

      Delete (V, Index => N);
      pragma Assert (not Is_In (E, V));

      pragma Assert (S = V);
      pragma Assert (Next (Last (S)) = Integer_Sets.No_Element);
      pragma Assert (Previous (First (S)) = Integer_Sets.No_Element);

--        if Length (S) mod 100 = 0 then
--           Put (Length (S), Width => 0);
--           New_Line;
--        end if;

--        Print (S);
--        New_Line;
      Vet (S);

   end loop;

end Test_Sets;
