--  Copyright (2008-2013) Cédric Coussinet (cedric.coussinet@nomoseed.net)
--
--  This program is free software: you can redistribute it and/or modify
--  it under the terms of the GNU Affero General Public License as published
--  by the Free Software Foundation, either version 3 of the License, or
--  (at your option) any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
--  GNU Affero General Public License for more details.

--  You should have received a copy of the GNU Affero General Public License
--  along with this program. If not, see <http://www.gnu.org/licenses/>

with Nomo.Numerics.Accurately.Constants;

package body Nomo.Interpreter.Gen_Rules_Directories.Insertion is

   function Get_New_Reference(This : in Rules_Directory) return not null Rule_Ptr is
   begin
      return This.References (This.Last_Reference + 1).Reference;
   end Get_New_Reference;

   function Has_Space (This : in Rules_Directory) return Boolean is
   begin
      return This.Last_Reference /= Reference_Index'Last;
   end Has_Space;

   procedure Specificity_Dichotomy(References                 : in Rule_References;
                                   Start_Index                : in Reference_Index;
                                   End_Index                  : in Reference_Index;
                                   Median_Index               : out Reference_Index;
                                   Excitatory_Specificity_Log : in Real_Accurately;
                                   Inhibitory_Specificity_Log : in Real_Accurately);
   pragma Inline(Specificity_Dichotomy);
   pragma Precondition(Start_Index <= End_Index);
   pragma Postcondition(Start_Index <= Median_Index and Median_Index <= End_Index);

   procedure Specificity_Dichotomy(References                 : in Rule_References;
                                   Start_Index                : in Reference_Index;
                                   End_Index                  : in Reference_Index;
                                   Median_Index               : out Reference_Index;
                                   Excitatory_Specificity_Log : in Real_Accurately;
                                   Inhibitory_Specificity_Log : in Real_Accurately) is
      Low_Index  : Reference_Index_Extend := Start_Index;
      High_Index : Reference_Index_Extend := End_Index;
   begin
      while Low_Index <= High_Index loop
         pragma Assert((Low_Index in Reference_Index and High_Index in Reference_Index) and then
                       (References (Low_Index).Excitatory_Specificity_Log < References (High_Index).Excitatory_Specificity_Log
           or else (References (Low_Index).Excitatory_Specificity_Log = References (High_Index).Excitatory_Specificity_Log
             and then References (Low_Index).Inhibitory_Specificity_Log <= References (High_Index).Inhibitory_Specificity_Log)));
         Median_Index := (Low_Index + High_Index) / 2;
         if Excitatory_Specificity_Log < References(Median_Index).Excitatory_Specificity_Log
           or else (Excitatory_Specificity_Log = References (Median_Index).Excitatory_Specificity_Log
                    and then Inhibitory_Specificity_Log <= References (Median_Index).Inhibitory_Specificity_Log) then
            High_Index := Median_Index - 1;
         else
            Low_Index := Median_Index + 1;
         end if;
      end loop;
   end Specificity_Dichotomy;

   procedure Get_Specificity_Sup(References                 : in Rule_References;
                                 Start_Index                : in Reference_Index;
                                 End_Index                  : in Reference_Index;
                                 Median_Index               : out Reference_Index;
                                 Excitatory_Specificity_Log : in Real_Accurately;
                                 Inhibitory_Specificity_Log : in Real_Accurately);
   pragma Precondition(Start_Index <= End_Index);
   pragma Postcondition(Start_Index <= Median_Index and Median_Index <= End_Index + 1);

   procedure Get_Specificity_Sup(References                 : in Rule_References;
                                 Start_Index                : in Reference_Index;
                                 End_Index                  : in Reference_Index;
                                 Median_Index               : out Reference_Index;
                                 Excitatory_Specificity_Log : in Real_Accurately;
                                 Inhibitory_Specificity_Log : in Real_Accurately) is
   begin
      Specificity_Dichotomy (References,
                             Start_Index,
                             End_Index,
                             Median_Index,
                             Excitatory_Specificity_Log,
                             Inhibitory_Specificity_Log);
      if Excitatory_Specificity_Log > References (Median_Index).Excitatory_Specificity_Log
        or else (Excitatory_Specificity_Log = References (Median_Index).Excitatory_Specificity_Log
        and then Inhibitory_Specificity_Log > References (Median_Index).Inhibitory_Specificity_Log) then
         Median_Index := Median_Index + 1;
      end if;
   end Get_Specificity_Sup;

   procedure Get_Specificity_Inf(References                 : in Rule_References;
                                 Start_Index                : in Reference_Index;
                                 End_Index                  : in Reference_Index;
                                 Median_Index               : out Reference_Index;
                                 Excitatory_Specificity_Log : in Real_Accurately;
                                 Inhibitory_Specificity_Log : in Real_Accurately);
   pragma Precondition(Start_Index <= End_Index);
   pragma Postcondition(Start_Index - 1 <= Median_Index and Median_Index <= End_Index);

   procedure Get_Specificity_Inf(References                 : in Rule_References;
                                 Start_Index                : in Reference_Index;
                                 End_Index                  : in Reference_Index;
                                 Median_Index               : out Reference_Index;
                                 Excitatory_Specificity_Log : in Real_Accurately;
                                 Inhibitory_Specificity_Log : in Real_Accurately) is
   begin
      Specificity_Dichotomy(References,
                            Start_Index,
                            End_Index,
                            Median_Index,
                            Excitatory_Specificity_Log,
                            Inhibitory_Specificity_Log);
      if Excitatory_Specificity_Log < References(Median_Index).Excitatory_Specificity_Log
        or else (Excitatory_Specificity_Log = References(Median_Index).Excitatory_Specificity_Log
                 and then Inhibitory_Specificity_Log <= References(Median_Index).Inhibitory_Specificity_Log) then
         Median_Index := Median_Index - 1;
      end if;
   end Get_Specificity_Inf;

   procedure Adjust_Updatables(Updatables     : in out Index_Tab;
                               Last_Updatable : in out Reference_Index_Minus;
                               Target_Index   : in Reference_Index;
                               Add_New        : in Boolean);

   procedure Adjust_Updatables(Updatables     : in out Index_Tab;
                               Last_Updatable : in out Reference_Index_Minus;
                               Target_Index   : in Reference_Index;
                               Add_New        : in Boolean) is
      Low_Index    : Reference_Index := Reference_Index'First;
      High_Index   : Reference_Index_Minus := Last_Updatable;
      Median_Index : Reference_Index := Reference_Index'First;
   begin
      if Last_Updatable /= Reference_Index_Minus'First then
         while Low_Index <= High_Index loop
            pragma Assert (Updatables (Low_Index) <= Updatables (High_Index));
            Median_Index := (Low_Index + High_Index) / 2;
            if Target_Index < Updatables (Median_Index) then
               High_Index := Median_Index - 1;
            else
               Low_Index := Median_Index + 1;
            end if;
         end loop;
         if Target_Index > Updatables (Median_Index) then
            Median_Index := Median_Index + 1;
         elsif Median_Index > 1 and then Target_Index = Updatables (Median_Index - 1) then
            Median_Index := Median_Index - 1;
         end if;
         if Add_New then
            for I in reverse Median_Index .. Last_Updatable loop
               Updatables (I + 1) := Updatables (I) + 1;
            end loop;
         else
            for I in Median_Index .. Last_Updatable loop
               Updatables (I) := Updatables (I) + 1;
            end loop;
         end if;
      end if;
      if Add_New then
         Last_Updatable := Last_Updatable + 1;
         Updatables (Median_Index) := Target_Index;
      end if;
   end Adjust_Updatables;

   Depth : constant Real_Accurately := Numerics.Accurately.Constants.Positive_Infinity_Log;

   procedure Insert (This                       : in out Rules_Directory;
                     Excitatory_Specificity_Log : in Real_Accurately;
                     Inhibitory_Specificity_Log : in Real_Accurately) is
      Target_Index   : Reference_Index := Reference_Index'First;
      Boundary_Index : Reference_Index;
      Target         : Rule_Reference := This.References(This.Last_Reference + 1);
      References     : Rule_References renames This.References;
   begin
      if This.Last_Reference /= Reference_Index_Minus'First then
         Target.Excitatory_Specificity_Log := Excitatory_Specificity_Log;
         Target.Inhibitory_Specificity_Log := Inhibitory_Specificity_Log;
         Get_Specificity_Sup (References,
                              Reference_Index'First,
                              This.Last_Reference,
                              Target_Index,
                              Excitatory_Specificity_Log,
                              Inhibitory_Specificity_Log);
         for I in Target_Index .. This.Last_Reference loop
            References(I).Final_Rule_Significantly := References(I).Final_Rule_Significantly + 1;
         end loop;
         References(Target_Index + 1 .. This.Last_Reference + 1) := References(Target_Index .. This.Last_Reference);
         References(Target_Index) := Target;
         if Target_Index > Reference_Index'First then
            if Target_Index < This.Last_Reference + 1 then
               Get_Specificity_Inf (References,
                                    References(Target_Index - 1).Final_Rule_Significantly,
                                    References(Target_Index + 1).Final_Rule_Significantly,
                                    Boundary_Index,
                                    Excitatory_Specificity_Log + Depth,
                                    Inhibitory_Specificity_Log);
            else
               Get_Specificity_Inf (References,
                                    References(Target_Index - 1).Final_Rule_Significantly,
                                    Target_Index,
                                    Boundary_Index,
                                    Excitatory_Specificity_Log + Depth,
                                    Inhibitory_Specificity_Log);
            end if;
         else
            if Target_Index < This.Last_Reference + 1 then
               Get_Specificity_Inf (References,
                                    Target_Index,
                                    This.References(Target_Index + 1).Final_Rule_Significantly,
                                    Boundary_Index,
                                    Excitatory_Specificity_Log + Depth,
                                    Inhibitory_Specificity_Log);
            else
               Boundary_Index := Target_Index;
            end if;
         end if;
         References(Target_Index).Final_Rule_Significantly := Boundary_Index;
         if Target_Index > Reference_Index'First then
            Get_Specificity_Sup (References,
                                 Reference_Index'First,
                                 Target_Index - 1,
                                 Boundary_Index,
                                 Excitatory_Specificity_Log - Depth,
                                 Inhibitory_Specificity_Log);
            for I in Boundary_Index .. Target_Index - 1 loop
               References(I).Final_Rule_Significantly := References(I).Final_Rule_Significantly + 1;
            end loop;
         end if;
      else
         References(Reference_Index'First).Final_Rule_Significantly := Reference_Index'First;
         References(Reference_Index'First).Excitatory_Specificity_Log := Excitatory_Specificity_Log;
         References(Reference_Index'First).Inhibitory_Specificity_Log := Inhibitory_Specificity_Log;
      end if;
      Adjust_Updatables (This.Updatables, This.Last_Updatable, Target_Index, Is_Updatable (Target.Reference.all));
      This.Last_Reference := This.Last_Reference + 1;
   end Insert;

end Nomo.Interpreter.Gen_Rules_Directories.Insertion;
