fldval50.clp

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

;;; This file contains a series of rules to test the basic CLIPS capability.
;;; The testing conforms to the content and capabilities as outlined in the
;;; CLIPS Basic Programming Guide.

;;; Section 2.2 Facts

;;; Field values may be numbers, words or strings.  Assumption:
;;; If a field value in a field tests correctly, then it is valid for all
;;; fields in a fact.

;;; Section 2.5.1 Defining Rules

;;; The defrule construct is employed checking pattern matching on the LHS
;;; of the rule.  Pattern matching involves only literal fields.  Additionally,
;;; assert and retract are employed on the RHS.

;;; Section 2.5.2 Defining Initial Facts

;;; The deffacts construct is employed to assert initial facts into the
;;; knowledge base.  Facts contain numbers, words and strings as field values.
;;; These initial facts are subsequently retracted.

;;; 3.0 Conditions

;;; 3.1 Literal Patterns

;;; Literal pattern matching is employed in verifing the functionality of the
;;; deffacts construct and in the manipulation of control facts.

;;; CR0077 implemented 07/09/90


;;;=============== INITIAL FACTS FOR LITERAL PATTERN MATCHING =================


(deffacts field-values-1 "loading of numbers"
 (number 237)
 (number 15.09)
 (number +12.9)
 (number -32.3e-7))

