Example Code

Below is the example code that was shown in the lecture to create the final version of the knowledge inferance system. The code can be downloaded as a .p file here You will need to relate the following procedures back to the lecture notes. There are some parts of the code marked "EX1", "EX2", through to "EX7". These are self-test exercises, and are not assessed. Try to write your own solutions, then compare them with the model solution provided here

• setupFacts() initialises the database with the starting facts.
• addFact() adds facts to the database preventing repeated rules.
• infer() contains the inference rules for adding new family tree facts into the database.
• think() contains a repeated call to infer() so rules can be applied to facts previously inserted into the database. Note how the procedure terminates if there was no change in the database.
• respondTo() two versions are included:
  • The simple version takes patterns and prints all database entries that match the patterns.
  • The complicated version takes more of a natural language approach and responds to questions (e.g. who is jack's son, who are harriet's daughters).
• interact() reads in user input and as long as this does not contain quit it repeats calling respondTo().

/*
* PROCEDURE: setupFacts()
* SUMMARY  : initialises a database of family relation facts
*/
define setupFacts();
    
    []-database;
    alladd(
        [
            [father jack mark]
            [sibling jane mark]
            [sibling helen bill]
            [sibling david jane]
            [sibling jack fred]
            [daughter helen sarah]
            [father steven fred]
            [sibling bob jill]
            [spouse jill jack]
            [spouse fred sarah]
            [spouse steven betty]
            [father peter jill]
            [spouse peter harriet]
            [spouse helen paul]
            [child nicola paul]
            [gender bill male]
            [gender mark male]
            [gender fred male]
            [gender david male]
            [gender helen female]
            [gender bill male]
            [gender jack male]
            [gender jill female]
            [gender jane female]
            [gender bob male]
            [gender steven male]
            [gender sarah female]
            [gender peter male]
            [gender harriet female]
            [gender nicola female]
            [gender betty female]
        ]);

enddefine;






/*
* PROCEDURE: addFact(fact)
* INPUT 1  : fact - a fact to add to the database
* SUMMARY  : adds a fact to the database if it is not already present
*/
define addFact(fact);
    if not(present(fact)) then
        add(fact);
       	;;; npr([Adding fact ^fact]); ;;; "npr" means "print, followed by a new line" 
    endif;
enddefine;





/*
* PROCEDURE: infer()
* SUMMARY  : defines inference rules, each of which will find any inferrable
*            facts and add them to the database.
*/
define infer();
    lvars x,y,z,s,g,g1;

    ;;; "spouse" is commutative - so add the other ordering
    forevery ![[spouse ?x ?y]] do
        addFact([spouse ^y ^x]);
    endforevery;

    ;;; if person X has a spouse Y, and X has a child Z,
    ;;; that child is also the child of the spouse
    forevery ![[spouse ?x ?y] [child ?z ?x]] do
        addFact([child ^z ^y]);
    endforevery;

    /* Child parent inferences */

    ;;; "son" and "daughter" inferred according to gender
    forevery ![[child ?x ?y] [gender ?x ?g]] do
        if g = "male" then
            addFact([son ^x ^y]);
        else
            addFact([daughter ^x ^y]);
        endif;
    endforevery;

    ;;; "sons" and "daughters" are children by definition
    forevery ![[son ?x ?y]] do
            addFact([child ^x ^y]);
    endforevery;

    forevery ![[daughter ?x ?y]] do
            addFact([child ^x ^y]);
    endforevery;

    ;;; "parent" implies "son" or "daughter" 
    forevery ![[father ?x ?y] [gender ?y ?g]] do
        if g="male" then
            addFact([son ^y ^x]);
        else
            addFact([daughter ^y ^x]);
        endif;
    endforevery;

    forevery ![[mother ?x ?y] [gender ?y ?g]] do
        if g="male" then
            addFact([son ^y ^x]);
        else
            addFact([daughter ^y ^x]);
        endif;
    endforevery;

    ;;; "son" implies "father" or "mother"
    forevery ![[son ?x ?y] [gender ?y ?g]] do
        if g="male" then
            addFact([father ^y ^x]);
        else
            addFact([mother ^y ^x]);
        endif;
    endforevery;

    forevery ![[daughter ?x ?y] [gender ?y ?g]] do
        if g="male" then
            addFact([father ^y ^x]);
        else
            addFact([mother ^y ^x]);
        endif;
    endforevery;



    ;;; EX1: Sibling stuff - similar to  
    ;;; "brother" and "sister" inferred according to gender






    ;;; EX2: "brothers" are siblings by definition
    ;;; (but remember: sibling is a commutative relationship!)




    ;;; EX3: "sisters" are siblings by definition
    ;;; (but remember: sibling is a commutative relationship!)





    ;;; EX4: shared siblings 






    ;;; siblings share the same parents (in a legal sense)
    forevery ![[child ?x ?y] [sibling ?x ?z] [gender ?z ?g]] do
        if g="male" then
            addFact([son ^z ^y]);
        else
            addFact([daughter ^z ^y]);
        endif;
        addFact([child ^z ^y]);
    endforevery;

    ;;; Grandparents, specialised according to gender
    forevery ![[child ?x ?y] [child ?y ?z] [gender ?z ?g] [gender ?x ?g1]]  do
        addFact([grandchild ^x ^z]);
        addFact([grandparent ^z ^x]);
        if g="male" then
            addFact([grandfather ^z ^x]);
        else
            addFact([grandmother ^z ^x]);
        endif;
         if g1="male" then
            addFact([grandson ^x ^z]);
        else
            addFact([granddaughter ^x ^z]);
        endif;
    endforevery;

    ;;; EX5: Great-grandparents, specialised according to gender













    ;;; any parent's brothers are uncles,
    ;;; and their wives are aunts
    forevery ![[child ?x ?y] [brother ?z ?y]] do
        addFact([uncle ^z ^x]);
        if present(![spouse ^z ?s]) then
            addFact([aunt ^s ^x]);
        endif;
    endforevery;

    ;;; any parent's sisters are aunts,
    ;;; and their husbands are uncles
    forevery ![[child ?x ?y] [sister ?z ?y]] do
        addFact([aunt ^z ^x]);
        if present(![spouse ^z ?s]) then
            addFact([uncle ^s ^x]);
        endif;
    endforevery;

    ;;; an uncle's children are cousins of the neice/nephew
    forevery ![[uncle ?x ?y] [child ?s ?x]] do
        addFact([cousin ^y ^s]);
        addFact([cousin ^s ^y]);
    endforevery;

    ;;; EX6: determine neice/nephew by gender (uncle)








    ;;; EX7: determine neice/nephew by gender (aunt)









