drtest10.exp

NASA 开发使用的一个专家系统

TRUE
CLIPS> (batch "drtest10.bat")
TRUE
CLIPS> (clear)                   ; DR0793
CLIPS> (load bug793.clp)
###!!
TRUE
CLIPS> (BEeditInit streamout)
TRUE
CLIPS> (BECPMIn bug793.ins)
24
CLIPS> (clear)                   ; DR0795
CLIPS> 
(defrule rule-1
  (blah $?y)
  =>
  (progn$ (?x ?y) (printout t ?x)))
CLIPS> (ppdefrule rule-1)
(defrule MAIN::rule-1
   (blah $?y)
   =>
   (progn$ (?x ?y) 
      (printout t ?x)))
CLIPS> (clear)                   ; DR0798
CLIPS> (reset)
CLIPS> (assert (a))
<Fact-1>
CLIPS> (assert (b))
<Fact-2>
CLIPS> (defrule t1 (b) (a) =>)
CLIPS> (defrule t2 (a) (or (b) (b)) =>)
CLIPS> (agenda)
0      t2: f-1,f-2
0      t2: f-1,f-2
0      t1: f-2,f-1
For a total of 3 activations.
CLIPS> (clear)                   ; DR0801
CLIPS> (setgen 1)
1
CLIPS> (unwatch all)
CLIPS> (watch instances)
CLIPS> (watch activations)
CLIPS> (watch rules)
CLIPS> 
(defclass A (is-a USER)
  (role concrete)
  (pattern-match reactive)
  (slot match (default yes) (create-accessor read-write))
  (slot container (create-accessor read-write)))
CLIPS>   
(defmessage-handler A delete before ()
  (if (instance-existp ?self:container) then
     (unmake-instance ?self:container)))
CLIPS>      
(defrule A-rule
  (logical ?obj <- (object (is-a A) (match yes)))
=>
  (send ?obj put-container 
      (make-instance of A (match no)
                          (container (make-instance of INITIAL-OBJECT))))
  (send ?obj put-match no))
CLIPS> (make-instance a of A)
==> instance [a] of A
==> Activation 0      A-rule: [a]
[a]
CLIPS> (run)
FIRE    1 A-rule: [a]
==> instance [gen1] of A
==> instance [gen2] of INITIAL-OBJECT
<== instance [gen2] of INITIAL-OBJECT
<== instance [gen1] of A
CLIPS> (unwatch all)
CLIPS> (clear)                   ; DR0802
CLIPS> 
(defclass A (is-a USER)
  (role concrete)
  (slot foo (default bar)))
CLIPS>   
(defmessage-handler A delete after ()
  (printout t ?self:foo crlf))
CLIPS> (unmake-instance (make-instance of A))
[INSFUN4] Invalid instance-address in function for slot get.
[PRCCODE4] Execution halted during the actions of message-handler delete after in class A
TRUE
CLIPS> (clear)                   ; DR0803
CLIPS> 
(defclass A
   (is-a USER)
  (role concrete)
  (pattern-match reactive)
  (multislot data
    (create-accessor read-write)))
CLIPS>     
(defrule rule1
  (object (is-a A) (data 0 ?x))
  (object (is-a A) (data 1 ?x))
  =>
  (printout t ?x crlf))
CLIPS> 
(definstances objects
  (a of A (data 0 0))
  (b of A (data 1 0))
  (c of A (data 1 1)))
CLIPS> (reset)
CLIPS> (agenda)
0      rule1: [a],[b]
For a total of 1 activation.
CLIPS> (clear)                   ; DR0804
CLIPS> 
(deffunction imfi (?cv)
   (bind ?position 3)
   (while TRUE do
     (bind ?nv (+ (nth$ ?position ?cv) 1))
     (if (<= ?nv 9)
        then 
        (return (replace$ ?cv ?position ?position ?nv)))
     (bind ?cv (replace$ ?cv ?position ?position 1))
     (bind ?position (- ?position 1))
     (if (< ?position 1) then (return FALSE))))
CLIPS>  
(deffunction optimize ()
   (bind ?current-settings (create$ 1 1 1))
   (while (neq ?current-settings FALSE)
      (bind ?current-settings (imfi ?current-settings))))
CLIPS> (reset)
CLIPS> (optimize)
FALSE
CLIPS> (clear)                   ; DR0805
CLIPS> (setgen 1)
1
CLIPS> 
(defclass A
   (is-a USER)
   (role concrete)
   (pattern-match reactive)
   (multislot data
      (create-accessor read-write)))
CLIPS> 
(defrule rule1
   (object (is-a A) (data ? red ?x&green))
   (object (is-a A) (data ? red ?x))
   =>)
CLIPS> (make-instance of A (data orange red green))
[gen1]
CLIPS> (matches rule1)
Matches for Pattern 1
[gen1]
Matches for Pattern 2
[gen1]
Partial matches for CEs 1 - 2
[gen1],[gen1]
Activations
[gen1],[gen1]
CLIPS> (clear)                   ; DR0806
CLIPS> (setgen 1)
1
CLIPS> 
(defclass A (is-a INITIAL-OBJECT)
   (multislot foo))
CLIPS> 
(defclass B (is-a A)
   (slot foo))
CLIPS> 
(defrule AB
   (object (is-a A) (foo ?val))
   =>
   (printout t ?val crlf))
