⟦602a6ba9a⟧

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

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

    package body Rule_Instance is separate;

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

    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;
        use Calendar;
    begin
        The_Inference_Count := 0;
        Started_At          := Calendar.Clock;
        loop  
            Firing := False;
            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
                        Do_Action (For_Rule => I, On_Facts => Answer);  
                        Firing              := True;  
                        The_Inference_Count := The_Inference_Count + 1;
                        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 is
        Started_At, Stopped_At : Calendar.Time;
        The_Instance           : Rule_Instance.Object;

        use Calendar;


---------------------
        use Output_Stream;

        On_Screen : Output_Stream.Object := Standard_Output;
---------------------

    begin
        The_Inference_Count := 0;
        Started_At          := Calendar.Clock;  
        loop  
            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));

                end;
            end loop;
            exit when Conflict_Set.Is_Empty;



-------------
            New_Line (On_Screen);
            Put_Line ("********** begining of conflict set **********",
                      On_Screen);
            Conflict_Set.Put (On_Screen);
            New_Line (On_Screen);
            Put_Line ("********** end of conflict set **********", On_Screen);
--------------




            The_Instance := Conflict_Set.Get;
            Do_Action (For_Rule => Rule_Instance.Get_Rule (The_Instance),
                       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 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_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

⟦602a6ba9a⟧ Ada Source

Derivation

E3 Source Code

E3 Meta Data
