2016-09-16 75 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>