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>
Related
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>
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>
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>
I'm new to lisp and I'm trying to trade two elements in an array. I would like to know if there is a function to get a specified position so I can use rotatef to swap them.
I've tried the function position but it doesn't work on arrays since it isn't a sequence.
What is the best computational solution in case there isn't a built in function for array?
I've searched around and can't seem to find a simple solution. Is row-major-aref the solution?
Basically, i want to find the position of an element in the 2 dimensional array and return the position to be used in rotatef
You can make a one-dimensional displaced array and use that as a vector for position.
Example:
CL-USER 9 > (let ((a0 (make-array '(2 3)
:initial-contents '((foo1 bar foo2)
(foo3 baz foo4)))))
(let ((a1 (make-array (reduce #'+ (array-dimensions a0))
:displaced-to a0)))
(let ((pos1 (position 'baz a1))
(pos2 (position 'bar a1)))
(when (and pos1 pos2)
(rotatef (aref a1 pos1)
(aref a1 pos2)))))
a0)
#2A((FOO1 BAZ FOO2) (FOO3 BAR FOO4))
I think it should work - arrays are indeed sequences.
(let* ((an-array (make-array 6 :initial-contents '(#\f #\o #\o #\b #\a #\r)))
(f-pos (position #\f an-array))
(r-pos (position #\r an-array)))
(rotatef (elt an-array f-pos)
(elt an-array r-pos))
an-array)
;=> #(#\r #\o #\o #\b #\a #\f)
Of course, you don't need to bind the positions to names. This will work too:
(let ((an-array (make-array 6 :initial-contents '(#\f #\o #\o #\b #\a #\r))))
(rotatef (elt an-array (position #\f an-array))
(elt an-array (position #\r an-array)))
an-array)
;=> #(#\r #\o #\o #\b #\a #\f)
If the problem is with position not finding the element you need, its :test argument may be helpful. There are also position-if and position-if-not functions which let you supply your own predicate for identifying the element. All three are described here in the HyperSpec.
Here's an example that probably won't work without the :test argument, since the default (which is eql for all sequence functions with :test arguments - see table 11-2 here for a nice summary of the standard sequence function keyword arguments) doesn't work on lists.
(let ((an-array (make-array 3 :initial-contents '((1 2 3)
(4 5 6)
(7 8 9)))))
(rotatef (elt an-array (position '(1 2 3) an-array :test #'equal))
(elt an-array (position '(7 8 9) an-array :test #'equal)))
an-array)
;=> ((7 8 9) (4 5 6) (1 2 3))
(Tested on SBCL 1.0.55.0.debian).
Added:
Here's a brute force way to do it with a two-dimensional array. find-position assumes the array is of size (3 3) but it would be easy to make it somewhat more general.
I don't advocate this as the best solution, but I didn't want to leave you empty handed after misunderstanding your question :)
(defvar an-array #2A((1 2 3) (4 5 6) (7 8 9)))
(defun find-position (array item &key (test #'eql))
(loop for i below 3 do
(loop for j below 3 do
(when (funcall test (aref array i j) item)
(return-from find-position (list i j))))))
(defun swap-4-and-7 (array)
;; Example use
(destructuring-bind (i1 j1) (find-position array 4)
(destructuring-bind (i2 j2) (find-position array 7)
(rotatef (aref array i1 j1)
(aref array i2 j2))))
array)
(swap-4-and-7 an-array)
;=> #2A((1 2 3) (7 5 6) (4 8 9))
How do we convert elegantly between arbitrarily nested lists and arrays?
e.g.
((1 2 3) (4 5 6))
becomes
#2A((1 2 3) (4 5 6))
and vice versa
List to 2d array:
(defun list-to-2d-array (list)
(make-array (list (length list)
(length (first list)))
:initial-contents list))
2d array to list:
(defun 2d-array-to-list (array)
(loop for i below (array-dimension array 0)
collect (loop for j below (array-dimension array 1)
collect (aref array i j))))
The multi-dimensional form for list to 2d is easy.
(defun list-dimensions (list depth)
(loop repeat depth
collect (length list)
do (setf list (car list))))
(defun list-to-array (list depth)
(make-array (list-dimensions list depth)
:initial-contents list))
The array to list is more complicated.
Maybe something like this:
(defun array-to-list (array)
(let* ((dimensions (array-dimensions array))
(depth (1- (length dimensions)))
(indices (make-list (1+ depth) :initial-element 0)))
(labels ((recurse (n)
(loop for j below (nth n dimensions)
do (setf (nth n indices) j)
collect (if (= n depth)
(apply #'aref array indices)
(recurse (1+ n))))))
(recurse 0))))
Another 2d array to list solution:
(defun 2d-array-to-list (array)
(map 'list #'identity array))
And list to 2d array (But maybe not as efficient as the solution of the last reply):
(defun list-to-2d-array (list)
(map 'array #'identity list))
Use coerce: Coerce the Object to an object of type Output-Type-Spec.
(coerce '(1 2 3) 'vector) => #(1 2 3)
(coerce #(1 2 3) 'list) => '(1 2 3)