Question

（首先，对不起我的英文:)）我试图为我的项目创建一个修改系统（一个简单的天然植物分类），我不想粘贴我的所有代码，但只包含重要的部分，所以我会尝试解释系统的作用。我做了一个函数（我称之为revise-attribute），当系统找到应该与用户给出的答案相对应的植物时，询问用户是否要修改某些属性，如果他回答＆＃34;是＆＃ 34;他可以选择想要改变的属性，然后系统找到属性的事实 - 并且撤回它们，因此它从一开始就应该重新评估规则。例如，我有两个规则：

(defrule month
        (not(attribute (name month)))
        =>
        (bind ?allow (create$ january february march april mamy june july august september october november december))
        (bind ?answer (ask-question "what month is it?" ?allow))
        (assert (attribute (name month) (value ?answer)))
)

(defrule flowering
    (not (attribute (name flowering)))
    (attribute (name month) (value ?month))
=>
    (assert (attribute (name flowering) (value ?month)))
)

如果最后用户想要更改月份属性，那么最后一个属性将被撤消，并且应该重新评估和解雇规则月份，因为没有月份属性，所以这样他可以改变月份的值，但是也应该改变开花属性，但是没有这样做，有一个名称开花的属性已被断言。考虑到这一点，我创建了一个＆＃34;焦点＆＃34;在修改功能之后：

(defmodule REVISITING (import MAIN ?ALL) )

(defrule REVISITING::retract-month
    (not (attribute(name month)))
    ?f <- (attribute(name flowering))
=>
    (retract ?f)
)

因此，如果收回月份，开花也会收回。但是，我想知道是否有可能用更好的方法做同样的事情，因为我对以下规则有疑问

(defrule petal-apex-toothed 
    (not (attribute (name petal-apex-toothed )))
    (attribute (name petal-color) (valore blue | unknown))
    (attribute (name habitat) (valore sea | montain | edge_of_the_road |camp | unknow))
    (attributo (name flowering) (valore may | june | july | august))
=>
    (bind ?allow (create$ yes no unknow))
    (bind ?answer (ask-question "The petal's apex is toothed?" ?allow))
    (assert (attribute (name petal-apex-toothed) (value ?answer)))
)

例如，如果用户想要更改栖息地属性，我可以在重访模块中创建以下规则

(defrule retract-habitat
    (not(attribute(name habitat)))
    ?f <- (attribute (name petal-apex-toothed)))
=>
    (retract ?f)
)

但是如果用户输入的第一个值是山，然后他用edge_of_road更改了它，那么花瓣顶点齿状属性也将被撤回并重新触发，但我觉得请求关于花瓣的问题可能是多余的-apex齿。那我怎么能改进我的代码？

P.S。我希望我很清楚，否则我可以尝试更好地解释mysef :)

Answer 1

在规则的条件中使用逻辑条件元素，从逻辑上依赖于一组模式的存在的规则的动作做出断言：

CLIPS> (clear)
CLIPS> 
(deftemplate attribute
  (slot name)
  (slot value))
CLIPS> 
(deffunction ask-question (?question ?allowed-values)
   (printout t ?question)
   (bind ?answer (read))
   (if (lexemep ?answer) then (bind ?answer (lowcase ?answer)))
   (while (not (member$ ?answer ?allowed-values)) do
      (printout t ?question)
      (bind ?answer (read))
      (if (lexemep ?answer) then (bind ?answer (lowcase ?answer))))
   ?answer)
CLIPS>   
(defrule month
   (not (attribute (name month)))
   =>
   (bind ?allow (create$ january february march april may june july 
                         august september october november december))
   (bind ?answer (ask-question "what month is it? " ?allow))
   (assert (attribute (name month) (value ?answer))))
CLIPS> 
(defrule flowering
   (logical (attribute (name month) (value ?month)))
   (not (attribute (name flowering)))
   =>
   (assert (attribute (name flowering) (value ?month))))
CLIPS> (run)
what month is it? september
CLIPS> (facts)
f-0     (initial-fact)
f-1     (attribute (name month) (value september))
f-2     (attribute (name flowering) (value september))
For a total of 3 facts.
CLIPS> (watch facts)
CLIPS> (retract 1)
<== f-1     (attribute (name month) (value september))
<== f-2     (attribute (name flowering) (value september))
CLIPS>

为防止再次询问后续问题，请在最初要求记住用户提供的最后一个值时断言事实：

CLIPS> (unwatch all)
CLIPS> (clear)
CLIPS> 
(deftemplate attribute
  (slot name)
  (slot value))
CLIPS>   
(deftemplate prior-response
  (slot attribute)
  (slot value))
CLIPS>   
(deffunction ask-question (?attribute ?question ?allowed-values)
   ;; Use do-for-fact to look for a prior response and if
   ;; found return the value last supplied by the user
   (do-for-fact ((?pr prior-response)) 
                (eq ?pr:attribute ?attribute)
     (return ?pr:value))
   ;; Ask the user the question and repeat
   ;; until a valid response is given
   (printout t ?question)
   (bind ?answer (read))
   (if (lexemep ?answer) then (bind ?answer (lowcase ?answer)))
   (while (not (member$ ?answer ?allowed-values)) do
      (printout t ?question)
      (bind ?answer (read))
      (if (lexemep ?answer) then (bind ?answer (lowcase ?answer))))
   ;; Remember the response
   (assert (prior-response (attribute ?attribute) (value ?answer)))
   ;; Return the answer
   ?answer)
CLIPS>   
(defrule month
   (not (attribute (name month)))
   =>
   (bind ?allow (create$ january february march april may june july 
                         august september october november december))
   (bind ?answer (ask-question month "what month is it? " ?allow))
   (assert (attribute (name month) (value ?answer))))
CLIPS> (run)
what month is it? may
CLIPS> (facts)
f-0     (initial-fact)
f-1     (prior-response (attribute month) (value may))
f-2     (attribute (name month) (value may))
For a total of 3 facts.
CLIPS> (retract 2)
CLIPS> (facts)
f-0     (initial-fact)
f-1     (prior-response (attribute month) (value may))
For a total of 2 facts.
CLIPS> (agenda)
0      month: *
For a total of 1 activation.
CLIPS> (run)
CLIPS> (facts)
f-0     (initial-fact)
f-1     (prior-response (attribute month) (value may))
f-3     (attribute (name month) (value may))
For a total of 3 facts.
CLIPS>

当用户想要更改属性的值时，您需要撤回属性和相关的先前响应事实：

CLIPS> (retract 1 3)
CLIPS> (facts)
f-0     (initial-fact)
For a total of 1 fact.
CLIPS> (run)
what month is it? june
CLIPS> (facts)
f-0     (initial-fact)
f-4     (prior-response (attribute month) (value june))
f-5     (attribute (name month) (value june))
For a total of 3 facts.
CLIPS>

剪辑修改系统

1 个答案: