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

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>

Related

cannot modify specific element in array of objects

(defclass schedule ()
((day :accessor schedule-day :initarg :day)))
(setf october
(make-array '(31)
:element-type 'schedule
:initial-element
(make-instance 'schedule :day 0)))
(setq searcher (read))
(setf (schedule-day (aref october (- searcher 1))) searcher)
(dotimes (i 31)
(format t "-month:10 day:~S~%" (schedule-day (aref october i))))
This is part of my october scheduling program.
This part should get the day I typed and change that day's day element, and print every october schedule.
however,
(setq searcher (read))
(setf (schedule-day (aref october (- searcher 1))) searcher)
I have trouble in this. if I type 17, then only 17th day of october should affected and printed like this,
-month:10 day:0
-month:10 day:0
...
-month:10 day:17
-month:10 day:0
...
but what I really got is
-month:10 day:17
-month:10 day:17
-month:10 day:17
...
why I can't change only one element? I managed to do this in c++ like,
october[searcher - 1].setDay(searcher);
It seems setf affects the class itself, not class object. can you help me? Thanks.
Your problem is that your array contains 31 pointers, each pointing to the same object.
Thus (setf (schedule-day (aref october a)) b) modifies that unique object.
You can achieve what you want by either encapsulating october so that the ith element is created only as necessary, or by initializing the array with something like
(apply #'vector (loop repeat 31 collect (make-instance 'schedule)))
or
(make-array 31 :initial-contents (loop repeat 31 collect (make-instance 'schedule)))
The root cause of your confusion is that you specified the array element-type and assumed that you created a "specialized" array.
Thus, despite the fact that you actually call (make-instance 'schedule) just once, you will have 31 objects in contiguous memory.
However, your implementation is not obligated to honor the
element-type specification in that way (it will create an array which
can hold the objects of the type you specified, but not necessarily
only those objects),
and what you actually got is a simple-vector.
PS. You should
use defvar or defparameter
instead of setq
or setf to define global
variables (like october), and you should name them
using
"earmuffs",
like *october*.
You can easily see that the array elements are pointing to just one CLOS object.
CL-USER 28 > (defclass foo () ())
#<STANDARD-CLASS FOO 4020002613>
CL-USER 29 > (make-array 3 :initial-element (make-instance 'foo))
#(#<FOO 402000AE9B> #<FOO 402000AE9B> #<FOO 402000AE9B>)
All objects have the same ID 402000AE9B.
In the next example the objects are different:
CL-USER 30 > (make-array 3 :initial-contents (list (make-instance 'foo)
(make-instance 'foo)
(make-instance 'foo)))
#(#<FOO 4020000B43> #<FOO 4020000B63> #<FOO 4020000B83>)
All have different IDs.

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

Increment and return number based on user input

So I have a vector of questions and want to increment and return a number based on the user's input. It's giving me trouble and I figure it's because of a lack of understanding of Clojure and it's ideals. Here is as close as I've gotten, but all I get returned is 0.
(defn print-questions [questions]
(let [number 0]
(doseq [question questions]
(println question)
(let [x (read-line)]
(if (= (.toLowerCase x) "y")
(inc number)
(println "No"))))
number))
Clojure does not use variables as you encounter in imperative languages so statements like (inc x) return a new value one higher than x, while leaving x alone rather than changing x in place.
As written this code means:
(defn print-questions [questions]
(let [number 0]
;; start with zero every time
;; don't carry any information forward between iterations of the loop
(doseq [question questions]
(println question)
(let [x (read-line)]
(if (= (.toLowerCase x) "y")
(inc number) ;; this DOES NOT change the value in number
(println "No"))))
number)) ;; when you are all done, return the original value of number
This is great for cases where many threads are working on the same data, though it does lead to a somewhat different way of looking at things.
One way to write something very similar would be to loop through the questions while passing the current value of number from each iteration to the next like so:
user=> (defn print-questions [questions]
#_=> (loop [number 0 remaining-questions questions]
#_=> (println remaining-questions)
#_=> (if (seq remaining-questions)
#_=> (let [x (read-line)]
#_=> (if (= x "y")
#_=> (do (println "yes")
#_=> (recur (inc number) (rest remaining-questions)))
#_=> (do (println "No")
#_=> (recur number (rest remaining-questions)))))
#_=> number)))
#'user/print-questions
user=> (print-questions ["who" "what" "when" "why"])
[who what when why]
y
yes
(what when why)
y
yes
(when why)
n
No
(why)
y
yes
()
3
which works, though it's a bit verbose. If instead we look at this as reducing a collection of questions into a number where each reduction stage adds either one of zero to the outcome it's a bit more compact:
user=> (defn print-questions [questions]
#_=> (reduce (fn [answer question]
#_=> (println question)
#_=> (if (= "y" (read-line))
#_=> (inc answer)
#_=> answer))
#_=> 0
#_=> questions))
#'user/print-questions
user=> (print-questions ["who" "what" "when" "why"])
who
y
what
n
when
y
why
y
3
reduce takes a function to do the actual work, a value to start with, and a list of inmputs. It then uses that function with the first value to create the new result, then uses the function with the second value to produce a new result and the third and so on until every value in the input has had a chance to affect the final result.

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>

Number equality test fails in CLIPS pattern matching?

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>

Resources