Question

嗨，首先，英语不是我的主要语言，对于拼写错误或者可能以错误的方式提出问题而感到抱歉。

我正在使用Clips 6.3 64位版本。

我在学校学习这个，但我的老师并没有给我们很多关于编程部分的信息，只有学习背后的理论，所以我的问题是我正在运行这个优秀的程序 { {3}} 在我的剪辑上看它是如何工作的，一切正常，除非2个项目具有相同的属性，它不会继续过滤它只是空白命令行，我必须重新开始，更具体的时候我运行该程序并回答2个第一个问题1.蓝色2.奶油它做了我正在谈论的错误，我的第一个想法是它崩溃，因为有超过1个注册表，从这2个属性开始。

很抱歉第一次询问长篇文章，感谢任何帮助，并且对我的询问方式的任何评论都很受欢迎。

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

Answer 1

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

(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))
)

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

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

保持原始奶酪的deftemplate和奶酪列表deffacts。

(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个项目时，命令行将重新启动

1 个答案: