How to stop rule repeating activation on facts that have already been modified? - 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))))

Related

CLIPS finding most common element across multiple multislot

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>

Compare symbol variable to many values

I'd like to compare a variable that holds a symbol to many values, so that if any of them matches the variable, the CE is satisfied. Here is a minimal example:
(defrule compare-students
?x <- (Student (FirstName ?n))
(or (eq ?n John) (eq ?n Beter) (eq ?n Sarah))
=>
(modify ?x (SecondName ?n)))
When I compile the constructs file to c code, I got something like this:
Defining defrule: compare-students +j+j+j
=j=j+j+j
=j=j+j+j
Is this the right way to do that?
Thanks
Preferably use this:
(defrule compare-students
?x <- (Student (FirstName ?n&John | Beter | Sarah)
(SecondName ~?n))
=>
(modify ?x (SecondName ?n)))
Or alternately this:
(defrule compare-students
?x <- (Student (FirstName ?n)
(SecondName ~?n))
(test (or (eq ?n John) (eq ?n Beter) (eq ?n Sarah)))
=>
(modify ?x (SecondName ?n)))
The first uses pattern matching constraints for brevity and the second uses the test conditional element (CE) to indicate that the following syntax is a function call to be evaluated, not a pattern to be matched. In your original rule, you don't use the test CE, so the "or" in that rule is an "or" conditional element. It will attempt to match eq facts rather than make a function call.

Looping defrule in CLIPS

