DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦3301e8a26⟧ Ada Source

    Length: 28672 (0x7000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Expert, seg_028103

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

E3 Source Code



with Text_Io, Dyn;

procedure Expert is

------------------------------------------------------------------------------
--GENERAL INFORMATION:
--
-- EXPERT is a backward chaining or goal driven expert system.  It is based on
--two articles, first Sept 1981 BYTE (Duda and Gaschnig)
--published the expert system in BASIC
--skirting the use of recursion, second Jan/Feb 85 issue of
--JOURNAL OF PASCAL,ADA, & MODULA-2 (Darrell Morgeson)
--published in Modula-2 with recursion
--implemented.  The listing had one logic error which caused pointer
--explosion on the last hypothesis in the GETRULE routine.  This
--implementation follows the MODULA-2 design completely and
--was not designed from the ground up in Ada.  Many improvements would
--be possible if more time permitted my working on this.

--AUTHOR: (sort of, translator) Alan McDonley (303) 593-7528 (home phone)
--DATE: 11 SEPT 85
--
------------------------------------------------------------------------------

--INPUTS:
--
-- Expert requires an expert rulebase.  The rule base consists of the following
-- items in the particular format:
--
--DATABASE NAME (thrown away by program)
--HYPOTHESIS 1  (Must fit on one line, any characters including spaces legal)
--.
--.
--HYPOTHESIS n
--               (blank line to signify end of all hypothesis)
--IF,ANTECEDENT 1[,ANTECEDENT n][,CONCLUSION n],THEN,CONCLUSION 1,
--IF,.....,CONCLUSION n, (must be a comma after last conclusion)
--
--  If you put spaces after comma be careful to note that the space becomes
--  part of symbol and that the symbols "IF" and "THEN" may not have a space
--  preceding them as they are defined by EXPERT without the spaces.
--
--  Each Hypothesis must appear as a conclusion at least once, program will
--  check for this and halt cleanly if not true.
--
--  Rules may cross line boundry at any comma (start of a symbol). See Animals
--  rulebase for example.
--
--  Blank lines may be inserted after any comma (useful to separate long rules)
------------------------------------------------------------------------------

--EXAMPLE RULE BASES: (remove -- from each line to use)

--THIS IS AN ANIMAL RULE SET
--IS ALBATROSS
--IS PENGUIN
--IS OSTRICH
--IS ZEBRA
--IS GIRAFFE
--IS TIGER
--IS CHEETAH

--IF,HAS HAIR,THEN,IS MAMMAL,
--IF,GIVES MILK,THEN,IS MAMMAL,
--IF,HAS FEATHERS,THEN,IS BIRD,
--IF,FLIES,LAYS EGGS,THEN,IS BIRD,
--IF,EATS MEAT,THEN,IS CARNIVORE,
--IF,HAS POINTED TEETH,HAS CLAWS,HAS FORWARD EYES,THEN,IS CARNIVORE,
--IF,IS MAMMAL,HAS HOOFS,THEN,IS UNGULATE,
--IF,IS MAMMAL,CHEWS CUD,THEN,IS UNGULATE,
--IF,IS MAMMAL,IS CARNIVORE,HAS TAWNY COLOR,HAS BLACK STRIPES,THEN,IS TIGER,
--IF,IS MAMMAL,IS CARNIVORE,HAS TAWNY COLOR,HAS DARK SPOTS,
--THEN,IS CHEETAH,
--IF,IS UNGULATE,HAS LONG NECK,HAS LONG LEGS,HAS DARK SPOTS,
--THEN,IS GIRAFFE,
--IF,IS UNGULATE,HAS BLACK STRIPES,THEN,IS ZEBRA,
--IF,IS BIRD,DOES NOT FLY,HAS LONG NECK,IS BLACK AND WHITE,
--THEN,IS OSTRICH,
--IF,IS BIRD,DOES NOT FLY,SWIMS,IS BLACK AND WHITE,THEN,IS PENGUIN,
--IF,IS BIRD,FLIES WELL,THEN,IS ALBATROSS,

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

--EXAMPLE RULE BASE: (remove -- from each line to use)

--FUSION DATABASE FROM "THE BUTTON" BY DANIEL FORD
--DEFINITE SS-18 LAUNCH
--DEFINITE SOFT TARGET ATTACK

--IF,DSP EAST REPORTS,SOUTH CENTRAL SIBERIA LAUNCH,THEN,PROBABLE SS-18 LAUNCH,
--IF,DSP EAST REPORTS,MONGOLIAN BORDER LAUNCH,THEN,PROBABLE SS-11 LAUNCH,
--IF,PROBABLE SS-11 LAUNCH,THEN,PROBABLE SOFT TARGET ATTACK,
--IF,DEFINITE SS-11 LAUNCH,THEN,DEFINITE SOFT TARGET ATTACK,
--IF,PROBABLE SS-18 LAUNCH,ALASKAN RADAR SHOWS INCOMING ICBM,THEN,
--DEFINITE SS-18 LAUNCH,
--IF,PROBABLE SS-11 LAUNCH,FYLINGDALES MOOR-ENGLAND RADAR SHOWS INCOMING ICBM,
--THEN,DEFINITE SS-11 LAUNCH,

------------------------------------------------------------------------------
--OPERATION:
--
--To use compile MYDYN.ADA, then EXPERT.ADA, then link EXPERT.
--RUN EXPERT
--enter name of rulebase
--answer questions

------------------------------------------------------------------------------
--THEORY OF OPERATION:
--
--EXPERT loads the rulebase, creating pointers to each symbol, rule and
--hypothesis.  EXPERT attempts to prove the last hypothesis first.  To prove
--an hypothesis, the rules are searched for one having the hypothesis as a
--conclusion, when found, VERIFIED attempts to verify that rule by calling
--VERIFIED recursively to verify each antecedent of that rule.  When all
--antecedents of a rule are verified true, EXPERT deduces the rule is true,
--If the conclusion of the rule is an hypothesis then execution stops.
--If any antecedent of a rule is false, EXPERT searches for another rule
--to prove the conclusion.
--EXAMPLE:
--for rulebase:
--TEST RULEBASE
--HYPOTHESIS 1
--
--IF,ANTECEDENT 1,THEN,CONCLUSION 1,
--IF,ANTECEDENT 2,CONCLUSION 1,THEN,HYPOTHESIS 1,
--
--EXPERT begins by looking for a rule with HYPOTHESIS 1 as its conclusion and
--finds rule 2.  To verify rule 2 it attempts to verify the first antecedent
--which is ANTECEDENT 2.  ANTECEDENT 2 does not appear as a conclusion in any
--other rule and so the user is asked to verify (Is this true? ANTECEDENT 2)
--the antecedent.  The user may respond Y or y for YES, N or n for NO, or
--E or e for EXPLAIN.  Requesting an explanation at this point will print:
--
--TRYING TO PROVE RULE 2:
--IF ANTECEDENT 2
--   CONCLUSION 1
--THEN
--   HYPOTHESIS 1
--
--Is this true? ANTECEDENT 2?
--
--If the user responds yes, then the symbol value is set to true and the
--next antecedent of rule 2 ( CONCLUSION 1) is verified.  To verify
--CONCLUSION 1 the rule set is searched for a rule with CONCLUSION 1 as the
--conclusion.  Rule 1 is found.  So the first antecedent of rule 1 is verified
--by searching the ruleset for a rule with ANTECEDENT 1 as the conclusion.  None
--is found, so the user is asked to verify it.  If the user answers yes (true)
-- then EXPERT deduces rule 1 (CONCLUSION 1) to be true, and subsequently
-- deduces rule 2 (HYPOTHESIS 1) to be true since both antecedents (ANTECEDENT 1
-- and CONCLUSION 1) are true.  Execution stops after displaying the deductions.
-- Backward chaining or goal driven chaining is the process of starting with
-- a hypothesis and finding ways to prove it true, where as forward chaining
-- would start with a known antecedent, then another antecedent (possibly
-- unrelated to the hypothesis that the first antecedent is part of)
-- and prove one or more hypothesis.
--
--        BACKWARD                       FORWARD
--
--        goal                    false antecedent
--         |                          |
--      false antecedent              |              antecedent
--         |                          |                  |     \
--      new goal                     no goal         antecedent  \
--         |                                             |        other goals
--      antecedent                                   proven goal
--         |
--      antecedent
--         |
--      proven goal
--
-- Each has a particular purpose and sometimes mixing the two is the best.
-- Forward chaining would work well on parallel processors, and where random
-- data is coming in.
-- Backward Chaining works well were requested data or queued systems are
-- involved.
--
-- Symbols are stored in a binary tree with no duplicate symbols.  Rules are
-- stored as a list of pointers to the symbols belonging to the rule.
-- Symbol values begin as U or Unknown and gradually are proven (T or true) or
-- disproved (F or False).
--
-- Current limits of the array of symbol pointers and the array of rule pointers
-- are set to 100 rules containing no more than 250 symbols.  These of course
-- are easily modified.
--
------------------------------------------------------------------------------
------------------------------------------------------------------------------

    use Text_Io, Dyn;

    package Integer_Io is new Text_Io.Integer_Io (Integer);

    Maxstrgsrules : constant := 250;
    Maxrules : constant := 100;

    subtype Rulrange is Integer range 0 .. Maxrules;
    subtype Ptrrange is Integer range 1 .. Maxstrgsrules;

    type Hypttype;
    type Hyptptr is access Hypttype;

    type Hypttype is
        record
            Symbol : Dyn_String;
            Next : Hyptptr;
        end record;

    type Symboltype;
    type Symbolptr is access Symboltype;
    type Symboltype is
        record
            Symbol : Dyn_String;
            Value : Character;
            Left, Right : Symbolptr;
        end record;

    Hypthdr, Hypttail : Hyptptr;
    Rules : array (Ptrrange'First .. Ptrrange'Last) of Symbolptr;
    Numrules : Rulrange;
    Ruleptr : array (Rulrange'First .. Rulrange'Last) of Ptrrange;

    Infile : Text_Io.File_Type;
    In_File_Name : Dyn_String;
    Response : Dyn_String;
    Response_Len : Natural;

    function Comparestr (Str1, Str2 : in Dyn_String) return Integer is
-- If two dynamic strings are of same length and contents return 0,
-- else order the strings
    begin
        if Str (Str1) = Str (Str2) then
            return (0);
        elsif Str (Str1) < Str (Str2) then
            return (-1);
        else
            return (1);
        end if;
    end Comparestr;

    procedure Getrules is

--GET HYPOTHESIS and RULES from rulebase

        Numstrgsrules : Ptrrange;  --current number of symbols in rules
        Root : Symbolptr; -- root of symbol binary tree
        Strg : Dyn_String;
        Sstrg : Dyn_String;

        procedure Makehyptlist (Symbol : Dyn_String) is
            --create a circular list of hypothesis strings

            Hypt : Hyptptr;
        begin
            Hypt := new Hypttype;
            if Hypthdr = null then
                Hypthdr := Hypt;
                Hypttail := Hypt;
            else
                Hypttail.Next := Hypt;
                Hypttail := Hypt;
            end if;
            Hypt.Symbol := Symbol;
            Hypt.Next := Hypthdr;
        end Makehyptlist;

        procedure Search (Curptr, Prevptr : in out Symbolptr;
                          Symbol : Dyn_String;
                          Found : in out Boolean) is
            -- searches the binary tree containing the rule symbols to see if the
            -- symbol already exists.  If not then prevptr points to the node at
            -- which the next symbol will be inserted

        begin
            Found := False;
            while not (Found) and (Curptr /= null) loop
                Prevptr := Curptr;
                if Comparestr (Symbol, Curptr.Symbol) = 0 then
                    Found := True;
                elsif Comparestr (Symbol, Curptr.Symbol) < 0 then
                    Curptr := Curptr.Left;
                else
                    Curptr := Curptr.Right;
                end if;
            end loop;
        end Search;

        procedure Makesymbol (Ptr : in out Symbolptr; Strg : Dyn_String) is
            --creates a symbol node, fills the node with the string (antecedent or
            --conclusion), then sets symbol value to unknown, and links the symbol into
            -- the binary symbol tree.

            Newptr : Symbolptr;

        begin
            Newptr := new Symboltype;
            Newptr.Symbol := Strg;
            Newptr.Value := 'U';
            Newptr.Left := null;
            Newptr.Right := null;
            Ptr := Newptr;
        end Makesymbol;

        procedure Loadrules (Strg : Dyn_String) is

            -- parses a rule extracting symbols and puting them in rule tree

            Local_Strg : Dyn_String := Strg;
            Curptr, Prevptr : Symbolptr;
            Symbol : Dyn_String;
            Found : Boolean := False;
            Endsymbol : Natural;

        begin
            while Length (Local_Strg) > 0 loop  
                Endsymbol := Dyn.Index
                                (Local_Strg, D_String (','), 1); -- find  comma
                if Endsymbol > 0 then
                    Symbol := Dyn.Substring
                                 (Local_Strg, 1, Endsymbol -
                                                    1); --get
                                                        --symbol,leave comma
                    if Dyn.Length (Local_Strg) >
                       Endsymbol then --if more to string
                        Local_Strg := Dyn.Substring (Local_Strg, Endsymbol + 1,
                                                     0);--remove symbol
                    else
                        Local_Strg := Dyn.D_String (""); --end of string
                    end if;

                    if Root = null then
                        -- begins the binary tree
                        Makesymbol (Root, Symbol);
                        Curptr := Root;
                    else
                        Curptr := Root;
                        Search (Curptr, Prevptr, Symbol, Found);
                        if not Found then
                            Makesymbol (Curptr, Symbol);
                            if Comparestr (Prevptr.Symbol, Symbol) > 0 then
                                Prevptr.Left := Curptr;
                            else
                                Prevptr.Right := Curptr;
                            end if;
                        end if;
                    end if;
                    if Comparestr (Curptr.Symbol, D_String ("IF")) = 0 then
                        Ruleptr (Numrules) :=
                           Numstrgsrules; -- put first antecedents symbol
                                          -- number as start of rule
                        Numrules := Numrules + 1;
                    end if;
                    Rules (Numstrgsrules) := Curptr;
                    Numstrgsrules := Numstrgsrules + 1;
                end if;
            end loop;
        end Loadrules;

    begin --GETRULES
        Hypthdr := null;
        Hypttail := null;

        Text_Io.Put ("ENTER NAME OF RULE BASE: ");
        Dyn.Get_Line (In_File_Name, Response_Len);
        Dyn.Open (Infile, Text_Io.In_File, In_File_Name);
        Dyn.Get_Line (Infile, Strg, Response_Len); -- dispose of header line

        loop
            Dyn.Get_Line (Infile, Sstrg, Response_Len); --read first hypothesis
            if Response_Len = 0 then
                exit;
            end if;
            Makehyptlist (Sstrg);
        end loop;

        Numrules := 1;
        Numstrgsrules := 1;
        Root := null;
        loop
            Dyn.Get_Line (Infile, Strg, Response_Len); -- read a rule line
            if Response_Len > 0 then  -- skip blank lines between rules if any
                Loadrules (Strg);
            end if;
            if Text_Io.End_Of_File (Infile) then
                exit;
            end if;  -- if no more rules exit
        end loop;

        Ruleptr (Numrules) := Numstrgsrules; --set end of list mark
        Numrules := Numrules - 1;
        Text_Io.Close (Infile);

    end Getrules;

    function Verified (Tgtstrg : Dyn_String;
                       Newstrptr : Ptrrange;
                       Startrule, Currulnum : Rulrange) return Boolean is
-- Attempts to verify a particular symbol (antecedent) as true or false
-- recurses if antecedent is a conclusion in another rule attempting to
-- prove each antecedent for the conclusion.

        Newstr : Dyn_String;
        Nomorestrgs,  
        Found : Boolean;
-- need local copies for sending to procedures with out parms
        New_Strptr : Ptrrange := Newstrptr;  --symbol number
        Tgtstring : Dyn_String := Tgtstrg;    --symbol string
        Startrul : Rulrange :=
           Startrule;    --first rule to look in for the symbol
        Currulenum : Rulrange := Currulnum;   --current rule that working on

        function Userverifies (Tgtstrg : Dyn_String;
                               Currulnum : Rulrange;
                               Newstrptr : Ptrrange) return Boolean is

            --ASKS USER ABOUT THE TGTSTRG AND RECORDS HIS ANSWER when antecedent does
            --not appear as a conclusion in any other rule.

            Ch : Character;
            Validchars : Dyn_String := D_String ("YyNnEe");
            I, J : Natural;

        begin
            loop
                loop
                    Text_Io.Put ("Is this true? ");
                    Dyn.Put (Tgtstrg);
                    Text_Io.Put (" ?? ");
                    Text_Io.Get (Ch);

                    exit when (Dyn.Index (Validchars, D_String (Ch), 1)) > 0;
                end loop;
                case Ch is
                    when 'Y' | 'y' =>
                        Rules (Newstrptr).Value := 'T';
                        return True;
                    when 'N' | 'n' =>
                        Rules (Newstrptr).Value := 'F';
                        return False;
                    when 'E' | 'e' =>
                        Text_Io.New_Line (2);
                        Text_Io.Put ("TRYING TO USE RULE");
                        Integer_Io.Put (Currulnum);
                        Text_Io.New_Line;
                        I := Newstrptr;
                        loop
                            I := I - 1;
                            exit when
                               Comparestr (Rules (I).Symbol, D_String ("IF")) =
                                  0;
                        end loop;
                        I := I + 1;
                        if I /= Newstrptr then
                            Text_Io.New_Line (2);
                            Text_Io.Put ("I already know that :");
                            Text_Io.New_Line;
                            J := I;
                            loop
                                Text_Io.Put ("   ");
                                Dyn.Put (Rules (J).Symbol);
                                Text_Io.New_Line;
                                exit when J = (Newstrptr - 1);
                                J := J + 1;
                            end loop;
                        end if;
                        Text_Io.New_Line (2);
                        Text_Io.Put ("IF");
                        Text_Io.New_Line;
                        I := Newstrptr;
                        loop
                            Text_Io.Put ("   ");
                            Dyn.Put (Rules (I).Symbol);
                            Text_Io.New_Line;
                            I := I + 1;
                            exit when
                               Comparestr
                                  (Rules (I).Symbol, D_String ("THEN")) = 0;
                        end loop;
                        Text_Io.Put ("THEN");
                        Text_Io.New_Line;
                        Text_Io.Put ("   ");
                        Dyn.Put (Rules (I + 1).Symbol);
                        Text_Io.New_Line (2);

                    when others =>
                        null;
                end case;
            end loop;
        end Userverifies;

        procedure Getrule (Startrule : in out Rulrange;
                           Tgtstrg : Dyn_String;
                           Found : out Boolean) is

            -- Finds the rule in which the tgtstrg appears as a consequent;
            -- begins search at the value of startrule; makes no change to
            -- startrule unless a new rule is found

            Rul : Rulrange;
            Strptr : Ptrrange;
            Strg : Dyn_String;

        begin --Gets relevant rules for tgtstrg if any; Puts result
              -- in currulnum
            Rul := Startrule + 1;

            loop
                if Rul >
                   Numrules then    --This line and three following put at top
                    Found :=
                       False;          --of loop to prevent overrunning structure
                    exit;                      --when startrule is passed in as last rule
                end if;                   --of rulebase.  Alan McDonley

                Strptr := Ruleptr (Rul + 1) - 1;
                Strg := Rules (Strptr).Symbol;
                if Comparestr (Strg, Tgtstrg) = 0 then --if found
                    Found := True;
                    Startrule := Rul;
                    exit;
                end if;
                Rul := Rul + 1;
                --Location of test in journal listing
            end loop;
        end Getrule;

        procedure Getstring (Newstr : in out Dyn_String;
                             Newstrptr : Ptrrange;
                             Nomorestrgs : out Boolean;
                             Currulnum : Rulrange) is

            -- Works in the current rule to find the next antecedent;
            -- if no more antecedents, sets rule consequent to 'T'rue
            -- and nomrestrgs to true;

        begin
            if Comparestr (Rules (Newstrptr).Symbol, D_String ("THEN")) = 0 then
                -- no more antecedents, confirm consequent as true
                Rules (Newstrptr + 1).Value := 'T';
                Nomorestrgs := True;
                Text_Io.New_Line (2);
                Text_Io.Put ("Rule");
                Integer_Io.Put (Currulnum);
                Text_Io.Put (" deduces ");
                Dyn.Put (Rules (Newstrptr + 1).Symbol);
                Text_Io.New_Line (2);
            else  -- Set newstr to the next antecedent
                Newstr := Rules (Newstrptr).Symbol;
                Nomorestrgs := False;
            end if;
        end Getstring;

    begin --VERIFIED

          -- Check to see if value is T or F

        if Rules (New_Strptr).Value = 'T' then
            return True;
        elsif Rules (New_Strptr).Value = 'F' then
            return False;
        end if;

        -- Find a rule with tgtstring as consequent; if there are none,
        -- must ask the user about the veracity of the antecedent;
        Getrule (Startrul, Tgtstring, Found);
        if not Found then
            if Userverifies (Tgtstring, Currulenum, New_Strptr) then
                return True;
            else
                return False;
            end if;
        else
            Currulenum := Startrul;
            loop --1
                New_Strptr := Ruleptr (Currulenum) + 1; -- first antecedent
                Getstring (Newstr, New_Strptr, Nomorestrgs, Currulenum);
                loop --2
                     -- Stay with this rule until all antecedents have been
                     -- confirmed as true; exit the loop if one is false

                    if Verified (Newstr, New_Strptr, 0, Currulenum) then
                        New_Strptr := New_Strptr + 1;
                        Getstring (Newstr, New_Strptr, Nomorestrgs, Currulenum);
                        if Nomorestrgs then
                            return True;
                        end if;
                    else
                        exit;
                    end if;
                end loop;  --2
                Getrule (Currulenum, Tgtstring, Found);
                if not Found then
                    -- Last call to VERIFIED is FLSE; RECORD TGTSTRING
                    -- as 'F'alse and return from verified
                    Rules (New_Strptr).Value := 'F';
                    return False;
                end if;
            end loop; --1
        end if;
    end Verified;

    procedure Diagnose is
-- Called to make a reccommendation
-- first checks to be sure rulebase is consistant, then procedes to verify
-- the last hypothesis in the rulebase.
-- If not proven moves to next hypothesis from last,etc. till first is
-- disproved or an hypothesis is proven.

        Hypothesis : Dyn_String;
        Hypt : Hyptptr;

        procedure Ckhypt (Hypothesis : Dyn_String) is
            Rule : Rulrange;
            Strptr : Ptrrange;
            Strg : Dyn_String;
            Bad_Rulebase : exception;

            -- Checks to insure all hypothesis have applicable rules
            -- (some rule contains hypothesis as conclusion)

        begin
            Rule := 1;
            loop
                Strptr := Ruleptr (Rule + 1) - 1; --Consequent of rule;
                Strg := Rules (Strptr).Symbol;
                if Comparestr (Strg, Hypothesis) = 0 then
                    exit;
                end if;
                Rule := Rule + 1;

                if Rule > Numrules then
                    Text_Io.New_Line;
                    Dyn.Put (Hypothesis);
                    Text_Io.Put (" not in rule set ");
                    raise Bad_Rulebase;
                    -- hypothesis cannot be confirmed with rule base so halt program
                end if;
            end loop;
        end Ckhypt;

        --Go thru the hypothesis one at a time until one is confirmed
        -- as true or all are false

    begin -- DIAGNOSE
        Text_Io.New_Line;
        Text_Io.Put ("I will use my ");
        Integer_Io.Put (Numrules);
        Text_Io.Put (" rules to prove one of the following:");
        Text_Io.New_Line (2);
        Hypt := Hypthdr;
        loop
            Ckhypt (Hypt.Symbol);
            Dyn.Put (Hypt.Symbol);
            Text_Io.New_Line;
            Hypt := Hypt.Next;
            exit when Hypt = Hypthdr;
        end loop;
        Text_Io.New_Line (2);
        Text_Io.Put ("Please answer with (Y)es, (N)o, or (E)xplain ");
        Text_Io.New_Line (2);

        Hypt := Hypthdr;
        loop
            Hypothesis := Hypt.Symbol;
            if Verified (Hypothesis, 1, 0, 1) then
                Text_Io.Put ("RECOMMENDATION: ");
                Dyn.Put (Hypothesis);
                Text_Io.New_Line;
                exit;
            end if;
            Hypt := Hypt.Next;
            if Hypt = Hypthdr then
                Text_Io.Put ("NO RECOMMENDATION CAN BE CONFIRMED");
                exit;
            end if;
        end loop;
    end Diagnose;

begin -- EXPERT  main block

    for I in 1 .. 10 loop
        Text_Io.New_Line;
    end loop;
    Text_Io.Put_Line ("Ada EXPERT SYSTEM");
    Getrules;
    Diagnose;

end Expert;


E3 Meta Data

    nblk1=1b
    nid=0
    hdr6=36
        [0x00] rec0=18 rec1=00 rec2=01 rec3=098
        [0x01] rec0=1a rec1=00 rec2=02 rec3=03a
        [0x02] rec0=1c rec1=00 rec2=03 rec3=064
        [0x03] rec0=19 rec1=00 rec2=04 rec3=018
        [0x04] rec0=17 rec1=00 rec2=05 rec3=050
        [0x05] rec0=15 rec1=00 rec2=06 rec3=0a0
        [0x06] rec0=11 rec1=00 rec2=07 rec3=07a
        [0x07] rec0=17 rec1=00 rec2=08 rec3=060
        [0x08] rec0=22 rec1=00 rec2=09 rec3=066
        [0x09] rec0=22 rec1=00 rec2=0a rec3=02a
        [0x0a] rec0=19 rec1=00 rec2=0b rec3=046
        [0x0b] rec0=1d rec1=00 rec2=0c rec3=026
        [0x0c] rec0=14 rec1=00 rec2=0d rec3=036
        [0x0d] rec0=15 rec1=00 rec2=0e rec3=068
        [0x0e] rec0=1e rec1=00 rec2=0f rec3=07a
        [0x0f] rec0=1a rec1=00 rec2=10 rec3=046
        [0x10] rec0=19 rec1=00 rec2=11 rec3=050
        [0x11] rec0=16 rec1=00 rec2=12 rec3=05c
        [0x12] rec0=16 rec1=00 rec2=13 rec3=016
        [0x13] rec0=19 rec1=00 rec2=14 rec3=02c
        [0x14] rec0=19 rec1=00 rec2=15 rec3=00a
        [0x15] rec0=16 rec1=00 rec2=16 rec3=062
        [0x16] rec0=1d rec1=00 rec2=17 rec3=080
        [0x17] rec0=16 rec1=00 rec2=18 rec3=026
        [0x18] rec0=1d rec1=00 rec2=19 rec3=02e
        [0x19] rec0=1d rec1=00 rec2=1a rec3=04a
        [0x1a] rec0=22 rec1=00 rec2=1b rec3=000
    tail 0x21520e3aa83be7c4f7e55 0x42a00088462060003