(deftemplate bikelife
(slot name)
(slot type))
(deffacts bike
(bikelife (name Strida) (type low_lifestyle))
(bikelife (name Brompton) (type med_lifestyle))
(bikelife (name Molton) (type high_lifestyle))
(bikelife (name Specialized_AlleComp) (type low_sport))
(bikelife (name Specialized_Tarmac) (type medium_sport))
(bikelife (name Pinarello_DOGMA_F8) (type high_sport)))
(defrule rule-1
(budget ?x)
(test (< ?x 300))
(use_for lifestyle)
=>
(assert (recommend low_lifestyle)))
(defrule rule-2
(budget ?x)
(test (< ?x 300))
(use_for sport)
=>
(assert (recommend low_sport)))
(defrule rule-3
(budget ?x)
(test (and (> ?x 300) (< ?x <500)))
(use_for lifestyle)
=>
(assert (recommend med_lifestyle)))
(defrule rule-4
(budget ?x)
(test (and (> ?x 300) (< ?x <500)))
(use_for sport)
=>
(assert (recommend med_sport)))
(defrule rule-5
(budget ?x)
(test (> ?x 500))
(use_for lifestyle)
=>
(assert (recommend high_lifestyle)))
(defrule rule-6
(budget ?x)
(test (and (> ?x 300) (< ?x <500)))
(use_for sport)
=>
(assert (recommend med_sport)))
(defrule rule-7
(budget ?x)
(test (> ?x 500))
(use_for sport)
=>
(assert (recommend high_sport)))
(defrule recommend-rule
(recommend ?type)
(bikelife (name ?x) (type ?type))
=>
(printout t crlf "I recommend " ?x " for you." crlf crlf))
(defrule ask-1
=>
(printout t crlf "================================ ")
(printout t crlf " testing testing testing. ")
(printout t crlf "================================ " crlf crlf)
(printout t "* How much are you going to spend on bike? ")
(assert (budget (read)))
(printout t "* what purpose? ( lifestyle, sport )")
(assert (use_for (read))))
(reset)
(run)
This is my Jess code for recommending bikes. I don't see anything wrong in the code. I have tried hundreds of times and came to Stack Overflow to get some
help on it.
The code operates as I get budget value and evaluate it by 300, 500 and if the budget range matches I check the purpose of the bike the user is buying. After that using facts I want to send the recommendation message. How can I solve this problem?
This should more or less work except for the typos. I see a number of them, like “tyle” instead of “type”, “user_for” instead of “use_for”, and a stray “<“ before most instances of the number 500. At least the first of these three errors should be reported by Jess when you run this code.
Most of the documentation that exists is available on the Jess website, www.jessrules.com . There are a few YouTube videos if you search for them, and there’s the book “Jess in Action”; it is out of print but it’s not hard to find used copies.
Related
I am making a console Lisp survival game and I am trying to add a function where until a = b, show "." every second. Then, when a = b, set a "hurt" variable to true, and if/when that variable is true, subtract "health" by 1 until the "use-medkit" function is invoked by the user and the "hurt" variable is set false and you exit both loops.
The problem I am having is when I am prompted to use the "use-medkit" function and I type it in, it doesn't evaluate anything that I input and keeps subtracting 1 from "health". How can I call a user-inputted function while a loop is running?
Here is my code:
(setq a (random 11)) ; Random from 0 - 10
(setq b (random 11)) ; ^^^^^^^^^^^^^^^^^^
(setq hurt 0)
(setq repair 0)
(setq health 999)
(defun use-medkit ()
(setq repair 1))
(defun get-hurt ()
(loop
(progn
(setq a (random 11))
(setq b (random 11))
(progn
(princ ".")
(sleep 1)))
(if (eq a b) (progn
(setq hurt 1)
(when (eq hurt 1) (progn
(format t "~%You are hurt!~%You will lose 1 hp every 10 seconds~%~%Type use-medkit to stop the bleeding~%")
(loop
(progn
(- 1 health)
(sleep 10))
;(format t "health: ~A~%" health)
(when (eq repair 1) (progn
(return "You stopped the bleeding") (setq hurt 0) (setq repair 0))))))))))
So a program can’t do two things at once. In particular if you’re busy printing dots, sleeping and subtracting 1 from 999 then you won’t pause to see if there’s another command coming.
Unfortunately solving this problem is hard. The nicest solution in a terminal would probably use something like ncurses. Additionally there is no standard way to control input buffering. In lieu of that, here is a simple way you can do a bit of concurrency and some prompts. You might want to use a proper async library instead.
(defun maybe-read (input-stream recording-stream)
(when (listen input-stream)
(let ((char (read-char input-stream)))
(if (char= char #\Newline)
t
(progn (write-char char recording-stream) (maybe-read))))))
(defun make-partial-reader (input-stream)
(list input-stream (make-string-output-stream)))
(defun partial-read (reader)
(when (apply #'maybe-read reader)
(get-output-stream-string (second reader))))
(defun how-long-until (time)
(let ((gap
(/ (- time (get-internal-run-time)) internal-time-units-per-second)))
(cond ((< gap 0) (values 0 :late))
((<= gap 0.001) (values 0 :now))
(T (values (- gap 0.001) :soon)))))
(defun sleep-until (time)
(multiple-value-bind (span type)
(how-long-until time)
(when (> span 60) (warn “long wait!”)
(case type
(:late nil)
(:now t)
(:soon
(sleep span)
(unless (sleep-until time) (warn “poor timekeeping”))
t))))
(defmacro with-prompt-and-scheduler ((schedule) (line &optional (input *standard-input*)) &body handle-line-input)
(let ((reader (gensym)) (insched (gensym)))
`(let ((,reader (make-partial-reader ,input) (,insched)))
(flet ((,schedule (in fun &aux (at (+ (get-internal-run-time) (* in internal-time-units-per-second))))
(if (null ,insched) (push (cons at fun) schedule)
(loop for s on ,insched
for ((at2) . y) = s
if (< at at2)
do (psetf (car s) (cons at fun)
(cdr s) (cons (car s) (cdr s)))
(finish-loop)
unless y do (setf (cdr s) (acons at fun nil)) (finish-loop)))))
(loop
(if ,insched
(let ((,insched (pop ,insched)))
(when (sleep-until (car ,insched))
(let ((,line (partial-read ,reader)))
(when ,line ,#handle-line-input)))
(funcall (cdr ,insched)))
(let ((,line (concatenate 'string (get-output-stream-string (second ,reader)) (read-line (first ,reader)))))
,#handle-line))))))))
And then you could use it like:
(let ((count 0))
(with-prompt-and-scheduler (schedule) (line)
(let ((n (read-from-string line)))
(when (realp n)
(schedule n (let ((x (incf count))) (lambda () (format t "Ding ~a ~a~%" x count) (finish-output))))))))
And after running that input 10, then on the next line 5. If you do that quickly you’ll get:
Ding 2 2
Ding 1 2
With the first line appearing after 5 seconds and the second after 10. If you are slow you should get:
Ding 1 1
Ding 2 2
With the first line coming 10 seconds after you enter 10 and the second line coming 5 seconds after you enter 5.
Hopefully this can give you an idea of how to make a program seem to do two things at once.
I am trying to fire these two rules but i am getting the same output for both the rules.
This is the output i am getting for both.
(defrule old-male
?gender <- (gender m)
?age <- (age ?age&:(> ?age 35))
=>
(printout t "Person is male & older. This Person must go after older females!" crlf)
(retract ?gender)
(retract ?age)
(ask-start-again))
(defrule young-male
?gender <- (gender m)
?age <- (age ?age&:(< ?age 35))
=>
(printout t "Person is male & younger. This Person must go after younger females!" crlf)
(retract ?gender)
(retract ?age)
(ask-start-again))
(reset)
(run)
Please advice what i need to do to fix this.
And also is there a way to store the inputs that are given (gender, age and name) and compare them with another person.?
Thank you!
I have added the rule you advised and also another rule for the list.
(defrule print-solution
=>
(printout t "Name Age Gender" crlf)
(printout t "--------------------------------------" crlf))
I have no errors but the (print-all-persons)rule is not getting executed. Did I miss anything? Kindly advice.
This is the new output I am getting
You are using the same name in the binding to the entire fact (?age <- ...) and the first item of the ordered fact ((age ?age&:...). Just use another name for the latter.
(defrule old-male
?gender <- (gender m)
?age <- (age ?a&:(> ?a 35))
=>
...
For storing age and gender of several persons at the same time a template such as the following can be used. A name is added so that there is a distinction when two üersons of the same gender and age are inserted.
(deftemplate person (slot gender)
(slot age (type INTEGER))
(slot name))
Edit
Q1 from comment: A template (as the name implies) is just a "blueprint" for facts, and you can assert as many as you like.
Q2 from comment: If you add a rule like the following it'll print all Person facts at the end of the show. Note the low salience - if you omit it, the printout happens as soon as the fact is asserted.
(defrule print-all-persons
(declare (salience -1000))
(person (name ?name)(gender ?gender)(age ?age))
=>
(printout t ?name " is a " ?age "-year old "
(if (eq ?gender f) then "fe" else "") "male" crlf)
)
I am trying to execute a JESS .clp file on a button click using Rete.batch() in Java. The .clp im trying to execute is similar to the Computer repair assistant example in Jess examples- with the GUI. When im executing the file inside the ActionListener of the button, I get the frame but with a blank window. However if I execute the file in main without putting it inside ActionListeners the .clp runs fine (frame appears with content). Any help is appreciated. Thanks.
Code for the Button Action Listener:
JButton btnEnterNew = new JButton("Take Test!");
btnEnterNew.setBounds(312, 439, 250, 30);
contentPane.add(btnEnterNew);
btnEnterNew.addActionListener(new ActionListener() {
public void actionPerformed(ActionEvent arg0) {
Rete ret = new Rete();
try {
ret.batch("computer.clp");
} catch (JessException e) {
e.printStackTrace();
}
}
});
Code for Computer.clp :-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Graphical version of PC Diagnostic Assistant from part 4 of
;; "Jess in Action"
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Import some commonly-used classes
(import javax.swing.*)
(import java.awt.*)
(import java.awt.event.*)
;; Don't clear defglobals on (reset)
(set-reset-globals FALSE)
(defglobal ?*crlf* = "
")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Question and answer templates
(deftemplate question
(slot text)
(slot type)
(multislot valid)
(slot ident))
(deftemplate answer
(slot ident)
(slot text))
(do-backward-chaining answer)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Module trigger
(defmodule trigger)
(defrule trigger::supply-answers
(declare (auto-focus TRUE))
(MAIN::need-answer (ident ?id))
(not (MAIN::answer (ident ?id)))
(not (MAIN::ask ?))
=>
(assert (MAIN::ask ?id))
(return))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; power rules
(defrule MAIN::not-plugged-in
(declare (auto-focus TRUE))
(answer (ident sound) (text no))
(answer (ident plugged-in) (text no))
=>
(recommend-action "plug in the computer")
(halt))
(defrule MAIN::power-supply-broken
(declare (auto-focus TRUE))
(answer (ident sound) (text no))
(answer (ident plugged-in) (text yes))
=>
(recommend-action "repair or replace power supply")
(halt))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; sound rules
(defrule MAIN::check-ram
(declare (auto-focus TRUE))
(answer (ident sound) (text yes))
(answer (ident seek) (text no))
(answer (ident does-beep) (text yes))
(answer (ident how-many-beeps) (text ?t))
(test (< (integer ?t) 3))
=>
(assert (check loose-ram))
(recommend-action "check for loose RAM, then continue"))
(defrule MAIN::unknown-sound
(declare (auto-focus TRUE))
(answer (ident sound) (text yes))
(answer (ident seek) (text no))
(answer (ident does-beep) (text no))
=>
(recommend-action "consult a human expert")
(halt))
(defrule MAIN::motherboard-or-keyboard
(declare (auto-focus TRUE))
(answer (ident sound) (text yes))
(answer (ident seek) (text no))
(answer (ident does-beep) (text yes))
(answer (ident how-many-beeps) (text ?t))
(test (>= (integer ?t) 3))
=>
(recommend-action "check keyboard and motherboard")
(halt))
(defrule MAIN::no-boot-start
(declare (auto-focus TRUE))
(answer (ident sound) (text yes))
(answer (ident seek) (text yes))
(answer (ident boot-begins) (text no))
=>
(recommend-action "check keyboard, RAM, motherboard, and power supply")
(halt))
(defrule MAIN::boot-start
(declare (auto-focus TRUE))
(answer (ident sound) (text yes))
(answer (ident seek) (text yes))
(answer (ident boot-begins) (text yes))
=>
(recommend-action "consult a software expert")
(halt))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; RAM rules
(defrule MAIN::loose-ram
(declare (auto-focus TRUE))
(check loose-ram)
(answer (ident loose-ram) (text yes))
=>
(recommend-action "remove and reseat memory modules")
(halt))
(defrule MAIN::faulty-ram
(declare (auto-focus TRUE))
(check loose-ram)
(answer (ident loose-ram) (text no))
=>
(recommend-action "replace memory modules one by one and retest")
(halt))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; domain rules
(defrule MAIN::right-architecture
(declare (auto-focus TRUE))
(explicit (answer (ident hardware) (text ~x86)))
=>
(recommend-action "consult a human expert")
(halt))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Results output
(deffunction recommend-action (?action)
"Give final instructions to the user"
(call JOptionPane showMessageDialog ?*frame*
(str-cat "I recommend that you " ?action)
"Recommendation"
(get-member JOptionPane INFORMATION_MESSAGE)))
(defadvice before halt (?*qfield* setText "Close window to exit"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Module ask
(defmodule ask)
(deffunction ask-user (?question ?type ?valid)
"Set up the GUI to ask a question"
(?*qfield* setText ?question)
(?*apanel* removeAll)
(if (eq ?type multi) then
(?*apanel* add ?*acombo*)
(?*apanel* add ?*acombo-ok*)
(?*acombo* removeAllItems)
(foreach ?item ?valid
(?*acombo* addItem ?item))
else
(?*apanel* add ?*afield*)
(?*apanel* add ?*afield-ok*)
(?*afield* setText ""))
(?*apanel* validate)
(?*apanel* repaint))
(deffunction is-of-type (?answer ?type ?valid)
"Check that the answer has the right form"
(if (eq ?type multi) then
(foreach ?item ?valid
(if (eq (sym-cat ?answer) (sym-cat ?item)) then
(return TRUE)))
(return FALSE))
(if (eq ?type number) then
(return (is-a-number ?answer)))
;; plain text
(return (> (str-length ?answer) 0)))
(deffunction is-a-number (?value)
(try
(integer ?value)
(return TRUE)
catch
(return FALSE)))
(defrule ask::ask-question-by-id
"Given the identifier of a question, ask it"
(declare (auto-focus TRUE))
(MAIN::question (ident ?id) (text ?text) (valid $?valid) (type ?type))
(not (MAIN::answer (ident ?id)))
(MAIN::ask ?id)
=>
(ask-user ?text ?type ?valid)
(engine))
(defrule ask::collect-user-input
"Check an answer returned from the GUI, and optionally return it"
(declare (auto-focus TRUE))
(MAIN::question (ident ?id) (text ?text) (type ?type) (valid $?valid))
(not (MAIN::answer (ident ?id)))
?user <- (user-input ?input)
?ask <- (MAIN::ask ?id)
=>
(if (is-of-type ?input ?type ?valid) then
(retract ?ask ?user)
(assert (MAIN::answer (ident ?id) (text ?input)))
(return)
else
(retract ?ask ?user)
(assert (MAIN::ask ?id))))
;; Main window
(defglobal ?*frame* = (new JFrame "Diagnostic Assistant"))
(?*frame* setDefaultCloseOperation (get-member JFrame EXIT_ON_CLOSE))
(?*frame* setSize 520 140)
(?*frame* setVisible TRUE)
;; Question field
(defglobal ?*qfield* = (new JTextArea 5 40))
(bind ?scroll (new JScrollPane ?*qfield*))
((?*frame* getContentPane) add ?scroll)
(?*qfield* setText "Please wait...")
;; Answer area
(defglobal ?*apanel* = (new JPanel))
(defglobal ?*afield* = (new JTextField 40))
(defglobal ?*afield-ok* = (new JButton OK))
(defglobal ?*acombo* = (new JComboBox (create$ "yes" "no")))
(defglobal ?*acombo-ok* = (new JButton OK))
(?*apanel* add ?*afield*)
(?*apanel* add ?*afield-ok*)
((?*frame* getContentPane) add ?*apanel* (get-member BorderLayout SOUTH))
(?*frame* validate)
(?*frame* repaint)
(deffunction read-input (?EVENT)
"An event handler for the user input field"
(assert (ask::user-input (sym-cat (?*afield* getText)))))
(bind ?handler (new jess.awt.ActionListener read-input (engine)))
(?*afield* addActionListener ?handler)
(?*afield-ok* addActionListener ?handler)
(deffunction combo-input (?EVENT)
"An event handler for the combo box"
(assert (ask::user-input (sym-cat (?*acombo* getSelectedItem)))))
(bind ?handler (new jess.awt.ActionListener combo-input (engine)))
(?*acombo-ok* addActionListener ?handler)
(deffacts MAIN::question-data
(question (ident hardware) (type multi) (valid x86 Macintosh other)
(text "What kind of hardware is it?"))
(question (ident sound) (type multi) (valid yes no)
(text "Does the computer make any sound?"))
(question (ident plugged-in) (type multi) (valid yes no)
(text "Is the computer plugged in?"))
(question (ident seek) (type multi) (valid yes no)
(text "Does the disk make \"seeking\" sounds?"))
(question (ident does-beep) (type multi) (valid yes no)
(text "Does the computer beep?"))
(question (ident how-many-beeps) (type number) (valid)
(text "How many times does it beep?"))
(question (ident loose-ram) (type multi) (valid yes no)
(text "Are any of the memory modules loose?"))
(question (ident boot-begins) (type multi) (valid yes no)
(text "Does the computer begin to boot?"))
(ask hardware))
(reset)
(run-until-halt)
Calling Rete to execute the long-running batch file freezes the graphics system - the button event handler is a callback. Detach a thread to execute the Rete method, e.g.
public void actionPerformed(ActionEvent e) {
Runnable r = new Runnable() {
public void run() {
Rete ret = new Rete();
try {
ret.batch("computer.clp");
} catch (JessException je) {
je.printStackTrace();
}
}
};
new Thread(r).start();
}
I'm trying to report the inference steps in JESS. For example, I would like to know which rules/facts caused inference engine to fire a certain rule. In order words, I want to see the theorem proving capabilities of JESS.
Here is an example from Wikipedia:
(defrule A ""
(and (X croaks) (X eats flies))
=>
(assert (X is a frog))
)
(defrule B ""
(and (X chirps) (X sings))
=>
(assert (X is a canary))
)
(defrule C ""
(X is a frog)
=>
(assert (X is green))
)
(defrule D ""
(X is a canary)
=>
(assert (X is yellow))
)
If I have the following:
(assert (X croaks))
(assert (X eats flies))
Then when I enter (run) then I will have rule C fired. It seems like, it's fired because of
(X is a frog)
but actually because of
(and (X croaks) (X eats flies))
I am not sure if I'm clear, but I wonder if there is any way that I can show why a certain rules is fired with a comlete inference process.
You'll have to write some Java code, implementing jess.JessListener. You attach an object of this class to the Rete object, using Rete.addJessListener(jess.JessListener). The event you are interesting in is JessEvent.DEFRULE_FIRED, and it'll contain a reference to the activation object, and the rule is available from that.
See the Javadoc for JessListener for some Java code.
You can attach the listener from CLP code, prior to (run).
I have this problem in Common Lisp.
I need to manipulate existential variables introducing the rule of skolemization.
For example I need to buid a function which turns
(exist ?x (p ?x)) in (p sk00042).
sk00042 is a variable. Note that this function becomes a bit harder when universal variables are involved.
For example, the function given the expression (forall ?y (exist ?x (p ?x ?y)) turns it into (forall ?y (p (sf666 ?y) ?y).
The idea is that the existencial variable tells me that there is something that satisfies the formulae. If this existential quantifier is the outer , then this quantifier does not depend on anything and the variable ?x in the first example above should be replaced with the constant skoo42 which is generated by this function :
(defun skolem-variable () (gentemp "SV-")).
If the harder (second) case takes place and there's a universal quantifier "out" of the existential one, then that something that exists depends on variables universally quantified, meaning that the function must take care of this dependence and the universal variables become incorporated in the constant, like in the example :
(forall ?y (exist ?x (p ?x ?y)) ----> (forall ?y (p (sf666 ?y) ?y)
For this also serves the function:
(defun skolem-function* (&rest args) (cons (gentemp "SF-") args))
(defun skolem-function (args) (apply #'skolem-function* args))
Here are some examples to get more familiar with the idea :
(skolemize '(forall ?y (exist ?x (p ?x ?y))))
;=> (forall ?y (P (SF-1 ?Y) ?Y))
(skolemize '(exist ?y (forall ?x (p ?x ?y))))
;=> (for all ?x (P ?X SV-2)
(skolemize '(exist ?y (and (p ?x) (f ?y))))
;=> (AND (P ?X) (F SV-4))
(skolemize '(forall ?x (exist ?y (and (p ?x) (f ?y)))))
;=> (forall ?x (AND (P ?X) (F (SF-5 ?X)))
I need to build the function (using skolem-variable and skolem-function above) that given
an expression controls if the outer is exist, then replaces the variable with skolem-variable. If the outer is a forall followed by and exist, the function does what i've explained above.
I just skimmed the Wikipedia article on the skolem normal form, but if I get it right, every existential becomes a skolem function invocation with the bound universals as arguments (or a skolem constant if no universals are in scope). One simple approach would be having a stack of bound universals while walking the expression tree recursively:
(defun skolemize (form &optional (universals nil))
(cond ((null form) nil) ; subtree done
((consp (car form)) ; walk branches
(cons (skolemize (car form) universals)
(skolemize (cdr form) universals)))
((eq (car form) 'forall) ; universal binding
(list 'forall
(cadr form)
(skolemize (caddr form) ; skolemize body
(cons (cadr form) universals)))) ; new var on the stack
((eq (car form) 'exist) ; existential binding
(subst (if universals ; substitute variables
(cons (gentemp "SF-") universals) ; with skolem function
(gentemp "SV-")) ; with skolem constant
(cadr form)
(skolemize (caddr form) universals)))
(t (cons (car form) (skolemize (cdr form) universals)))))
Note that this is just to get you started – I neither delved into this topic, nor is this really tested or optimized for performance or elegance. Also, it will accept malformed input, e.g. (skolemize '(forall (foo bar))).
Your examples:
CL-USER> (skolemize '(exist ?x (p ?x)))
(P SV-16)
CL-USER> (skolemize '(forall ?y (exist ?x (p ?x ?y))))
(FORALL ?Y (P (SF-17 ?Y) ?Y))
CL-USER> (skolemize '(exist ?y (forall ?x (p ?x ?y))))
(FORALL ?X (P ?X SV-18))
CL-USER> (skolemize '(exist ?y (and (p ?x) (f ?y))))
(AND (P ?X) (F SV-19))
CL-USER> (skolemize '(forall ?x (exist ?y (and (p ?x) (f ?y)))))
(FORALL ?X (AND (P ?X) (F (SF-20 ?X))))
Testing a more complex expression:
CL-USER> (skolemize '(exist ?a
(forall ?b
(exist ?c
(forall ?d
(exist ?e (and (or (and (f ?a) (g ?b))
(and (f ?c) (g ?d)))
(or (and (f ?c) (g ?e))
(and (f ?d) (g ?e))))))))))
(FORALL ?B
(FORALL ?D (AND (OR (AND (F SV-15) (G ?B))
(AND (F (SF-16 ?B)) (G ?D)))
(OR (AND (F (SF-16 ?B)) (G (SF-17 ?D ?B)))
(AND (F ?D) (G (SF-17 ?D ?B)))))))