当找到具有相同属性的 2 个项目时命令行重新启动

Question

您好，首先，英语不是我的主要语言，对于拼写错误或者做题方式错误，我们深表歉意。

我使用的是 Clips 6.3 64 位版本。

我正在为学校学习这个，但我的老师没有给我们很多关于编程部分的信息，在那里只学习它背后的理论，所以我的问题是我运行ning这个很好的程序 https://github.com/JherezTaylor/cheese-classification/blob/master/wichCheese.clp 在我的剪辑上查看它是如何工作的，一切正常，除非 2 个项目具有相同的属性，它不会继续过滤它只是让命令行空白我必须重新开始，更具体地说，当我运行程序并用 1. Blue 2. Creamy 回答第一个问题时，它会出现我正在谈论的错误，我的第一个想法是它崩溃了，因为那里超过 1 个以这 2 个属性开头的注册表。

抱歉第一次问这么长的文字，感谢任何帮助，欢迎对我的提问方式发表任何评论。

感谢任何愿意提供帮助的人。

Answer 1

问题是 check-facts-at-texture 规则删除了激活 mainQuestion-Colour 规则所需的事实：

(defrule check-facts-at-texture
  ?f <- (cheeseTexture ?)
=>
  (cheeseFound)
  (cheeseNotFound)
  (retract ?f)
)

(defrule mainQuestion-Colour
  (cheeseTexture ?tx)
  =>
  (bind ?colour (ask-question "### What is the general colour of the cheese? (white yellow pale-yellow green) ### " "" "" white yellow pale-yellow green))
  (assert (cheeseColour ?colour))
)

程序暂停，因为没有更多适用的规则。如果您对这些规则进行适当的更改，您可以使它们正确触发：

(defrule check-facts-at-texture
  ?f <- (cheeseTexture ?)
=>
  (assert (ask-color))
  (cheeseFound)
  (cheeseNotFound)
  (retract ?f)
)

(defrule mainQuestion-Colour
  (declare (salience -10))
  (ask-color)
  ;; only ask if there are at least two cheeses left
  (exists (cheese (name ?name))
          (cheese (name ~?name)))
  =>
  (bind ?colour (ask-question "### What is the general colour of the cheese? (white yellow pale-yellow green) ### " "" "" white yellow pale-yellow green))
  (assert (cheeseColour ?colour))
)

您将运行遇到与程序中后续规则相同的问题，这些规则也需要更改。

您可以通过编写通用规则来提出问题并删除不匹配的奶酪来简化原始程序。跟踪奶酪数量的全局变量和函数也是不必要的。

保留原始的 cheese detemplate 和 cheese-list defacts。

(deftemplate cheese
  (multislot name)
  (multislot milk-source)
  (multislot country)
  (multislot type)
  (multislot texture)
  (multislot colour)
  (multislot flavour)
  (multislot aroma)
  (multislot common-useage))

(deffacts cheese-list 
  (cheese (name "gouda")
        (milk-source cow)
        (country "netherlands")
        (type semi-hard)
        (texture firm)
        (colour yellow)
        (flavour rich)
        (aroma pungent)
        (common-useage table-cheese))
  .
  .
  .        
)

删除其他代码。使用以下代码提问：

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

(deftemplate question
   (slot text)
   (slot priority (default 0))
   (slot attribute)
   (multislot values))

(deftemplate response
   (slot attribute)
   (slot value))

(deffacts questions
   (question (text "What type of cheese is it?")
             (priority 1)
             (attribute type)
             (values semi-soft soft semi-hard hard blue))
   (question (text "How would you describe the texture of the cheese?")
             (priority 2)
             (attribute texture)
             (values crumbly springy firm creamy smooth))
   (question (text "What is the general colour of the cheese?")
             (priority 3)
             (attribute colour)
             (values white yellow pale-yellow green))
   (question (text "How would you describe the flavour of the cheese?")
             (priority 4)
             (attribute flavour)
             (values strong mild rich sweet spicy creamy))
   (question (text "How would you describe the aroma of the cheese?")
             (priority 5)
             (attribute aroma)
             (values strong mild pleasant pungent none))
   (question (text "What is the most common use of the cheese?")
             (priority 6)
             (attribute common-useage)
             (values table-cheese bread cooking pasta salad melting dip dessert dressing pizza cheesecake)))

(defrule ask-question
   (declare (salience -10))
   ?f <- (question (text ?text)
                   (priority ?p)
                   (attribute ?attribute)
                   (values $?values))
   ;; Verify that this is the highest priority question
   (not (question (priority ?p2&:(< ?p2 ?p))))
   ;; Keep asking questions as long there
   ;; are at least two cheeses
   (exists (cheese (name ?name))
           (cheese (name ~?name)))
   =>
   (retract ?f)
   (bind ?response (ask-question ?text ?values))
   (assert (response (attribute ?attribute) (value ?response))))

使用以下规则根据响应过滤奶酪：

(defrule filter-response
   (declare (salience 10))
   (response (attribute ?attribute) (value ?value))
   ?f <- (cheese)
   (test (not (member$ ?value (fact-slot-value ?f ?attribute))))
   =>
   (retract ?f))

使用以下代码检测匹配的奶酪：

(deffunction fsv (?fact ?slot)
   (nth$ 1 (fact-slot-value ?fact ?slot)))

(defrule match-not-found
  (not (cheese))
  =>
  (printout t crlf "No matching cheese found." crlf))

(defrule match-found
  ?f <- (cheese (name ?name))
  (not (cheese (name ~?name)))
  =>
  (printout t crlf "Cheese found:" crlf)
  (printout t "  Name: " ?name crlf)
  (printout t "  Milk Source: " (fsv ?f milk-source) crlf)
  (printout t "  Type: " (fsv ?f type) crlf)
  (printout t "  Country: " (fsv ?f country) crlf)
  (printout t "  Texture: " (fsv ?f texture) crlf)
  (printout t "  Colour: " (fsv ?f colour) crlf)
  (printout t "  Flavour: " (fsv ?f flavour) crlf)
  (printout t "  Aroma: " (fsv ?f aroma) crlf)
  (printout t "  Common Useage: " (fsv ?f common-useage) crlf))

(defrule multiple-matches-found
  (exists (cheese (name ?name))
          (cheese (name ~?name)))
  (not (question))
  =>
  (printout t crlf "Multiple matching cheeses: ")
  (do-for-all-facts ((?c cheese)) TRUE
     (printout t (fsv ?c name) " "))
  (printout t crlf))

生成的程序现在有 5 个规则，而不是原始程序中的 19 个。

当找到具有相同属性的 2 个项目时命令行重新启动

Command line restarts when 2 items with same attributes found

64-bit

expert-system

clips