I am trying to print my 1234 list like:
1
12
123
1234
Here is my code:
(deffacts lists
(list 1 2 3 4)
)
(defrule print
(list $?x ? $?)
=>
(printout t ?x )
)
I'm not sure exactly how I should continue...
CLIPS>
(deffacts lists
(list 1 2 3 4))
CLIPS>
(deffunction pyramid-print (?list)
(loop-for-count (?i (length$ ?list))
(printout t (implode$ (subseq$ ?list 1 ?i)) crlf)))
CLIPS>
(defrule print
(list $?x)
=>
(pyramid-print ?x))
CLIPS> (reset)
CLIPS> (run)
1
1 2
1 2 3
1 2 3 4
CLIPS>
Related
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'm trying to write a general rule that will activate when two facts like these two are present:
(Vector v1 3 4 5)
(Vector v2 1 3 10 15 5 2 4)
(Elements 4 5 3)
So, my problem is that I don't know how to match ALL the unordered elements in the vector, in order to fire the rule.
I want the rule to activate only when ALL the elements from Elements are present, not taking in consideration if they follow the same order.
I haven't been able to achieve it, so I ask for help.
Examples of rules not doing what I want:
(defrule Equal
(Elements $?x)
(Vector ?name $?y)
(test (member$ $?x $?y))
=>
(printout t ?name crlf)
)
*The problem of this one is that it fires when both are blank, and mainly when a single member of ?x is contained in ?y, but I want the rule to fire when ALL elements in ?x are in ?y.
I tried using this simplier one too:
(defrule Equal
(Elements $? $?x $?)
(Vector ?name $? $?y $?)
=>
(printout t ?name crlf)
)
But in this case the rule only activates when the elements are exactly the same and ordered in the same way, but I want to have the flexibility of elements not having to be ordered exactly as they appear in the vector.
Use the subsetp function rather than member$:
CLIPS (6.31 4/1/19)
CLIPS>
(defrule equal
(elements $?elements)
(test (> (length$ ?elements) 0))
(vector ?name $?values)
(test (subsetp ?elements ?values))
=>
(printout t ?name crlf))
CLIPS>
(assert (vector v1 3 4 5)
(vector v2 1 3 10 15 5 2 4)
(vector v3 4 5 7 2)
(elements 4 5 3))
<Fact-4>
CLIPS>
(agenda)
0 equal: f-4,f-2
0 equal: f-4,f-1
For a total of 2 activations.
CLIPS> (run)
v2
v1
CLIPS>
You can also do it this way without a function call:
CLIPS> (clear)
CLIPS>
(defrule equal
(elements ? $?)
(vector ?name $?list)
(forall (elements $? ?v $?)
(vector ?name $? ?v $?))
=>
(printout t ?name crlf))
CLIPS>
(assert (vector v1 3 4 5)
(vector v2 1 3 10 15 5 2 4)
(vector v3 4 5 7 2)
(elements 4 5 3))
<Fact-4>
CLIPS> (agenda)
0 equal: f-4,f-2,*
0 equal: f-4,f-1,*
For a total of 2 activations.
CLIPS> (run)
v2
v1
CLIPS>
The problem is to compare between two multifield-variable of type SYMBOL.
Here an example of the code I try to develop.
CLIPS>(defrule r
=>
(printout t "Input A: ")
(bind $?A (explode$ (readline)))
(printout t "Input B: ")
(bind $?B (explode$ (readline)))
(if (member$ $?A $?B) then (printout t " Something ..." crlf)))
CLIPS> (run)
Input A: 1 2 3 4 5
Input B: 7 3 2 1 6
CLIPS>
I want to compare each argument (or value) of $?A with each argument of $?B and if at least one argument of both is in the $?A or $?B, the if test becomes TRUE.
You can write a function to test for the intersection of two multifield values:
CLIPS>
(deffunction intersectionp (?m1 ?m2)
(foreach ?i1 ?m1
(foreach ?i2 ?m2
(if (eq ?i1 ?i2)
then (return TRUE))))
(return FALSE))
CLIPS>
(defrule r
=>
(printout t "Input A: ")
(bind ?A (explode$ (readline)))
(printout t "Input B: ")
(bind ?B (explode$ (readline)))
(if (intersectionp ?A ?B) then (printout t " Something ..." crlf)))
CLIPS> (run)
Input A: 1 2 3 4 5
Input B: 7 3 2 1 6
Something ...
CLIPS> (reset)
CLIPS> (run)
Input A: 1 2 3
Input B: 4 5 6
CLIPS>
Alternately you can use pattern matching to test for an intersection:
CLIPS> (clear)
CLIPS>
(defrule r
=>
(printout t "Input A: ")
(bind ?A (explode$ (readline)))
(assert (A ?A))
(printout t "Input B: ")
(bind ?B (explode$ (readline)))
(assert (B ?B)))
CLIPS>
(defrule intersect
(exists (A $? ?v $?)
(B $? ?v $?))
=>
(printout t " Something ..." crlf))
CLIPS> (reset)
CLIPS> (run)
Input A: 1 2 3 4 5
Input B: 7 3 2 1 6
Something ...
CLIPS> (reset)
CLIPS> (run)
Input A: 1 2 3
Input B: 4 5 6
CLIPS>
(bind ?existing_total_count (nth$ 2 (send ?INSTANCE ?get-INTS)))
(send (nth$ 2 (send ?INSTANCE put-INTS)) (+ ?total_count ?existing_total_count))
first line compiles fine, but second line throwing error
Function send expected argument #2 to be of type symbol
I cant findout what the issue is. I am trying to update the second entry in slot INTS.
CLIPS>
(defclass A
(is-a USER)
(multislot INTS))
CLIPS> (make-instance [a] of A (INTS 1 2 3))
[a]
CLIPS> (send [a] print)
[a] of A
(INTS 1 2 3)
CLIPS> (bind ?INSTANCE [a])
[a]
CLIPS> (bind ?existing_total_count (nth$ 2 (send ?INSTANCE get-INTS)))
2
CLIPS> (bind ?total_count 3)
3
CLIPS> (slot-replace$ ?INSTANCE INTS 2 2 (+ ?total_count ?existing_total_count))
(1 5 3)
CLIPS> (send [a] print)
[a] of A
(INTS 1 5 3)
CLIPS> (bind ?total_count 5)
5
CLIPS> (send ?INSTANCE put-INTS (replace$ (send ?INSTANCE get-INTS) 2 2 (+ ?total_count ?existing_total_count)))
(1 7 3)
CLIPS> (send [a] print)
[a] of A
(INTS 1 7 3)
CLIPS>
I am a new to expert systems world.I am learning to use CLIPS tools.can anyone help me to make a program to add three numbers?
Thanks
CLIPS>
(deftemplate add
(multislot numbers))
CLIPS>
(defrule add-3-numbers
(add (numbers ?n1 ?n2 ?n3))
=>
(printout t ?n1 " + " ?n2 " + " ?n3 " = " (+ ?n1 ?n2 ?n3) crlf))
CLIPS> (assert (add (numbers 1 2 3)))
<Fact-1>
CLIPS> (assert (add (numbers 2 9 11)))
<Fact-2>
CLIPS> (run)
2 + 9 + 11 = 22
1 + 2 + 3 = 6
CLIPS>
Updated:
CLIPS> (clear)
CLIPS>
(defrule add-3-numbers
=>
(printout t "Number 1? ")
(bind ?n1 (read))
(printout t "Number 2? ")
(bind ?n2 (read))
(printout t "Number 3? ")
(bind ?n3 (read))
(printout t ?n1 " + " ?n2 " + " ?n3 " = " (+ ?n1 ?n2 ?n3) crlf))
CLIPS> (reset)
CLIPS> (run)
Number 1? 1
Number 2? 2
Number 3? 3
1 + 2 + 3 = 6
CLIPS> (evenp 3)
FALSE
CLIPS> (oddp 7)
TRUE
CLIPS>