2016-09-16 60 views
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))) 
) 

如果在年底,用户要更改月份属性,这最后会被退回,并且规则月份应重新评估,并解雇了,因为有ISN” t没有月份属性,所以通过这种方式他可以改变月份的值,但是开花属性也应该改变,但是这没有做到有名称开花的属性已经被声明。考虑到这一点我创建了一个模块,是“专注”的修改功能后:

(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改变了它的花瓣尖齿属性也将被收回并重新解雇,但我东西要求关于花瓣顶端齿的问题可能是多余的。那我怎么才能提高我的代码?

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

回答

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> 

当用户想要改变at的价值致敬,您需要收回属性和相关的事先响应事实:

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>