drtest09.exp

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

TRUE
CLIPS> (batch "drtest09.bat")
TRUE
CLIPS> (clear)                   ; DR0724
CLIPS> [x]
[x]
CLIPS> (clear)                   ; DRO725
CLIPS> 
(defrule should-be-ok
   (message $?first)
   (test (length$ ?first))
   (translation $?first)
   =>)
CLIPS> (clear)                   ; DR0726
CLIPS> 
(defrule bar
   (not (and (c ?x) (d ?y&:(> ?y 3))))
   =>)
CLIPS> (reset)
CLIPS> (assert (c 1) (d a)) ; should not hang
[ARGACCES5] Function > expected argument #1 to be of type integer or float

[FACTMCH1] This error occurred in the fact pattern network
   Currently active fact: (d a)
   Problem resides in field #1
      Of pattern #3 in rule(s):
         bar

FALSE
CLIPS> (clear)                   ; DR0727
CLIPS> 
(defrule foo
   (not (and (a) (b) (c)))
   (d ?x&:(> ?x 3))
   =>)
CLIPS> (reset)
CLIPS> (assert (d a)) ; Error should be for pattern 5
[ARGACCES5] Function > expected argument #1 to be of type integer or float

[FACTMCH1] This error occurred in the fact pattern network
   Currently active fact: (d a)
   Problem resides in field #1
      Of pattern #5 in rule(s):
         foo

<Fact-1>
CLIPS> (clear)                   ; DR0728
CLIPS> 
(deftemplate attempt
   (multifield numbers (default 7 7 3 3))
   (multifield rpn))
CLIPS> 
(deffacts initial-info
   (attempt)
   (operator *)
   (operator /)
   (operator -)
   (operator +))
CLIPS> 
(defrule do-first
   ?f <- (attempt (numbers $?b ?n1 $?m ?n2 $?e)
                  (rpn))
   (operator ?o)
   =>
   (duplicate ?f (numbers ?b ?m ?e)
                 (rpn ?n1 ?n2 ?o)))
CLIPS> 
(defrule do-next
   ?f <- (attempt (numbers $?b ?n $?e)
                  (rpn ?f $?rest))
   (operator ?o)
   =>
   (duplicate ?f (numbers ?b ?e)
                 (rpn ?f ?rest ?n ?o)))
CLIPS> (reset)
CLIPS> (run) ; should not hang or crash
CLIPS> (clear)                   ; DR0729
CLIPS> (get-salience-evaluation)
when-defined
CLIPS> (set-salience-evaluation every-cycle) ; should return when-defined
when-defined
CLIPS> (set-salience-evaluation when-defined) ; should return every-cycle
every-cycle
CLIPS> (clear)                   ; DR0730
CLIPS> (get-salience-evaluation)
when-defined
CLIPS> (defmodule A)
CLIPS> (refresh-agenda *)
CLIPS> (get-salience-evaluation) ; should be when-defined
when-defined
CLIPS> (clear)                   ; DR0731
CLIPS> (unwatch all)
CLIPS> (defrule zoiks =>)
CLIPS> (reset)
CLIPS> (watch rules)
CLIPS> (defrule zoiks =>) ; activation should not be printed
CLIPS> (unwatch all)
CLIPS> (clear)                   ; DR0734
CLIPS> (defmodule MAIN (export ?ALL))
CLIPS> (defglobal MAIN ?*proximity* = 9)
CLIPS> (defmodule SCORE (import MAIN ?ALL))
CLIPS> 
(defrule SCORE::should-be-ok
   (attempt1)
   (test (<= 3 ?*proximity*))
   =>)
CLIPS> (clear)                  ; DR0736
CLIPS> 
(deftemplate where
   (multislot x (type SYMBOL)))
CLIPS> 
(defrule yak ; This should be OK
   (where (x $?pds&:(member$ x ?pds)))
   =>)
CLIPS> (clear)
CLIPS> 
(defrule foo ; This should fail
   (bbb ?x&:(member a ?x))
   =>)

[RULECSTR2] Previous variable bindings of ?x caused the type restrictions
for argument #2 of the expression (member a ?x)
found in CE #1 field #1 to be violated.

ERROR:
(defrule MAIN::foo
   (bbb ?x&:(member a ?x))
   =>)
CLIPS> (clear)
CLIPS> 
(deftemplate this
   (slot x)
   (slot y (type INTEGER))
   (multislot z (type STRING)))
CLIPS> 
(defrule this-1 ; This should fail
   (this (x ?x))
   =>
   (member$ a ?x))

[RULECSTR3] Previous variable bindings of ?x caused the type restrictions
for argument #2 of the expression (member$ a ?x)
found in the rule's RHS to be violated.

ERROR:
(defrule MAIN::this-1
   (this (x ?x))
   =>
   (member$ a ?x))
CLIPS> (clear)                   ; DR0737
CLIPS> 
(defrule fd-1 ; This should be ok
   (a)
   (not (and (b)
             (or (c)
                 (d))))
   =>)
CLIPS>    
(defrule fd-2 ; this should be ok
   (a)
   (exists (b)
           (or (and (c))
               (d)))
   =>)
CLIPS> 
(defrule fd-3 ; this should be ok
   (a)
   (not (and (b)
             (or (and (c) (e))
                 (d))))
   =>)
