CLIPS: asserting facts from within a function does not respect template constraints - constraints

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>

Related

storing values in clips into variable

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.

CLIPS Error: Illegal use of the module specifier when defrule

I want to define some module-rules to assert module-facts, and then batch get a group of facts list by get-fact-list, but an error occurred!
CLIPS (6.31 6/12/19)
CLIPS> (defmodule M)
CLIPS> (deftemplate M::T (slot k1))
CLIPS> (defrule M::T (testvalue 1) => (assert (M::T (k1 "v1"))))
[MODULDEF1] Illegal use of the module specifier.
ERROR:
(defrule M::T
(testvalue 1)
=>
(assert (M::T
CLIPS>
expected:
CLIPS> (defmodule M)
CLIPS> (deftemplate M::T (slot k1))
CLIPS> (defrule M::T (testvalue 1) => (assert (M::T (k1 "v1"))))
CLIPS> (assert (testvalue 1))
CLIPS> (get-fact-list M)
;; return the facts that M::rulexx assert
Why is the sytax error? How can I do it for the defrule of module?
Don't use M::T in your assert command. Since the defrule is contained in module M, all deftemplates visible to M can be referenced without using a module specifier.
CLIPS (6.31 6/12/19)
CLIPS> (defmodule M)
CLIPS> (deftemplate M::T (slot k1))
CLIPS> (defrule M::T (testvalue 1) => (assert (T (k1 "v1"))))
CLIPS> (assert (testvalue 1))
<Fact-1>
CLIPS> (get-fact-list M)
(<Fact-1>)
CLIPS>

Writing a select() function in ACL2

I'm trying to write a function in ACL2 (specifically ACL2s) that takes in a list and a natural number and returns the item in the list at the given index. So (select (list 1 2 3) 2) would return 3.
Here is my code:
;; select: List x Nat -> All
(defunc select (l n)
:input-contract (and (listp l) (natp n))
:output-contract t
(if (equal 0 n)
(first l)
(select (rest l) (- n 1))))
I'm receiving the following error:
Query: Testing body contracts ...
**Summary of Cgen/testing**
We tested 50 examples across 1 subgoals, of which 48 (48 unique) satisfied
the hypotheses, and found 1 counterexamples and 47 witnesses.
We falsified the conjecture. Here are counterexamples:
[found in : "top"]
-- ((L NIL) (N 0))
Test? found a counterexample.
Body contract falsified in:
-- (ACL2::EXTRA-INFO '(:GUARD (:BODY SELECT)) '(FIRST L))
Any help is much appreciated!
The message seems pretty clear to me: you are trying to get the first element of an empty list, which conflicts with your specification.
Based on this reference, it seems that first expects a non-empty list, whereas car returns nil when your input is nil.
Either you handle the nil case explicitely with an endp test or you use car instead of first.

Get facts and print parameters in CLIPS

I would like to print all the datas of the facts with a rule. Here are the facts :
(deffacts datas
(pile name 1 blocks A B C A B)
(pile name 2 blocks B A)
(pile name 3 blocks A B)
(pile name 4 blocks A))
And here are the printing I want to see :
pile 1 : A B C A B
pile 2 : B A
pile 3 : A B
pile 4 : A
Does somebody has an idea how to do it ?
Thank you for your help !
If the order in which the piles are printed doesn't matter, you can do it this way:
CLIPS> (clear)
CLIPS>
(deffacts datas
(pile name 1 blocks A B C A B)
(pile name 2 blocks B A)
(pile name 3 blocks A B)
(pile name 4 blocks A))
CLIPS>
(defrule print
(pile name ?name blocks $?blocks)
=>
(printout t pile " " ?name " : " (implode$ ?blocks) crlf))
CLIPS> (reset)
CLIPS> (run)
pile 4 : A
pile 3 : A B
pile 2 : B A
pile 1 : A B C A B
CLIPS> (clear)
CLIPS>
(deftemplate pile
(slot name)
(multislot blocks))
CLIPS>
(deffacts datas
(pile (name 1) (blocks A B C A B))
(pile (name 2) (blocks B A))
(pile (name 3) (blocks A B))
(pile (name 4) (blocks A)))
CLIPS>
(defrule print
(pile (name ?name) (blocks $?blocks))
=>
(printout t pile " " ?name " : " (implode$ ?blocks) crlf))
CLIPS> (reset)
CLIPS> (run)
pile 4 : A
pile 3 : A B
pile 2 : B A
pile 1 : A B C A B
CLIPS>
If the order is important, you can do it using facts in the following manners, but this is either destructive in the first case or requires cleanup in the second case:
CLIPS> (clear)
CLIPS>
(deftemplate pile
(slot name)
(multislot blocks))
CLIPS>
(deffacts datas
(pile (name 1) (blocks A B C A B))
(pile (name 2) (blocks B A))
(pile (name 3) (blocks A B))
(pile (name 4) (blocks A)))
CLIPS>
(defrule print
?pile <- (pile (name ?name) (blocks $?blocks))
(not (pile (name ?name2&:(< ?name2 ?name))))
=>
(retract ?pile)
(printout t pile " " ?name " : " (implode$ ?blocks) crlf))
CLIPS> (reset)
CLIPS> (run)
pile 1 : A B C A B
pile 2 : B A
pile 3 : A B
pile 4 : A
CLIPS> (facts)
f-0 (initial-fact)
For a total of 1 fact.
CLIPS> (clear)
CLIPS>
(deftemplate pile
(slot name)
(multislot blocks))
CLIPS>
(deffacts datas
(pile (name 1) (blocks A B C A B))
(pile (name 2) (blocks B A))
(pile (name 3) (blocks A B))
(pile (name 4) (blocks A)))
CLIPS>
(defrule print
(pile (name ?name) (blocks $?blocks))
(not (and (pile (name ?name2&:(< ?name2 ?name)))
(not (pile-printed ?name2))))
=>
(assert (pile-printed ?name))
(printout t pile " " ?name " : " (implode$ ?blocks) crlf))
CLIPS> (reset)
CLIPS> (run)
pile 1 : A B C A B
pile 2 : B A
pile 3 : A B
pile 4 : A
CLIPS> (facts)
f-0 (initial-fact)
f-1 (pile (name 1) (blocks A B C A B))
f-2 (pile (name 2) (blocks B A))
f-3 (pile (name 3) (blocks A B))
f-4 (pile (name 4) (blocks A))
f-5 (pile-printed 1)
f-6 (pile-printed 2)
f-7 (pile-printed 3)
f-8 (pile-printed 4)
For a total of 9 facts.
CLIPS>
Finally, you can use the fact query functions to retrieve all the piles facts and then sort them to get the desired order:
CLIPS> (clear)
CLIPS>
(deffunction pile-sort (?f1 ?f2)
(> (fact-slot-value ?f1 name)
(fact-slot-value ?f2 name)))
CLIPS>
(deftemplate pile
(slot name)
(multislot blocks))
CLIPS>
(deffacts datas
(pile (name 1) (blocks A B C A B))
(pile (name 2) (blocks B A))
(pile (name 3) (blocks A B))
(pile (name 4) (blocks A)))
CLIPS>
(defrule print
=>
(bind ?facts (find-all-facts ((?f pile)) TRUE))
(bind ?facts (sort pile-sort ?facts))
(progn$ (?f ?facts)
(printout t pile " " (fact-slot-value ?f name) " : "
(implode$ (fact-slot-value ?f blocks)) crlf)))
CLIPS> (reset)
CLIPS> (run)
pile 1 : A B C A B
pile 2 : B A
pile 3 : A B
pile 4 : A
CLIPS>

CLIPS incrementing variable without endless loop

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

Resources