How to use and operator and or operator together in CLIPS programming - clips

I want to add a else part for below code as (assert (diabetes-assume false)). I glad if someone can help me to fix this issue.
(defrule diabetes-adult
(disease ?d)
(body-status ?b)
(age ?a&:(and (eq ?d none) (>= ?a 19) (< ?a 51) (or (eq ?b obesity) (eq ?b overweight) )))
=>
(assert (diabetes-assume true)))

You can assume as part of your initial state that diabetes is false and then define a higher salience rule (than the rules which rely on that assumption) to change the assumption to true:
(deffacts assumptions
(diabetes-assume false))
(defrule diabetes-adult-true
(declare (salience 10))
?f <- (diabetes-assume false)
(disease ?d)
(body-status ?b)
(age ?a&:(and (eq ?d none)
(>= ?a 19)
(< ?a 51)
(or (eq ?b obesity) (eq ?b overweight))))
=>
(retract ?f)
(assert (diabetes-assume true)))

Related

CLIPS does not recognize deftemplate name

I am trying to retract a deftemplate fact but when I do this CLIPS keeps saying I have to first declare the deffunction yet it is the appropriate deftemplate.What seems to be the problem?
I have attached the related code:
I get this error:
[EXPRNPSR3] Missing function declaration for Agriculture.
What seems to be the problem?
(deftemplate Agriculture
(slot weed
(type SYMBOL)
(allowed-symbols B G))
(slot crop
(type SYMBOL)
(allowed-symbols C S))
(slot organic-matter
(type INTEGER)
(allowed-values 1 2 3)))
(defrule Sencor-1
(and (Agriculture(weed B))
(Agriculture(crop C|S))
(Agriculture(organic-matter 1)))
=>
(printout t "Do not use Sencor!!"crlf))
(defrule Sencor-2
(and (Agriculture(weed B))
(Agriculture(crop C|S))
(Agriculture(organic-matter 2|3)))
=>
(printout t " " crlf "Use 3/4 pt/ac of Sencor" crlf ))
(defrule Lasso-1
(and (Agriculture(weed B|G))
(Agriculture(crop C|S))
(Agriculture(organic-matter 1)))
=>
(printout t crlf"Use 2 pt/ac of Lasso" crlf))
(defrule Lasso-2
(and (Agriculture(weed B|G))
(Agriculture(crop C|S))
(Agriculture(organic-matter 2)))
=>
(printout t crlf "Use 1 pt/ac of Lasso" crlf))
(defrule Lasso-3
(and (Agriculture(weed B|G))
(Agriculture(crop C|S))
(Agriculture(organic-matter 3)))
=>
(printout t crlf "Use 0.5 pt/ac of Lasso" crlf))
(defrule Bicep-1
(and (Agriculture(weed B|G))
(Agriculture(crop C))
(Agriculture(organic-matter 1)))
=>
(printout t crlf "Use 1.5 pt/ac of Bicep" crlf))
(defrule Bicep-2
(and (Agriculture(weed B|G))
(Agriculture(crop C))
(Agriculture(organic-matter 2)))
=>
(printout t crlf"Use 2.5 pt/ac of Bicep" crlf))
(defrule Bicep-3
(and (Agriculture(weed B|G))
(Agriculture(crop C))
(Agriculture(organic-matter 3)))
=>
(printout t crlf "Use 3 pt/ac of Bicep" crlf))
(defrule input
(initial-fact)
=>
(printout t crlf "What is the crop? (C:corn,S:soybean)")
(bind ?a (read))
(assert(Agriculture(crop ?a))) ;gets input from user
(printout t crlf "What is the weed problem? (B:broadleaf, G:grass)")
(bind ?b (read))
(assert(Agriculture(weed ?b)))
(printout t crlf "What is the % of organic matter content? (1:<2%,2:2-4%,3:>4%)")
(bind ?c (read))
(assert(Agriculture(organic-matter ?c)))
?d <- (Agriculture(crop ?a) (weed ?b) (organic-matter ?c))
(printout t ""crlf crlf "RECOMMENDATIONS:"crlf)
(retract ?d))
In the RHS of the input rule you state:
?d <- (Agriculture(crop ?a) (weed ?b) (organic-matter ?c))
This is interpreted as "Run function Agriculture and bind its results into ?d".
What you probably are trying to do is:
(bind ?d (assert (Agriculture (crop ?a) (weed ?b) (organic-matter ?c))))

How to make the complement and difference operation between two sets in CLIPS?

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>