CLIPS> (make-instance of B)
[gen1]
CLIPS> (run)
nil
CLIPS> (clear)                   ; DR0807
CLIPS> (insert$ (rest$ (create$ abc def)) 2 ghi)
(def ghi)
CLIPS> (clear)                   ; DR0808
CLIPS> (assert (m))
<Fact-0>
CLIPS> (assert (a))
<Fact-1>
CLIPS> (defrule r1 (m) (not (a)) =>)
CLIPS> (defrule r2 (m) (not (a)) (not (b)) =>)
CLIPS> (agenda)
CLIPS> (clear)                   ; DR0809
CLIPS> (deffunction pins () (ppinstance))
CLIPS> (defmessage-handler USER pins () (pins))
CLIPS> (defclass A (is-a USER) (role concrete))
CLIPS> (make-instance a of A)
[a]
CLIPS> (send [a] pins)
[MSGFUN4] ppinstance may only be called from within message-handlers.
[PRCCODE4] Execution halted during the actions of deffunction pins.
[PRCCODE4] Execution halted during the actions of message-handler pins primary in class USER
FALSE
CLIPS> (clear)                   ; DR0810
CLIPS> (deffunction MAIN::foo
   (?garbage)
   (setgen 1)
   (loop-for-count ?garbage
      (make-instance of INITIAL-OBJECT))
   (delayed-do-for-all-instances ((?ins INITIAL-OBJECT))
      TRUE
      (progn
         (unmake-instance *)
         (return (gensym*)))))
CLIPS> (foo 100)
gen101
CLIPS> (foo 500)
gen501
CLIPS> (clear)                   ; DR0813
CLIPS> 
(defclass A (is-a INITIAL-OBJECT)
   (multislot foo (create-accessor read-write)))
CLIPS> 
(defrule A
   (fact ?v)
   (not (object (is-a A) (foo $? ?v $?)))
=>)
CLIPS> (assert (fact a))
<Fact-0>
CLIPS> (make-instance a of A (foo a b c))
[a]
CLIPS> (make-instance b of A (foo a b c))
[b]
CLIPS> 
(object-pattern-match-delay
   (modify-instance a (foo q))
   (modify-instance b (foo q)))
TRUE
CLIPS> (clear)                   ; DR0815
CLIPS> 
(defclass grammy (is-a USER)
    (role concrete)
    (pattern-match reactive)
    (multislot  text
    (create-accessor write)
    (type SYMBOL)))
CLIPS> 
(defmessage-handler grammy print before ()
    (printout t crlf)
    (printout t "******  starting to print   ****"  ?self crlf))
CLIPS> 
(defmessage-handler grammy print after ()
    (printout t "******  starting to print   ****"  ?self crlf)
    (printout t crlf))
CLIPS> 
(deffunction resize (?xlist)
   (if (= (length$ ?xlist)  0)
     then
     (printout t "got to here !!! "  crlf)
     (return)
     else
     (make-instance (gensym) of grammy
         (text (subseq$ ?xlist 1 9))))
     (resize (subseq$ ?xlist 10 (length$ ?xlist))))
CLIPS> 
(deffunction ask ()
   (do-for-all-instances ((?tag grammy)) (instancep ?tag)
      (send ?tag print)))
CLIPS> 
(defrule commence  "make it happen"
   =>
   (resize (create$ a b c d e f g h i j k l m n)))
CLIPS> (reset)
CLIPS> (run)
got to here !!! 
CLIPS> (clear)                   ; DR0816
CLIPS> 
(defclass A
	  (is-a USER)
	  (role concrete)
	  (slot str
	    (create-accessor read-write)
	    (type STRING))
	  (slot length
	    (create-accessor read-write)
	    (type INTEGER)))
CLIPS> 
(defmessage-handler A put-str after (?value)
   (bind ?self:length 3))
CLIPS> (make-instance a of A (str 4))
[a]
CLIPS> (send [a] get-length)
3
CLIPS> (clear)                   ; DR0817
CLIPS> 
(deftemplate status 
   (slot search-depth)
   (slot parent))
CLIPS> 
(defrule move-alone 
  ?node <- (status)
  =>
  (duplicate ?node (search-depth =(+ 1 3))
                   (parent ?node)))
CLIPS> (ppdefrule move-alone) 
(defrule MAIN::move-alone
   ?node <- (status)
   =>
   (duplicate ?node (search-depth =(+ 1 3)) (parent ?node)))
CLIPS>  
(deftemplate dbdata
  (multislot values))
CLIPS>  
(defrule bug1
  =>
  (assert (dbdata (values (create$ 1 2)))))
CLIPS> (ppdefrule bug1)
(defrule MAIN::bug1
   =>
   (assert (dbdata (values (create$ 1 2)))))
CLIPS>  
(defrule bug2
  =>
  (assert (dbdata (values (create$ 1 2) (create$ 3 4)))))
CLIPS> (ppdefrule bug2)    
(defrule MAIN::bug2
   =>
   (assert (dbdata (values (create$ 1 2) (create$ 3 4)))))
CLIPS>  
(deftemplate foo 
   (field x) 
   (multifield y))
CLIPS>  
(deffacts d5 (foo (y a)))
CLIPS> (ppdeffacts d5)
(deffacts MAIN::d5
   (foo (y a)))
CLIPS> (deffacts d6 (foo (y a b)) (b) (foo (x 3)) (d))
CLIPS> (ppdeffacts d6)
(deffacts MAIN::d6
   (foo (y a b))
   (b)
   (foo (x 3))
   (d))
CLIPS> (clear)                   ; DR0818
CLIPS> (defmodule A (export ?ALL))
CLIPS> (defgeneric A::foo)
CLIPS> (defmethod A::foo ((?arg NUMBER)))
CLIPS> (defmodule B (import A ?ALL))
CLIPS> (defclass B (is-a USER))
CLIPS> (defmethod B::foo ((?arg B)))

[CSTRCPSR3] Cannot define defgeneric foo because of an import/export conflict.

ERROR:
(defmethod B::foo
CLIPS> (clear)
CLIPS> (dribble-off)