Number equality test fails in CLIPS pattern matching? - artificial-intelligence

I have this following rule in my CLIPS file:
(defrule check-final (declare (salience 12))
?scnt <- (set-count (value ?v) (class ?c))
(test (= ?v ?*total*))
=>
(printout T ?*total* " == " ?v crlf)
)
And I get the following strange output:
CLIPS>(run)
14 == 9
5 == 2
How is this possible ????

Pattern matching for this rule occurs whenever the fact set-count is asserted or modified. The rule is fired some time afterwards, during the call to run. These two processes can be widely separated in time. The value of ?*v* can of course change during that long period of time.
The key is to realize that he printed results will reflect the value of ?v from the the epoch during which pattern matching happened, while ?*total* will be the value when the results are printed. Since ?*total* may have seen arbitrary changes since the pattern matching, there's no guarantee that it will be equal to ?v when the rule actually fires.

Found part of the problem: I'm using the global ?*total* and according to the
CLIPS Manual
Global variables can be accessed as part of the pattern‑matching
process, but changing them does not invoke the pattern‑matching
process.
But this does not explain the equality test failure

The most likely explanation is that at some point the equality test is being satisfied and then the value of the global is changed before the rule executes.
CLIPS> (deftemplate set-count (slot value) (slot class))
CLIPS>
(defglobal ?*total* = 0)
CLIPS>
(defrule check-final (declare (salience 12))
?scnt <- (set-count (value ?v) (class ?c))
(test (= ?v ?*total*))
=>
(printout T ?*total* " == " ?v crlf)
)
CLIPS> (bind ?*total* 9)
9
CLIPS> (assert (set-count (value 9) (class a)))
<Fact-1>
CLIPS> (bind ?*total* 14)
14
CLIPS> (run)
14 == 9
CLIPS> (bind ?*total* 2)
2
CLIPS> (assert (set-count (value 2) (class b)))
<Fact-2>
CLIPS> (bind ?*total* 5)
5
CLIPS> (run)
5 == 2
CLIPS>

Related

How to translate the C language loop (do ... while) in CLIPS?

Suppose following portion of code in C:
void function(int n,int x)
{
int i,j;
int max=5;
int p[max]; // for example: p[max]={{100,1,100,3,10}};
...
...
for(i=0; i<n; i++)
if(i!=x)
{
j=i;
do
{
j=p[j];
}
while(j!=x);
}
...
}
I try following in CLIPS, but the condition in while loop is evaluated before [do] execution, which is not the case in the portion of C language code above where [do] is executed befor while loop:
(deftemplate q
(slot line (type INTEGER)(default 1))
(slot column (type INTEGER))
(slot value (type INTEGER))
)
(deffacts Data ; for example
(q (line 1)(column 1)(value 100))
(q (line 1)(column 2)(value 1))
(q (line 1)(column 3)(value 100))
(q (line 1)(column 4)(value 3))
(q (line 1)(column 5)(value 10))
)
(deffunction function (?n ?x)
(loop-for-count (?i 1 ?n)
(if (!= ?i ?x)
then
(bind ?j ?i)
(while (!= ?j ?x) do
(do-for-all-facts ((?q q))
(and
(= (fact-slot-value ?q line) 1)
(= (fact-slot-value ?q column) ?j)
)
(bind ?j (fact-slot-value ?q value))
)
)
)
)
)
Question: Is it a correct code ? Any help will be welcome. Thanks in advance.
Do ... while is not directly supported, but you can put a break statement at the end of the while body to implement that functionality:
(deffunction function (?n ?x)
(loop-for-count (?i 1 ?n)
(if (!= ?i ?x)
then
(bind ?j ?i)
(while TRUE do
(do-for-all-facts ((?q q))
(and
(= (fact-slot-value ?q line) 1)
(= (fact-slot-value ?q column) ?j)
)
(bind ?j (fact-slot-value ?q value))
)
(if (!= ?j ?x) then (break))
)
)
)
)
Ok general dumb overpowered solution: define a macro kind of like this (pseudocode I never quite got the hang of lisp syntax)
(defmacro do-while (#test #body) (
(body)
(while (!= ?j ?x) do (body))
))
I think you can even skip the middle man and embed the loop directly into the recursive expansion but I simply don't know enough to force it to tail-recurse.

Is there a way to make a controlled loop in CLIPS?

