relation.clp

clips的odbc应用

;;;======================================================
;;;
;;; Name       : Michael Giordano
;;; Instructor : Dr.Kurfess
;;; Date       : 06/17/97
;;; Assignment : Family Relations Test script for CLISPODBC
;;;
;;;======================================================

;;;======================================================
;;;   Family Tree
;;;     
;;;   Describes extended family relationships
;;;     (sister, brother, grandparent, grandmother, grandfather,
;;;      uncle, aunt, cousin, ancestor, in-law)
;;;
;;;     CLIPS Version 6.0 Example
;;;
;;;     To execute, merely load, reset and run.
;;;======================================================
;;;*************
;;;* TEMPLATES *
;;;*************
(deftemplate grandparent-of(slot grandpar) (slot grandchild))
(deftemplate uncle-of(slot uncle) (slot child))
(deftemplate aunt-of(slot aunt) (slot child))
(deftemplate father-of (slot father) (slot child))
(deftemplate mother-of (slot mother) (slot child))
(deftemplate brother-of (slot s-brother) (slot sibling))
(deftemplate sister-of  (slot s-sister)  (slot sibling))
(deftemplate sibling-of (slot person) (slot sibling))
(deftemplate wife-of (slot wife) (slot husband))
(deftemplate husband-of (slot husband) (slot wife))
(deftemplate male (slot person))
(deftemplate female (slot person))
(deftemplate Print-Phase (slot phase))

;;;******************
;;;* RULES *
;;;******************
;(defrule PrintSetup ""
;=>
;(assert (Print-Phase (phase Print-Brother)))

;(assert (father-of (father "Franz Xaver") (child "Franz Anton")))
;(assert (father-of (father "Franz Xaver") (child "Erwin")))
;(assert (father-of (father "Franz Xaver") (child "Mildred"))) ;Made up Aunt
;(assert (mother-of (mother "Josefine") (child "Franz Anton")))
;(assert (mother-of (mother "Josefine") (child "Erwin")))
;(assert (mother-of (mother "Josefine") (child "Mildred"))) ;Made up Aunt

;(assert (father-of (father "Michael") (child "Margarethe"))) ;Made up Grandfather
;(assert (father-of (father "Michael") (child "Herman")))
;(assert (father-of (father "Michael") (child "Edwina")))
;(assert (mother-of (mother "Gertrude") (child "Margarethe"))) ;Made up Grandmother
;(assert (mother-of (mother "Gertrude") (child "Herman")))
;(assert (mother-of (mother "Gertrude") (child "Edwina")))

;(assert (father-of (father "Franz Anton") (child "Franz Josef")))
;(assert (father-of (father "Franz Anton") (child "Hubert")))
;(assert (father-of (father "Franz Anton") (child "Bernhard")))
;(assert  (father-of (father "Franz Anton") (child "Heinrich")))
;(assert  (father-of (father "Franz Anton") (child "Irmgard")))
;(assert  (mother-of (mother "Margarethe") (child "Franz Josef")))
;(assert  (mother-of (mother "Margarethe") (child "Hubert")))
;(assert  (mother-of (mother "Margarethe") (child "Bernhard")))
;(assert  (mother-of (mother "Margarethe") (child "Heinrich")))
;(assert  (mother-of (mother "Margarethe") (child "Irmgard")))

;(assert  (father-of (father "Erwin") (child "Erwin II")))
;(assert  (father-of (father "Erwin") (child "Adolf")))
;(assert  (father-of (father "Erwin") (child "Amanda")))
;(assert  (mother-of (mother "Anna") (child "Erwin II")))
;(assert  (mother-of (mother "Anna") (child "Adolf")))
;(assert  (mother-of (mother "Anna") (child "Amanda")))
;(assert  (wife-of (wife "Margarethe") (husband "Franz Anton")))
;;;(assert  (husband-of (husband "Franz Anton") (wife "Margarethe")))
;(assert  (wife-of (wife "Anna") (husband "Erwin")))
;;;(assert  (husband-of (husband "Erwin") (wife "Anna")))
;(assert  (wife-of (wife "Mildred") (husband "Josef III")))
;;;(assert  (husband-of (husband "Josef III") (wife "Mildred")))

;(assert  (male (person "Franz Anton")))
;(assert  (male (person "Erwin")))
;(assert  (male (person "Franz Josef")))
;(assert  (male (person "Hubert")))
;(assert  (male (person "Bernhard")))
;(assert  (male (person "Heinrich")))
;(assert  (male (person "Herman")))
;(assert  (female (person "Edwina")))
;(assert  (female (person "Margarethe")))
;(assert  (female (person "Irmgard")))
;(assert  (female (person "Mildred")))
;(assert  (female (person "Anna")))
;)