Import rules to CLIPS and evaluate its performance

Can someone explain me how can I import the WEKA created rules in CLIPS and evaluate its efficience in TRS and TES data?
The data I use
I have written 7 rules out of 20 from WEKA tree. I include also 3 instances from the glass datasheet
small test code
(deftemplate glass
(slot n(type FLOAT))
(slot m(type FLOAT))
(slot a(type FLOAT))
(slot b(type FLOAT))
(slot r(type FLOAT))
(slot s(type FLOAT))
(slot k(type FLOAT))
(slot c(type FLOAT)))
(deftemplate Type
(slot type))
(deffacts instances1
(glass (n 13.00)
(m 2.28)
(a 1.00)
(b 0.00)))
(deffacts instances2
(glass (n 13.70)
(m 1.80)
(a 1.40)
(b 0.00)))
(deffacts instances3
(glass (n 13.70)
(m 1.90)
(a 1.40)
(b 0.00)))
(defrule R1
(glass (b ?b))
(test (<= ?b 0.27))
(glass (m ?m))
(test (<= ?m 2.41))
(glass (n ?n))
(test (<= ?n 13.78))
(glass (a ?a))
(test (<= ?a 1.38))
=>
(assert (Type (type buildwindnonfloat1)))
(printout t "buildwindnonfloat1 detected" crlf))
(defrule R2
(glass (b ?b))
(test (<= ?b 0.27))
(glass (m ?m))
(test (<= ?m 2.41))
(glass (n ?n))
(test (<= ?n 13.78))
(glass (a ?a))
(test (> ?a 1.38))
(glass (m ?m))
(test (<= ?m 1.88))
=>
(assert (Type (type containers2)))
(printout t "containers2 detected" crlf))
(defrule R3
(glass (b ?b))
(test (<= ?b 0.27))
(glass (m ?m))
(test (<= ?m 2.41))
(glass (n ?n))
(test (<= ?n 13.78))
(glass (a ?a))
(test (> ?a 1.38))
(glass (m ?m))
(test (> ?m 1.88))
=>
(assert (Type (type buildwindnonfloat3)))
(printout t "buildwindnonfloat3 detected" crlf))
(defrule R4
(glass (b ?b))
(test (<= ?b 0.27))
(glass (m ?m))
(test (<= ?m 2.41))
(glass (n ?n))
(test (> ?n 13.78))
=>
(assert (Type (type tableware4)))
(printout t "tableware detected" crlf))
(defrule R5
(glass (b ?b))
(test (<= ?b 0.27))
(glass (m ?m))
(test (> ?m 2.41))
(glass (a ?a))
(test (<= ?a 1.4))
(glass (m ?m))
(test (<= ?m 3.34))
(glass (a ?a))
(test (<= ?a 1.25))
=>
(assert (Type (type buildwindnonfloat5)))
(printout t "buildwindnonfloat5 detected" crlf))
(defrule R6
(glass (b ?b))
(test (<= ?b 0.27))
(glass (m ?m))
(test (> ?m 2.41))
(glass (a ?a))
(test (<= ?a 1.4))
(glass (m ?m))
(test (<= ?m 3.34))
(glass (a ?a))
(test (> ?a 1.25))
=>
(assert (Type (type buildwindfloat6)))
(printout t "buildwindfloat6 detected" crlf))
(defrule R7
(glass (b ?b))
(test (<= ?b 0.27))
(glass (m ?m))
(test (> ?m 2.41))
(glass (a ?a))
(test (<= ?a 1.4))
(glass (m ?m))
(test (> ?m 3.34))
(glass (m ?m))
(test (<= ?m 3.82))
(glass (r ?r))
(test (<= ?r 1.51707))
(glass (r ?r))
(test (<= ?r 51596))
=>
(assert (Type (type buildwindfloat7)))
(printout t "buildwindfloat7 detected" crlf))
To convert your data, it's easiest to read the data from the file when your program is running and directly assert the facts. So if your data looks like the following with each entry on its own line
1.5159,13.24,3.34,1.47,73.1,0.39,8.22,0,0,'build wind non-float'
1.5167,13.24,3.57,1.38,72.7,0.56,8.44,0,0.1,'vehic wind float'
then your can read your data by reading each line as a single string, replacing the commas with spaces, and then splitting the string into multiple values. You can then have a separate rule map the values from your file to the appropriate slots in your deftemplate facts.
Store the expected result with each glass fact and then you can compare that value to the value that your rule is proposing.
CLIPS (6.31 6/12/19)
CLIPS>
(deftemplate glass
(slot n (type FLOAT))
(slot m (type FLOAT))
(slot a (type FLOAT))
(slot b (type FLOAT))
(slot r (type FLOAT))
(slot s (type FLOAT))
(slot k (type FLOAT))
(slot c (type FLOAT))
(slot f (type FLOAT))
(slot type))
CLIPS>
(deftemplate input
(multislot data))
CLIPS>
(deffunction str-rpl (?str ?find ?replace)
(if (eq ?find "")
then
(return ?str))
(bind ?rs "")
(bind ?fl (str-length ?find))
(bind ?i (str-index ?find ?str))
(while (neq ?i FALSE)
(bind ?rs (str-cat ?rs (sub-string 1 (- ?i 1) ?str) ?replace))
(bind ?str (sub-string (+ ?i ?fl) (str-length ?str) ?str))
(bind ?i (str-index ?find ?str)))
(bind ?rs (str-cat ?rs ?str))
?rs)
CLIPS>
(defrule get-data
=>
(printout t "Input File? ")
(bind ?file (readline))
(if (not (open ?file data))
then
(printout t "Unable to open file" crlf)
(return))
(bind ?line (readline data))
(while (neq ?line EOF)
(bind ?line (str-rpl ?line "," " "))
(bind ?line (str-rpl ?line "'" "\""))
(assert (input (data (explode$ ?line))))
(bind ?line (readline data)))
(close data))
CLIPS>
(defrule convert-data
?i <- (input (data ?r ?n ?m ?a ?s ?k ?c ?b ?f ?type))
=>
(retract ?i)
(assert (glass (r ?r) (n ?n) (m ?m) (a ?a) (s ?s) (k ?k) (c ?c) (b ?b) (f ?f) (type ?type))))
CLIPS>
(defrule R1
(glass (b ?b)
(m ?m)
(n ?n)
(a ?a)
(type ?type))
(test (<= ?b 0.27))
(test (<= ?m 2.41))
(test (<= ?n 13.78))
(test (<= ?a 1.38))
=>
(printout t "buildwindnonfloat1 detected type = " ?type crlf))
CLIPS>
(defrule R2
(glass (b ?b)
(m ?m)
(n ?n)
(a ?a)
(type ?type))
(test (<= ?b 0.27))
(test (<= ?m 2.41))
(test (<= ?n 13.78))
(test (> ?a 1.38))
(test (<= ?m 1.88))
=>
(printout t "containers2 detected type = " ?type crlf))
CLIPS>
(defrule R3
(glass (b ?b)
(m ?m)
(n ?n)
(a ?a)
(type ?type))
(test (<= ?b 0.27))
(test (<= ?m 2.41))
(test (<= ?n 13.78))
(test (> ?a 1.38))
(test (> ?m 1.88))
=>
(printout t "buildwindnonfloat3 detected type = " ?type crlf))
CLIPS>
(defrule R4
(glass (b ?b)
(m ?m)
(n ?n)
(type ?type))
(test (<= ?b 0.27))
(test (<= ?m 2.41))
(test (> ?n 13.78))
=>
(printout t "tableware detected type = " ?type crlf))
CLIPS>
(defrule R5
(glass (b ?b)
(m ?m)
(a ?a)
(type ?type))
(test (<= ?b 0.27))
(test (> ?m 2.41))
(test (<= ?a 1.4))
(test (<= ?m 3.34))
(test (<= ?a 1.25))
=>
(printout t "buildwindnonfloat5 detected type = " ?type crlf))
CLIPS>
(defrule R6
(glass (b ?b)
(m ?m)
(a ?a)
(type ?type))
(test (<= ?b 0.27))
(test (> ?m 2.41))
(test (<= ?a 1.4))
(test (<= ?m 3.34))
(test (> ?a 1.25))
=>
(printout t "buildwindfloat6 detected type = " ?type crlf))
CLIPS>
(defrule R7
(glass (b ?b)
(m ?m)
(a ?a)
(r ?r)
(type ?type))
(test (<= ?b 0.27))
(test (> ?m 2.41))
(test (<= ?a 1.4))
(test (> ?m 3.34))
(test (<= ?m 3.82))
(test (<= ?r 1.51707))
(test (<= ?r 51596))
=>
(printout t "buildwindfloat7 detected type = " ?type crlf))
CLIPS> (reset)
CLIPS> (run)
Input File? weka.txt
buildwindfloat7 detected type = vehic wind float
CLIPS>

