fldval50.clp

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

 ?f1 <- (rule-2 $?)
=>
 (retract ?f1))

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

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

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

(defrule error-clean-up-data-rule-1-facts
 (declare (salience -30)) ; Added by Gary Riley
 (end variable-matching)
 (or (rule-1 $?)
  (rule-2 $?)
  (rule-3 $?)
  (rule-4 $?)
  (rule-5 $?))
=>
 (printout t "error in cleaning up rule facts for single patterns" crlf))

(defrule error-clean-up-data-facts
 (declare (salience -30)) ; Added by Gary Riley
 (end variable-matching)
 (data ? $?)
=>
 (printout t "error in cleaning up data facts for single patterns" crlf))
 
(defrule begin-multiple-pattern-matching-test
 (declare (salience -40)) ; Added by Gary Riley
 (end variable-matching)
 =>
 (assert (begin multiple-pattern-matching)))
 
;;; ================ SINGLE AND MULTIPLE FIELD VARIABLES ======================
;;; ========================= MULTIPLE PATTERNS ===============================


(defrule data-facts-for-multiple-pattern-matching
 (declare (salience -10))
 (begin multiple-pattern-matching)
 ?f <- (end variable-matching)
=>
 (retract ?f)
 (assert (data red))
 (assert (data green))
 (assert (data blue))
 (assert (data 10.5))
 (assert (data red green))
 (assert (data red blue))
 (assert (data purple blue))
 (assert (data purple green))
 (assert (data red blue green))
 (assert (data purple blue green))
 (assert (data blue red blue)))

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

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


(defrule multiple-pattern-matching-clean-up 
 (declare (salience -10))
 ?f <- (begin multiple-pattern-matching)
 (rule-1 green)
 (rule-1 blue)
 (rule-2 green)
 (rule-2 blue)
 (rule-2 blue green)
=>
 (retract ?f)
 (assert (end multiple-pattern-matching)))

(defrule error-multiple-pattern-matching
 (declare (salience -30))
 (begin multiple-pattern-matching)
=>
 (printout t "error multiple pattern variable matching" crlf))

(defrule fact-clean-up-multiple-pattern
 (declare (salience -20)) ; Added by Gary Riley
 ?f2 <- (rule-1 green)
 ?f3 <- (rule-1 blue)
 ?f4 <- (rule-2 green)
 ?f5 <- (rule-2 blue)
 ?f6 <- (rule-2 blue green)
=>
 (retract ?f2 ?f3 ?f4 ?f5 ?f6))

(defrule error-fact-clean-up-multiple-pattern
 (declare (salience -30)) ; Added by Gary Riley
 (or (rule-1 $?)
     (rule-2 $?))
=>
 (printout t "error in multiple pattern matching variable values" crlf))

(defrule begin-logical-operators-test
 (declare (salience -40)) ; Added by Gary Riley
 ?f1 <- (end multiple-pattern-matching)
 =>
 (retract ?f1)
 (assert (begin logical-operators)))
 
;;; 3.4 Constraining Fields

;;; 3.4.1 Logical Operators

;;; The three logical operators &, ~ and | are used in single and multiple
;;; patterns with or without variable assignment.  Assumption: If a logical
;;; operator performs correctly in one field of a pattern, it will correctly
;;; perform in every field.


;;; ===================== CONSTRAINING FIELDS ================================
;;; ====================== LOGICAL OPERATORS =================================


(defrule not-with-no-variable-assignment
 (declare (salience 8)) ; Added by Gary Riley
 (begin logical-operators)
 (data ~red)
=>
 (printout t "not-with-no-variable-assignment should fire three")
 (printout t " times" crlf))

(defrule or-with-no-variable-assignment
 (declare (salience 7)) ; Added by Gary Riley
 (begin logical-operators)
 (data red|blue)
=>
 (printout t "or-with-no-variable-assignment should fire twice" crlf))

(defrule not-and-with-no-variable-assignment
 (declare (salience 6)) ; Added by Gary Riley
 (begin logical-operators)
 (data ~red&~blue)
=>
 (printout t "not-and-with-no-variable-assignment should fire twice")
 (printout t " " crlf))

(defrule not-or-and-with-no-variable-assignment
 (declare (salience 5)) ; Added by Gary Riley
 (begin logical-operators)
 (data ~red&~blue|green)
=>
 (printout t "not-or-and-with-no-variable-assignment should fire")
 (printout t " twice  " crlf))

(defrule not-with-variable-assignment
 (declare (salience 4)) ; Added by Gary Riley
 (begin logical-operators)
 (data ?x&~red)
=>
 (assert (rule-1 ?x))
 (printout t "not-with-variable-assignment should fire three times")
 (printout t " " crlf))

