CLIPS: Match multislot if all values match different other facts - matching

Is there any possibility to match each multislot in CLIPS to different other facts? I have a short example rule:
(stn-action (id ?id) (name lock-position) (state pending)
(cond-actions) (opts ?r ?action ?to))
(stn-action (id ?other-id) (name lock-position) (state running|finished)
(opts ?r ?action ?other-to&:~(eq ?other-to ?to)))
cond-actions is a multifield and I want each value to match against a fact that matches the second line. Obviously I need to match with member$, but I don't know how to match each member against a different fact in my fact-base. Is there any possibility to do this? A short set of complete facts that match would look like this:
(stn-action (id 3) (name lock-position) (state pending) (duration 0)
(cond-actions 1 2) (opts R-1 PICK-CC C-CS2-I) (active-robot R-1) (sync-id 1000003))
(stn-action (id 2) (name lock-position) (state running) (duration 0)
(cond-actions 1) (opts R-1 GET-PROD C-CS2-O) (active-robot R-1) (sync-id 1000002))
(stn-action (id 1) (name lock-position) (state finished) (duration 0)
(cond-actions) (opts R-1 GET-PROD C-BS-O) (active-robot R-1) (sync-id 1000001))
My old solution was to remove id's from all fields upon action completion, but due to a different issue I cannot do this anymore

Use the forall conditional element:
CLIPS>
(deftemplate stn-action
(slot id)
(slot name)
(slot state)
(slot duration)
(multislot cond-actions)
(multislot opts)
(slot active-robot)
(slot sync-id))
CLIPS>
(deffacts initial
;; id 3 will not match because PICK-CC doesn't match GET-PROD
(stn-action (id 3) (name lock-position) (state pending) (duration 0)
(cond-actions 1 2) (opts R-1 PICK-CC C-CS2-I)
(active-robot R-1) (sync-id 1000003))
(stn-action (id 2) (name lock-position) (state running) (duration 0)
(cond-actions 1) (opts R-1 GET-PROD C-CS2-O)
(active-robot R-1) (sync-id 1000002))
(stn-action (id 1) (name lock-position) (state finished) (duration 0)
(cond-actions) (opts R-1 GET-PROD C-BS-O)
(active-robot R-1) (sync-id 1000001))
;; id 6 will match
(stn-action (id 6) (name lock-position) (state pending) (duration 0)
(cond-actions 5 4) (opts R-1 PICK-CC C-CS2-I)
(active-robot R-1) (sync-id 1000003))
(stn-action (id 5) (name lock-position) (state running) (duration 0)
(cond-actions 4) (opts R-1 PICK-CC C-CS2-O)
(active-robot R-1) (sync-id 1000002))
(stn-action (id 4) (name lock-position) (state finished) (duration 0)
(cond-actions) (opts R-1 PICK-CC C-BS-O)
(active-robot R-1) (sync-id 1000001)))
CLIPS>
(defrule match
(stn-action (id ?id)
(name lock-position)
(state pending)
(opts ?r ?action ?to))
(forall (stn-action (id ?id)
(cond-actions $? ?other-id $?))
(stn-action (id ?other-id)
(name lock-position)
(state running | finished)
(opts ?r ?action ?other-to&~?to)))
=>
(printout t "id " ?id " has all cond-actions satisfied" crlf))
CLIPS> (reset)
CLIPS> (run)
id 6 has all cond-actions satisfied
CLIPS>

Related

Is there any way to prioritize a rule by its own slot in CLIPS?