;(assert (male (person fred)))
;(assert (male (person mike)))
;(assert (male (person matt)))
;(assert (female (person sheila)))
;(assert (wife-of (wife sheila) (husband fred)))
;(assert (mother-of (mother-of sheila) (child mike)))
;(assert (mother-of (mother-of sheila) (child matt))))
;(assert (father-of (father-of fred) (child mike)))
;(assert (father-of (father-of fred) (child matt)))
;)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                               ;;;
;;;                   Relation Inference Section                  ;;;
;;;                                                               ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;
;- Husband Inference from Wives
;
(defrule GetHusbands ""
(wife-of (wife ?wife) (husband ?husband))
=>
(assert (husband-of (wife ?wife) (husband ?husband))))

;
;- Sister Rule definition
;
(defrule sister"same father, mother; female"
(father-of (father ?fa) (child ?name1))
(father-of (father ?fa) (child ?name2&~?name1))
(mother-of (mother ?mom) (child ?name1))
(mother-of (mother ?mom) (child ?name2&~?name1))
(female (person ?name2))
?rn <- (Print-Phase (phase Print-Sister))
=>
(printout t ?name2 " is the sister of " ?name1 crlf)
(assert (sister-of (s-sister ?name2) (sibling ?name1)))
(assert (sibling-of (person ?name2)  (sibling ?name1))))


;
;- Brother Rule definition
;
(defrule brother"same father, mother; male"
(father-of (father ?fa) (child ?name1))
(father-of (father ?fa) (child ?name2&~?name1))
(mother-of (mother ?mom) (child ?name1))
(mother-of (mother ?mom) (child ?name2&~?name1))
(male (person ?name2))
?rn <- (Print-Phase (phase Print-Brother))
=>
(printout t ?name2 " is the brother of " ?name1 crlf)
(assert (brother-of (s-brother ?name2) (sibling ?name1)))
(assert (sibling-of (person ?name2)    (sibling ?name1))))


;
;- Uncle Rule definition(No in-law version)
;
(defrule uncle"Male sibling of father/mother"
(or (and (father-of  (father ?fa)  (child ?name1))
         (brother-of (s-brother ?fa) (sibling ?name2)))
    (and (mother-of  (mother ?mom) (child ?name1))
         (brother-of (s-brother ?mom) (sibling ?name2))))
(male (person ?name2))
?rn <- (Print-Phase (phase Print-Uncle))
=>
(printout t ?name2 " is the uncle of " ?name1 crlf)
(assert (uncle-of(uncle ?name2) (child ?name1))))


;
;- Uncle Rule definition(In-law version)
;- Please note : No need to have descendant rules as they are not
;-               ancestors (no blood line).
;-               No need for uncle rule for siblings as it is
;-               covered by the corresponding aunt.
;
(defrule uncle-in-law"Female sibling's husband of father/mother"
(or (and (father-of  (father ?fa)  (child ?name1))
         (sister-of (s-sister ?sis) (sibling ?fa))
         (husband-of (husband ?unc) (wife ?sis)))
    (and (mother-of  (mother ?mom) (child ?name1))
         (sister-of (s-sister ?sis) (sibling ?mom))
         (husband-of (husband ?unc) (wife ?sis))))
?rn <- (Print-Phase (phase Print-Uncle-In-Law))
=>
(printout t ?unc " is the uncle (in-law) of " ?name1 crlf))


;
;- Aunt Rule definition(No in-law version)
;
(defrule aunt"Female sibling of father/mother"
(or (and (father-of  (father ?fa)  (child ?name1))
         (sister-of (s-sister ?name2) (sibling ?fa)))
    (and (mother-of  (mother ?mom) (child ?name1))
         (sister-of (s-sister ?name2) (sibling ?mom))))
(female (person ?name2))
?rn <- (Print-Phase (phase Print-Aunt))
=>
(printout t ?name2 " is the aunt of " ?name1 crlf)
(assert (aunt-of(aunt ?name2) (child ?name1))))


;
;- Aunt Rule definition(In-law version)
;
(defrule aunt-in-law"Male sibling's wife of father/mother"
(or (and (father-of  (father ?fa)     (child ?name1))
         (brother-of (s-brother ?bro) (sibling ?fa))
         (wife-of    (wife ?aunt)     (husband ?bro)))
    (and (mother-of  (mother ?mom)    (child ?name1))
         (brother-of (s-brother ?bro) (sibling ?mom))
         (wife-of    (wife ?aunt)     (husband ?bro))))
?rn <- (Print-Phase (phase Print-Aunt-In-Law))
=>
(printout t ?aunt " is the aunt (in-law) of " ?name1 crlf))


;
;- Grandfather Rule definition
;
(defrule grandfather"father-of, father-of; father-of, mother-of"
(or (and (father-of (father ?fa) (child ?name1))
         (father-of (father ?grandfa) (child ?fa)))
    (and (mother-of (mother ?ma) (child ?name1))
         (father-of (father ?grandfa) (child ?ma))))
?rn <- (Print-Phase (phase Print-GrandFather))
=>
(printout t ?grandfa " is the grandfather of " ?name1 crlf)
(assert (grandparent-of (grandpar ?grandfa) (grandchild ?name1))))


