(defclass PERSON (is-a USER) (role concrete) (pattern-match reactive) (slot nom (default "John Doe") (create-accessor read-write)) (slot age (create-accessor read-write)) (multislot address (create-accessor read-write)) ) (defclass ENSI (is-a PERSON) (role concrete) (slot year (create-accessor read-write)) (slot OPTION (default MD) (create-accessor read-write)) ) (make-instance of ( )...) (defclass PERSON (is-a USER) (role concrete) (slot nom (create-accessor read-write)) (multislot address(create-accessor read-write)) (slot age(create-accessor read-write)) ) ================================================================================ ******************************************************************************** Concrete: direct instances of this class can be created. Non-reactive: direct instances of this class cannot match defrule patterns. Direct Superclasses: USER Inheritance Precedence: PERSON USER OBJECT Direct Subclasses: -------------------------------------------------------------------------------- SLOTS : FLD DEF PRP ACC STO MCH SRC VIS CRT OVRD-MSG SOURCE(S) nom : SGL STC INH RW LCL RCT EXC PRV RW put-nom PERSON address : MLT STC INH RW LCL RCT EXC PRV RW put-address PERSON age : SGL STC INH RW LCL RCT EXC PRV RW put-age PERSON Constraint information for slots: SLOTS : SYM STR INN INA EXA FTA INT FLT nom : + + + + + + + + RNG:[-oo..+oo] address : + + + + + + + + RNG:[-oo..+oo] CRD:[0..+oo] age : + + + + + + + + RNG:[-oo..+oo] -------------------------------------------------------------------------------- Recognized message-handlers: init primary in class USER delete primary in class USER print primary in class USER direct-modify primary in class USER message-modify primary in class USER direct-duplicate primary in class USER message-duplicate primary in class USER get-nom primary in class PERSON put-nom primary in class PERSON get-address primary in class PERSON put-address primary in class PERSON get-age primary in class PERSON put-age primary in class PERSON ******************************************************************************** ================================================================================ CLIPS> (make-instance [Jim] of PERSON (nom "jim")(age 18)) (make-instance of PERSON (nom "joe")(age 19)) (send [gen1] get-age) (send [Jim] get-age) (send [Jim] put-age 52) (make-instance of PERSON (nom "jim")(age 18)) (list-defclasses) ;;; Heritage (defclass A (is-a USER)) (defclass B (is-a A)) (defclass C (is-a A)) (defclass D (is-a A)) (defclass A (is-a USER)) (defclass B (is-a USER)) (defclass C (is-a A B)) (defclass D (is-a B A)) (defclass E (is-a A C )) -> E A C A B USER OBJECT (defclass E (is-a C A)) -> E C A B A USER OBJECT -> (defclass F (is-a C B)) (defclass G (is-a C D)) -> A B B A (defclass H (is-a A)) (defclass I (is-a B)) (defclass J (is-a H I A B)) ;; SELF (defclass THING (is-a USER) (role concrete) (slot NAME (create-accessor read-write) (default A)) ) (defmessage-handler THING ask-name () (send ?self get-NAME) ) (defmessage-handler THING return-name () ?self:NAME ) (make-instance [thing] of THING (NAME "myThing")) (send [thing] get-NAME) ;; message handlers (defmessage-handler THING return-NAME after () (printout t "after" crlf) ) (defmessage-handler THING return-NAME () (printout t ?self:NAME crlf) ) (send [thing] return-NAME) (defmessage-handler THING return-NAME () ?self:NAME ) (defmessage-handler THING return-NAME primary () (printout t "primary" crlf) (return ?self:NAME) ) ;;; TYPES of Handlers (defmessage-handler THING return-NAME before () (printout t "before" crlf) ) (send [gen2] return-NAME) Recognized message-handlers: init primary in class USER delete primary in class USER print primary in class USER direct-modify primary in class USER message-modify primary in class USER direct-duplicate primary in class USER message-duplicate primary in class USER get-NAME primary in class THING put-NAME primary in class THING get-NAME after in class THING (defclass THING (is-a USER) (role concrete) (slot NAME (create-accessor read-write) (default A)) (slot COUNT (create-accessor read-write) (default 0)) ) CLIPS> (send [gen2] get-NAME) Quack "myThing" (defmessage-handler THING get-NAME after () (printout t "Quack" crlf) ) (defmessage-handler THING get-NAME before () (bind ?self:COUNT (+ ?self:COUNT 1)) (printout t ?self:NAME " read "?self:COUNT " times." crlf) ) ;;Regles et Objets (clear) (defclass A (is-a USER) (role concrete) (pattern-match reactive) (slot foo (create-accessor write) (pattern-match reactive) ) ) (make-instance a of A) (make-instance b of A) (defrule test-A-existe ?ins <- (object (is-a A)) => (printout t "Objet " ?ins " est de la classe A" crlf) ) CLIPS> (run) Objet est de la classe A (defrule test-foo-eq-toto ?ins <- (object (is-a A) (foo ?f&~nil)) => (printout t "Objet " ?ins " foo = " ?f crlf) ) (run) (send [a] put-foo toto) (run) (defclass PERSON (is-a USER) (role concrete) (pattern-match reactive) (slot famille (create-accessor read-write)) (slot prenom (create-accessor read-write)) (slot age (create-accessor read-write)) (multislot address (create-accessor read-write)) ) (defclass INFO (is-a USER) (role concrete) (pattern-match reactive) (slot famille (create-accessor read-write)) (slot prenom (create-accessor read-write)) (slot age (create-accessor read-write)) ) (make-instance [BOB] of PERSON (prenom Bob) (famille Barker) ) (make-instance [BOB2] of INFO (prenom Bob) (famille Barker)(age 20)) (defrule demande-nom-de-famille ?ins <- (object (is-a PERSON) (famille nil)) => (printout t "Quel est le nom de famille de "?ins "? ") (send ?ins put-famille (read)) ) (defrule demande-prenom ?ins <- (object (is-a PERSON) (prenom nil)) => (printout t "Quel est le prenom de "?ins "? ") (send ?ins put-prenom (read)) ) (make-instance [Fred] of PERSON) (make-instance [Bob] of PERSON (prenom Bob)) (run) (defclass STUDENT (is-a USER) (role concrete) (pattern-match reactive) (slot famille (create-accessor read-write)) (slot prenom (create-accessor read-write)) (slot age (create-accessor read-write)) (slot option (create-accessor read-write)) (slot promo (create-accessor read-write)) ) (make-instance [Bob] of PERSON (prenom Bob) (famille Barker) (age 20)) (make-instance [B] of STUDENT (prenom Bob) (famille Barker)) ;; ;; Determiner la classe d'un objet ;; (defrule deduire-class ?o <- (object (is-a ?c)) => (printout t "l'objet " ?o " de classe "?c "." crlf) ) ;; ;; Completer un objet par un autre ;; (make-instance [B] of person (prenom Bob) (famille Barker)) (defrule deduire-age ?o1 <- (object (famille ?f&~nil) (prenom ?p&~nil) (age ?a&~nil)) ?o2 <- (object (is-a ?c) (famille ?f) (prenom ?p) (age nil)) => (send ?o2 put-age ?a) (printout t "Affecter age " ?a " pour ") (printout t ?c" " ?p " " ?f "." crlf) ) ;; ;; Exemples de relations de famille ;; (defclass PERSON (is-a USER) (role abstract) (slot ID (create-accessor read-write)) (slot father (create-accessor read-write) (default unknown)) (slot mother (create-accessor read-write) (default unknown)) (multislot brothers (create-accessor read-write)) (multislot sisters (create-accessor read-write)) ) (defclass MAN (is-a PERSON) (role concrete)(pattern-match reactive) (slot wife (create-accessor read-write) (default unknown)) (slot sex (storage shared) (default male) (create-accessor read)) ) (defclass WOMAN (is-a PERSON) (role concrete)(pattern-match reactive) (slot husband (create-accessor read-write) (default unknown)) (slot sex (storage shared)(access read-only) (default female) (create-accessor read)) ) (make-instance [Jean] of MAN (ID Jean)) (make-instance [Jacques] of MAN (ID jacques)) (make-instance [A] of MAN (ID A) (wife []) (father [F]) (mother [G])(brothers []) (sisters [B])) (make-instance [B] of WOMAN (ID B) (husband []) (father [F]) (mother [G])(brothers [A]) (sisters [])) (make-instance [C] of MAN (ID C) (wife []) (father [J]) (mother [K])(brothers []) (sisters [D])) (make-instance [D] of WOMAN (ID D) (husband []) (father [J]) (mother [K])(brothers [C]) (sisters [])) (make-instance [E] of MAN (ID E) (wife []) (father [O]) (mother [N])(brothers [F]) (sisters [])) (make-instance [F] of MAN (ID F) (wife []) (father [O]) (mother [N])(brothers [E]) (sisters [])) (make-instance [G] of WOMAN (ID G) (husband []) (father []) (mother [])(brothers [H]) (sisters [])) (make-instance [H] of MAN (ID H) (wife []) (father []) (mother [])(brothers []) (sisters [G])) (make-instance [I] of WOMAN (ID I) (husband []) (father [T]) (mother [S])(brothers []) (sisters [])) (make-instance [J] of WOMAN (ID J) (husband []) (father [T]) (mother [S])(brothers []) (sisters [])) (make-instance [K] of MAN (ID K) (wife []) (father [W]) (mother [V])(brothers []) (sisters [])) (make-instance [L] of WOMAN (ID L) (husband []) (father [W]) (mother [V])(brothers [K]) (sisters [])) (make-instance [M] of MAN (ID M) (wife []) (father []) (mother [])(brothers []) (sisters [N])) (make-instance [N] of WOMAN (ID N) (husband []) (father []) (mother [])(brothers [M]) (sisters [])) (make-instance [O] of MAN (ID O) (wife []) (father []) (mother [])(brothers [P]) (sisters [])) (make-instance [P] of MAN (ID P) (wife []) (father []) (mother [])(brothers [O]) (sisters [])) (make-instance [R] of MAN (ID R) (wife []) (father []) (mother [])(brothers []) (sisters [S])) (make-instance [S] of WOMAN (ID S) (husband []) (father []) (mother [])(brothers [R]) (sisters [])) (make-instance [T] of MAN (ID T) (wife []) (father []) (mother [])(brothers []) (sisters [U])) (make-instance [U] of WOMAN (ID U) (husband []) (father []) (mother [])(brothers [T]) (sisters [])) (make-instance [V] of WOMAN (ID V) (husband []) (father []) (mother [])(brothers []) (sisters [])) (make-instance [W] of MAN (ID W) (wife []) (father []) (mother [])(brothers []) (sisters [])) (defrule ask-wife ?M <- (object (is-a MAN) (ID ?n) (wife unknown)) => (printout t "Who is the wife of " ?n "? ") (bind ?ID (read)) (send ?M put-wife ?ID) (if (neq ?ID nil) then (make-instance ?ID of WOMAN (ID ?ID) (husband ?n))) ) (defrule ask-father ?M <- (object (is-a MAN) (ID ?n) (father unknown)) => (printout t "Who is the father of " ?n "? ") (bind ?ID (read)) (send ?M put-father ?ID) (if (neq ?ID nil) then (make-instance ?ID of MAN (ID ?ID))) ) (defmessage-handler PERSON paternal-grandfather () (send ?self:father get-father) ) (send [David] get-father) (defmessage-handler PERSON paternal-grandfather () (send ?self:father get-father) ) (defmessage-handler PERSON paternal-grandfather () (if (neq unknown ?self:father) then (send ?self:father get-father) else (printout t "the father of "?self:ID "is unknown" CRLF) ) ) (defmessage-handler PERSON paternal-grandmother () (send ?self:father get-mother) ) (defmessage-handler PERSON paternal-grandfather () (bind ?g-father (send ?self:father get-father)) (send ?g-father get-ID) ) (defmessage-handler PERSON paternal-grandmother () (bind ?g-father (send ?self:father get-mother)) (send ?g-father get-ID) ) (defmessage-handler PERSONNE uncles () (create$ (send ?self:father get-brothers) (send ?self:mother get-brothers) ) ) (defmessage-handler PERSON name-the-uncles () (bind $?uncles (create$ (send ?self:father get-brothers) (send ?self:mother get-brothers) ) ) (progn$ (?uncle $uncles) (printout t "the names of " ?oncle " is ") (printout t (send ?Uncle get-ID) crlf) ) ) (defrule ask-brother ?M <- (object (is-a MAN) (ID ?ID) (brothers $?brothers)) (test (eq (nth 1 $?brothers) unknown)) => (printout t "Who is the brother of " ?ID "? ") (bind ?b (read)) (if (eq ?b nil) then (bind $?brothers (delete$ $?brothers 1 1)) else (replace$ $?brothers 1 1 ?b)) (send ?M put-brothers $?brothers)) ) (defmessage-handler PERSON grand-parents () (create$ (send (send ?self:father get-father) get-ID) (send (send ?self:father get-mother) get-ID) (send (send ?self:mother get-father) get-ID) (send (send ?self:mother get-mother) get-ID) ) ) ; ; Frames Example ; (defclass ENTITY (is-a USER) (role abstract) (slot ID (create-accessor read-write)) ;; a unique ID ) (defclass BLOCK (is-a ENTITY) (role concrete) (slot AKO (allowed-values cube long)) ) ;;;AKO - A Kind Of (defclass pince (is-a ENTITY) (role concrete) ) (deffacts BLOCK-RELATIONS (BLOCK cube A) (BLOCK cube B) (BLOCK long C) (BLOCK long D) ) (defrule CreateBlocks (BLOCK ?kind ?ID) => (make-instance of BLOCK (ID ?ID) (AKO ?kind) (defclass RELATION (is-a USER) (role abstract) (pattern-match reactive) (multislot expression (create-accessor read-write)) ;; Forme (predicate arg*) (slot length (create-accessor read-write)) ) (defrule assign-length ?R <- (object (is-a RELATION) (length nil) (expression $?e)) => (send ?R put-length (length $?e)) ) (defmessage-handler RELATION verify ($?exp) (and (eq (length ?self:expression) (length $?exp)) (subsetp $?exp ?self:expression) ) (deffacts BLOCK-RELATIONS (RELATION OnTable A) (RELATION OnTable B) (RELATION Over C A B) (RELATION HandEmpty) ) (defule MakeRelations (RELATION $?R) => (make-instance of RELATION (expression $?R) ) (defclass ROLE (is-a USER) (role concrete) (slot ID (create-accessor read-write)) (slot entity (create-accessor read-write)) (slot a-test (create-accessor read-write) (default default-test)) (slot what-is (create-accessor read-write)) ) (defmessage-handler ROLE Assign (?e) ;; function to evaluate suitability of entity for role (send ?self ?self:a-test ?e)) ;; if a test exists, apply it. (defmessage-handler ROLE default-test (?e) ( return 0) ;;; par defaut no entitiy is suitably ) (defclass SITUATION (is-a USER) (slot ID (create-accessor read-write)) (slot context (create-accessor read-write)) (multislot roles (create-accessor read-write)) (multislot relations (create-accessor read-write)) (multislot neighbors (create-accessor read-write)) ) (defclass REALITY (is-a USER) (role concrete) (pattern-match reactive) (multislot relations (create-accessor read-write)) ) ; ; Pour voir si une relation est vraie dans un contexte: ; (defmessagehandler REALITY verify (?exp) (progn$ (?rel self:$?RELATIONS) (if (send ?rel ?exp) then (return TRUE)) (return false) ) ; ;La situation est vrai si tous les relations sont vraies ; (defmessagehandler SITUATION verify (?Reality) (progn$ (?rel self:$?RELATIONS (if (not (send ?sit verify ?rel)) then (return FALSE)) (return TRUE) )