CLIPS: OR conditional element that evaluates to TRUE if and only if 2 or more of its internal patterns are TRUE - clips

A normal (or) element evaluates to TRUE if 1 or more of the patterns are matched:
(or
(object (name name-1))
(object (name name-2))
(object (name name-3))
(object (name name-4))
)
The question is: is there a simple way to create a modified (or) element that evaluates to TRUE if 2 or more of the patterns are matched?
The dumb brute way of doing this would of course be the following, but I'm convinced there's a smoother way.
(or
(and
(object (name name-1))
(object (name name-2))
)
(and
(object (name name-1))
(object (name name-3))
)
(and
(object (name name-1))
(object (name name-4))
)
(and
(object (name name-2))
(object (name name-3))
)
...
)

If you're trying to match more than two objects, then use that same number of patterns and discard extraneous permutations with a call to a utility function:
CLIPS (6.31 6/12/19)
CLIPS> (defclass X (is-a USER))
CLIPS>
(definstances Xs
(name-0 of X)
(name-1 of X)
(name-3 of X)
(name-4 of X)
(name-5 of X))
CLIPS>
(deffunction in-order (?n1 ?n2)
(< (str-compare ?n1 ?n2) 0))
CLIPS>
(defrule r1
(object (name ?name1&[name-1] | [name-2] | [name-3] | [name-4]))
(object (name ?name2&[name-1] | [name-2] | [name-3] | [name-4]))
(test (in-order ?name1 ?name2))
=>)
CLIPS>
(defrule r2
(exists
(object (name ?name1&[name-1] | [name-2] | [name-3] | [name-4]))
(object (name ?name2&[name-1] | [name-2] | [name-3] | [name-4]))
(test (in-order ?name1 ?name2)))
=>)
CLIPS> (reset)
CLIPS> (agenda)
0 r1: [name-1],[name-4]
0 r1: [name-3],[name-4]
0 r1: [name-1],[name-3]
0 r2: *
For a total of 4 activations.
CLIPS>

Related

Clips range find between 2 json inputs

I want to implemen a rule ;
Lets assume that ı have one input.json it consist a name value pair.Example;
{
"quality":"300"
}
I have another constant json ,Example
[{
"up":"100",
"down":"0",
"data":"xx"
},
{
"up":"200",
"down":"100",
"data":"yy"
},
,
{
"up":"300",
"down":"200",
"data":"zz"
}
]
I am trying to find propert value for data for which up and down range.
for this one ı, have to get zz because "quality":"300" is between 200-300.
how can ı success this one in clips rule.
CLIPS (6.31 6/12/19)
CLIPS>
(deftemplate pair
(slot name)
(slot value))
CLIPS>
(deffacts pairs
(pair (name "quality") (value 300)))
CLIPS>
(deftemplate data
(slot name)
(slot up)
(slot down))
CLIPS>
(deffacts data-values
(data (name "xx") (up 100) (down 0))
(data (name "yy") (up 200) (down 100))
(data (name "zz") (up 300) (down 200)))
CLIPS>
(defrule in-range
(pair (name "quality")
(value ?value))
(data (name ?name)
(up ?up)
(down ?down))
(test (and (> ?value ?down) (<= ?value ?up)))
=>
(printout t ?name " is in range." crlf))
CLIPS> (reset)
CLIPS> (facts)
f-0 (initial-fact)
f-1 (pair (name "quality") (value 300))
f-2 (data (name "xx") (up 100) (down 0))
f-3 (data (name "yy") (up 200) (down 100))
f-4 (data (name "zz") (up 300) (down 200))
For a total of 5 facts.
CLIPS> (agenda)
0 in-range: f-1,f-4
For a total of 1 activation.
CLIPS> (run)
zz is in range.
CLIPS>

How to stop rule repeating activation on facts that have already been modified?

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

How to retrive facts asserted by a rule having particular name?

I have certain template defined as follows:
(deftemplate action
(slot name)
(slot field)
(slot value))
I have other rules which will use other facts to assert the action fact.
Now I want to retrieve only the fact with template action.
For now, I am using find-fact to retrieve, but here I have to use query which I do not want to provide.
(find-fact ((?fact action)) (= (str-compare ?fact:name 'Action1') 0))
I want all facts with template action and do not want to write a loop over all names with Action1, Action2 etc..
Thank you in advance.
CLIPS (6.31 4/1/19)
CLIPS>
(deftemplate action
(slot name)
(slot field)
(slot value))
CLIPS>
(deffacts actions
(action (name Action1) (field x) (value 3))
(action (name Action2) (field y) (value 4))
(action (name Action3) (field z) (value 5)))
CLIPS>
(defrule find-Action1
(action (name Action1))
=>)
CLIPS> (reset)
CLIPS> (agenda)
0 find-Action1: f-1
For a total of 1 activation.
CLIPS> (facts)
f-0 (initial-fact)
f-1 (action (name Action1) (field x) (value 3))
f-2 (action (name Action2) (field y) (value 4))
f-3 (action (name Action3) (field z) (value 5))
For a total of 4 facts.
CLIPS>

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>

How to printout all matches facts in a rule

I have a rule like below and I want to print all facts(here objct) that are compatible to this rule. I have a fact objct and there are some of these "objct"s that follow the rule. how I can do it? The printout below just prints the latest objct that player got. However I want to printout all of them. Any idea?
(defrule have_objcts
?input <- (input have|possession)
(objct (name ?n) (location player) (used 0))
=>
;WHAT SHOULD I WRITE HERE TO PRINTOUT those OBJCT's BELONG TO
PALYER???????????
(printout t crlf ?n)
(retract ?input))
Use the matches command:
CLIPS>
(deftemplate objct
(slot name)
(slot location)
(slot used))
CLIPS>
(deffacts initial
(objct (name x) (location player) (used 0))
(objct (name y) (location elsewhere) (used 1))
(objct (name z) (location player) (used 0))
(input have)
(input want)
(input possession)
(input thing))
CLIPS>
(defrule have_objcts
?input <- (input have|possession)
(objct (name ?n) (location player) (used 0))
=>
(retract ?input))
CLIPS> (reset)
CLIPS> (matches have_objcts)
Matches for Pattern 1
f-4
f-6
Matches for Pattern 2
f-1
f-3
Partial matches for CEs 1 - 2
f-6,f-3
f-6,f-1
f-4,f-3
f-4,f-1
Activations
f-6,f-3
f-6,f-1
f-4,f-3
f-4,f-1
(4 4 4)
CLIPS> (run)
CLIPS> (matches have_objcts)
Matches for Pattern 1
None
Matches for Pattern 2
f-1
f-3
Partial matches for CEs 1 - 2
None
Activations
None
(2 0 0)
CLIPS>

Resources