CLIPS runtime crash

I wrote a program which asserts the facts in the LHS of this rule:
(defrule check-open-better (declare (salience 50))
?f1 <- (newnode (ident ?id) (gcost ?g) (fcost ?f) (father ?anc))
(status (ident ?id) (subject ?subject) (data $?eqL))
?f2 <- (status (ident ?old) (subject ?subject) (data $?eqL))
?f3 <- (node (ident ?old) (gcost ?g-old) (open yes))
(test
(eq
(implode$
(find-all-facts ((?f status))
(and
(eq(str-compare ?f:ident ?id) 0)
(eq(str-compare ?f:subject ?subject) 0)
(eq(str-compare (implode$ ?f:data) (implode$ $?eqL)) 0)
)
)
)
(implode$
(find-all-facts ((?f status))
(and
(eq(str-compare ?f:ident ?old) 0)
(eq(str-compare ?f:subject ?subject) 0)
(eq(str-compare (implode$ ?f:data) (implode$ $?eqL)) 0)
)
)
)
0)
)
(test (< ?g ?g-old))
?f4 <- (open-better ?a)
=>
(assert (node (ident ?id) (gcost ?g) (fcost ?f) (father ?anc) (open yes)))
(assert (open-better (+ ?a 1)))
(retract ?f1 ?f2 ?f3 ?f4)
(pop-focus)
(pop-focus))
node, newnode and status are defined as deftemplate.
When this rule is in the agenda, CLIPS crash like it was typed the (exit) command.
I'm sure it's not fault of the rules that assert facts that allow this rule to be added in the agenda. Does anyone know why?
If CLIPS is crashing, it's a bug in CLIPS. I tried reproducing the problem by filling in the missing pieces and running in CLIPS 6.3, 6.31, and 6.4, but was unable to get a crash.
(deftemplate newnode
(slot ident)
(slot gcost (type INTEGER))
(slot fcost)
(slot father))
(deftemplate status
(slot ident)
(slot subject)
(multislot data))
(deftemplate node
(slot ident)
(slot gcost (type INTEGER))
(slot open))
(deffacts start
(node (ident "1") (gcost 10) (open yes))
(open-better 0)
(newnode (ident "2"))
(status (ident "1"))
(status (ident "2")))
Generally, it's a bad idea to use the query functions from the conditions of a rule because 1) you can use pattern matching and 2) the query contained within a test CE will not be reevaluated unless there's some changes to prior patterns.
It's not clear what you're trying to do with the find-all-facts calls. First, there's cruft in there that you don't need. The str-compare and implode$ function calls are unnecessary and the third argument of 0 to eq will cause the test CE to always fail since the return values of the find-all-facts calls will never be 0.
(test
(eq
(find-all-facts ((?f status))
(and
(eq ?f:ident ?id)
(eq ?f:subject ?subject)
(eq ?f:data $?eqL)
)
)
(find-all-facts ((?f status))
(and
(eq ?f:ident ?old)
(eq ?f:subject ?subject)
(eq ?f:data $?eqL)
)
)
)
)
Both find-all-fact calls must return the same facts in order for the test CE to be satisfied. That can only be true if there are no status facts or the ?id and ?old variables have the same value.
Try this one, it should work. :)
(defrule check-open-better (declare (salience 50))
?f1 <- (newnode (ident ?id) (gcost ?g) (fcost ?f) (father ?anc))
(status (ident ?id) (subject ?subject) (data $?eqL))
?f2 <- (status (ident ?old) (subject ?subject) (data $?eqL))
?f3 <- (node (ident ?old) (gcost ?g-old) (open yes))
(test (< ?g ?g-old))
?f4 <- (open-better ?a)
=>
(if (eq
(implode$
(find-all-facts ((?f status))
(and
(eq ?f:ident ?id)
(eq ?f:subject ?subject)
(eq (implode$ ?f:data) (implode$ $?eqL)))))
(implode$
(find-all-facts ((?f status))
(and
(eq ?f:ident ?old)
(eq ?f:subject ?subject)
(eq (implode$ ?f:data) (implode$ $?eqL)) 0))))
then
(assert (node (ident ?id) (gcost ?g) (fcost ?f) (father ?anc) (open yes)))
(assert (open-better (+ ?a 1)))
(retract ?f1 ?f2 ?f3 ?f4))
(pop-focus)
(pop-focus))

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>

Resources