⟦2d84b4f8a⟧

E3 Source Code



with Calendar;
with Constant_String;
with Generic_Condition_Element;
with Output_Stream;

package body Generic_Rule_Base is

    package Condition_Elements is
       new Generic_Condition_Element
              (Max_Condition_Elements => Max_Condition_Elements,
               Fact_Query             => Fact_Query,
               Null_Fact_Query        => Null_Fact_Query,
               Fact_Queries           => Fact_Queries);

    -------------------------------------------------------------------------


    subtype Rule_Name is Constant_String.Object;
    Null_Rule_Name : Rule_Name renames Constant_String.Null_Object;

    function As_Rule_Name (For_String : String) return Rule_Name
        renames Constant_String.Value;

    function Image (Of_Rule_Name : Rule_Name) return String
        renames Constant_String.Image;

    -------------------------------------------------------------------------

    type Rule (The_Query_Count : Premiss_Size := 0) is
        record  
            The_Date    : Recency.Object;
            The_Bundle  : Rule_Bundles;
            The_Rule    : Natural;  
            The_Name    : Rule_Name;
            The_Premiss : Condition_Elements.Ids (1 .. The_Query_Count);
        end record;

    Null_Rule : constant Rule := (The_Date        => Recency.Null_Object,
                                  The_Query_Count => 0,
                                  The_Bundle      => Rule_Bundles'First,
                                  The_Rule        => 0,
                                  The_Name        => Null_Rule_Name,
                                  The_Premiss     => (others => 1));

    subtype Rule_Index is Rule_Id range 1 .. Rule_Id (Max_Rules);
    type    Rules      is array (Rule_Index) of Rule;

    The_Rules     : Rules   := (others => Null_Rule);
    The_Last_Rule : Rule_Id := No_Rule;

    The_Inference_Count    : Natural  := 0;
    The_Elapsed_Time       : Duration := 0.0;
    The_Firings_Per_Second : Natural  := 0;

    -------------------------------------------------------------------------

    Stop_Infere : Boolean := False;

    -------------------------------------------------------------------------

    package body Rule_Instance is separate;

    -------------------------------------------------------------------------

    procedure Halt is
    begin
        Stop_Infere := True;
    end Halt;

    function Count return Natural is
    begin
        return The_Last_Rule;
    end Count;

    function Valid_Id (R : Rule_Id) return Boolean is
    begin
        return R > 0 and then R <= Max_Rules;
    end Valid_Id;

    function Get (R : Rule_Id) return Rule_Bundles is
    begin
        if Valid_Id (R) then
            return The_Rules (R).The_Bundle;
        else
            raise Illegal_Rule_Id;
        end if;
    end Get;

    function Get (R : Rule_Id) return Rule is
    begin
        if Valid_Id (R) then
            return The_Rules (R);
        else
            raise Illegal_Rule_Id;
        end if;
    end Get;

    procedure Null_Action (On : Fact_Collection) is
    begin
        null;
    end Null_Action;

    procedure Infere is  
        Firing                 : Boolean;
        Started_At, Stopped_At : Calendar.Time;
        Date                   : Recency.Object;

        use Calendar;
    begin  
        Stop_Infere         := False;
        The_Inference_Count := 0;
        Started_At          := Calendar.Clock;
        loop  
            Firing := False;  
            exit when Stop_Infere;
            for I in The_Rules'First .. The_Last_Rule loop
                declare
                    Answer : constant Fact_Collection :=
                       Retrieve (Filter => Condition_Elements.Get
                                              (The_Rules (I).The_Premiss));
                begin
                    if Answer /= Empty_Fact_Collection then
                        Recency.Get (Date);
                        The_Rules (I).The_Date := Date;
                        Do_Action (For_Rule => I, On_Facts => Answer);  
                        Firing              := True;  
                        The_Inference_Count := The_Inference_Count + 1;
                        Recency.Increase;
                        exit;
                    end if;
                end;
            end loop;
            exit when not Firing;
        end loop;
        Stopped_At             := Calendar.Clock;
        The_Elapsed_Time       := Stopped_At - Started_At;
        The_Firings_Per_Second :=
           Natural (Float (Inference_Count) / Float (Elapsed_Time));

    end Infere;


    procedure Infere_With_Conflict_Set
                 (Conflict_Set_Size : Integer := Conflict_Set.Unlimited_Size) is
        Started_At, Stopped_At : Calendar.Time;
        The_Instance           : Rule_Instance.Object;  
        The_Rule_Id            : Rule_Id := 0;
        The_Rule               : Rule    := Null_Rule;  
        Date                   : Recency.Object;

        use Calendar;
        use Rule_Instance;
        use Output_Stream;

        On_Screen : Output_Stream.Object := Standard_Output;

    begin  
        Conflict_Set.Set_Max_Instances (To => Conflict_Set_Size);
        Stop_Infere         := False;
        The_Inference_Count := 0;
        Started_At          := Calendar.Clock;  
        loop  
            exit when Stop_Infere;
            Conflict_Set.Clear;
            for I in The_Rules'First .. The_Last_Rule loop
                begin
                    Retrieve (The_Rule => I,
                              Filter   => Condition_Elements.Get
                                             (The_Rules (I).The_Premiss));
                    exit when Conflict_Set.Is_Full;
                end;
            end loop;
            exit when Conflict_Set.Is_Empty;
            The_Instance := Conflict_Set.Get;
            The_Rule_Id  := Rule_Instance.Get_Rule (The_Instance);
            Recency.Increase;  
            Recency.Get (Date);
            The_Rules (The_Rule_Id).The_Date := Date;
            Do_Action (For_Rule => The_Rule_Id,
                       On_Facts => Rule_Instance.Get_Facts (The_Instance));
            The_Inference_Count := The_Inference_Count + 1;  
        end loop;
        Stopped_At             := Calendar.Clock;
        The_Elapsed_Time       := Stopped_At - Started_At;
        The_Firings_Per_Second :=
           Natural (Float (Inference_Count) / Float (Elapsed_Time));

    end Infere_With_Conflict_Set;


    function One_Inference_With_Conflict_Set
                (Conflict_Set_Size : Integer := Conflict_Set.Unlimited_Size)
                return Boolean is  
        The_Instance : Rule_Instance.Object;
        The_Rule_Id  : Rule_Id := 0;
        The_Rule     : Rule    := Null_Rule;
        Date         : Recency.Object;
    begin  
        Conflict_Set.Clear;
        for I in The_Rules'First .. The_Last_Rule loop
            begin
                Retrieve (The_Rule => I,
                          Filter   => Condition_Elements.Get
                                         (The_Rules (I).The_Premiss));
                exit when Conflict_Set.Is_Full;
            end;
        end loop;
        if Conflict_Set.Is_Empty then
            return False;
        end if;
        The_Instance := Conflict_Set.Get;
        The_Rule_Id  := Rule_Instance.Get_Rule (The_Instance);
        Recency.Increase;  
        Recency.Get (Date);
        The_Rules (The_Rule_Id).The_Date := Date;
        Do_Action (For_Rule => The_Rule_Id,
                   On_Facts => Rule_Instance.Get_Facts (The_Instance));
        return True;
    end One_Inference_With_Conflict_Set;


    function Inference_Count return Natural is
    begin
        return The_Inference_Count;
    end Inference_Count;


    function Elapsed_Time return Duration is
    begin
        return The_Elapsed_Time;
    end Elapsed_Time;


    function Firings_Per_Second return Natural is
    begin
        return The_Firings_Per_Second;
    end Firings_Per_Second;


    procedure Put (R : Rule_Id; Where : Output_Stream.Object) is
        The_Rule    : Rule renames The_Rules (R);
        The_Premiss : constant Fact_Queries :=
           Condition_Elements.Get (The_Rule.The_Premiss);
        use Output_Stream;
    begin
        Put_Line ("Rule'(", Where);
        Indent_Right (Where);
        Put ("The_Date  => ", Where);
        Recency.Put (The_Rule.The_Date, Where);
        Put_Line ("", Where);
        Put ("The_Bundle  => ", Where);
        Put_Line (Rule_Bundles'Image (The_Rule.The_Bundle), Where);  
        Put ("The_rule    => ", Where);
        Put_Line (Image (The_Rule.The_Name), Where);
        Put ("The_premiss => ", Where);
        Queries_Put (The_Premiss, Where);
        Indent_Left (Where);
        Put_Line (")", Where);
    end Put;


    package body Generic_Rule_Bundle is separate;

end Generic_Rule_Base;
DataMuseum.dk

Rational R1000/400

⟦2d84b4f8a⟧ Ada Source

Derivation

E3 Source Code

E3 Meta Data
