如何去掉CLIPS中的if-then-else来更好的优化代码

Question

我是 CLIPS 的新手，回溯范式确实让我头疼。

有人问我需要生成以下输出。

Q: Is the patient's temperature more than 39? [yes/no]: yes
    The patient has fever
Q: Does the patient sick over a month? [yes/no]: yes
    We suspect the patient has bacterial infection
Q: How about sore throat? [yes/no]: yes
    We believe the patient has strep throat

所以根据需要我定义了一些规则来让它工作。

(defrule rule_1
  (THE-PATIENT-HAS-A-SORE-THROAT)
  (WE-SUSPECT-A-BACTERIAL-INFECTION) =>
  (assert(WE-BELIEVE-THE-PATIENT-HAS-STREP-THROAT))
  (printout t "We believe the patient has strep throat" crlf))

(defrule rule_2
  (THE-PATIENT-TEMPERATURE-IS-40C) =>
  (assert(THE-PATIENT-HAS-A-FEVER)))

(defrule rule_3
  (THE-PATIENT-HAS-BEEN-SICK-OVER-A-MONTH)
  (THE-PATIENT-HAS-A-FEVER) => 
  (assert(WE-SUSPECT-A-BACTERIAL-INFECTION)))

(defrule ask-sick
  (start-question) =>
  (printout t "Q: Is the patient's temperature more than 39? [yes/no]: ")
  (bind ?input (readline))
  (if (neq ?input "no")
    then
      (assert (THE-PATIENT-TEMPERATURE-IS-40C))
      (printout t "The patient has fever" crlf)
      (printout t "Q: Does the patient sick over a month? [yes/no]: ")
      (bind ?input2 (readline))
      (if (neq ?input2 "no")
        then
          (assert (THE-PATIENT-HAS-BEEN-SICK-OVER-A-MONTH))
          (printout t "We suspect the patient has bacterial infection" crlf)
          (printout t "Q: How about sore throat? [yes/no]: ")
          (bind ?input3 (readline))
          (if (neq ?input3 "no")
            then
              (assert (THE-PATIENT-HAS-A-SORE-THROAT))
          )
      )
  )
)

(deffacts start
  (start-question)
)

最终我确实让程序上线了。

问题是，在规则 ask-sick 中，我不得不合并一堆 if-then-else 以使程序在不太符合的地方运行使用回溯范式。

谁能告诉我应该如何优化它，因为它知道从哪里开始，rule1 -> rule2 / rule3 等等

Answer 1

这是一种方法：

(deffunction ask-question (?question $?allowed-values)
   (printout t "Q: " ?question " [" (implode$ ?allowed-values) "] " )
   (bind ?answer (read))
   (if (lexemep ?answer) 
       then (bind ?answer (lowcase ?answer)))
   (while (not (member ?answer ?allowed-values)) do
      (printout t "Q: " ?question " [" (implode$ ?allowed-values) "] ")
      (bind ?answer (read))
      (if (lexemep ?answer) 
          then (bind ?answer (lowcase ?answer))))
   ?answer)

(deffunction yes-or-no (?question)
   (ask-question ?question yes no))

(defrule ask-temperature
  =>
  (bind ?input (yes-or-no "Is the patient's temperature more than 39?"))
  (assert (THE-PATIENT-TEMPERATURE-IS-40C ?input)))

(defrule ask-sick-for-over-a-month
   (THE-PATIENT-HAS-A-FEVER yes)
   =>  
   (bind ?input (yes-or-no "Does the patient sick over a month?"))
   (assert (THE-PATIENT-HAS-BEEN-SICK-OVER-A-MONTH ?input)))

(defrule ask-sore-throat
   (WE-SUSPECT-A-BACTERIAL-INFECTION yes)
   =>
   (bind ?input (yes-or-no "How about sore throat?"))
   (assert (THE-PATIENT-HAS-A-SORE-THROAT ?input)))

