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

package body Nomo.Interpreter.Gen_Rules_Directories.Standard is

   procedure Forget (This             : in out Standard_Directory;
                     Number_Of_Forget : in out Reference_Index_Minus;
                     Updatable        : in Reference_Index;
                     Reference        : in Reference_Index);

   procedure Forget (This             : in out Standard_Directory;
                     Number_Of_Forget : in out Reference_Index_Minus;
                     Updatable        : in Reference_Index;
                     Reference        : in Reference_Index) is
   begin
      if Is_Forget (This.References (Updatable).Reference.all) then
         Number_Of_Forget := Number_Of_Forget + 1;
         This.Last_Space := This.Last_Space + 1;
         This.Spaces (This.Last_Space) := Updatable;
         This.Trash (This.Last_Space) := This.References (Updatable);
      elsif Number_Of_Forget /= Reference_Index_Minus'First then
         This.Updatables (Reference - Number_Of_Forget) := Updatable - Number_Of_Forget;
      end if;
   end Forget;

   procedure Recycle (This : in out Standard_Directory);
   pragma Precondition (This.Last_Space > Reference_Index_Minus'First);
   pragma Postcondition (This.Last_Space = Reference_Index_Minus'First);

   procedure Recycle (This : in out Standard_Directory) is
      I : Reference_Index := Reference_Index'First;
      Buffer : Reference_Index := Reference_Index'First;
      First, Last : Reference_Index_Minus := Reference_Index_Minus'First;
   begin
      if Reference_Index'First = This.Last_Space then
         This.References (This.Spaces (I) .. This.Last_Reference - 1) := This.References (This.Spaces (I) + 1.. This.Last_Reference);
      else
         First := This.Spaces (I);
         loop
            while I < This.Last_Space and then This.Spaces (I) = This.Spaces (I + 1) - 1 loop
               I := I + 1;
            end loop;
            Last := This.Spaces (I);
            if I = This.Last_Space then
               if Last /= This.Last_Reference then
                  This.References (First .. First - 1 + This.Last_Reference - Last) := This.References (Last + 1 .. This.Last_Reference);
               end if;
               exit;
            else
               Buffer := First - 1 + This.Spaces (I + 1) - 1 - Last;
               This.References (First .. First - 1 + This.Spaces (I + 1) - 1 - Last) := This.References (Last + 1 .. This.Spaces (I + 1) - 1);
               First := Buffer + 1;
            end if;
            I := I + 1;
         end loop;
      end if;
      pragma Assert (I = This.Last_Space);
      This.References (This.Last_Reference - I + 1 .. This.Last_Reference) := This.Trash (Reference_Index'First .. This.Last_Space);
      This.Last_Reference := This.Last_Reference - I;
      I := Reference_Index'First;
      for N in Reference_Index'First .. This.Last_Reference loop
         Last := This.References (N).Final_Rule_Significantly;
         while Last >= This.Spaces (I) and then I <= This.Last_Space loop
            I := I + 1;
         end loop;
         This.References (N).Final_Rule_Significantly := Last - I + 1;
      end loop;
      This.Last_Space := Reference_Index_Minus'First;
   end Recycle;

   procedure Update_Relevance (This : in out Standard_Directory) is
      Number_Of_Forget : Reference_Index_Minus := Reference_Index_Minus'First;
      Updatable        : Reference_Index;
   begin
      for I in Reference_Index'First .. This.Last_Updatable loop
         Updatable := This.Updatables (I);
         Update_Relevance (This.References (Updatable).Reference.all);
         Forget (This, Number_Of_Forget, Updatable, I);
      end loop;
      if Number_Of_Forget /= Reference_Index_Minus'First then
         This.Last_Updatable := This.Last_Updatable - Number_Of_Forget;
         Recycle (This);
      end if;
   end Update_Relevance;

   procedure Update_Relevance (This       : in out Standard_Directory;
                               Scores_Sum : in Strictly_Positive_Real);

   procedure Update_Relevance (This       : in out Standard_Directory;
                               Scores_Sum : in Strictly_Positive_Real) is
      Number_Of_Forget : Reference_Index_Minus := Reference_Index_Minus'First;
      Updatable        : Reference_Index;
   begin
      for I in Reference_Index'First .. This.Last_Updatable loop
         Updatable := This.Updatables (I);
         Update_Relevance (This.References (Updatable).Reference.all, Scores_Sum);
         Forget (This, Number_Of_Forget, Updatable, I);
      end loop;
      if Number_Of_Forget /= Reference_Index_Minus'First then
         This.Last_Updatable := This.Last_Updatable - Number_Of_Forget;
         Recycle (This);
      end if;
   end Update_Relevance;

   procedure Update_Relevance (This          : in out Standard_Directory;
                               Scores_Sum    : in Strictly_Positive_Real;
                               Selected_Rule : in not null Rule_Ptr;
                               Rule_Index    : in Reference_Index);

   procedure Update_Relevance (This          : in out Standard_Directory;
                               Scores_Sum    : in Strictly_Positive_Real;
                               Selected_Rule : in not null Rule_Ptr;
                               Rule_Index    : in Reference_Index) is
      Number_Of_Forget : Reference_Index_Minus := Reference_Index_Minus'First;
   begin
      for I in Reference_Index'First .. This.Last_Updatable loop
         Update_Relevance (This.References (This.Updatables (I)).Reference.all, Scores_Sum);
      end loop;
      Adjust (Selected_Rule.all, This.References (Rule_Index).Excitatory_Specificity_Log);
      for I in Reference_Index'First .. This.Last_Updatable loop
         Forget(This, Number_Of_Forget, This.Updatables (I), I);
      end loop;
      if Number_Of_Forget /= Reference_Index_Minus'First then
         This.Last_Updatable := This.Last_Updatable - Number_Of_Forget;
         Recycle (This);
      end if;
   end Update_Relevance;

   procedure Update_Rules(This          : in out Standard_Directory;
                          Scores_Sum    : in Positive_Real;
                          Selected_Rule : in Rule_Ptr;
                          Rule_Index    : in Reference_Index_Minus);

   procedure Update_Rules(This          : in out Standard_Directory;
                          Scores_Sum    : in Positive_Real;
                          Selected_Rule : in Rule_Ptr;
                          Rule_Index    : in Reference_Index_Minus) is
   begin
      if Selected_Rule = null then
         Update_Relevance (This);
      elsif Is_Updatable (Selected_Rule.all) then
         Update_Relevance (This, Scores_Sum, Selected_Rule, Rule_Index);
      else
         Update_Relevance (This, Scores_Sum);
      end if;
   end Update_Rules;

   procedure Evaluate_The_Rest (References    : in Rule_References;
                                First_Index   : in Reference_Index;
                                Scores_Sum    : in out Strictly_Positive_Real;
                                Selected_Rule : out not null Rule_Ptr;
                                Rule_Index    : out Reference_Index);
   pragma Precondition (Scores_Sum > Strictly_Positive_Real'First and Scores_Sum <= 1.0);
   pragma Postcondition (Scores_Sum > Strictly_Positive_Real'First);

   procedure Evaluate_The_Rest (References    : in Rule_References;
                                First_Index   : in Reference_Index;
                                Scores_Sum    : in out Strictly_Positive_Real;
                                Selected_Rule : out not null Rule_Ptr;
                                Rule_Index    : out Reference_Index) is
      Score     : Positive_Real;
      Score_Max : Strictly_Positive_Real := Scores_Sum;
      Shift     : constant Real_Accurately := References (First_Index).Excitatory_Specificity_Log;
   begin
      Selected_Rule := References (First_Index).Reference;
      Rule_Index := First_Index;
      for I in First_Index + 1..References (First_Index).Final_Rule_Significantly loop
         Evaluate (References (I).Reference.all, Shift, Score);
         Scores_Sum := Scores_Sum + Score;
         if Score > Score_Max then
            Score_Max := Score;
            Selected_Rule := References (I).Reference;
            Rule_Index := I;
         end if;
      end loop;
   end Evaluate_The_Rest;

   procedure Evalute_Whitout_Update (References    : in Rule_References;
                                     First_Index   : in Reference_Index;
                                     Score_Max     : in out Positive_Real;
                                     Selected_Rule : in out not null Rule_Ptr;
                                     Rule_Index    : in out Reference_Index);
   pragma Precondition (Score_Max > Strictly_Positive_Real'First and First_Index = Rule_Index);
   pragma Postcondition (Score_Max > Strictly_Positive_Real'First);

   procedure Evalute_Whitout_Update (References    : in Rule_References;
                                     First_Index   : in Reference_Index;
                                     Score_Max     : in out Positive_Real;
                                     Selected_Rule : in out not null Rule_Ptr;
                                     Rule_Index    : in out Reference_Index) is
      Score : Positive_Real;
      Shift : constant Real_Accurately := References (Rule_Index).Excitatory_Specificity_Log;
   begin
      for I in First_Index + 1..References (First_Index).Final_Rule_Significantly loop
         Evaluate (References (I).Reference.all, Shift, Score);
         if Score > Score_Max then
            Score_Max := Score;
            Selected_Rule := References (I).Reference;
            Rule_Index := I;
            exit when Score_Max = 1.0;
         end if;
      end loop;
   end Evalute_Whitout_Update;

   procedure Interpret (This          : in out Standard_Directory;
                        Selected_Rule : out Rule_Ptr) is
      References : Rule_References renames This.References;
      Scores_Sum : Positive_Real;
      Rule_Index : Reference_Index_Minus := Reference_Index_Minus'First;
   begin
      Selected_Rule := null;
      if This.Last_Updatable /= Reference_Index_Minus'First then
         for I in Reference_Index'First .. This.Last_Reference loop
            Evaluate (References (I).Reference.all, Scores_Sum);
            if Scores_Sum >= Strictly_Positive_Real'First then
               Evaluate_The_Rest (References, I, Scores_Sum, Selected_Rule, Rule_Index);
               exit;
            end if;
         end loop;
         Update_Rules (This, Scores_Sum, Selected_Rule, Rule_Index);
      else
         for I in Reference_Index'First .. This.Last_Reference loop
            Evaluate (References (I).Reference.all, Scores_Sum);
            if Scores_Sum >= Strictly_Positive_Real'First then
               Selected_Rule := References (I).Reference;
               Rule_Index := I;
               if Scores_Sum < 1.0 then
                  Evalute_Whitout_Update (References, I, Scores_Sum, Selected_Rule, Rule_Index);
               end if;
               exit;
            end if;
         end loop;
         if Selected_Rule /= null then
            Adjust (Selected_Rule.all, References (Rule_Index).Excitatory_Specificity_Log);
         end if;
      end if;
      --  Attention à la suite de l'ajustement la spécifité d'une règle peut évoluer suite à
      --  sa sélection par la maximisation des prémises.
      --  Cette modification n'est pas répercuté dans le classement de "Standard_Directory".
      --  Car les ordres de grandeur de ces modifications ne devraient pas
      --  entrainer d'erreur dans l'évaluation des règles uniquement dans les cas limites
      --  apriori improbable compte tenu de la précision calculatoire.
   end Interpret;

end Nomo.Interpreter.Gen_Rules_Directories.Standard;
