I would greatly appreciate some assistance with my CLIPS project.
Okay so I'm attempting to create a dog breed adviser. The deftemplate looks like this:
(deftemplate breed
(multislot name)
(slot size)
(slot type-owner)
(slot Living_Space)
(slot children)
(slot grooming)
(slot exercise)
(slot noisiness)
(slot trainability)
(slot aggression)
(slot playfulness)
(slot excitability)
(slot score))
A deffacts looks like this:
(deffacts dog-breeds
(breed (name Great_Dane)
(size 5)
(type-owner No)
(Living_Space 5)
(children 5)
(grooming 1)
(exercise 4)
(noisiness 2)
(trainability 1)
(aggression 2)
(playfulness 2)
(excitability 3)
(score 0))
So I write two types of defrules: one retracts facts that do not meet the (user specified) criteria and the other type increments the "score" value every time the fact meets the criteria. Only a few rules retract, so it's important for me to get the increment rules working. The user input and criteria for each slot can be from 1 to 5.
My question is: how do I change the following code without going into an infinite loop? At the end I want to seek out the fact with the maximum score and display it.
(defrule children
(input 1)
?children <- (breed (name ?)(size ?)(type-owner ?)(Living_Space ?) (children 1|2)(grooming ?)(exercise ?)(noisiness ?)
(trainability ?)(aggression ?)(playfulness ?)(excitability ?)(score ?score)
=>
(bind ?sc (+ ?score 1))
(modify ?children (score ?sc))
If the sole purpose of the (input 1) fact is to increment the score and is no longer needed after the score is incremented, just retract that fact.
(defrule children
?f <- (input 1)
?children <- (breed (children 1|2) (score ?score))
=>
(retract ?f)
(bind ?sc (+ ?score 1))
(modify ?children (score ?sc)))
Note that I've removed all of the slots from the pattern containing the ? wildcard as these are unnecessary.
If the (input 1) fact is needed by other rules, you can create an intermediate fact that can be retracted.
(defrule create-intermediate
(input 1)
=>
(assert (increment)))
(defrule children
?f <- (increment)
?children <- (breed (children 1|2) (score ?score))
=>
(retract ?f)
(bind ?sc (+ ?score 1))
(modify ?children (score ?sc)))
You could also track what you've scored within the fact. Add a (multislot scored) to your breed deftemplate and then you can do this:
(defrule children
(input 1)
?children <- (breed (children 1|2) (score ?score) (scored $?scored))
(test (not (member$ children ?scored)))
=>
(bind ?sc (+ ?score 1))
(modify ?children (score ?sc) (scored children ?scored)))
Finally, object patterns do not retrigger when slots are changed that are not present in the pattern. So if you used defclasses instead of deftemplates, you could do this:
(defrule children
(input 1)
?children <- (object (is-a BREED) (children 1|2))
=>
(bind ?sc (+ (send ?children get-score) 1))
(send ?children put-score ?sc))
Related
I am having a template of
(deftemplate Product
(slot productId (type INTEGER))
(slot uom (default EA))
(slot quantity (type INTEGER))
(slot amount))
I'm using the code for
(defrule sum_of_quantity
(exists (Product (productId 1 | 2 | 3)(amount ?amount)))
=>
(bind ?totalQuantity 0)
(do-for-all-facts ((?p Product))
(or (eq ?p:productNumber 1)
(eq ?p:productNumber 2)
(eq ?p:productNumber 3))
(bind ?totalQuantity (+ ?totalQuantity ?p:quantity)))
(if (>= ?amount 5000) then
(printout t "TotalQuantity is " ?totalQuantity crlf)))
Here i am getting an error saying that:
Undefined variable amount referenced in RHS of defrule.
I have to check if the amount of each product is greater than 5000. How do we do that.
A simple fact pattern that can be matched by several different facts can cause multiple activations of a rule:
CLIPS>
(deftemplate product
(slot id)
(slot amount))
CLIPS>
(deffacts products
(product (id 1) (amount 1000))
(product (id 2) (amount 3000))
(product (id 3) (amount 6000)))
CLIPS>
(defrule print-amount
(product (id ?id) (amount ?amount))
=>
(printout t ?id ": " ?amount crlf))
CLIPS> (reset)
CLIPS> (agenda)
0 print-amount: f-3
0 print-amount: f-2
0 print-amount: f-1
For a total of 3 activations.
CLIPS> (run)
3: 6000
2: 3000
1: 1000
CLIPS>
When each activation is allowed to executed, the variable amount is retrieved from the product fact associated with activation. So there are three rule firings where amount is 6000, 3000, and 1000 respectively.
An exists conditional element is matched just once regardless of the number of time the fact patterns it contains are matched:
CLIPS>
(defrule exists
(exists (product (id ?id) (amount ?amount)))
=>)
CLIPS> (agenda)
0 exists: *
For a total of 1 activation.
CLIPS>
When the agenda is listed, an * is displayed indicating that the pattern is matched, but not by a specific fact. If you tried accessing the variable amount in the actions of the rule, you'd get an error. This is because the variable amount has no meaning outside of the pattern because it has no specific value. You'd get unpredictable behavior if one of the facts matching the fact pattern was arbitrarily chosen to provide the value for amount.
The simplest way to rewrite your rule is to move the amount check from the actions of the rule to the exists pattern:
(defrule sum_of_quantity
(exists (Product (productId 1 | 2 | 3)
(amount ?amount&:(>= ?amount 5000))))
=>
(bind ?totalQuantity 0)
(do-for-all-facts ((?p Product))
(or (eq ?p:productId 1)
(eq ?p:productId 2)
(eq ?p:productId 3))
(bind ?totalQuantity (+ ?totalQuantity ?p:quantity)))
(printout t "TotalQuantity is " ?totalQuantity crlf))
Your do-for-all-facts query was also referencing productNumber rather than productId.
I have this rule that fires thousands of other same rule:
(defrule calculate-temperature
?zone <- (object (is-a ZONE) (id ?id-zone) (dew-temperature ?dew-temperature) (delta-R ?delta-R))
(process-action (is cooling))
=>
(bind ?supply-temperature (+ ?delta-R ?dew-temperature))
(modify-instance ?zone (supply-temperature ?supply-temperature))
(printout ?*debug-print* "supply-temperature:", ?supply-temperature crlf))
What I want to do is to modify my zone's supply-temperature when I can calculate it, i.e. when inside zone are defined delta-R and dew-temperature.
But the modification of the object keeps on firing in a recursice neverendless cycle.
What are best practices to avoid these annoying loops, please?
Thank you
Nicola
By itself this rule doesn't loop:
CLIPS> (clear)
CLIPS>
(defclass ZONE
(is-a USER)
(slot id)
(slot dew-temperature)
(slot supply-temperature)
(slot delta-R))
CLIPS>
(definstances start-instances
(z1 of ZONE (id 1) (dew-temperature 100) (delta-R 10)))
CLIPS>
(deftemplate process-action
(slot is))
CLIPS>
(deffacts start-facts
(process-action (is cooling)))
CLIPS> (defglobal ?*debug-print* = nil)
CLIPS>
(defrule calculate-temperature
?zone <- (object (is-a ZONE)
(id ?id-zone)
(dew-temperature ?dew-temperature)
(delta-R ?delta-R))
(process-action (is cooling))
=>
(bind ?supply-temperature (+ ?delta-R ?dew-temperature))
(modify-instance ?zone (supply-temperature ?supply-temperature))
(printout ?*debug-print* "supply-temperature:", ?supply-temperature crlf))
CLIPS> (watch slots)
CLIPS> (reset)
::= local slot id in instance z1 <- 1
::= local slot dew-temperature in instance z1 <- 100
::= local slot delta-R in instance z1 <- 10
::= local slot supply-temperature in instance z1 <- nil
CLIPS> (run)
::= local slot supply-temperature in instance z1 <- 110
CLIPS>
So it's the interactions between your rules that are causing the loop.
There are three general techniques to prevent rule looping. First, you can remove one of the facts/instances matching the conditions of the rule. For example, the process-action fact:
(defrule calculate-temperature
?zone <- (object (is-a ZONE)
(id ?id-zone)
(dew-temperature ?dew-temperature)
(delta-R ?delta-R))
?p <- (process-action (is cooling))
=>
(retract ?p)
(bind ?supply-temperature (+ ?delta-R ?dew-temperature))
(modify-instance ?zone (supply-temperature ?supply-temperature))
(printout ?*debug-print* "supply-temperature:", ?supply-temperature crlf))
Second, you can modify a fact/instance slot value to prevent a pattern from matching. For example, delta-R:
(defrule calculate-temperature
?zone <- (object (is-a ZONE)
(id ?id-zone)
(dew-temperature ?dew-temperature)
(delta-R ?delta-R&~0))
(process-action (is cooling))
=>
(bind ?supply-temperature (+ ?delta-R ?dew-temperature))
(modify-instance ?zone (supply-temperature ?supply-temperature) (delta-R 0))
(printout ?*debug-print* "supply-temperature:", ?supply-temperature crlf))
Third (and this is only applicable for object pattern matching), rules are only triggered by changes to slots that are explicitly matched in the conditions of the rules. So if you want changes to delta-R to trigger the rule, but not changes to dew-temperature, you'd write the rule like this:
(defrule calculate-temperature
?zone <- (object (is-a ZONE)
(id ?id-zone)
(delta-R ?delta-R))
(process-action (is cooling))
=>
(bind ?supply-temperature (+ ?delta-R (send ?zone get-dew-temperature)))
(modify-instance ?zone (supply-temperature ?supply-temperature))
(printout ?*debug-print* "supply-temperature:", ?supply-temperature crlf))
I have a single-slot deftemplate definition with a constraint on the allowed symbols. If I directly assert a fact from the top level, the constraints work as expected (i.e. I can only use one of the allowed symbols). However, if I do it from within a deffunction, the constraint is effectively non-existent (see code output below). How do I enforce the constraint from within my function?
CLIPS> (clear)
CLIPS> (deftemplate test-template (slot myslot (type SYMBOL) (allowed-symbols A B C)))
CLIPS> (deffunction test-function (?s) (assert (test-template (myslot ?s))))
CLIPS> (assert (test-template (myslot X)))
[CSTRNCHK1] A literal slot value found in the assert command
does not match the allowed values for slot myslot.
CLIPS> (test-function X)
<Fact-1>
CLIPS> (facts)
f-0 (initial-fact)
f-1 (test-template (myslot X))
For a total of 2 facts.
CLIPS>
Static constraint checking (which occurs during parsing) is enabled by default. Dynamic constraint checking (which occurs during code execution) is not (see section 11 of the Basic Programming Guide). If you enable it you'll get a constraint violation in your example (although you need to assert a fact with a slot value other than X--duplicate facts are not allowed and during execution this check will occur before the constraint check).
CLIPS> (clear)
CLIPS> (deftemplate test-template (slot myslot (type SYMBOL) (allowed-symbols A B C)))
CLIPS> (deffunction test-function (?s) (assert (test-template (myslot ?s))))
CLIPS> (assert (test-template (myslot X)))
[CSTRNCHK1] A literal slot value found in the assert command
does not match the allowed values for slot myslot.
CLIPS> (test-function Y)
<Fact-1>
CLIPS> (set-dynamic-constraint-checking TRUE)
FALSE
CLIPS> (test-function Z)
[CSTRNCHK1] Slot value Z found in fact f-2
does not match the allowed values for slot myslot.
[PRCCODE4] Execution halted during the actions of deffunction test-function.
<Fact-2>
CLIPS>
In Common LISP I am attempting to provide a list and create an array:
(defun make (hand)
(make-array '(5 2)
:initial-contents
hand))
(defparameter array(make '((3 H)(2 H)(11 D)(8 C)(5 D))))
This seems to work fine. Where I am tripping up is working with this array.
I want to compare the 2nd field in each position of the array.
ie.
H eq H? Yes.
H eq D? No. End.
I am unsure how to do this. I tried:
(cond ((eq 'aref hand 1 1) 'aref hand 0 1) (t)))
This did not work. Any help would be appreciated.
eq takes two parameters:
(eq 'h 'h)
=> T
(eq 'h 'd)
=> NIL
aref takes a number of parameters, depending on the rank of the array- in your case, three:
(aref hand 1 1)
=> H
(aref hand 0 1)
=> H
What you want is to give the latter as arguments to the former:
(eq (aref hand 1 1) (aref hand 0 1))
=> T
cond allows you to check a set of conditions and return a value according to the first condition that is true: (cond (condition-1 value-1) (condition-2 value-2) ...)
(cond ((eq (aref hand 1 1) (aref hand 0 1))
"first and second are the same")
((eq (aref hand 2 1) (aref hand 0 1))
"first and third are the same")
(t
"this is always true"))
=> "first and second are the same"
Some time ago I asked how I could use Z3 to get models for constraints involving sets (Is there a way to use Z3 to get models for constraints involving sets?). For this the extended array theory works well in my case.
Now I have got the same issue with sequences (with operations length, membership, (in-)equality, perhaps slicing) and maps. I.e. axiomatization leads to the same problem as for sets. I have been thinking of encoding sequences and maps using the extended array theory as well but I have not yet been able to come up with a good way to do this.
Does anyone have an idea on how sequences and maps could be encoded to get accurate models?
In Z3, arrays are essentially maps. Here is an example on how to create an "array" from list of integers to integers.
(declare-const a (Array (List Int) Int))
(declare-const l1 (List Int))
(declare-const l2 (List Int))
(assert (= (select a l1) 0))
(assert (= (select a l2) 0))
(check-sat)
(get-model)
For sequences, we can encode them using quantifiers. Z3 is complete for many decidable fragments.
Most of them are described in the Z3 tutorial. Here is a possible encoding.
;; In this example, we are encoding sequences of T.
;; Let us make T == Int
(define-sort T () Int)
;; We represent a sequence as a pair: function + length
(declare-fun S1-data (Int) T)
(declare-const S1-len Int)
(declare-fun S2-data (Int) T)
(declare-const S2-len Int)
(declare-fun S3-data (Int) T)
(declare-const S3-len Int)
;; This encoding has one limitation, we can't have sequences of sequences; nor have sequences as arguments of functions.
;; Here is how we assert that the sequences S1 and S2 are equal.
(push)
(assert (= S1-len S2-len))
(assert (forall ((i Int)) (=> (and (<= 0 i) (< i S1-len)) (= (S1-data i) (S2-data i)))))
;; To make the example more interesting, let us assume S1-len > 0
(assert (> S1-len 0))
(check-sat)
(get-model)
(pop)
;; Here is how we say that sequence S3 is the concatenation of sequences S1 and S2.
(push)
(assert (= S3-len (+ S1-len S2-len)))
(assert (forall ((i Int)) (=> (and (<= 0 i) (< i S1-len)) (= (S3-data i) (S1-data i)))))
(assert (forall ((i Int)) (=> (and (<= 0 i) (< i S2-len)) (= (S3-data (+ i S1-len)) (S2-data i)))))
;; let us assert that S1-len and S2-len > 1
(assert (> S1-len 1))
(assert (> S2-len 1))
;; let us also assert that S3(0) != S3(1)
(assert (not (= (S3-data 0) (S3-data 1))))
(check-sat)
(get-model)
(pop)
;; Here is how we encode that sequence S2 is sequence S1 with one extra element a
(push)
(declare-const a T)
(assert (> a 10))
(assert (= S2-len (+ 1 S1-len)))
(assert (= (S2-data S1-len) a))
(assert (forall ((i Int)) (=> (and (<= 0 i) (< i S1-len)) (= (S2-data i) (S1-data i)))))
;; let us also assert that S1-len > 1
(assert (> S1-len 1))
(check-sat)
(get-model)
(pop)