;
;- Grandmother Rule definition
;
(defrule grandmother"mother-of, mother-of, mother-of, father-of"
(or (and (father-of (father ?fa) (child ?name1))
         (mother-of (mother ?grandma) (child ?fa)))
    (and (mother-of (mother ?ma) (child ?name1))      
         (mother-of (mother ?grandma) (child ?ma))))
?rn <- (Print-Phase (phase Print-GrandMother))
=>
(printout t ?grandma " is the grandmother of " ?name1 crlf)
(assert (grandparent-of (grandpar ?grandma) (grandchild ?name1))))


;
;- Ancestor Rule Definition
;
(defrule ancestor"mother, father, aunt, uncle, grandparent"
(or (father-of      (father ?ancestor)   (child ?descendant))
    (mother-of      (mother ?ancestor)   (child ?descendant))
    (grandparent-of (grandpar ?ancestor) (grandchild ?descendant)))
?rn <- (Print-Phase (phase Print-Ancestor))
=>
(printout t ?ancestor " is the ancestor of " ?descendant crlf))


;
;- In-Law Rule Definition
;
(defrule InLaw"siblings of your wife/husband"
(or (and (husband-of (husband ?name1) (wife ?name2))
         (sibling-of (person ?name2)  (sibling ?name3)))
    (and (wife-of    (wife ?name1)    (husband ?name2))
         (sibling-of (person ?name2)  (sibling ?name3))))
?rn <- (Print-Phase (phase Print-In-Law))
=>
(printout t ?name3 " is the in-law of " ?name1 crlf))


;
;- Cousin Rule Definition
;- Please note that this function covers ONLY first cousins
;
(defrule Cousin"siblings of Aunt/Uncle"
(or (and (uncle-of   (uncle  ?unc) (child ?kid)) 
         (father-of  (father ?unc) (child ?cousin)))
    (and (aunt-of    (aunt   ?aunt) (child ?kid))
         (mother-of  (mother ?aunt) (child ?cousin))))
(Print-Phase (phase Print-Cousin))
=>
(printout t ?kid " is a cousin of " ?cousin crlf))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                               ;;;
;;;                     Print Control Section                     ;;;
;;;                                                               ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;
;- If Brothers are done printing, then print Sisters
;
(defrule SetupPrintSister ""
?rn <- (Print-Phase (phase Print-Brother))
=>
(retract ?rn)
(assert (Print-Phase (phase Print-Sister))))

;
;- If Sisters are done printing, then print Uncles
;
(defrule SetupPrintUncle ""
?rn <- (Print-Phase (phase Print-Sister))
=>
(retract ?rn)
(assert (Print-Phase (phase Print-Uncle))))

;
;- If Uncles are done printing, then print Uncle-In-Laws
;
(defrule SetupPrintUncleInLaw ""
?rn <- (Print-Phase (phase Print-Uncle))
=>
(retract ?rn)
(assert (Print-Phase (phase Print-Uncle-In-Law))))

;
;- If Uncle-In-Laws are done printing, then print Aunts
;
(defrule SetupPrintAunt ""
?rn <- (Print-Phase (phase Print-Uncle-In-Law))
=>
(retract ?rn)
(assert (Print-Phase (phase Print-Aunt))))

;
;- If Aunts are done printing, then print Aunt-In-Laws
;
(defrule SetupPrintAuntInLaw ""
?rn <- (Print-Phase (phase Print-Aunt))
=>
(retract ?rn)
(assert (Print-Phase (phase Print-Aunt-In-Law))))

;
;- If Aunt-In-Laws are done printing, then print GrandFathers
;
(defrule SetupPrintGrandFather ""
?rn <- (Print-Phase (phase Print-Aunt-In-Law))
=>
(retract ?rn)
(assert (Print-Phase (phase Print-GrandFather))))

;
;- If GrandFathers are done printing, then print GrandMothers
;
(defrule SetupPrintGrandMother ""
?rn <- (Print-Phase (phase Print-GrandFather))
=>
(retract ?rn)
(assert (Print-Phase (phase Print-GrandMother))))

;
;- If GrandMothers are done printing, then print Ancestors
;
(defrule SetupPrintAncestor ""
?rn <- (Print-Phase (phase Print-GrandMother))
=>
(retract ?rn)
(assert (Print-Phase (phase Print-Ancestor))))

;
;- If Ancestors are done printing, then print In-Laws
;
(defrule SetupPrintInLaw ""
?rn <- (Print-Phase (phase Print-Ancestor))
=>
(retract ?rn)
(assert (Print-Phase (phase Print-In-Law))))

;
;- If In-Laws are done printing, then print Cousins
;
(defrule SetupPrintCousin ""
?rn <- (Print-Phase (phase Print-In-Law))
=>
(retract ?rn)
(assert (Print-Phase (phase Print-Cousin))))