I'm trying to build a simple expert system for recommending courses and want to implement certainty factor in my program, however I'm stuck looking for a simple integration method.
I've stumbled upon this example but can't seems to figure out how to make it fire.
; Allow facts that are duplicates:
(defrule start
(declare (salience 1000))
(initial-fact)
=>
(set-fact-duplication TRUE))
(defrule combine-certainities-both-positive
?fact1 <- (organism ?attribute ?value ?C1&:(>= ?C1 0))
?fact2 <- (organism ?attribute ?value ?C2&:(>= ?C2 0))
(test (neq ?fact1 ?fact2))
=>
(retract ?fact1 ?fact2)
(bind ?C3 (- (+ ?C1 ?C2) (* ?C1 ?C2)))
(assert (organism ?attribute ?value ?C3)))
(defrule combine-certainities-both-negative
?fact1 <- (organism ?attribute ?value ?C1&:(< ?C1 0))
?fact2 <- (organism ?attribute ?value ?C2&:(< ?C2 0))
(test (neq ?fact1 ?fact2))
=>
(retract ?fact1 ?fact2)
(bind ?C3 (+ (+ ?C1 ?C2) (* ?C1 ?C2)))
(assert (organism ?attribute ?value ?C3)))
(defrule combine-certainities-with-opposite-signs
?fact1 <- (organism ?attribute ?value ?C1)
?fact2 <- (organism ?attribute ?value ?C2)
(test (< (* ?C1 ?C2) 0))
(test (neq ?fact1 ?fact2))
=>
(retract ?fact1 ?fact2)
(bind ?C3 (/ (+ ?C1 ?C2) (- 1 (min (abs ?C1) (abs ?C2)))))
(assert (organism ?attribute ?value ?C3)))
I try to assert two new organism facts to kick start the first rule:
CLIPS> (assert (organism morpholgy1 rod1 0.25)
(organism morpholgy2 rod2 0.25))
==> f-4 (organism morpholgy1 rod1 0.25)
==> f-5 (organism morpholgy2 rod2 0.25)
<Fact-5>
CLIPS> (run)
<== Focus MAIN
0 rules fired Run time is 0.00300693511962891 seconds.
0.0 rules per second.
2 mean number of facts (2 maximum).
0 mean number of instances (0 maximum).
0 mean number of activations (0 maximum).
And use the matches but still don't get how to make it match here..
CLIPS> (matches combine-certainities-both-positive)
Matches for Pattern 1
f-4
f-5
Matches for Pattern 2
f-4
f-5
Partial matches for CEs 1 - 2
None
Activations
None
(4 0 0)
The attribute and the value have to match (morpholgy1 != morpholgy2 and rod1 != rod2). That's why fact duplication has to be enabled to allow multiple copies of the same attribute/value.
CLIPS> (set-fact-duplication TRUE)
FALSE
CLIPS>
(assert (organism morpholgy rod 0.25)
(organism morpholgy rod 0.25))
<Fact-2>
CLIPS> (watch facts)
CLIPS> (run)
<== f-2 (organism morpholgy rod 0.25)
<== f-1 (organism morpholgy rod 0.25)
==> f-3 (organism morpholgy rod 0.4375)
CLIPS>
Related
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)))
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>
I have the following deftemplate
(deftemplate potential
(multislot values (type INTEGER))
)
and I want to remove instances of this deftemplate if an integer only occurs in it.
Example:
fact-1: potential 1 2 3
fact-2: potential 2 3 4
fact-3: potential 2 3 4 5
I want to retract fact-1 and fact-3 because they include 1 and 5 uniquely.
I'm trying to achieve it using a rule like the following:
1 (defrule remove_if_only_option
2 ?p<-(potential (values $? ?value $? ))
3 (not (exists (potential (values $? ?value $?) )))
4 =>
5 (retract ?p)
7 )
Obviously it doesn't work as line 3 can match the initial fact. Is there any way to make this run in such a way the rule doesn't consider ?p for the rest of it?
Thanks.
Neither of the patterns in your rule will be effected by the presence or absence of the initial-fact since they both match potential facts. The exists conditional element is superfluous in the second pattern, so your rule is equivalent to
(defrule remove_if_only_option
?p <- (potential (values $? ?value $?))
(not (potential (values $? ?value $?)))
=>
(retract ?p))
and since the condition x and not x is never true, this rule can never be satisfied.
You can tell if two facts of the same type are different by comparing their fact address, but since you can't bind a fact address within a not conditional element, you can't do that in this case. Alternatively, you can include a slot containing a unique value for each fact that can be used to tell if the facts are different:
CLIPS (6.31 6/12/19)
CLIPS>
(deftemplate potential
(slot id (default-dynamic (gensym*)))
(multislot values (type INTEGER)))
CLIPS>
(defrule remove_if_only_option
?p <- (potential (id ?id) (values $? ?value $?))
(not (potential (id ~?id) (values $? ?value $?)))
=>
(retract ?p))
CLIPS>
(assert (potential (values 1 2 3))
(potential (values 2 3 4))
(potential (values 2 3 4 5)))
<Fact-3>
CLIPS> (agenda)
0 remove_if_only_option: f-3,*
0 remove_if_only_option: f-1,*
For a total of 2 activations.
CLIPS>
Initially, this appears to work, but once it runs you can see there are issues:
CLIPS> (run 1)
CLIPS> (agenda)
0 remove_if_only_option: f-2,*
0 remove_if_only_option: f-1,*
For a total of 2 activations.
CLIPS>
Once f-3 is removed, the value 4 in f-2 now becomes unique and so this fact will now also be removed by this rule. The problem is that the common set of values is implicitly represented by the collection of potential facts, and once you start removing them you're altering the common set of values.
In order to do this, you'll need at least two steps and consequently at least two rules. One way to do it is to mark the facts that need to be deleted in one step and then delete them in another:
CLIPS> (clear)
CLIPS>
(deftemplate potential
(slot id (default-dynamic (gensym*)))
(multislot values (type INTEGER))
(slot delete (default no)))
CLIPS>
(defrule remove_if_only_option
(not (done))
?p <- (potential (id ?id) (values $? ?value $?) (delete no))
(not (potential (id ~?id) (values $? ?value $?)))
=>
(modify ?p (delete yes)))
CLIPS>
(defrule remove
(declare (salience -10))
?p <- (potential (delete yes))
=>
(assert (done))
(retract ?p))
CLIPS>
(assert (potential (values 1 2 3))
(potential (values 2 3 4))
(potential (values 2 3 4 5)))
<Fact-3>
CLIPS> (agenda)
0 remove_if_only_option: *,f-3,*
0 remove_if_only_option: *,f-1,*
For a total of 2 activations.
CLIPS> (run 1)
CLIPS> (agenda)
0 remove_if_only_option: *,f-1,*
-10 remove: f-4
For a total of 2 activations.
CLIPS> (facts)
f-0 (initial-fact)
f-1 (potential (id gen4) (values 1 2 3) (delete no))
f-2 (potential (id gen5) (values 2 3 4) (delete no))
f-4 (potential (id gen6) (values 2 3 4 5) (delete yes))
For a total of 4 facts.
CLIPS> (run 1)
CLIPS> (agenda)
-10 remove: f-5
-10 remove: f-4
For a total of 2 activations.
CLIPS> (run)
CLIPS> (facts)
f-0 (initial-fact)
f-2 (potential (id gen5) (values 2 3 4) (delete no))
f-6 (done)
For a total of 3 facts.
CLIPS>
Another way to create a fact containing the unique values:
CLIPS> (clear)
CLIPS>
(deftemplate potential
(slot id (default-dynamic (gensym*)))
(multislot values (type INTEGER)))
CLIPS>
(defrule add-to-unique
(not (done))
?c <- (unique $?unique)
(potential (id ?id) (values $? ?value $?))
(not (potential (id ~?id) (values $? ?value $?)))
(test (not (member$ ?value ?unique)))
=>
(retract ?c)
(assert (unique $?unique ?value)))
CLIPS>
(defrule remove_if_only_option
(declare (salience -10))
(unique $?unique)
?p <- (potential (values $? ?value $?))
(test (member$ ?value ?unique))
=>
(assert (done))
(retract ?p))
CLIPS>
(assert (potential (values 1 2 3))
(potential (values 2 3 4))
(potential (values 2 3 4 5)))
<Fact-3>
CLIPS> (assert (unique))
<Fact-4>
CLIPS> (run)
CLIPS> (facts)
f-0 (initial-fact)
f-2 (potential (id gen26) (values 2 3 4))
f-6 (unique 5 1)
f-7 (done)
For a total of 4 facts.
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>
I'm asking if there is a possibility of accessing a get the index of fact in RHS of defrule ?
It gives me that undefined every time I try to index a fact in a RHS of defrule.
because I have a while loop , I want to be able to modify elevator fact depending on my input data.
(deftemplate elevator
(slot goal))
(deffacts elevator
(elevator (goal 0)))
(defrule read-data
=>
?f1 <- (elevator)
(modify ?f2 (goal 1))
)
this an example of my code , since I can't put all online :
(deftemplate data
(slot data)
)
(deffacts data
(data (data 1))
)
(defrule rule1
?f1 <-(data)
=>
(bind ?value (readline input) )
(while (neq ?value EOF)
do
(bind ?data (fact-slot-value ?f1 data))
(printout t "data " ?data crlf )
(retract ?f1)
(modify ?f1 (data ?value))
(bind ?value (readline input)
)
)
)
this is my input file :
2
3
4
5
6
7
this is what I'm getting :
CLIPS> (run)
data 1
data FALSE
data FALSE
data FALSE
data FALSE
data FALSE
CLIPS>
I want it to print out
data 2
data 3
data 4 ..ect
You can do it this way from the RHS of a rule, but if your rule actually has no LHS conditions, it's pointless to use a rule to change the value of the fact. Just use a function.
CLIPS>
(deftemplate elevator
(slot goal))
CLIPS>
(deffacts elevator
(elevator (goal 0)))
CLIPS>
(defrule read-data
=>
(do-for-fact ((?f elevator)) TRUE
(modify ?f (goal 1))))
CLIPS> (watch facts)
CLIPS> (reset)
<== f-0 (initial-fact)
==> f-0 (initial-fact)
==> f-1 (elevator (goal 0))
CLIPS> (run)
<== f-1 (elevator (goal 0))
==> f-2 (elevator (goal 1))
CLIPS>
Alternately, you can bind the fact you want to modify in the conditions of the rule:
CLIPS> (clear)
CLIPS>
(deftemplate elevator
(slot goal))
CLIPS>
(deffacts elevator
(elevator (goal 0)))
CLIPS>
(defrule read-data
?f <- (elevator (goal 0))
=>
(modify ?f (goal 1)))
CLIPS> (watch facts)
CLIPS> (reset)
<== f-0 (initial-fact)
==> f-0 (initial-fact)
==> f-1 (elevator (goal 0))
CLIPS> (run)
<== f-1 (elevator (goal 0))
==> f-2 (elevator (goal 1))
CLIPS>
Updated:
You can get your original rule to "work" by removing the retract and rebinding ?f1 to the value returned by modify:
CLIPS> (clear)
CLIPS>
(deftemplate data
(slot data))
CLIPS>
(deffacts data
(data (data 1)))
CLIPS>
(defrule rule1
?f1 <- (data)
=>
(bind ?value (readline input))
(while (neq ?value EOF)
(bind ?data (fact-slot-value ?f1 data))
(printout t "data " ?data crlf )
(bind ?f1 (modify ?f1 (data ?value)))
(bind ?value (readline input))))
CLIPS> (reset)
CLIPS> (open input.txt input)
TRUE
CLIPS> (run)
data 1
data 2
data 3
data 4
data 5
data 6
CLIPS> (close input)
TRUE
CLIPS>
It's still suspiciously complicated to be modifying the same fact multiple times on the RHS.