Is there anyway to make a rule fire earlier given a specific slot value that a fact may have?
I was wondering if there is anything like dynamic salience but for slot values
Thank you
It's likely there's a more elegant solution to whatever problem you're solving than changing the salience of a rule based on a slot value, but since you can use a global variable for the salience value of a rule, you can dynamically change the salience for a rule by assigning the global a value pulled from a fact slot:
CLIPS (6.31 6/12/19)
CLIPS> (set-salience-evaluation every-cycle)
when-defined
CLIPS>
(defglobal ?*r-1* = 0
?*r-2* = 0)
CLIPS>
(deftemplate rule-priority
(slot rule)
(slot salience))
CLIPS>
(deffacts start
(rule-priority (rule r-1) (salience -10))
(rule-priority (rule r-2) (salience -10))
(prime))
CLIPS>
(defrule assign
(declare (salience 10000))
(rule-priority (rule ?r) (salience ?s))
=>
(eval (str-cat "(bind ?*" ?r "* " ?s ")")))
CLIPS>
(defrule start
?rp <- (rule-priority (rule r-2) (salience ~10))
=>
(modify ?rp (salience 10)))
CLIPS>
(defrule r-1
(declare (salience ?*r-1*))
(prime)
=>)
CLIPS>
(defrule r-2
(declare (salience ?*r-2*))
(prime)
=>)
CLIPS> (reset)
CLIPS> (agenda)
10000 assign: f-2
10000 assign: f-1
0 r-1: f-3
0 r-2: f-3
0 start: f-2
For a total of 5 activations.
CLIPS> (run 2)
CLIPS> (agenda)
0 start: f-2
-10 r-1: f-3
-10 r-2: f-3
For a total of 3 activations.
CLIPS> (run 1)
CLIPS> (agenda)
10000 assign: f-4
-10 r-1: f-3
-10 r-2: f-3
For a total of 3 activations.
CLIPS> (run 1)
CLIPS> (agenda)
10 r-2: f-3
-10 r-1: f-3
For a total of 2 activations.
CLIPS>
You can also dynamically assign the salience of a rule using a deffuction and retrieve the slot value using the fact query functions:
CLIPS> (clear)
CLIPS> (set-salience-evaluation every-cycle)
every-cycle
CLIPS>
(deftemplate rule-priority
(slot rule)
(slot salience))
CLIPS>
(deffunction get-salience (?rule)
(do-for-fact ((?rp rule-priority))
(eq ?rp:rule ?rule)
(return ?rp:salience))
(return 0))
CLIPS>
(deffacts priorities
(rule-priority (rule r-1) (salience -10))
(rule-priority (rule r-2) (salience -10))
(prime))
CLIPS>
(defrule start
?rp <- (rule-priority (rule r-2) (salience ~10))
=>
(modify ?rp (salience 10)))
CLIPS>
(defrule r-1
(declare (salience (get-salience r-1)))
(prime)
=>)
CLIPS>
(defrule r-2
(declare (salience (get-salience r-2)))
(prime)
=>)
CLIPS> (reset)
CLIPS> (agenda)
0 start: f-2
-10 r-1: f-3
-10 r-2: f-3
For a total of 3 activations.
CLIPS> (run 1)
CLIPS> (agenda)
10 r-2: f-3
-10 r-1: f-3
For a total of 2 activations.
CLIPS>

How to create rules of divisibility in Clips?

I'm very new to Clips Expert System, I would like to know if some of you can help to implement rules of divisibility for numbers 7, 11 and 13.
This is what I used for divisibility of 2 but I can't do the same for 7, 11 and 13
;Facts for divisibility of 2
(deffacts lastnumbers
(firstnum 0)
(secondnum 2)
(thirdnum 4)
(fourthnum 6)
(fifth 8))
I'm trying to get the out like this:
Number 886782 is divisible by 13
Thanks in advance.
In general, you cannot determine if one number is evenly divisible by another just looking at the last digit of the dividend. Instead look at the remainder of the integer division and if it's zero, then the dividend was evenly divisible by the divisor.
CLIPS (6.31 6/12/19)
CLIPS>
(defrule get-dividend
(not (dividend ?))
=>
(printout t "Dividend? ")
(assert (dividend (read))))
CLIPS>
(defrule get-divisor
(dividend ?dividend&:(integerp ?dividend))
(not (divisor ?))
=>
(printout t "Divisor? ")
(assert (divisor (read))))
CLIPS>
(defrule bad-response
(or ?f <- (dividend ?d)
?f <- (divisor ?d))
(test (not (integerp ?d)))
=>
(retract ?f))
CLIPS>
(defrule is-divisible
(dividend ?dividend&:(integerp ?dividend))
(divisor ?divisor&:(integerp ?divisor))
=>
(printout t "Dividend " ?dividend " is"
(if (= (mod ?dividend ?divisor) 0)
then " "
else " not ")
"divisible by " ?divisor crlf))
CLIPS> (reset)
CLIPS> (run)
Dividend? 17
Divisor? 3
Dividend 17 is not divisible by 3
CLIPS> (reset)
CLIPS> (run)
Dividend? 886782
Divisor? 13
Dividend 886782 is divisible by 13
CLIPS>

Output specific facts by increasing order of a certain value in CLIPS