(defrule or-with-variable-assignment
 (declare (salience 3)) ; Added by Gary Riley
 (begin logical-operators)
 (data ?x&red|blue)
=>
 (assert (rule-2 ?x))
 (printout t "or-with-variable-assignment should fire twice" crlf))

(defrule not-with-variable-assignment-multiple-patterns
 (declare (salience 2)) ; Added by Gary Riley
 (begin logical-operators)
 (data red ?x)
 (data purple ?x&~green)
=>
 (assert (rule-3 ?x))
 (printout t "not-with-variable-assignment-multiple-patterns")
 (printout t " should fire once" crlf))

(defrule or-with-variable-assignment-multiple-patterns
 (declare (salience 1)) ; Added by Gary Riley
 (begin logical-operators)
 (data red ?x)
 (data purple ?x&green|blue)
=>
 (assert (rule-4 ?x))
 (printout t "or-with-variable-assignment-multiple-patterns")
 (printout t " should fire twice" crlf))

(defrule logical-operator-clean-up
 (declare (salience -10)) ; Added by Gary Riley
 ?f <- (begin logical-operators)
 ?f1 <- (rule-1 blue)
 ?f2 <- (rule-1 green)
 ?f3 <- (rule-1 10.5)
 ?f4 <- (rule-2 red)
 ?f5 <- (rule-2 blue)
 ?f6 <- (rule-3 blue)
 ?f7 <- (rule-4 green)
 ?f8 <- (rule-4 blue)
=>
 (retract ?f ?f1 ?f2 ?f3 ?f4 ?f5 ?f6 ?f7 ?f8)
 (assert (end logical-operators)))

(defrule error-logical-operator-clean-up
 (declare (salience -30))
 (begin logical-operators)
=>
 (printout t "error in logical operators" crlf))

(defrule data-facts-clean-up-two
 (declare (salience -20)) ; Added by Gary Riley
 (end logical-operators)
 ?f <- (data $?)
=>
 (retract ?f))

(defrule error-data-facts-clean-up-two
 (declare (salience -30)) ; Changed by Gary Riley
 (end logical-operators)
 (data $?)
=>
 (printout t "error in data facts clean up two"))

(defrule error-clean-up-rule-facts-logical-operators
 (declare (salience -30)) ; Added by Gary Riley
 (end logical-operators)
 (or (rule-1 $?)
  (rule-2 $?)
  (rule-3 $?)
  (rule-4 $?))
=>
 (printout t "error in logical-operators values" crlf))
 
(defrule begin-predicate-functions-test
 (declare (salience -40)) ; Added by Gary Riley
 (end logical-operators)
 =>
 (assert (begin predicate-functions)))
 
 
;;; 3.4.2 Predicate Functions

;;; Predicate functions check to see if the value of the field meets the
;;; constraints defined in the function.  If it does, the function returns
;;; true (non-zero) and pattern matching continues.  Otherwise, it returns
;;; false (0) and the pattern fails to match.  In this section, predicate
;;; functions provided by CLIPS are tested in single patterns.


;;; ======================= CONSTRAINING FIELDS =============================
;;; ======================= PREDICATE FUNCTIONS =============================
;;; =======================   SINGLE FUNCTIONS  =============================

(defrule data-facts-for-predicate-functions
 (declare (salience -10))
 (begin predicate-functions)
 ?f <- (end logical-operators)
=>
 (retract ?f)
 (assert (data 2))
 (assert (data red))
 (assert (data 11))
 (assert (data "red"))
 (assert (data -13))
 (assert (data 6.5))
 (assert (data 0)))

(defrule predicate-function-numberp
 (declare (salience 6)) ; Added by Gary Riley
 (begin predicate-functions)
 (data ?x&:(numberp ?x))
=>
 (assert (rule-1 ?x))
 (printout t "predicate-function-numberp should fire five times")
 (printout t " " crlf))

(defrule predicate-function-evenp                     ;DR0056 CR0025
 (declare (salience 5)) ; Added by Gary Riley
 (begin predicate-functions)                          ;DR0056 CR0025
 (data ?x&:(integerp ?x)&:(evenp ?x))                 ;DR0056 CR0025
=>                                                    ;DR0056 CR0025
 (assert (rule-2 ?x))                                 ;DR0056 CR0025
 (printout t "predicate-function-evenp should fire twice" crlf));DR0056 CR0025

(defrule predicate-function-oddp                     ;DR0056 CR0025
 (declare (salience 4)) ; Added by Gary Riley
 (begin predicate-functions)                         ;DR0056 CR0025
 (data ?x&:(integerp ?x)&:(oddp ?x))                 ;DR0056 CR0025
=>                                                   ;DR0056 CR0025
 (assert (rule-3 ?x))                                ;DR0056 CR0025
 (printout t "predicate-function-oddp should fire twice" crlf));DR0056 CR0025

