Search code examples
clipsexpert-systeminference-engine

Clips revise system


( First of all, sorry for my English :) ) I'm trying to create a revise system for my project(a simple classification of natural plants), I dont't want to paste all my code, but only the important parts, so I'll try to explain what the system do. I made a function( that I call revise-attribute), when the system find the plants that should corresponding with answers given from user, that ask to the user if he want to modify some attributes, if he answers "yes" he can choose what attributes want to change, then the system find the fact-andress of attributes and retracts them, therefore it starts from the beginning and should re-evaluate rules. For example I have this two rules:

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

If , at the end, the user wants to change the month attribute, this last will be retracted and the rule month should be re-evaluated and fired because there isn't no month attribute ,so in this way he can change the value of month, however the flowering attribute should be changed too, but this is not done there is an attribute with name flowering which has been asserted. With this in mind I created a module that is "focus" after the revise-function :

(defmodule REVISITING (import MAIN ?ALL) )

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

So if month is retracted, flowering is retracted too. However I'm wondering if there is a possibility to do the same thing in a better method because I have a doubt for the following rule

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

For example if the user wants to change the habitat attribute I could create the following rule in Revisiting module

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

But if the first value entered by user was mountain and then he changed it with edge_of_road the petal-apex-toothed attribute will be retracted too and re-fired, but I thing that it might be redundant to request the question about petal-apex-toothed. So how I can improve my code??

P.S. I hope I was clear, otherwise I can try to explain mysef better :)


Solution

  • Use the logical conditional element in the conditions of a rule to make assertions from the actions of a rule logically dependent upon the existence of a group of patterns:

    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> 
    

    To prevent subsequent questions from being asked again, assert a fact when the question is originally asked to remember the last value supplied by the user:

    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> 
    

    When the user wants to change the value of the attribute, you'll need to retract both the attribute and associated prior response fact:

    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>