I have to implement an expert system in CLIPS that uses a grammar that can generate:
I saw a tutorial.
I went in a library.
In library a tutorial I saw.
I receive an input from a user - let's suppose it it the first sentence - and I have to print a message like: YES G1 G4 G3 G8, if I can parse the input with my system or NO, otherwise.
In order to achieve this, I found a model system, implemented like:
(deffacts facts
(rule G1 S i B)
(rule G2 S in E)
(rule G3 B a C)
(rule G4 B saw B)
(rule G5 B went S)
(rule G6 B saw #)
(rule G7 B #)
(rule G8 C tutorial #)
(rule G9 D i B)
(rule G10 E a library B)
(rules S)
)
Now, I don't know how to implement the rules and I'm looking for some help.
Thank you!
CLIPS (6.31 6/12/19)
CLIPS>
(deftemplate sentence
(multislot words)
(multislot queue)
(multislot rules)
(slot symbol (default S)))
CLIPS>
(deffacts productions
(rule G1 S i B)
(rule G2 S in E)
(rule G3 B a C)
(rule G4 B saw B)
(rule G5 B went S)
(rule G6 B saw #)
(rule G7 B #)
(rule G8 C tutorial #)
(rule G9 D i B)
(rule G10 E a library B))
CLIPS>
(deffacts test
(sentence (words i saw a tutorial))
(sentence (words i went in a library))
(sentence (words in library a tutorial i saw)))
CLIPS>
(defrule load-queue
?f <- (sentence (words ?w1 $?w2)
(queue)
(symbol S))
=>
(modify ?f (queue ?w1 $?w2)))
CLIPS>
(defrule apply
(rule ?r ?s $?m ?ns)
(sentence (words $?w)
(symbol ?s)
(queue $?m $?e)
(rules $?rules))
=>
(assert (sentence (words ?w)
(symbol ?ns)
(queue ?e)
(rules ?rules ?r))))
CLIPS>
(defrule success
(declare (salience -10))
(sentence (words $?w)
(symbol #)
(queue)
(rules $?r))
=>
(printout t "YES " (implode$ ?w) " : " (implode$ ?r) crlf))
CLIPS>
(defrule failure
(declare (salience -10))
(sentence (words $?w) (queue $?w))
(not (sentence (words $?w) (queue) (symbol #)))
=>
(printout t "NO " (implode$ ?w) crlf))
CLIPS> (reset)
CLIPS> (run)
YES i saw a tutorial : G1 G4 G3 G8
YES i went in a library : G1 G5 G2 G10 G7
NO in library a tutorial i saw
CLIPS>
Related
modify is not working. I expected fact 1 to be (a x y z).
Further, if I want to change the second element c of the fact 1 to say g, i.e the new fact should be (a b g d) is there a way using modify ?
Snippet attached below.
CLIPS> (assert (a b c d))
<Fact-1>
CLIPS> (bind ?s x y z)
(x y z)
CLIPS> (facts)
f-1 (a b c d)
For a total of 1 fact.
CLIPS> ?s
(x y z)
CLIPS> (modify 1 (implied ?s))
FALSE
CLIPS> (facts)
f-1 (a b c d)
For a total of 1 fact.
CLIPS>
Modify only works with template facts. If you're using ordered facts, you need to do a retract and assert:
CLIPS> (assert (a b c d))
<Fact-1>
CLIPS> (bind ?s x y z)
(x y z)
CLIPS> (retract 1)
CLIPS> (assert (a ?s))
<Fact-2>
CLIPS> (facts)
f-2 (a x y z)
For a total of 1 fact.
CLIPS>
Use the replace$ function to replace values in a multifield value before asserting it as part of a fact:
CLIPS> (bind ?s (replace$ ?s 2 2 g))
(x g z)
CLIPS>
I'm trying to find the most common element across multiple multislot entry of type symbol and I don't seem to get a decent way to extracts the content of those multislot to single entry to iterate over.
==================================
(deftemplate chain ""
(multislot edge
(type SYMBOL))
)
(assert (chain (edge a b c d e f g)))
(assert (chain (edge d e f g h k l)))
(assert (chain (edge e o p q r s f)))
(deffunction find_most_common_edge ()
(bind ?edge (create$))
(bind ?counted_edge (create$))
(bind ?largest_count 0)
(do-for-all-facts ((?s chain)) TRUE
(loop-for-count (length$ ?s:edge) (?s1 (expand$ ?s:edge))
(if (not (member$ ?s1 ?counted_edge))
then
(bind ?counted_edge (create$ ?s1 ?counted_edge))
(bind ?count (length$ (find-all-facts ((?s2 chain)) (member$ ?s1 ?s2:edge))))
(if (= ?count ?largest_count)
then
(bind ?edge (create$ ?s1 ?edge))
else
(if (> ?count ?largest_count)
then
(bind ?largest_count ?count)
(bind ?edge (create$ ?s1)))))))
(return ?edge))
Using functions:
CLIPS (6.4 2/9/21)
CLIPS>
(deftemplate chain
(multislot edge (type SYMBOL)))
CLIPS>
(deffacts start
(chain (edge a b c d e f g))
(chain (edge d e f g h k l))
(chain (edge e o p q r s f)))
CLIPS>
(deffunction get-all-edges ()
(bind ?all-edges (create$))
(do-for-all-facts ((?f chain)) TRUE
(bind ?all-edges (create$ ?all-edges ?f:edge)))
(return ?all-edges))
CLIPS>
(deffunction count-edge (?e ?all-edges)
(bind ?all-length (length$ ?all-edges))
(return (- ?all-length (length$ (delete-member$ ?all-edges ?e)))))
CLIPS>
(deffunction remove-duplicates ($?mf)
(bind ?rv (create$))
(foreach ?v ?mf
(if (not (member$ ?v ?rv))
then
(bind ?rv (create$ ?rv ?v))))
(return ?rv))
CLIPS>
(deffunction find-most-common-edge ()
(bind ?all-edges (get-all-edges))
(bind ?unique-edges (remove-duplicates ?all-edges))
(bind ?largest-count 0)
(bind ?most-common (create$))
(foreach ?e ?unique-edges
(bind ?count (count-edge ?e ?all-edges))
(if (= ?count ?largest-count)
then
(bind ?most-common (create$ ?most-common ?e))
else
(if (> ?count ?largest-count)
then
(bind ?largest-count ?count)
(bind ?most-common (create$ ?e)))))
(return ?most-common))
CLIPS> (reset)
CLIPS> (find-most-common-edge)
(e f)
CLIPS>
Using rules:
CLIPS> (clear)
CLIPS>
(deftemplate chain
(slot id (default-dynamic (gensym*)))
(multislot edge (type SYMBOL)))
CLIPS>
(deftemplate count
(slot edge)
(multislot ids))
CLIPS>
(deffacts start
(chain (edge a b c d e f g))
(chain (edge d e f g h k l))
(chain (edge e o p q r s f))
(find-common-edge))
CLIPS>
(defrule create-count
(logical (find-common-edge))
(chain (id ?id) (edge $? ?e $?))
(not (count (edge ?e)))
=>
(assert (count (edge ?e) (ids ?id))))
CLIPS>
(defrule add-to-count
(logical (find-common-edge))
(chain (id ?id) (edge $? ?e $?))
?f <- (count (edge ?e) (ids $?ids))
(test (not (member$ ?id ?ids)))
=>
(modify ?f (ids ?ids ?id)))
CLIPS>
(defrule most-common-edge
(declare (salience -10))
?f <- (find-common-edge)
(count (edge ?e) (ids $?r1))
(not (and (count (edge ~?e) (ids $?r2))
(test (> (length$ ?r2) (length$ ?r1)))))
=>
(bind ?length (length$ ?r1))
(bind ?edges (create$))
(do-for-all-facts ((?c count))
(eq (length$ ?c:ids) ?length)
(bind ?edges (create$ ?edges ?c:edge)))
(assert (most-common-edges ?edges))
(retract ?f))
CLIPS> (reset)
CLIPS> (run)
CLIPS> (facts)
f-1 (chain (id gen4) (edge a b c d e f g))
f-2 (chain (id gen5) (edge d e f g h k l))
f-3 (chain (id gen6) (edge e o p q r s f))
f-20 (most-common-edges e f)
For a total of 4 facts.
CLIPS>
I have a rule I have made in CLIPS that deletes two values from a multislot field. Even though it does this, the rule repeats itself on the same facts that have now deleted the two values and this goes on infinitely.
Below are my fact templates and the rule
(deftemplate ar-node
(slot group
(type SYMBOL)
(allowed-symbols grp1 grp2 grp3 grp4) )
(slot name
(type SYMBOL)
(allowed-symbols oc nps ef sef yn))
(slot direction
(type SYMBOL)
(allowed-symbols + -))
(slot element
(type INTEGER)
(range 1 3))
(slot trip
(type INTEGER)
(range 1 4))
(multislot allowed-values
(type SYMBOL)
(allowed-symbols D R L A C S nil)
(default D))
(slot value
(type SYMBOL)
(allowed-symbols D R L A C S nil)
(default D)))
(defrule 22_061
(ar-node (group ?group)
(name ?name)
(direction ?direction)
(element ?element)
(trip ?trip)
(value ?value&R))
=>
(do-for-all-facts ((?fact ar-node)) (and (eq ?fact:group ?group)
(eq ?fact:name ?name)
(eq ?fact:direction ?direction)
(eq ?fact:element 1)
(> ?fact:trip 1))
(modify ?fact (allowed-values (delete-member$ ?fact:allowed-values C S))))
)
Here is also some example facts that will cause the rule to execute (the rule would only delete the C and S from the second fact here)
(ar-node (group grp1) (name cool) (direction +) (element 1) (trip 1) (allowed-values L D R A C S) (value R))
(ar-node (group grp1) (name cool) (direction +) (element 1) (trip 2) (allowed-values L D R A C S) (value L))
I have tried using more parameters to only delete values if the values are present such as (eq $member ?fact:allowed-values C S) in the RHS (and) statement or even to the LHS of the rule. However these either doesn't work or the rule won't execute at all.
I think the solution will be some way to check that the fact has C or S in the multifield on the LHS but I don't know how I could search all the facts before hand like I do on the RHS. Also I would prefer not to have to edit the fact template too though if its necessary to store something that.
Any advice or suggestions are welcome and I am new to CLIPS so sorry if this may be trivial but I'm super stumped even after using a bunch of functions from the documentation.
You can modify the query in the RHS to check for the presence of C or S:
(defrule 22_061
(ar-node (group ?group)
(name ?name)
(direction ?direction)
(value R))
=>
(do-for-all-facts ((?fact ar-node)) (and (eq ?fact:group ?group)
(eq ?fact:name ?name)
(eq ?fact:direction ?direction)
(eq ?fact:element 1)
(> ?fact:trip 1)
(or (member$ C ?fact:allowed-values)
(member$ S ?fact:allowed-values)))
(modify ?fact (allowed-values (delete-member$ ?fact:allowed-values C S))))
)
Or you can use pattern matching in the LHS and allow the rule to fire multiple times to modify all the facts:
(defrule 22_061
(ar-node (group ?group)
(name ?name)
(direction ?direction)
(value R))
?fact <- (ar-node (group ?group)
(name ?name)
(direction ?direction)
(element 1)
(trip ?trip&:(> ?trip 1))
(allowed-values $?b C | S $?e))
=>
(modify ?fact (allowed-values (delete-member$ (create$ ?b ?e) C S))))
I need to make complement and difference operations between two sets. I've a example, to do union between two sets, I can reuse this code to make these two other operations.
Thanks
The union example, that I've is:
(deffacts datos-iniciales
(conjunto B C A D E E B C E)
(conjunto E E B F D E))
(defrule inicio
=>
(assert (union)))
(defrule union
?h <- (union $?u)
(conjunto ? $? ?e $?)
(not (union $? ?e $?))
=>
(retract ?h)
(assert (union ?e $?u)))
Specifically, which part of the program should be changed? Thx
Here's how you can compute all three leaving the set-1 and set-2 facts unmodified, ignoring duplicate members, and sorting the results.
CLIPS (6.31 6/12/19)
CLIPS>
(deffacts datos-iniciales
(set-1 B C A D E E B C E)
(set-2 E E B F D E))
CLIPS>
(deffacts universe
(universe A B C D E F G H I J K))
CLIPS>
(deffunction str-sort (?a ?b)
(> (str-compare (sym-cat ?a) (sym-cat ?b)) 0))
CLIPS>
(defrule calcula
=>
(assert (union)
(complement)
(difference)))
CLIPS>
(defrule add-to-union
?union <- (union $?u)
(or (set-1 $? ?v $?)
(set-2 $? ?v $?))
(test (not (member$ ?v ?u)))
=>
(retract ?union)
(assert (union ?u ?v)))
CLIPS>
(defrule add-to-complement
?complement <- (complement $?c)
(universe $?u1 ?v $?u2)
(set-1 $?s)
(test (and (not (member$ ?v ?c))
(not (member$ ?v ?s))))
=>
(retract ?complement)
(assert (complement ?c ?v)))
CLIPS>
(defrule add-to-difference
?difference <- (difference $?d)
(set-1 $? ?v $?)
(set-2 $?set2)
(test (and (not (member$ ?v ?d))
(not (member$ ?v ?set2))))
=>
(retract ?difference)
(assert (difference ?d ?v)))
CLIPS>
(defrule write-union
(declare (salience -10))
(union $?u)
=>
(printout t "The union is " (sort str-sort ?u) crlf))
CLIPS>
(defrule write-complement
(declare (salience -10))
(complement $?c)
=>
(printout t "The complement is " (sort str-sort ?c) crlf))
CLIPS>
(defrule write-difference
(declare (salience -10))
(difference $?d)
=>
(printout t "The difference is " (sort str-sort ?d) crlf))
CLIPS> (reset)
CLIPS> (run)
The union is (A B C D E F)
The complement is (F G H I J K)
The difference is (A C)
CLIPS>
Let's say I have this template:
(deftemplate TRIP::trip
(multislot resort-sequence)
(multislot place-sequence)
(multislot days-distribution))
and this rule:
(defrule test
?p <- (trip (days-distribution $?days))
=>
;change value of ?days
Now, since ?p has 3 fields what I'm wondering is: Is it possible to reassert the facts ?p without having to bind separatly all the fields?
Something like this:
(assert (trip ?p (days-distribution $?days)))
Edit:
To Clarify,
from one trip-fact I need to create multiple ones so I cannot modify the first
You can use the modify function but you need to pay attention to looping rules. Your rule above, once fired, would loop indefinitely as a newly modified trip fact would activate the rule over and over again.
In [1]: (deftemplate trip
: (multislot resort-sequence)
: (multislot place-sequence)
: (multislot days-distribution))
In [2]: (defrule test
: ?loop-prevention <- (new-trip)
: ?p <- (trip (days-distribution $?days))
: =>
: (retract ?loop-prevention)
: (modify ?p (days-distribution 1 2 3)))
In [3]: (assert (trip (resort-sequence a b c) (place-sequence d e f) (days-distribution 22 23 24)))
(trip (resort-sequence a b c) (place-sequence d e f) (days-distribution 22 23 24))
In [4]: (assert (new-trip))
(new-trip)
In [5]: (facts)
f-0 (initial-fact)
f-1 (trip (resort-sequence a b c) (place-sequence d e f) (days-distribution 22 23 24))
f-2 (new-trip)
For a total of 3 facts.
In [6]: (agenda)
0 test: f-2,f-1
For a total of 1 activation.
In [7]: (run)
In [8]: (facts)
f-0 (initial-fact)
f-3 (trip (resort-sequence a b c) (place-sequence d e f) (days-distribution 1 2 3))
For a total of 2 facts.