剪辑规则-有条件地触发规则

Question

我正在尝试使用基于农业的系统的规则。

举个例子，

基于位置-->列出作物-->基于所选作物-->选择种子

这是一个正向链接问题。

我只能静态地定义规则。也就是说，为每种可能的场景定义规则

有没有一种编码的方法，比如说，如果我选择一个位置，我会得到所有作物的列表，当用户选择作物时，我会得到种子列表

如何确保这些规则是基于前一个规则的输出触发的？

Answer 1

您可以采取的一种方法是将问题表示为事实，然后编写处理这些事实的一般规则。首先定义一些定义模板来表示问题，根据用户的回答从一个问题到另一个问题的分支。

(deftemplate question
   (slot name)
   (slot text)
   (slot display-answers (allowed-values yes no))
   (slot last-question (default none)))

(deftemplate branch
   (slot question)
   (slot answer)
   (slot next-question)
   (multislot next-answers))

(deftemplate response
   (slot question)
   (slot answer))

接下来，定义您的问题以及它们之间的分支：

(deffacts questions
   (question (name location)
             (text "Country")
             (display-answers no)
             (last-question none))
   (question (name crop-type)
             (text "Crop Type")
             (display-answers yes)
             (last-question location))
   (question (name seed)
             (text "Seed")
             (display-answers yes)
             (last-question crop-type)))

(deffacts locations
   (branch (question location)
           (answer "United States")
           (next-question crop-type)
           (next-answers food fiber))
   (branch (question location)
           (answer "India")
           (next-question crop-type)
           (next-answers food fiber))
   (branch (question location)
           (answer "China")
           (next-question crop-type)
           (next-answers food fiber))
   (branch (question location)
           (answer "Brazil")
           (next-question crop-type)
           (next-answers food fiber))
   (branch (question location)
           (answer "Pakistan")
           (next-question crop-type)
           (next-answers fiber)))

(deffacts crop-types
   (branch (question crop-type)
           (answer fiber)
           (next-question seed)
           (next-answers cotton hemp flax))
   (branch (question crop-type)
           (answer food)
           (next-question seed)
           (next-answers corn wheat rice)))

定义一些用于处理用户响应的实用程序定义。这将允许程序忽略用户响应中字母大小写的差异。

(deffunction lenient-eq (?v1 ?v2)
   (if (eq ?v1 ?v2)
      then
      (return TRUE))
   (if (eq (lowcase (str-cat ?v1)) (lowcase (str-cat ?v2)))
      then
      (return TRUE))
   (return FALSE))   
      
(deffunction lenient-member$ (?value $?allowed-values)
   (loop-for-count (?i (length$ ?allowed-values))
      (bind ?v (nth$ ?i ?allowed-values))
      (if (lenient-eq ?value ?v)
         then
         (return ?i)))
   (return FALSE)) 
 
(deffunction ask-question (?question $?allowed-values)
   (printout t ?question)
   (bind ?answer (lowcase (readline)))
   (while (not (lenient-member$ ?answer ?allowed-values)) do
      (printout t ?question)
      (bind ?answer (lowcase (readline))))
   ?answer)

添加一些规则，用于处理提问时未显示有效答案列表的情况(因为可能存在大量有效答案)。

;;; Ask question without valid answers displayed or checked

(defrule ask-question-without-answers

   ;; There is a question that should be 
   ;; displayed without valid answers.

   (question (name ?question)
             (text ?text)
             (display-answers no)
             (last-question ?last-question))

   ;; There is no prior question or
   ;; the prior question has a response.

   (or (test (eq ?last-question none))
       (response (question ?last-question)))

   ;; There is no response to the question.
   
   (not (response (question ?question)))

   =>
   
   ;; Ask the question
   
   (printout t ?text ": ")
   
   ;; Assert a response with the question and answer. 
   
   (assert (response (question ?question)
                     (answer (lowcase (readline))))))

;;; Check for valid response to a question

(defrule bad-answer-to-question

   ;; There is a question that should be 
   ;; displayed without valid answers.

   (question (name ?question)
             (display-answers no))
             
   ;; There is a response to the question.
        
   ?r <- (response (question ?question)
                   (answer ?answer))
   
   ;; The response to the question does
   ;; not branch to another question.
                   
   (not (branch (question ?question) 
                (answer ?a&:(lenient-eq ?a ?answer))))
   =>
   
   ;; Print the list of valid answers for the question.
   
   (printout t "Valid answers are:" crlf)
   (do-for-all-facts ((?b branch))
                     (eq ?b:question ?question)
      (printout t "   " ?b:answer crlf))
      
   ;; Retract the response so that the
   ;; question will be asked again.
   
   (retract ?r))

最后，添加一个规则来处理这样的情况:问题被问到时，会显示有效答案列表，并立即由ask- where检查。

;;; Ask questions with valid answers displayed and checked

(defrule ask-question-with-answers

   ;; There is a question that should be 
   ;; displayed including valid answers.
   
   (question (name ?question)
             (text ?text)
             (display-answers yes)
             (last-question ?last-question))
   
   ;; The preceding question has been answered.
   
   (response (question ?last-question)
             (answer ?last-answer))
             
   ;; There is a branch from the preceding question
   ;; and its answer to this question and the allowed
   ;; values for the answer.
              
   (branch (answer ?a&:(lenient-eq ?a ?last-answer)) 
           (next-question ?question)
           (next-answers $?next-answers))
   =>  
   
   ;; Construct the question text including the possible answers.
    
   (bind ?text (str-cat ?text " [" (implode$ ?next-answers) "]: "))

   ;; Ask the question.
   
   (bind ?answer (ask-question ?text ?next-answers))

   ;; Assert a response fact with the question and answer.
   
   (assert (response (question ?question) (answer ?answer))))

运行此程序时的输出：

         CLIPS (6.31 6/12/19)
CLIPS> (load "seeds.clp")
%%%$$$!!!***
TRUE
CLIPS> (reset)
CLIPS> (run)
Country: Sweden
Valid answers are:
   United States
   India
   China
   Brazil
   Pakistan
Country: China
Crop Type [food fiber]: food
Seed [corn wheat rice]: wheat
CLIPS> 

要允许第一个问题显示有效的回答，请重新定义问题的有效性，以包括已回答的初始问题：

(deffacts questions
   (question (name location)
             (text "Country")
             (display-answers yes)
             (last-question start-program))
   (question (name crop-type)
             (text "Crop Type")
             (display-answers yes)
             (last-question location))
   (question (name seed)
             (text "Seed")
             (display-answers yes)
             (last-question crop-type))
   (response (question start-program)
             (answer yes))
   (branch (question start-program)
           (answer yes)
           (next-question location)
           (next-answers "United States" "India" "China" "Brazil" "Pakistan")))

然后输出将如下所示：

CLIPS> (run)
Country ["United States" "India" "China" "Brazil" "Pakistan"]: Sweden
Country ["United States" "India" "China" "Brazil" "Pakistan"]: China
Crop Type [food fiber]: food
Seed [corn wheat rice]: wheat
CLIPS>