Hello there Stack overflow community, I'm turning to you for help. I'm trying to do something in CLIPS, sort of like a parser and I'm having a bit of trouble. To summarize, I'm trying to make a program that takes the user's input, which is a phrase such as "I read a book" and give an output based on some rules I have defined, let's say "I read" is identified by rule G1, and "a book" is identified by rule G2 ("A book" can be identified by rule G3 should we need to process input "A book I read").
The output for "I read a book" should be "YES G1 G2" because based on the user input and rules the program identified the rules used in order to identify what was written in the input provided by the user. I hope I explained that pretty well, it's basically my first question here. So far I have managed to create the rules and I accounted for situations where the string could be placed at the beginning of the input (see G3 rule mentioned above).
Maybe this can be solved using explode$ and wildcards like $? but I'm really not sure how to start.
This is my code so far, I know it's not very much:
(defrule G1
=>
(assert (regula G1 "I read"))
)
(defrule G2
=>
(assert (regula G2 "I read."))
)
(defrule G3
=>
(assert (regula G3 "a book."))
)
(defrule G4
=>
(assert (regula G4 "A book"))
)
I appreciate all help and all answers.
You problem statement doesn't exactly match the code you've generated so far ("a book" is not identified by rule G2). Also, you can use a deffacts statement in place of rules that unconditionally assert facts.
Here's one way to solve the problem:
CLIPS (6.31 6/12/19)
CLIPS>
(deffacts regulas
(regula G1 I read)
(regula G2 I read.)
(regula G3 a book.)
(regula G4 A book))
CLIPS>
(deftemplate translation
(multislot text)
(multislot tokens)
(multislot output)
(slot complete (default NO)))
CLIPS>
(defrule get-input
=>
(printout t "Input: ")
(bind ?text (readline))
(assert (translation (text ?text)
(tokens (explode$ ?text)))))
CLIPS>
(defrule parse
?t <- (translation (tokens $?tokens $?rest)
(output $?output))
(regula ?replacement $?tokens)
=>
(modify ?t (tokens $?rest)
(output $?output ?replacement)))
CLIPS>
(defrule success
?t <- (translation (tokens)
(complete NO))
=>
(modify ?t (complete YES)))
CLIPS>
(defrule print-results
(declare (salience -10))
?t <- (translation (complete ?complete)
(tokens $?tokens)
(output $?output))
=>
(printout t ?complete " " (implode$ (create$ ?output ?tokens)) crlf))
CLIPS> (reset)
CLIPS> (run)
Input: I read a book.
YES G1 G3
CLIPS> (reset)
CLIPS> (run)
Input: A book I read.
YES G4 G2
CLIPS> (reset)
CLIPS> (run)
Input: A book you read.
NO G4 you read.
CLIPS> (reset)
CLIPS> (run)
Input: You read a book.
NO You read a book.
CLIPS>

Common Lisp vector printing: Vector axis is not zero: 1

This is the first time I have ever seen this compiler error does anyone know what it is? and why my function can't print my nested vectors.
(defvar *col-lookup* #.(let ((ht (make-hash-table)))
(loop for (key . value) in
'(
(A . 0) (B . 1) (C . 2)
(D . 3) (E . 4) (F . 5) (G . 6))
do (setf (gethash key ht) value))
ht))
;; vector of vectors
(defparameter *game-board*
(make-array 7 :initial-element (make-array 0 :initial-element 0)))
;;make move lookup character in table then push X onto vector of value of key
(defun move (c)
(let ((place (gethash c *col-lookup*)))
(cond ((oddp *turn-count*)
(push "X" (aref *game-board* place))
(incf *turn-count*))
((push "O" (aref *game-board* place))
(incf *turn-count*)))))
You are creating a very peculiar vector of vectors with the code:
(make-array 7 :initial-element (make-array 0 :initial-element 0)))
This code will create a vector of 7 elements, each of them a vector with 0 elements (i.e. an empty vector) (and note that giving the initial-element to 0 is useless because there are no elements to assign). If you print it you should see:
#(#() #() #() #() #() #() #())
which means exactly this, a vector with seven empty vectors. So if you try to access the internal vector with something like (aref (aref *game-board*) 1) 2) you get an error.
Finally note that in the code of the function move you use:
(push "X" (aref *game-board* place))
whose effect is not of modifying the internal vector at place place, but of replace the old value of (aref *game-board* place) with a cons of the string "X" and the old value of (aref *game-board* place), the empty vector.
I was able to print my vector of vectors by simply looping over it once. I still do not know what that error was but I haven't ran into it since.
(defun print-game ()
(loop for i from 0 to 6 do
(print (aref *game-board* i))))

CLIP: how to find out if a fact exists