I am trying to solve a problem, where I have to fill a 5x5 matrix with letters A, B, C, D, and E. Each letter cannot occur more than once in each row and in each column. With some initial letter positions given.
I created every position as separate facts eg. "M 1 1 X".
I am struggling how to loop a defrule in way to assert a fact with correct letter and check the conditions again.
(defrule solveA5
?a <-(M 5 ?c X)
(not (M ?x ?c A))
=>
(retract ?a)
(assert (M 5 ?c A))
)
Code above for example is only to check presence of A in every position of 5th row, but the problem is that conditions are checked at the beginning only and instead of asserting correct fact and checking again it asserts A in every position.
I've tried using deffunction to loop defrule.
(deffunction solve (?letter)
(loop-for-count (?x 1 5) do
(loop-for-count (?y 1 5) do
(build (str-cat"defrule costam
?a <-(M ?x ?y X)
(not (and(M ?x ?a ?letter) (M ?b ?y ?letter))
=>
(retract ?a)
(assert (M ?x ?y ?letter))")
)
)
)
)
Unfortunately running
(solve A)
returns "FALSE" and doesn't modify any facts.
To handle iteration within rules, you must assert the iteration information as facts to allow the rules to match and modify this information. In the placement, it's not essential to do this in any particular order, so you can just assert information containing the rows, columns, and letters to place and allow the rules fire arbitrarily:
CLIPS>
(deftemplate element
(slot row)
(slot column)
(slot value))
CLIPS>
(deftemplate print
(slot row)
(slot column)
(slot end-of-row))
CLIPS>
(deffacts initial
(rows 1 2 3 4 5)
(columns 1 2 3 4 5)
(letters A B C D E))
CLIPS>
(defrule place
(rows $? ?r1 $?)
(columns $? ?c1 $?)
(letters $? ?l $?)
(not (element (row ?r1) (column ?c1)))
(not (and (element (row ?r2)
(column ?c2)
(value ?l))
(test (or (= ?r1 ?r2) (= ?c1 ?c2)))))
=>
(assert (element (row ?r1) (column ?c1) (value ?l))))
CLIPS>
(defrule print-start
(declare (salience -10))
(rows ?r $?)
(columns ?c $?rest)
=>
(assert (print (row ?r)
(column ?c)
(end-of-row (= (length$ ?rest) 0)))))
CLIPS>
(defrule print-next-column
(declare (salience -10))
?f <- (print (column ?c))
(columns $? ?c ?nc $?rest)
=>
(modify ?f (column ?nc)
(end-of-row (= (length$ ?rest) 0))))
CLIPS>
(defrule print-next-row
(declare (salience -10))
?f <- (print (column ?c) (row ?r))
(columns $?first ?c)
(rows $? ?r ?nr $?)
=>
(if (= (length$ ?first) 0)
then
(bind ?eor TRUE)
(bind ?nc ?c)
else
(bind ?eor FALSE)
(bind ?nc (nth$ 1 ?first)))
(modify ?f (row ?nr)
(column ?nc)
(end-of-row ?eor)))
CLIPS>
(defrule print-placed
(print (row ?r) (column ?c) (end-of-row ?eor))
(element (row ?r) (column ?c) (value ?l))
=>
(if ?eor
then
(printout t ?l crlf)
else
(printout t ?l " ")))
CLIPS>
(defrule print-unplaced
(print (row ?r) (column ?c) (end-of-row ?eor))
(not (element (row ?r) (column ?c)))
=>
(if ?eor
then
(printout t "?" crlf)
else
(printout t "? ")))
CLIPS> (reset)
CLIPS> (run)
E D C B A
? C D A B
? B A D C
? A B C D
A ? ? ? E
CLIPS>
In this example, the print rules iterate over the rows and columns by storing the iteration information in facts. You can see how much more complicated this is than the place rule which assigns the elements in an arbitrary manner.
Whether you assign the values arbitrarily or in a specific order, it's possible to assign values that prevent a solution, so you must implement backtracking in order to guarantee finding the solution if one exists. In this example, the facts store information about the order of the value placements and the values that have been tried:
CLIPS> (clear)
CLIPS>
(deftemplate element
(slot row)
(slot column)
(slot value (default unset))
(multislot values)
(slot placement))
CLIPS>
(deffacts initial
(placement 0)
(rows 1 2 3 4 5)
(columns 1 2 3 4 5)
(letters A B C D E))
CLIPS>
(defrule prime
(placement ?p)
(rows $? ?r $?)
(columns $? ?c $?)
(letters $?l)
(not (element (placement ?p)))
(not (element (row ?r) (column ?c)))
=>
(assert (element (placement ?p) (values ?l) (row ?r) (column ?c))))
CLIPS>
(defrule place-good
?f1 <- (placement ?p)
?f2 <- (element (placement ?p)
(value unset)
(row ?r1)
(column ?c1)
(values ?v $?rest))
(not (and (element (row ?r2)
(column ?c2)
(value ?v))
(test (or (= ?r1 ?r2) (= ?c1 ?c2)))))
=>
(retract ?f1)
(assert (placement (+ ?p 1)))
(modify ?f2 (value ?v) (values ?rest)))
CLIPS>
(defrule place-bad
(placement ?p)
?f2 <- (element (placement ?p)
(value unset)
(row ?r1)
(column ?c1)
(values ?v $?rest))
(element (row ?r2)
(column ?c2)
(value ?v))
(test (or (= ?r1 ?r2) (= ?c1 ?c2)))
=>
(modify ?f2 (values ?rest)))
CLIPS>
(defrule backtrack
?f1 <- (placement ?p)
?f2 <- (element (placement ?p)
(value unset)
(values))
?f3 <- (element (placement =(- ?p 1))
(value ~unset))
=>
(retract ?f1)
(assert (placement (- ?p 1)))
(retract ?f2)
(modify ?f3 (value unset)))
CLIPS>
(defrule print
(declare (salience -10))
(rows $?rows)
(columns $?columns)
=>
(progn$ (?r ?rows)
(progn$ (?c ?columns)
(if (not (do-for-fact ((?f element))
(and (= ?r ?f:row) (= ?c ?f:column))
(printout t ?f:value " ")))
then
(printout t "? ")))
(printout t crlf)))
CLIPS> (reset)
CLIPS> (run)
B C D E A
A B C D E
C A E B D
D E A C B
E D B A C
CLIPS>
The print rules have been simplified into a single rule that iterates over the row and columns in the actions of the rule and uses the fact query functions to retrieve values that have been assigned.
The program also works if you preassign some of the values:
CLIPS> (reset)
CLIPS> (assert (element (row 1) (column 1) (value A)))
<Fact-5>
CLIPS> (assert (element (row 3) (column 3) (value C)))
<Fact-6>
CLIPS> (assert (element (row 5) (column 4) (value E)))
<Fact-7>
CLIPS> (run)
A C E D B
B A D C E
D E C B A
E D B A C
C B A E D
CLIPS>

List manipulation in CLIPS (expert system)

I just want a function to print on item per line.
I am trying:
(deffunction myprint (?first $?rest)
(if (neq ?rest nil) then
(printout t ?first crlf)
(myprint ?rest)))
What is wrong?
Use the length function to determine if a list is empty (a return value of 0). Comparing a list to the symbol nil will always fail.
You want to print ?first even if ?rest is empty. Otherwise the last element will never be printed.
It is not necessary to use recursion.
CLIPS>
(deffunction myprint ($?rest)
(foreach ?r $?rest
(printout t ?r crlf)))
CLIPS> (myprint a b c)
a
b
c
CLIPS> (myprint (create$ a b) (create$ c d))
a
b
c
d
CLIPS>

Find facts using multiple values

(defglobal ?*myGlobal* = 0)
(deftemplate myTemp
(slot one)
(slot second)
(slot third)
(slot fourth)
)
(find-fact ((?p myTemp)) (eq ?p:one aValue))
I want to match a fact based on multiple values; the code above matches facts using only one value.
You can just use boolean clauses:
(assert (myTemp (one asd) (second jhg))
(myTemp (one asd) (second kjh))
(myTemp (one bvc) (second jhg))
(myTemp (one bvc) (second jhg) (third qwe)))
(find-fact ((?p myTemp)) (or (eq ?p:one bvc) (eq ?p:third qwe))
(<Fact-4>)
(find-fact ((?p myTemp)) (or (eq ?p:one bvc) (eq ?p:second jhg))
(<Fact-1>)
(find-all-fact ((?p myTemp)) (or (eq ?p:one bvc) (eq ?p:second jhg))
(<Fact-1> <Fact-3> <Fact-4>)

Resources