(defrule conclude-fever
  (THE-PATIENT-TEMPERATURE-IS-40C yes) 
  =>
  (assert (THE-PATIENT-HAS-A-FEVER yes))
  (printout t "The patient has fever" crlf))

(defrule conclude-bacterial-infection
  (THE-PATIENT-HAS-BEEN-SICK-OVER-A-MONTH yes)
  (THE-PATIENT-HAS-A-FEVER yes) 
  => 
  (assert (WE-SUSPECT-A-BACTERIAL-INFECTION yes))
  (printout t "We suspect the patient has bacterial infection" crlf))

(defrule conclude-strep-throat
  (THE-PATIENT-HAS-A-SORE-THROAT yes)
  (WE-SUSPECT-A-BACTERIAL-INFECTION yes) 
  =>
  (assert (WE-BELIEVE-THE-PATIENT-HAS-STREP-THROAT yes))
  (printout t "We believe the patient has strep throat" crlf))

还有一个：

(deffunction ask-question (?question $?allowed-values)
   (printout t "Q: " ?question " [" (implode$ ?allowed-values) "] " )
   (bind ?answer (read))
   (if (lexemep ?answer) 
       then (bind ?answer (lowcase ?answer)))
   (while (not (member ?answer ?allowed-values)) do
      (printout t "Q: " ?question " [" (implode$ ?allowed-values) "] ")
      (bind ?answer (read))
      (if (lexemep ?answer) 
          then (bind ?answer (lowcase ?answer))))
   ?answer)

(deffunction yes-or-no (?question)
   (ask-question ?question yes no))

(deftemplate attribute
   (slot name)
   (slot value))

(deftemplate question
   (slot text)
   (slot attribute)
   (multislot precursors))

(deftemplate conclusion
   (slot text)
   (slot attribute)
   (multislot precursors))

(deffacts questions
   (question
      (text "Is the patient's temperature more than 39?")
      (attribute THE-PATIENT-TEMPERATURE-IS-40C))
   (question
      (text "Does the patient sick over a month?")
      (attribute THE-PATIENT-HAS-BEEN-SICK-OVER-A-MONTH)
      (precursors THE-PATIENT-HAS-A-FEVER))
   (question
      (text "How about sore throat?")
      (attribute THE-PATIENT-HAS-A-SORE-THROAT)
      (precursors WE-SUSPECT-A-BACTERIAL-INFECTION)))

(deffacts conclusions
   (conclusion
      (text "The patient has fever")
      (attribute THE-PATIENT-HAS-A-FEVER)
      (precursors THE-PATIENT-TEMPERATURE-IS-40C))
   (conclusion
      (text "We suspect the patient has bacterial infection")
      (attribute WE-SUSPECT-A-BACTERIAL-INFECTION)
      (precursors THE-PATIENT-HAS-BEEN-SICK-OVER-A-MONTH THE-PATIENT-HAS-A-FEVER))
   (conclusion
      (text "We believe the patient has strep throat")
      (attribute WE-BELIEVE-THE-PATIENT-HAS-STREP-THROAT)
      (precursors THE-PATIENT-HAS-A-SORE-THROAT WE-SUSPECT-A-BACTERIAL-INFECTION)))

(defrule ask-question   
    (question (text ?text)
              (attribute ?attr))
    (forall (question (attribute ?attr)
                      (precursors $? ?pre $?))
            (attribute (name ?pre)
                       (value yes)))
    =>
    (bind ?input (yes-or-no ?text))
    (assert (attribute (name ?attr) (value ?input))))

(defrule conclude
    (conclusion (text ?text)
                (attribute ?attr))
    (forall (conclusion (attribute ?attr)
                        (precursors $? ?pre $?))
            (attribute (name ?pre)
                       (value yes)))
    =>
    (assert (attribute (name ?attr) (value yes)))
    (printout t ?text crlf))

如何去掉CLIPS中的if-then-else来更好的优化代码

How to eliminate if-then-else in CLIPS to better optimise code

backtracking

clips