CLIPS> 
(defrule fd-4 ; this should be ok
   (a)
   (exists (b)
           (or (c)         
               (d)))
   =>)
CLIPS> (clear)
CLIPS> 
(defrule foo-1
   (not (or (a) (b)))
   =>)
CLIPS> 
(defrule foo-2
   (not (not (or (a) (b))))
   =>)
CLIPS> 
(defrule foo-3
   (not (and (not (a))
             (not (b))))
   =>)
CLIPS> (reset)
CLIPS> (agenda)
0      foo-1: f-0,,
For a total of 1 activation.
CLIPS> (assert (a))
<Fact-1>
CLIPS> (agenda)
0      foo-2: f-0,
0      foo-3: f-0,
For a total of 2 activations.
CLIPS> (assert (b))
<Fact-2>
CLIPS> (agenda)
0      foo-2: f-0,
0      foo-3: f-0,
For a total of 2 activations.
CLIPS> (clear)                   ; DR0738
CLIPS> 
(deffacts f1
   (s 1)
   (s 2)
   (s 3)
   (c)
   (a 1))
CLIPS> 
(defrule r1 ; SHOULD activate, but doesn't
   (s 1)
   (exists (or (and (a ?x)
                    (d)
                    (test (> 16 10)))
               (and (a ?x)
                    (c))))
   =>)
CLIPS>    
(defrule r2 ; SHOULD activate, but doesn't
   (s 2)
   (not (and (not (and (a ?x)
                       (d)
                       (test (> 16 10))))
              (not (and (a ?x)
                        (c)))))
   =>)
CLIPS> 
(defrule r3 ; SHOULD NOT activate, but does
   (s 3)
   (not (and (a ?x)
             (d)
             (test (> 16 10))))
   (not (and (a ?x)
             (c)))
   =>)
CLIPS> (reset)
CLIPS> (agenda)
0      r1: f-1,
0      r2: f-2,
For a total of 2 activations.
CLIPS> (clear)                    ; DR0740
CLIPS> 
(deffunction bug (?list ?a ?b)
   (while TRUE (return (subseq$ ?list ?a ?b))))
CLIPS> (bug (create$ a b c) 1 2) ; Should return (a b)
(a b)
CLIPS> 
(deffunction bug (?list ?a ?b)
   (loop-for-count 1 (return (subseq$ ?list ?a ?b))))
CLIPS> (bug (create$ a b c) 1 2) ; Should return (a b)
(a b)
CLIPS> (clear)                   ; DR0742 - should have no error
CLIPS> (deftemplate TREATMENT
   (multislot values
   (type INTEGER)
   (range 0 19)
   (cardinality 0 20)))
CLIPS> (assert (TREATMENT (values (create$))))
<Fact-0>
CLIPS> (clear)                  ; DR0743 - should have no error
CLIPS> (defglobal ?*x* = 3)
CLIPS> (bsave "mytest.bin")
TRUE
CLIPS> (clear)
CLIPS> (watch all)
CLIPS> (bload "mytest.bin")
<== Focus MAIN
:== ?*x* ==> 3 <== 
TRUE
CLIPS> (unwatch all)
CLIPS> (clear)                 ; DR0745
CLIPS> (unwatch all)
CLIPS> (defclass A (is-a USER)
  (role concrete)
  (pattern-match reactive)
  (slot x (create-accessor write))
  (slot y (create-accessor write)))
CLIPS> (defrule bug
  (object (is-a A)
          (y 100)
          (x 100))
  =>)
CLIPS> (agenda) ; should be no activations
CLIPS> (make-instance a of A)
[a]
CLIPS> (watch activations)
CLIPS> (object-pattern-match-delay ; should have only one activation arrow
   (send [a] put-y 100)
   (send [a] put-x 100))
==> Activation 0      bug: [a]
100
CLIPS> (unwatch all)
CLIPS> (clear)                 ; DR0747
CLIPS> 
(defclass A (is-a USER)
   (slot foo (type INSTANCE-NAME)))
CLIPS> (slot-types A foo) ; Should be just instance-name
(INSTANCE-NAME)
CLIPS> (clear)                ; DR0748 - Should have no error from print message
CLIPS> (defmodule MAIN (export ?ALL))
CLIPS> (defclass TEST (is-a USER)
  (role concrete))
CLIPS> (defmodule TEST (import MAIN ?ALL))
CLIPS> (make-instance test of TEST)
[MAIN::test]
CLIPS> (do-for-instance ((?t TEST)) TRUE
  (send ?t print))
[test] of TEST
CLIPS> (clear)                ; DR0749
CLIPS> (defclass A (is-a USER)
   (slot foo (access read-only)))
CLIPS> (slot-facets A foo) ; facet should be SHR and not LCL
(SGL STC INH R SHR RCT EXC PRV NIL NIL)
CLIPS> (clear)                ; DR0750 - Should not crash
CLIPS> (defclass FOO (is-a USER) (slot x))
CLIPS> (slot-cardinality FOO x)
()
CLIPS> (clear)                ; DR0752 - Should return "a"
CLIPS> (deffunction y ()
   (progn$ (?x (create$ "a" "b" "c"))
      (return ?x))
   (return "hello"))
CLIPS> (y)
"a"