enddefine;








/*
* PROCEDURE: setupFacts()
* SUMMARY  : applies inference until goal fact is reached, or 20 iterations
*            are performed (which is deemed a failure).
*/
define think();
    lvars test;
    repeat 20 times
        infer();
        quitif(database matches test);
        copydata(database)->test;
    endrepeat;
enddefine;









/*
* PROCEDURE: respondTo(input)
* INPUT 1  : input - an input query-fact, to "prove"
* SUMMARY  : takes simple query-fact patterns and attempts to 
*            show that they are true according to the database.
*            True query-facts print a result; false ones do not.
*/
define respondTo(input);
    foreach input do
        it=>
    endforeach;
enddefine;




/* COMMENTED OUT TO ALLOW SIMPLE ONE FIRST! */
/*
define respondTo(input);
    lvars name,relations,results,
        tempName,tempRel,plural,match;

    if input matches ![who ?plural ?name ?relations] then
        ;;; If are is use then relations will have an s on the end
        if plural="are" then
            subword(1,length(relations)-1,relations)->tempRel;
        else
            relations->tempRel;
        endif;

        ;;; The name will always have an s on the end
        subword(1,length(name)-1,name)->tempName;

        ;;; Do the matching and gather into a list
        [%
            foreach ![^tempRel ?match ^tempName] do
                match;
            endforeach;
        %] -> results;

        ;;; Check for more than 1 result
        if length(results) > 1 then
            "are"->plural;
        endif;

        ;;; Print results
        if length(results) > 0 then
            [^name ^relations ^plural ^^results]=>
        else
            [^name has no ^relations]=>
        endif;
    elseif input matches [show] then
        database ==>
    else
        [Please rephrase your question]=>
    endif;
enddefine;
*/
/* COMMENTED OUT TO ALLOW SIMPLE ONE FIRST! */






/*
* PROCEDURE: interact()
* SUMMARY  : allows a user to interact with the query-system, until they type "quit"
*/
define interact();
    lvars input=readline();
    while not(input matches [== quit ==]) do
        respondTo(input);
        readline()->input;
    endwhile;
enddefine;


;;; test!
setupFacts();
think();
interact();

If we compiled the code including the simple respondTo() procedure and commenting out the complicated respondTo() procedure, we would see the following interactions:

• If we wanted to know who jill was the daughter of we could type daughter jill ==

  ? daughter jill ==
  ** [daughter jill harriet]
  ** [daughter jill peter]
  

• If we wanted to know all the son facts we could type son ==

  ? son ==
  ** [son david jill]
  ** [son mark jill]
  ** [son bob harriet]
  ** [son jack betty]
  ** [son fred betty]
  ** [son david jack]
  ** [son jack steven]
  ** [son bob peter]
  ** [son bill fred]
  ** [son bill sarah]
  ** [son mark jack]
  ** [son fred steven]
  

• Or we could check for specific facts e.g. is david the son of jill.

  ? son david jill
  ** [son david jill]
  

If we compiled the code including the complicated respondTo() procedure and commenting out the simple respondTo() procedure, using a more natural language like approach we would see the following interactions:

• We can ask who helen's grandfather is

  ? who is helens grandfather
  ** [helens grandfather is steven]
  

• We can ask who are john's sons

  ? who are johns sons
  ** [johns has no sons]
  

• We can ask who nicola's great grandmother is

  ? who is nicolas greatgrandmother
  ** [nicolas greatgrandmother is betty]
  

• We can ask who david's cousins are

  ? who are davids cousins
  ** [davids cousins are helen bill]
  

• We can ask mark's siblings are

  ? who are marks siblings
  ** [marks siblings are david jane]