CLIPS条款相互依赖

时间:2016-07-21 18:12:53

标签: clips

我想从以下规则中删除两个测试条件元素,并提高它的可读性。

(defrule compare-things
    (logical ?thing0 <- (object (is-a TYPED_THING)
                                (type-results $? ?t0 $?)))
    (logical ?thing1 <- (object (is-a TYPED_THING)
                                (type-results $? ?t1 $?)))

    (thing-comparable ?type)

    ?type0 <- (object (is-a TYPING)
                      (qualified-type ?type ?model ?mode ?comp0))
    ?type1 <- (object (is-a TYPING)
                      (qualified-type ?type ?model ?mode ?comp1))

    ; This test exists to restrict the number of rule firings    
    (test (> (str-compare (instance-name ?thing0) (instance-name ?thing1)) 0))

    ; Ideally, the following two tests can be removed
    (test (= (str-compare (instance-name ?type0) (instance-name ?t0)) 0))
    (test (= (str-compare (instance-name ?type1) (instance-name ?t1)) 0))
=>
    (make-instance of COMPARISON
        (compares ?thing0 ?thing1)
        (score nil)
    )
    (printout t "comparing: " (instance-name ?thing0) (instance-name ?thing1) crlf)
)

多时隙字段值?t0?t1应与?type0?type1相同。如果我将?t0?t1替换为?type0?type1(这是直观的首次尝试),那么我在加载规则时会收到以下错误:

Defining defrule: compare-things 
[ANALYSIS2] Pattern-address ?type0 used in CE #4 was previously bound within a pattern CE.

[ANALYSIS2] Pattern-address ?type1 used in CE #5 was previously bound within a pattern CE.

ERROR:
(defrule MAIN::compare-things
   (logical
        ?thing0 <- (object (is-a TYPED_THING)
                (type-results $? ?type0 $?)))
   (logical
        ?thing1 <- (object (is-a TYPED_THING)
                (type-results $? ?type1 $?)))
   (thing-comparable ?type)
   ?type0 <- (object (is-a TYPING)
           (qualified-type ?type ?model ?mode ?comp0))
   ?type1 <- (object (is-a TYPING)
           (qualified-type ?type ?model ?mode ?comp1))
   (test (> (str-compare (instance-name ?thing0) (instance-name ?thing1)) 0))
   =>
   (make-instance of COMPARISON
      (compares ?thing0 ?thing1)
      (score nil))
   (printout t "comparing: " (instance-name ?thing0) (instance-name ?thing1) crlf))
FALSE

以下数据用于刺激发展规则:

(defclass TYPING (is-a USER)
    (role concrete)
    (multislot qualified-type (access initialize-only)
                              (type STRING)
                              (cardinality 4 4))
    (slot score (access initialize-only)
                (type FLOAT))
)

(defclass TYPED_THING (is-a USER)
    (slot id (access initialize-only)
             (type INTEGER))
    (multislot type-results (access initialize-only)
                            (type INSTANCE)) ; of TYPING
)

(defclass COMPARISON (is-a USER)
    (multislot compares (access initialize-only)
                        (type INSTANCE) ; of TYPED_THING
                        (cardinality 2 2))
    (slot score (access read-write)
                (type FLOAT))
)

; These facts tag top-level types that are comparable
(deffacts KNOWN_COMPARABLE_TYPES
    (thing-comparable "cat-a")
    (thing-comparable "cat-c")
)

(definstances KNOWN_THINGS
    (thing0 of TYPED_THING
        (id 0)
        (type-results (make-instance of TYPING (qualified-type "cat-a" "x0" "y0" "z0")(score 0.9))
                      (make-instance of TYPING (qualified-type "cat-b" "x0" "y0" "z0")(score 0.9))))
    (thing1 of TYPED_THING
        (id 1)
        (type-results (make-instance of TYPING (qualified-type "cat-a" "x0" "y0" "z1")(score 0.9))
                      (make-instance of TYPING (qualified-type "cat-a" "x1" "y1" "z0")(score 0.9))))
    (thing2 of TYPED_THING
        (id 2)
        (type-results (make-instance of TYPING (qualified-type "cat-b" "x0" "y0" "z1")(score 0.9))))
)

哪个应产生以下输出(如目前所示):

CLIPS> (reset)
CLIPS> (run)
comparing: [thing1][thing0]

1 个答案:

答案 0 :(得分:1)

在错误消息指示的限制范围内工作,您可以通过此修改获得编译规则:

(defrule compare-things
    (logical ?thing0 <- (object (is-a TYPED_THING)
                                (type-results $? ?t0 $?)))
    (logical ?thing1 <- (object (is-a TYPED_THING)
                                (type-results $? ?t1 $?)))

    (thing-comparable ?type)

    (object (is-a TYPING)
            (name =(instance-name ?t0))
            (qualified-type ?type ?model ?mode ?comp0))
    (object (is-a TYPING)
            (name =(instance-name ?t1))
            (qualified-type ?type ?model ?mode ?comp1))

    ; This test exists to restrict the number of rule firings    
    (test (> (str-compare (instance-name ?thing0) (instance-name ?thing1)) 0))

=>
    (make-instance of COMPARISON
        (compares ?thing0 ?thing1)
        (score nil)
    )
    (printout t "comparing: " (instance-name ?thing0) (instance-name ?thing1) crlf)
)