(deffacts field-values-2 "loading of words"
 (word foo)
 (word Hello)
 (word B76-HI)
 (word bad-value)
 (word specialchar!@#$%^*_+{}:>`-=\[]',./))

(deffacts field-values-3 "loading of strings"
 (string "foo")
 (string "a and b")
 (string "1 number")
 (string "a\"quote")
;  should be "two crlf lines"   ; DR0152
 (string "two lines")
 (string "specialchar~!@#$%^&*()_+|{}:\"<>? `-=\\[];',./"))

(deffacts field-values-4 "loading of delimeter test subset"
 (delimeter ab<cd)   
 (delimeter ab   ;xy       
               cw)        
 (delimeter a"a")  
 (delimeter ab
cd))


;(deffacts no-values)     ; DR0151

;;;============= RULES FOR STARTING AND STOPPING TEST =============


(defrule start-test                                                     ;CR0020
=>                                                                      ;CR0020
 (assert (begin field-values)))                                         ;CR0020

(defrule end-test
 (declare (salience -100))
 ?f1 <- (end additional-action-functions)
=>
 (retract ?f1))


;;;================= LITERAL PATTERN MATCHING ==========================


(defrule field-values-matching-1 "testing of numbers"
 (begin field-values)
 (number 237)
 (number 15.09)
 (number +12.9)
 (number -32.3e-7)
=>
 (assert (successful "number field values")))

(defrule field-values-matching-2 "testing of words"              ;CR0001
 (begin field-values)                                            ;CR0001
 (word foo)                                                      ;CR0001
 (word Hello)                                                    ;CR0001
 (word B76-HI)                                                   ;CR0001
 (word bad-value)                                                ;CR0001
 (word specialchar!@#$%^*_+{}:>`-=\[]',./)                       ;CR0001
=>                                                               ;CR0001
 (assert (successful "word field values")))                      ;CR0001

(defrule field-values-matching-3 "testing of strings"            ;CR0001
 (begin field-values)                                            ;CR0001
 (string "foo")                                                  ;CR0001
 (string "a and b")                                              ;CR0001
 (string "1 number")                                             ;CR0001
 (string "a\"quote")                                             ;CR0001
;             should be "two crlf lines"                       ; DR0152 
 (string "two lines")                                                          ;CR0001 CR0004
 (string "specialchar~!@#$%^&*()_+|{}:\"<>? `-=\\[];',./")       ;CR0001 CR0004
=>                                                               ;CR0001
 (assert (successful "string field values")))                    ;CR0001

(defrule field-values-matching-4 "testing of delimeters"         ;CR0001
 (begin field-values)                                            ;CR0001
 (delimeter ab cw)                                               ;CR0001
 (delimeter ab <cd)                                              ;CR0001
 (delimeter a  "a")                                         ;CR0001
 (delimeter ab cd)                                               ;CR0001
=>                                                               ;CR0001
 (assert (successful "delimeter test")))                         ;CR0001

(defrule field-values-clean-up "wildcard testing coming next"
 (declare (salience -10)) ; Added by Gary Riley
 ?f1 <- (successful "number field values")
 ?f2 <- (successful "word field values")
 ?f3 <- (successful "string field values")
 ?f4 <- (successful "delimeter test")
 ?f5 <- (begin field-values)
=>
 (retract ?f1 ?f2 ?f3 ?f4 ?f5)
 (printout t "literal pattern matching successful" crlf)       ;CR0020
 (assert (end field-values)))

(defrule error-matching-literal-patterns
 (declare (salience -30))
 (begin field-values)
=>
 (printout t "error in literal pattern matching" crlf))

(defrule clean-up-number-facts
 (declare (salience -20)) ; Added by Gary Riley
 ?f1 <- (number ?)
 (end field-values)
=>
 (retract ?f1))

(defrule error-clean-up-number-facts
 (declare (salience -30)) ; Added by Gary Riley
 (number ?)
 (end field-values)
=>
 (printout t "error clean-up-number-facts" crlf))

(defrule clean-up-word-facts
 (declare (salience -20)) ; Added by Gary Riley
 ?f1 <- (word $?)
 (end field-values)
=>
 (retract ?f1))

(defrule error-clean-up-word-facts
 (declare (salience -30)) ; Added by Gary Riley
 (word $?)
 (end field-values)
=>
 (printout t "error clean-up-word-facts" crlf))

(defrule clean-up-string-facts
 (declare (salience -20)) ; Added by Gary Riley
 ?f1 <- (string $?)
 (end field-values)
=>
 (retract ?f1))

(defrule error-clean-up-string-facts
 (declare (salience -30)) ; Added by Gary Riley
 (string $?)
 (end field-values)
=>
 (printout t "error clean-up-string-facts" crlf))

(defrule clean-up-delimeter-facts
 (declare (salience -20)) ; Added by Gary Riley
 ?f1 <- (delimeter $?)
 (end field-values)
=>
 (retract ?f1))

(defrule error-clean-up-delimeter-facts
 (declare (salience -30)) ; Added by Gary Riley
 (delimeter $?)
 (end field-values)
=>
 (printout t "error clean-up-delimeter-facts" crlf))

(defrule begin-wildcards-test
 (declare (salience -40)) ; Added by Gary Riley
 (end field-values)
 =>
 (assert (begin wildcards)))
 
;;; 3.2 Wildcards - Single and Multi-field

;;; In this file, single field and multiple field wildcards are employed in
;;; retracting facts during the clean up operations. In this section, single
;;; field and multi-field wildcards are used in various combinations within
;;; a single pattern. Additionally, multi-field wildcard and literal fields
;;; are combined in a single pattern. Assumption: If a wildcard performs
;;; correctly in one field, then it will perform correctly in all fields.

;;; ========= INITIAL FACTS FOR SINGLE AND MULTIPLE FIELD WILDCARDS =========


(deffacts wildcards "facts for single and multi-field"
 (data red)
 (data red green)
 (data red "green")
 (data red green green)
 (data green red)
 (data red 3.5e3))

;;; ======================= WILDCARD MATCHING =================================


(defrule single-field-wildcard "matching"
 (declare (salience 1)) ; Added by Gary Riley
 (begin wildcards)
 (data red ?)
=>
 (assert (successful "single field matching"))
 (printout t "single-field-wildcard should fire three times" crlf))

(defrule multi-field-wildcard "matching"
 (declare (salience 2)) ; Added by Gary Riley
 (begin wildcards)
 (data red $?)
=>
 (assert (successful "multi field matching"))
 (printout t "multi-field-wildcard should fire five times" crlf))

(defrule multi-single-field-wildcard "matching and variable delimeters"
 (declare (salience 3)) ; Added by Gary Riley
 (begin wildcards)                                               ;CR0001
 (data ??)                                                        ;CR0001
=>
 (assert (successful "multi single field wildcard matching"))
 (printout t "multi-single-field-wildcard should fire four times" crlf))


(defrule multi-multi-field-wildcard "matching and variable delimeters"
 (declare (salience 4)) ; Added by Gary Riley
 (begin wildcards)
 (data $? $?)
=>
 (assert (successful "multi multi field wildcard matching"))
 (printout t "multi-multi-field-wildcard should fire eighteen times" crlf))

(defrule multi-and-single-field-wildcard "matching"
 (declare (salience 5)) ; Added by Gary Riley
 (begin wildcards)
 (data $? ?)
=>
 (assert (successful "multi and single field wildcards matching"))
 (printout t "multi-and-single-field-wildcard should fire six times" crlf))

(defrule multi-field-and-literal-field "matching"                ;CR0001
 (declare (salience 6)) ; Added by Gary Riley
 (begin wildcards)
 (color $? YELLOW $?)                                            ;CR0001
=>                                                               ;CR0001
 (assert (successful "multi field and literal field"))           ;CR0001
 (printout t "multi-field-and-literal-field should fire six times" crlf))

(defrule assert-color-facts "add data"
 (successful "single field matching")
 (successful "multi field matching")
 (successful "multi multi field wildcard matching")
 (successful "multi single field wildcard matching")
 (successful "multi and single field wildcards matching")
=>
 (assert (color YELLOW blue red green))
 (assert (color YELLOW red))
 (assert (color red YELLOW))
 (assert (color YELLOW))
 (assert (color YELLOW color YELLOW)))

(defrule wildcard-clean-up
 (declare (salience -10))
 ?f1 <- (begin wildcards)
 ?f2 <- (successful "single field matching")
 ?f3 <- (successful "multi field matching")
 ?f4 <- (successful "multi single field wildcard matching")
 ?f5 <- (successful "multi multi field wildcard matching")
 ?f6 <- (successful "multi and single field wildcards matching")
 ?f7 <- (successful "multi field and literal field")
=>
 (retract ?f1 ?f2 ?f3 ?f4 ?f5 ?f6 ?f7)
 (assert (end wildcards)))

(defrule error-wildcards
 (declare (salience -30))
 (begin wildcards)
=>
 (printout t "error in wildcard matching" crlf))

(defrule color-facts-clean-up
 (declare (salience -20)) ; Added by Gary Riley
 (end wildcards)
 ?f1 <- (color $? YELLOW $?)
=>
 (retract ?f1))

(defrule error-color-facts-clean-up
 (declare (salience -30)) ; Added by Gary Riley
 (end wildcards)
 (color $? YELLOW $?)
=>
 (printout t "error in color facts clean up" crlf))

(defrule begin-variable-matching-test
 (declare (salience -40)) ; Added by Gary Riley
 (end wildcards)
 =>
 (assert (begin variable-matching)))

;;; 3.3 Variables- Single and Multi-field

;;; Single field and multi-field variables are used in various combinations in
;;; single and multiple patterns.  Assumption:  If a single or multiple field
;;; variable in a field performs correctly, then it will perform correctly in
;;; all fields.


;;; ================= SINGLE AND MULTIPLE FIELD VARIABLES ====================
;;; ========================== SINGLE PATTERN ================================

(defrule single-variable-single-pattern "matching"
 (declare (salience 1)) ; Added by Gary Riley
 (begin variable-matching)
 (data red ?x)
=>
 (assert (rule-1 ?x))
 (printout t "single-variable-single-pattern should fire three")
        (printout t " times" crlf))

(defrule multi-field-variable-single-pattern "matching"     ;DR0087
 (declare (salience 2)) ; Added by Gary Riley
 (begin variable-matching)                                  ;DR0087
 (data red $?x)                                             ;DR0087
=>                                                          ;DR0087
 (assert (rule-2 ?x))                                      ;DR0087
 (printout t "multi-field-variable-single-pattern should fire five");DR0087
 (printout t " times" crlf))                               ;DR0087

(defrule multi-single-variable-single-pattern
 (declare (salience 3)) ; Added by Gary Riley
 (begin variable-matching)
 (data ?x ?y)
=>
 (assert (rule-3 ?x ?y))
 (printout t "multi-single-variable-single-pattern should fire four")
 (printout t " times" crlf))


(defrule multi-multi-field-variable-single-pattern          ;DR0087
 (declare (salience 4)) ; Added by Gary Riley
 (begin variable-matching)                                  ;DR0087
 (data red $?x $?y)                                         ;DR0087
=>                                                          ;DR0087
 (assert (rule-4 x ?x y ?y))                              ;DR0087
 (printout t "multi-multi-field-variable-single-pattern should fire");DR0087
 (printout t " ten times" crlf))                           ;DR0087

(defrule single-and-multi-field-variable-single-pattern     ;DR0087
 (declare (salience 5)) ; Added by Gary Riley
 (begin variable-matching)                                  ;DR0087
 (data red $?x ?y)                                          ;DR0087
=>                                                          ;DR0087
 (assert (rule-5 x ?x y ?y))                               ;DR0087
 (printout t "single-and-multi-field-variable-single-pattern should");DR0087
 (printout t " fire four times" crlf))                     ;DR0087

(defrule single-pattern-variable-clean-up "Change by Gary Riley"
 (declare (salience -10))
 ?f1 <- (begin variable-matching)
 (rule-1 green)
 (rule-1 "green")
 (rule-1 3500.0)
 (rule-2)
 (rule-2 green)
 (rule-2 "green")
 (rule-2 green green)
 (rule-2 3500.0)
 (rule-3 red green)
 (rule-3 red 3500.0)
 (rule-3 green red)
 (rule-3 red "green")
 (rule-4 x 3500.0 y)
 (rule-4 x y 3500.0)
 (rule-4 x green green y)
 (rule-4 x y)
 (rule-4 x y green)
 (rule-4 x green y)
 (rule-4 x y "green")
 (rule-4 x "green" y)
 (rule-4 x y green green)
 (rule-4 x green y green)
 (rule-5 x y green)
 (rule-5 x y 3500.0)
 (rule-5 x green y green)
 (rule-5 x y "green")
=>
 (retract ?f1)
 (assert (end variable-matching)))

(defrule error-variable-matching
 (declare (salience -30)) ; Added by Gary Riley
 (begin variable-matching)
=>
 (printout t "error in variable matching" crlf))

(defrule clean-up-data-facts
 (declare (salience -20)) ; Added by Gary Riley
 (end variable-matching)
 ?f1 <- (data ? $?)
=>
 (retract ?f1))

(defrule clean-up-rule-1-facts
 (declare (salience -20)) ; Added by Gary Riley
 (end variable-matching)
 ?f1 <- (rule-1 $?)
=>
 (retract ?f1))

(defrule clean-up-rule-2-facts
 (declare (salience -20)) ; Added by Gary Riley
 (end variable-matching)