I am pretty new in expert programming and stuck with a problem.
I want to find out if a fact exists and then do some operation based on those facts in RHS.
For Eg:- I have 4 facts.
(deffacts test (A 1) (B 2) (C 3) (D 4))
in following Rule fact E does not exist. so it Never goes to RHS. and dose not fire the rule.
(defrule rul1
(declare (salience 10))
(A ?var1)
(B ?var2)
(C ?var3)
(E ?var4)
=>
(if
(
or (or (or (= ?var1 1) (= ?var2 1)) (= ?var3 1)) (= ?var4 4)
)
then
(printout t "Rule matched" crlf))
)
)
My requirement is if a fact doesn't exist simply ignore that or assign a dummy value so that it can fire Rule.
How can I achieve this?
Try placing the matching logic in the conditions of the rule rather than the actions:
CLIPS>
(deffacts test (A 1) (B 2) (C 3) (D 4))
CLIPS>
(defrule rul1
(declare (salience 10))
(or (A 1)
(B 1)
(C 1)
(E 4))
=>
(printout t "Rule matched" crlf))
CLIPS> (reset)
CLIPS> (agenda)
10 rul1: f-1
For a total of 1 activation.
CLIPS>

Variadic Functions in Scheme (using nested maps)

I have to define a variadic function in Scheme that takes the following form: (define (n-loop procedure [a list of pairs (x,y)]) where the list of pairs can be any length.
Each pair specifies a lower (inclusive) and upper bound (exclusive). That is, the following function call: (n-loop (lambda (x y) (inspect (list x y))) (0 2) (0 3)) produces:
(list x y) is (0 0)
(list x y) is (0 1)
(list x y) is (0 2)
(list x y) is (1 0)
(list x y) is (1 1)
(list x y) is (1 2)
Now, I had posted on this topic one previous time and was helped wonderfully. However, I have been given new guidelines to adhere to. The solution is to be found using nested maps only.
The way I've been going about this is as follows: find all of the values specified by the first set of bounds (in the example, (0 1 2)). This can be done by a function called (enumerate lowBound highBound). Then, I need to take each of those numbers, and cons each number in the next set of bounds (0 1 2 3), resulting in ((0 0) (0 1) (0 2) (0 3) (1 0)...).
What I've written to this point is the following:
(define (n-loop op . pairs)
(apply op (generate pairs))
)
(define (generate pairs)
(map (lambda (x) (cons x (generate (cdr pairs))))
(map (lambda (x) (enumerate (car x) (cadr x))) pairs))
)
But for the given numbers, this outputs (0 1 0 1 2 0 1 2 0 1 2) when I need ((0 0) (0 1) (0 2) (0 3) (1 0)...). This is a nasty problem. Does anyone have any insight?
This problem is more complex than you seem to realize. In particular, generating the cartesian product of an arbitrary list of ranges needs far more work - have you tried your procedure with more than two ranges? It piqued my interest, this time I'll give my shot to a complete solution, using only procedures defined for the solution, simple operations over lists (cons, car, cdr, append), lambda, apply and map.
First, the helper procedures from simplest to hardest. We need a way to generate a range of numbers. If available, use build-list or for-list, but if you need to implement it from scratch:
(define (enumerate low high)
(if (>= low high)
'()
(cons low
(enumerate (add1 low) high))))
Now we need a mechanism for folding (reducing, accumulating) the values in a list. If available use foldr, otherwise implement it like this:
(define (reduce proc lst init)
(if (null? lst)
init
(proc (car lst)
(reduce proc (cdr lst) init))))
To avoid unnecessary nesting in lists, use a flatmap - a procedure that both maps and flattens a list of values:
(define (flatmap proc lst)
(reduce (lambda (e acc)
(append (proc e) acc))
lst '()))
This is the core of the solution - a procedure that generates the cartesian product of an arbitrarily long list of lists of values denoting ranges:
(define (product . args)
(reduce (lambda (pool result)
(flatmap (lambda (x)
(map (lambda (y)
(cons x y))
result))
pool))
args
'(())))
Finally, the procedure in the question. It uses the helper procedures defined above, noticing that the op received can have an arbitrary number of parameters (depending on the number of ranges specified), so we need to use apply on each generated tuple of values:
(define (n-loop op . pairs)
(map (lambda (tuple) (apply op tuple))
(apply product
(map (lambda (pair)
(enumerate (car pair) (cadr pair)))
pairs))))
Test it like this:
(n-loop (lambda (x y z) (list x y z))
'(0 2) '(0 3) '(4 6))
> '((0 0 4) (0 0 5) (0 1 4) (0 1 5) (0 2 4) (0 2 5)
(1 0 4) (1 0 5) (1 1 4) (1 1 5) (1 2 4) (1 2 5))

Resources