the sorting function using my comparator gives me this sorting
(Fact-57 Fact-58 Fact-59 Fact-60).
The facts to sort are:
COMPARATOR:
(deffunction MAIN::rating-sort (?f1 ?f2)
(if (< (fact-slot-value ?f1 sum-certainties) (fact-slot-value ?f2 sum-certainties)) then return TRUE
else (if (> (fact-slot-value ?f1 sum-certainties) (fact-slot-value ?f2 sum-certainties)) then return FALSE
else (if (> (fact-slot-value ?f1 total-price) (fact-slot-value ?f2 total-price)) then return TRUE
else (if (< (fact-slot-value ?f1 total-price) (fact-slot-value ?f2 total-price)) then return FALSE
else return FALSE)))))
CODE:
(bind ?facts (find-all-facts ((?f alternative)) TRUE))
(bind ?facts (sort rating-sort ?facts))
(printout t ?facts crlf)
I can't understand why it doesn't order them...
AN EXPECTED RESULT: (Fact-57 Fact-59 Fact-58 Fact-60)
Related
I would like to know in each day which activities I do, so I constructed the following code:
(deftemplate schedule
(slot activity)
(slot starthour)
(slot endhour)
)
(defrule r1
(schedule (activity ?a) (starthour ?start) (endhour ?end))
(not (busy ?start ?a))
=>
(assert (busy ?start ?a))
)
(defrule r2
(busy ?d ?a)
(schedule (activity ?a) (starthour ?start) (endhour ?end))
(test (< ?d ?end))
=>
(assert (busy ( + ?d 1) ?a))
)
CLIPS> (assert (schedule (activity reading) (starthour 3) (endhour 5)))
<Fact-1>
CLIPS> (assert (schedule (activity music) (starthour 4) (endhour 7)))
<Fact-2>
For the facts that I inserted I obtained a result that does not order the days.
How CLIPS interpret the order of the facts?
Is there a way to me to combine in a day more than 1 activity?
Thanks very much!
By default CLIPS uses a depth first strategy for determining which rule to execute next, so generally the next rule executed will have been activated by the last fact asserted or retracted. Section 5.3, Conflict Resolution Strategies, in the Basic Programming Guide describes this process in greater detail.
As long as the correct facts are being generated by the rules, you shouldn't be particularly concerned with the order in which they're place on the fact-list because 1) It's not practical to use the fact-list to display the output of a program and 2) forcing a particular order of placement can be difficult and overly complex.
Instead, to order facts in your program output, collect all of the relevant facts using one of the fact query functions and then use the sort function with a custom comparator to order the facts before printing them:
CLIPS (6.4 2/9/21)
CLIPS>
(deftemplate schedule
(slot activity)
(slot starthour)
(slot endhour))
CLIPS>
(deftemplate busy
(slot activity)
(slot hour))
CLIPS>
(defrule r1
(schedule (activity ?a) (starthour ?start) (endhour ?end))
(not (busy (activity ?a) (hour ?start)))
=>
(assert (busy (activity ?a) (hour ?start))))
CLIPS>
(defrule r2
(busy (activity ?a) (hour ?d))
(schedule (activity ?a) (starthour ?start) (endhour ?end))
(test (< ?d ?end))
=>
(assert (busy (activity ?a) (hour (+ ?d 1)))))
CLIPS>
(deffacts schedules
(schedule (activity reading) (starthour 3) (endhour 5))
(schedule (activity music) (starthour 4) (endhour 7)))
CLIPS>
(deffunction busy-compare (?f1 ?f2)
;; Sort by hour
(if (> (fact-slot-value ?f2 hour) (fact-slot-value ?f1 hour))
then (return FALSE))
(if (< (fact-slot-value ?f2 hour) (fact-slot-value ?f1 hour))
then (return TRUE))
;; And then sort by activity
(if (> (str-compare (fact-slot-value ?f2 activity)
(fact-slot-value ?f1 activity)) 0)
then (return FALSE)
else (return TRUE)))
CLIPS>
(defrule print
(declare (salience -10))
=>
(bind ?schedule (find-all-facts ((?f busy)) TRUE))
(bind ?schedule (sort busy-compare ?schedule))
(foreach ?s ?schedule
(format t "%2d %s%n" (fact-slot-value ?s hour) (fact-slot-value ?s activity))))
CLIPS> (reset)
CLIPS> (run)
3 reading
4 music
4 reading
5 music
5 reading
6 music
7 music
CLIPS> (facts)
f-1 (schedule (activity reading) (starthour 3) (endhour 5))
f-2 (schedule (activity music) (starthour 4) (endhour 7))
f-3 (busy (activity music) (hour 4))
f-4 (busy (activity music) (hour 5))
f-5 (busy (activity music) (hour 6))
f-6 (busy (activity music) (hour 7))
f-7 (busy (activity reading) (hour 3))
f-8 (busy (activity reading) (hour 4))
f-9 (busy (activity reading) (hour 5))
For a total of 9 facts.
CLIPS>
Here's another way to do it storing multiple activities in each busy fact:
CLIPS> (clear)
CLIPS>
(deftemplate schedule
(slot activity)
(slot starthour)
(slot endhour))
CLIPS>
(deftemplate busy
(multislot activity)
(slot hour))
CLIPS>
(defrule r1
(schedule (activity ?a) (starthour ?start) (endhour ?end))
=>
(loop-for-count (?hour ?start ?end)
(assert (busy (activity ?a) (hour ?hour)))))
CLIPS>
(defrule combine
?b1 <- (busy (activity $?a) (hour ?d))
?b2 <- (busy (activity ?n&:(not (member$ ?n ?a))) (hour ?d))
=>
(modify ?b1 (activity ?a ?n))
(retract ?b2))
CLIPS>
(deffacts schedules
(schedule (activity reading) (starthour 3) (endhour 5))
(schedule (activity music) (starthour 4) (endhour 7)))
CLIPS>
(deffunction busy-compare (?f1 ?f2)
(if (> (fact-slot-value ?f2 hour) (fact-slot-value ?f1 hour))
then (return FALSE))
(if (< (fact-slot-value ?f2 hour) (fact-slot-value ?f1 hour))
then (return TRUE))
(return FALSE))
CLIPS>
(defrule print
(declare (salience -10))
=>
(bind ?schedule (find-all-facts ((?f busy)) TRUE))
(bind ?schedule (sort busy-compare ?schedule))
(foreach ?s ?schedule
(format t "%2d %s%n" (fact-slot-value ?s hour) (implode$ (fact-slot-value ?s activity)))))
CLIPS> (reset)
CLIPS> (run)
3 reading
4 reading music
5 reading music
6 music
7 music
CLIPS> (facts)
f-1 (schedule (activity reading) (starthour 3) (endhour 5))
f-2 (schedule (activity music) (starthour 4) (endhour 7))
f-5 (busy (activity music) (hour 6))
f-6 (busy (activity music) (hour 7))
f-7 (busy (activity reading) (hour 3))
f-8 (busy (activity reading music) (hour 4))
f-9 (busy (activity reading music) (hour 5))
For a total of 7 facts.
CLIPS>
I need to write a comparator to order facts in CLIPS. This comparator must sort the facts according to a first field (sum-certanties) and if the first field were not enough to find a sort, I would like it to order them according to the second field (total-price).
This is what I wrote, but it doesn't work ...
(deffunction MAIN::rating-sort (?f1 ?f2)
(if (< (fact-slot-value ?f1 sum-certainties) (fact-slot-value ?f2 sum-certainties)) then return TRUE
else (if (> (fact-slot-value ?f1 sum-certainties) (fact-slot-value ?f2 sum-certainties)) then return FALSE
else (if (> (fact-slot-value ?f1 total-price) (fact-slot-value ?f2 total-price)) then return TRUE
else (if (< (fact-slot-value ?f1 total-price) (fact-slot-value ?f2 total-price)) then return FALSE
else then return FALSE)))))
Descending order for sum-certainties and ascending order for total-price.
Your function is fine. You just need to pass its name and a list of facts into the sort function.
CLIPS (6.31 6/12/19)
CLIPS>
(deffunction MAIN::rating-sort (?f1 ?f2)
(if (< (fact-slot-value ?f1 sum-certainties) (fact-slot-value ?f2 sum-certainties)) then return TRUE
else (if (> (fact-slot-value ?f1 sum-certainties) (fact-slot-value ?f2 sum-certainties)) then return FALSE
else (if (> (fact-slot-value ?f1 total-price) (fact-slot-value ?f2 total-price)) then return TRUE
else (if (< (fact-slot-value ?f1 total-price) (fact-slot-value ?f2 total-price)) then return FALSE
else then return FALSE)))))
CLIPS>
(deftemplate thing
(slot sum-certainties)
(slot total-price))
CLIPS>
(deffacts things
(thing (sum-certainties 90) (total-price 200))
(thing (sum-certainties 30) (total-price 100))
(thing (sum-certainties 30) (total-price 300))
(thing (sum-certainties 90) (total-price 150))
(thing (sum-certainties 50) (total-price 150))
(thing (sum-certainties 70) (total-price 200)))
CLIPS> (reset)
CLIPS>
(foreach ?f (sort rating-sort (find-all-facts ((?f thing)) TRUE))
(printout t (fact-slot-value ?f sum-certainties) " " (fact-slot-value ?f total-price) crlf))
90 150
90 200
70 200
50 150
30 100
30 300
CLIPS>
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))
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.
I'm trying to change the code of the expert system (The Engine Diagnosis Expert System) Add disordered patterns - . Clip does not produce errors, but the questions are not loaded. What am I doing wrong?
(deftemplate your_car "This is template for describing condition car"
(slot working-state (default undefined))
(slot rotation-state (default undefined))
(slot spark-state (default undefined))
(slot charge-state (default undefined))
(slot symptom (default undefined))
(slot repair(default undefined))
)
(deffunction ask-question (?question $?allowed-values)
(printout t ?question)
(bind ?answer (read))
(if (lexemep ?answer)
then
(bind ?answer (lowcase ?answer)))
(while (not (member ?answer ?allowed-values)) do
(printout t ?question)
(bind ?answer (read))
(if (lexemep ?answer)
then
(bind ?answer (lowcase ?answer))))
?answer
)
;-----------------------------------------------------------------------------------
(deffunction yes-or-no-p (?question)
(bind ?response (ask-question ?question yes no у n))
(if (or (eq ?response yes) (eq ?response y))
then
TRUE
else
FALSE)
)
;-----------------------------------------------------------------------------------
(defrule determine-engine-state ""
;(your_car (working-state undefined))
;(your_car (repair undefined))
?f1 <- (your_car (working-state undefined)(repair undefined))
=>
(if (yes-or-no-p "Does the engine start (yes/no)? ")
then
(if (yes-or-no-p "Does the engine run normally (yes/no)? ")
then
(modify ?f1 (working-state "engine normal"))
else
(modify ?f1 (working-state "engine unsatisfactory")))
else
(modify ?f1 (working-state "engine does-not-start"))))
;...
;-----------------------------------------------------------------------------------
(defrule no-repairs ""
(declare (salience -10))
;(your_car (repair undefined))
?f1 <- (your_car (repair undefined))
=>
(modify ?f1 (repair "Take your car to a mechanic."))
)
(defrule print-repair ""
(declare (salience 10))
;(your_car (repair ?item))
?f1 <- (your_car (repair ?item))
=>
(printout t crlf crlf)
(printout t "Suggested Repair:")
(printout t crlf crlf)
(format t " %s%n%n%n" ?item)
)
;-----------------------------------------------------------------------------------
(defrule system-banner ""
(declare (salience 10))
=>
(printout t crlf crlf)
(printout t "****************************************" crlf)
(printout t "* The Engine Diagnosis Expert System *" crlf)
(printout t "****************************************" crlf)
(printout t crlf crlf)
)
A deftemplate defines the structure of a fact, but it does not create them. Add a deffacts to your program after the deftemplate definition.
(deffacts start
(your_car))
When a (reset) command is issued, this will assert the facts contained in any deffacts constructs.
CLIPS> (clear)
CLIPS>
(deftemplate your_car "This is template for describing condition car"
(slot working-state (default undefined))
(slot rotation-state (default undefined))
(slot spark-state (default undefined))
(slot charge-state (default undefined))
(slot symptom (default undefined))
(slot repair(default undefined))
)
CLIPS>
(deffacts start
(your_car))
CLIPS>
(deffunction ask-question (?question $?allowed-values)
(printout t ?question)
(bind ?answer (read))
(if (lexemep ?answer)
then
(bind ?answer (lowcase ?answer)))
(while (not (member ?answer ?allowed-values)) do
(printout t ?question)
(bind ?answer (read))
(if (lexemep ?answer)
then
(bind ?answer (lowcase ?answer))))
?answer
)
CLIPS>
(deffunction yes-or-no-p (?question)
(bind ?response (ask-question ?question yes no у n))
(if (or (eq ?response yes) (eq ?response y))
then
TRUE
else
FALSE)
)
CLIPS>
(defrule determine-engine-state ""
?f1 <- (your_car (working-state undefined)(repair undefined))
=>
(if (yes-or-no-p "Does the engine start (yes/no)? ")
then
(if (yes-or-no-p "Does the engine run normally (yes/no)? ")
then
(modify ?f1 (working-state "engine normal"))
else
(modify ?f1 (working-state "engine unsatisfactory")))
else
(modify ?f1 (working-state "engine does-not-start"))))
CLIPS>
(defrule no-repairs ""
(declare (salience -10))
?f1 <- (your_car (repair undefined))
=>
(modify ?f1 (repair "Take your car to a mechanic."))
)
CLIPS>
(defrule print-repair ""
(declare (salience 10))
?f1 <- (your_car (repair ?item))
=>
(printout t crlf crlf)
(printout t "Suggested Repair:")
(printout t crlf crlf)
(format t " %s%n%n%n" ?item)
)
CLIPS>
(defrule system-banner ""
(declare (salience 10))
=>
(printout t crlf crlf)
(printout t "****************************************" crlf)
(printout t "* The Engine Diagnosis Expert System *" crlf)
(printout t "****************************************" crlf)
(printout t crlf crlf)
)
CLIPS> (reset)
CLIPS> (run)
Suggested Repair:
undefined
****************************************
* The Engine Diagnosis Expert System *
****************************************
Does the engine start (yes/no)? yes
Does the engine run normally (yes/no)? yes
Suggested Repair:
undefined
Suggested Repair:
Take your car to a mechanic.
CLIPS>