(defrule predicate-function-stringp
 (declare (salience 3)) ; Added by Gary Riley
 (begin predicate-functions)
 (data ?x&:(stringp ?x))
=>
 (assert (rule-4 ?x))
 (printout t "predicate-function-stringp should fire once" crlf))

(defrule predicate-function-wordp                               ;DR0059
 (declare (salience 2)) ; Added by Gary Riley
 (begin predicate-functions)                                    ;DR0059
 (data ?x&:(wordp ?x))                                          ;DR0059
=>                                                              ;DR0059
 (assert (rule-5 ?x))                                           ;DR0059
 (printout t "predicate-function-wordp should fire once" crlf));DR0059

(defrule predicate-function-integerp
 (declare (salience 1)) ; Added by Gary Riley
 (begin predicate-functions)
 (data ?x&:(numberp ?x)&:(integerp ?x))
=>
 (assert (rule-6 ?x))
 (printout t "predicate-function-integerp should fire four times" crlf))

(defrule predicate-functions-clean-up
 (declare (salience -10)) ; Added by Gary Riley
 ?f <- (begin predicate-functions)
 ?f1 <- (rule-1 2)
 ?f2 <- (rule-1 11)
 ?f3 <- (rule-1 -13)
 ?f4 <- (rule-1 0)
 ?f5 <- (rule-2 2)
 ?f6 <- (rule-2 0)
 ?f7 <- (rule-3 11)
 ?f8 <- (rule-3 -13)
 ?f9 <- (rule-4 "red")
 ?f10 <- (rule-5 red)
 ?f11 <- (rule-1 6.5)
 ?f12 <- (rule-6 2)
 ?f13 <- (rule-6 11)
 ?f14 <- (rule-6 -13)
 ?f15 <- (rule-6 0)
=>
 (retract ?f ?f1 ?f2 ?f3 ?f4 ?f5 ?f6 ?f7 ?f8 ?f9 ?f10 ?f11 ?f12 ?f13 ?f14 ?f15)
 (assert (end predicate-functions)))

(defrule error-prediate-functions-clean-up
 (declare (salience -30)) ; added by Gary Riley
 (begin predicate-functions)
=>
 (printout t "error in predicate functions" crlf))

(defrule data-facts-clean-up-three
 (declare (salience -20)) ; Added by Gary Riley
 (end predicate-functions)
 ?f <- (data $?)
=>
 (retract ?f))

(defrule error-clean-up-rules-for-predicate-functions
 (declare (salience -30)) ; Added by Gary Riley
 (end predicate-functions)
 (or (rule-1 ?)
  (rule-2 ?)
  (rule-3 ?)
  (rule-4 ?)
  (rule-5 ?)
  (rule-6 ?))
=>
 (printout t "error in predicate functions values" crlf))
 
(defrule begin-constraining-functions-test
 (declare (salience -40)) ; Added by Gary Riley
 (end predicate-functions)
 =>
 (assert (begin constraining-functions)))
 
 
;;; 3.4.3 Constraining fields through pattern expansion

;;; The equals (=) operator permits an external functions to be called from
;;; the inside of a pattern.  The return value of the external function
;;; constrains the the value of a field.  In this section, external
;;; functions provided with CLIPS are tested.


;;; ===================== CONSTRAINING FUNCTIONS ============================
;;; ======================= EXTERNAL FUNCTIONS ==============================


(defrule point-facts-for-constraining-functions
 (declare (salience -10))
 (begin constraining-functions)
 ?f <- (end predicate-functions)
=>
 (retract ?f)
 (assert (point A 0 3))
 (assert (point B 4 6))
 (assert (point C -6 3))
 (assert (point D 4 -12)))

(defrule external-functions-logical-operators
 (declare (salience 6)) ; Added by Gary Riley
 (begin constraining-functions) ; Added by Gary Riley
 (point ?p1 ?x1 ?)
 (point ?p2 ?x2&=(+ ?x1 -10)|=(- ?x1 4) ?)
=>
 (assert (rule-1 ?p1 ?p2 ?x1 ?x2))
 (printout t "external-functions-logical-operators should fire four")
 (printout t " times" crlf))


(defrule constraining-functions-vertical
 (declare (salience 5)) ; Added by Gary Riley
 (begin constraining-functions) ; Added by Gary Riley
 (point ?p1 ?x1 ?)
 (point ?p2&~?p1 ?x2&:(eq ?x1 ?x2) ?)
=>
 (assert (rule-2 ?p1 ?p2 vertical))
 (printout t "constraining-functions-vertical should fire twice")
 (printout t " " crlf))