剪辑修改系统

Question

（首先，对不起我的英语:)）我正在尝试为我的项目（自然植物的简单分类）创建一个修订系统，我不想粘贴我的所有代码，而只粘贴重要的部分，所以我将尝试解释该系统的作用。我做了一个函数（我称之为修改属性），当系统找到应该与用户给出的答案相对应的植物时，询问用户是否要修改某些属性，如果他回答 "yes" 他可以选择要更改的属性，然后系统找到属性的事实地址并收回它们，因此它从头开始，应该重新评估规则。例如我有这两条规则：

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

如果最后，用户想要更改月份属性，则最后一个将被收回，规则月份应该重新评估并被解雇，因为没有月份属性，所以他通过这种方式可以更改月份的值，但是 flowering 属性也应该更改，但这并没有完成，有一个名称为 flowering 的属性已被断言。考虑到这一点，我在修改函数之后创建了一个 "focus" 的模块：

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

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

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

但是如果用户输入的第一个值是山，然后他用 edge_of_road 更改了它，花瓣顶点齿属性也会被收回并重新触发，但我认为它可能是多余的请求有关花瓣尖齿的问题。那么我该如何改进我的代码呢？？

P.S。我希望我说清楚了，否则我可以尝试更好地解释我自己 :)

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>

剪辑修改系统

Clips revise system

clips

expert-system

inference-engine