剪辑规则 - 有条件地触发规则
Clips rules - conditional firings of rules
我正在尝试使用基于农业的系统规则
例如，
基于位置 --> 列出作物 --> 基于作物 selected --> select 种子
这是一个前向链接问题
我只能静态定义规则。意思是，为每个可能的场景定义规则
有没有一种编码方式，比如说如果我 select 一个位置，我会得到所有作物的列表，当用户 select 是作物时，我会得到种子列表
我如何确保规则是根据先前规则的输出触发的？
您可以采用的一种方法是将问题表示为事实，然后编写处理这些事实的一般规则。首先定义一些 detemplates 来表示问题，根据用户的响应从一个问题分支到另一个问题，以及用户的响应。
(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 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>
要允许第一个问题显示有效回答，请重新定义问题 defacts 以包括已回答的初始问题：
(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>
我正在尝试使用基于农业的系统规则
例如，
基于位置 --> 列出作物 --> 基于作物 selected --> select 种子
这是一个前向链接问题
我只能静态定义规则。意思是，为每个可能的场景定义规则
有没有一种编码方式，比如说如果我 select 一个位置，我会得到所有作物的列表，当用户 select 是作物时，我会得到种子列表
我如何确保规则是根据先前规则的输出触发的？
您可以采用的一种方法是将问题表示为事实，然后编写处理这些事实的一般规则。首先定义一些 detemplates 来表示问题，根据用户的响应从一个问题分支到另一个问题，以及用户的响应。
(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 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>
要允许第一个问题显示有效回答，请重新定义问题 defacts 以包括已回答的初始问题：
(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>