I have the following list of facts :
f-0 (initial-fact)
f-1 (fact 1 [input_1] 21)
f-2 (fact 1 [input_2] 28)
f-3 (fact 1 [input_3] 10)
f-4 (fact 1 [input_4] 25)
f-5 (fact 1 Normal Operation!)
f-6 (fact 2 [input_1] 7)
f-7 (fact 2 [input_2] 25)
f-8 (fact 2 [input_3] 13)
f-9 (fact 2 [input_4] 15)
f-10 (fact 2 adder a1 error!)
f-11 (fact 3 [input_1] 11)
f-12 (fact 3 [input_2] 17)
f-13 (fact 3 [input_3] 24)
f-14 (fact 3 [input_4] 31)
f-15 (fact 3 multiplier p1 error!)
Is there a way to somehow choose and print from all these facts the ones that contain only the number and the type of error? For example I want to print in increasing order:
1 Normal Operation!
2 adder a1 error!
3 multiplier p1 error!
Note that I actually have more facts and the order that they are in the fact list is not in increasing order as I have shown. So I have to somehow make it increasing.
CLIPS (6.31 2/3/18)
CLIPS>
(deffacts initial
(fact 1 [input_1] 21)
(fact 1 [input_2] 28)
(fact 1 [input_3] 10)
(fact 1 [input_4] 25)
(fact 1 Normal Operation!)
(fact 2 [input_1] 7)
(fact 2 [input_2] 25)
(fact 2 [input_3] 13)
(fact 2 [input_4] 15)
(fact 2 adder a1 error!)
(fact 3 [input_1] 11)
(fact 3 [input_2] 17)
(fact 3 [input_3] 24)
(fact 3 [input_4] 31)
(fact 3 multiplier p1 error!))
CLIPS>
(deffunction compare-1st (?f1 ?f2)
(> (nth$ 1 (fact-slot-value ?f1 implied))
(nth$ 1 (fact-slot-value ?f2 implied))))
CLIPS>
(defrule print
=>
(bind ?facts
(find-all-facts ((?f fact))
(not (instance-namep (nth$ 2 ?f:implied)))))
(bind ?facts (sort compare-1st ?facts))
(foreach ?f ?facts
(bind ?data (fact-slot-value ?f implied))
(printout t (implode$ (first$ ?data)) " "
(implode$ (rest$ ?data)) crlf)))
CLIPS> (reset)
CLIPS> (run)
1 Normal Operation!
2 adder a1 error!
3 multiplier p1 error!
CLIPS>

Loop in rule to create facts in CLIPS

I have the following facts:
(deffacts Cars
(color red)
(color green)
(color yellow)
(doors three)
(doors five)
)
Is is possible to create defrule to loop through the facts to create new facts like (car red three), (car red five), (car green three), (...), for all the possible combinations of color and doors?
Thanks
CLIPS>
(deffacts Cars
(color red)
(color green)
(color yellow)
(doors three)
(doors five))
CLIPS>
(defrule combinations
(color ?color)
(doors ?doors)
=>
(assert (car ?color ?doors)))
CLIPS> (reset)
CLIPS> (run)
CLIPS> (facts)
f-0 (initial-fact)
f-1 (color red)
f-2 (color green)
f-3 (color yellow)
f-4 (doors three)
f-5 (doors five)
f-6 (car red five)
f-7 (car green five)
f-8 (car yellow five)
f-9 (car red three)
f-10 (car green three)
f-11 (car yellow three)
For a total of 12 facts.
CLIPS>

Sum of two value of two array LISP

I have two vector array :
t1 (vector 1 2 3)
t2 (vector 1 2 3 6 4)
I just want sum the value of t1 with t2
The result is like this :
t2 (2 4 6 6 4)
First i try this code :
(defun addition-v2 (t1 t2)
(if(< (length t1) (length t2))
(do ((x 0 (+ 1 x)))
((>= x (length t1)) t2)
(setf (aref t2 x) (+ (aref t1 x) (aref t2 x))))))
Like you imagine the result is
#(2 4 6 6 4)
Ok fine, but how can i do if length of t1 > length of t2
Since you destructively update t2, you can use MAP-INTO.
(defun addition-v2 (t1 t2)
(when (> (length t1) (length t2))
(rotatef t1 t2))
(map-into t2 #'+ t1 t2))
If you want to use the bottom-up & functional approach to this, here's how it would look:
(defun ensure-length (vec len)
(let ((vec-len (length vec)))
(if (< vec-len len)
(let ((result (make-array len
:initial-element 0)))
(dotimes (i vec-len)
(setf (elt result i)
(aref vec i)))
result)
vec)))
(defun ensure-lengths (vec1 vec2)
(values (ensure-length vec1 (length vec2))
(ensure-length vec2 (length vec1))))
(defun ensured-vector-add (vec1 vec2)
(multiple-value-bind (v1 v2)
(ensure-lengths vec1 vec2)
(map 'vector #'+ v1 v2)))
(defun ensured-vector-+ (&rest vs)
(reduce #'ensured-vector-add vs
:initial-value #()))
Then you can just call (ensured-vector-+ t1 t2) or however many vectors you have.
Finally found the problem with the size of t1 or t2, in this line :
((>= x (length c)) t2)
(>= x (length c) need to be < length c so I use function min.
Maybe there is other solution, but this one works !
(defun addition-v2 (t1 t2)
(if(< (length t1) (length t2))
(setq c t2)
(setq c t1))
(do ((x 0 (+ 1 x)))
((>= x (min (length t1) (length t2))) c)
(setf (aref t2 x) (+ (aref t1 x) (aref t2 x))))))

Resources