0

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

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

如果,最后,用户想要更改月份属性,最后一个将被收回,并且规则月份应该重新评估并被解雇,因为没有月份属性,所以他可以通过这种方式更改的值月,然而开花属性也应该被改变,但这并没有这样做,有一个名为开花的属性已被断言。考虑到这一点,我在 revise-function 之后创建了一个“焦点”模块:

(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 更改了它,那么花瓣尖齿属性也将被收回并重新触发,但我认为请求关于花瓣尖的问题可能是多余的-带齿的。那么我该如何改进我的代码呢?

PS我希望我很清楚,否则我可以尝试更好地解释mysef :)

4

1 回答 1

0

使用规则条件中的逻辑条件元素,根据一组模式的存在来从逻辑上依赖于规则操作的断言:

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> 
于 2016-09-18T19:26:05.797 回答