I have compiled CLIPS 6.4 into a shared library (compiled as C++) so that I can use in a C++ application.
I want to now write a simple test C++ application that allows me to:
Start up the CLIPS engine
Load a CLIPS program (see animal.clp)
Assert a fact from the C++ program to the CLIPS engine and receive responses back from CLIPS in my C++ program
Safely terminate the CLIPS engine and cleanup when nothing on the agenda (all rules fired) - i.e. program completed
Testapp.cc
int main(
int argc,
char *argv[])
{
mainEnv = CreateEnvironment();
// load CLIPS ruleset (program - e.g. animal.clp)
// while( !agenda.empty() ) {
// Receive "question" from CLIPS engine
// Send "Answer" to CLIPS engine
// Cleanly terminate CLIPS engine
return 0;
}
animal.clp
;;;======================================================
;;; Animal Identification Expert System
;;;
;;; A simple expert system which attempts to identify
;;; an animal based on its characteristics.
;;; The knowledge base in this example is a
;;; collection of facts which represent backward
;;; chaining rules. CLIPS forward chaining rules are
;;; then used to simulate a backward chaining inference
;;; engine.
;;;
;;; CLIPS Version 6.4 Example
;;;
;;; To execute, merely load, reset, and run.
;;; Answer questions yes or no.
;;;======================================================
(defmodule MAIN (export ?ALL))
(defmodule VALIDATE (import MAIN ?ALL))
(defmodule CHAIN (import MAIN ?ALL))
(defmodule ASK (import MAIN ?ALL))
;;;*************************
;;;* DEFGLOBAL DEFINITIONS *
;;;*************************
(defglobal MAIN
?*rule-index* = 1
?*validate* = TRUE)
;;;***************************
;;;* DEFFUNCTION DEFINITIONS *
;;;***************************
(deffunction generate-rule-name ()
(bind ?name (sym-cat rule- ?*rule-index*))
(bind ?*rule-index* (+ ?*rule-index* 1))
(return ?name))
;;;***************************
;;;* DEFTEMPLATE DEFINITIONS *
;;;***************************
(deftemplate MAIN::rule
(slot name (default-dynamic (generate-rule-name)))
(slot validate (default no))
(multislot if)
(multislot then)
(multislot processed))
(deftemplate MAIN::question
(multislot valid-answers)
(slot variable)
(slot query))
(deftemplate MAIN::answer
(slot variable)
(slot prefix (default ""))
(slot postfix (default "")))
(deftemplate MAIN::goal
(slot variable))
(deftemplate MAIN::variable
(slot name)
(slot value))
(deftemplate MAIN::activity)
(deftemplate MAIN::legalanswers
(multislot values))
;;;**************************
;;;* INFERENCE ENGINE RULES *
;;;**************************
(defrule MAIN::startup
=>
(if ?*validate*
then
(focus VALIDATE CHAIN ASK)
else
(focus CHAIN ASK)))
(defrule MAIN::continue
(declare (salience -10))
?f <- (activity)
=>
(retract ?f)
(focus CHAIN ASK))
(defrule MAIN::goal-satified ""
(goal (variable ?goal))
(variable (name ?goal) (value ?value))
(answer (prefix ?prefix) (postfix ?postfix) (variable ?goal))
=>
(println ?prefix ?value ?postfix))
;;; ##################
;;; CHAIN MODULE RULES
;;; ##################
(defrule CHAIN::propagate-goal ""
(logical (goal (variable ?goal))
(rule (if ?variable $?)
(then ?goal ? ?value)))
=>
(assert (goal (variable ?variable))))
(defrule CHAIN::modify-rule-match-is ""
(variable (name ?variable) (value ?value))
?f <- (rule (if ?variable is ?value and $?rest)
(processed $?p))
=>
(modify ?f (if ?rest)
(processed ?p ?variable is ?value and)))
(defrule CHAIN::rule-satisfied-is ""
(variable (name ?variable) (value ?value))
?f <- (rule (if ?variable is ?value)
(then ?goal ? ?goal-value)
(processed $?p))
=>
(modify ?f (if)
(processed ?p ?variable is ?value #)))
(defrule CHAIN::apply-rule ""
(logical (rule (if)
(then ?goal ? ?goal-value)))
=>
(assert (variable (name ?goal) (value ?goal-value))))
;;; ################
;;; ASK MODULE RULES
;;; ################
(defrule ASK::ask-question-no-legalvalues ""
(not (legalanswers))
?f1 <- (goal (variable ?variable))
(question (variable ?variable) (query ?text))
(not (variable (name ?variable)))
=>
(assert (activity))
(retract ?f1)
(print ?text " ")
(assert (variable (name ?variable) (value (read)))))
(defrule ASK::ask-question-legalvalues ""
(legalanswers (values $?answers))
?f1 <- (goal (variable ?variable))
(question (variable ?variable) (query ?text))
(not (variable (name ?variable)))
=>
(assert (activity))
(retract ?f1)
(print ?text " ")
(print ?answers " ")
(bind ?reply (read))
(if (lexemep ?reply)
then
(bind ?reply (lowcase ?reply)))
(if (member$ ?reply ?answers)
then (assert (variable (name ?variable) (value ?reply)))
else (assert (goal (variable ?variable)))))
;;; #####################
;;; VALIDATE MODULE RULES
;;; #####################
(defrule VALIDATE::copy-rule
(declare (salience 10))
?f <- (rule (validate no))
=>
(duplicate ?f (validate yes))
(modify ?f (validate done)))
(defrule VALIDATE::next-condition
(declare (salience -10))
?f <- (rule (name ?name) (validate yes)
(if ?a ?c ?v and $?rest))
=>
(modify ?f (if ?rest)))
(defrule VALIDATE::validation-complete
(declare (salience -10))
?f <- (rule (validate yes) (if ? ? ?))
=>
(retract ?f))
;;; *******************
;;; Validation - Syntax
;;; *******************
(defrule VALIDATE::and-connector
?f <- (rule (name ?name) (validate yes)
(if ?a ?c ?v ?connector&~and $?))
=>
(retract ?f)
(println "In rule " ?name ", if conditions must be connected using and:" crlf
" " ?a " " ?c " " ?v " *" ?connector "*"))
(defrule VALIDATE::and-requires-additional-condition
?f <- (rule (name ?name) (validate yes)
(if ?a ?c ?v and))
=>
(retract ?f)
(println "In rule " ?name ", an additional condition should follow the final and:" crlf
" " ?a " " ?c " " ?v " and <missing condition>"))
(defrule VALIDATE::incorrect-number-of-then-terms
?f <- (rule (name ?name) (validate yes)
(then $?terms&:(<> (length$ ?terms) 3)))
=>
(retract ?f)
(println "In rule " ?name ", then portion should be of the form <variable> is <value>:" crlf
" " (implode$ ?terms)))
(defrule VALIDATE::incorrect-number-of-if-terms
?f <- (rule (name ?name) (validate yes)
(if $?terms&:(< (length$ ?terms) 3)))
=>
(retract ?f)
(println "In rule " ?name ", if portion contains an incomplete condition:" crlf
" " (implode$ ?terms)))
(defrule VALIDATE::incorrect-then-term-syntax
?f <- (rule (name ?name) (validate yes)
(then ?a ?c&~is ?v))
=>
(retract ?f)
(println "In rule " ?name ", then portion should be of the form <variable> is <value>:" crlf
" " ?a " " ?c " " ?v " "))
(defrule VALIDATE::incorrect-if-term-syntax
?f <- (rule (name ?name) (validate yes)
(if ?a ?c&~is ?v $?))
=>
(retract ?f)
(println "In rule " ?name ", if portion comparator should be \"is\"" crlf
" " ?a " " ?c " " ?v " "))
(defrule VALIDATE::illegal-variable-value
?f <- (rule (name ?name) (validate yes)
(if ?a ?c ?v $?))
(question (variable ?a) (valid-answers))
(legalanswers (values $?values))
(test (not (member$ ?v ?values)))
=>
(retract ?f)
(println "In rule " ?name ", the value " ?v " is not legal for variable " ?a ":" crlf
" " ?a " " ?c " " ?v))
(defrule VALIDATE::reachable
(rule (name ?name) (validate yes)
(if ?a ?c ?v $?))
(not (question (variable ?a)))
(not (rule (then ?a $?)))
=>
(println "In rule " ?name " no question or rule could be found "
"that can supply a value for the variable " ?a ":" crlf
" " ?a " " ?c " " ?v))
(defrule VALIDATE::used "TBD lower salience"
?f <- (rule (name ?name) (validate yes)
(then ?a is ?v))
(not (goal (variable ?a)))
(not (rule (if ?a ? ?v $?)))
=>
(retract ?f)
(println "In rule " ?name " the conclusion for variable " ?a
" is neither referenced by any rules nor the primary goal" crlf
" " ?a " is " ?v))
(defrule VALIDATE::variable-in-both-if-and-then
?f <- (rule (name ?name) (validate yes)
(if ?a $?)
(then ?a is ?v))
=>
(retract ?f)
(println "In rule " ?name " the variable " ?a
" is used in both the if and then sections"))
(defrule VALIDATE::question-variable-unreferenced
(question (variable ?a) (query ?q))
(not (rule (validate done) (if $? ?a is ?v $?)))
=>
(println "The question \"" ?q "\", assigns a value to the variable " ?a
" which is not referenced by any rules"))
;;;***************************
;;;* DEFFACTS KNOWLEDGE BASE *
;;;***************************
(deffacts MAIN::knowledge-base
(goal (variable type.animal))
(legalanswers (values yes no))
(rule (if backbone is yes)
(then superphylum is backbone))
(rule (if backbone is no)
(then superphylum is jellyback))
(question (variable backbone)
(query "Does your animal have a backbone?"))
(rule (if superphylum is backbone and
warm.blooded is yes)
(then phylum is warm))
(rule (if superphylum is backbone and
warm.blooded is no)
(then phylum is cold))
(question (variable warm.blooded)
(query "Is the animal warm blooded?"))
(rule (if superphylum is jellyback and
live.prime.in.soil is yes)
(then phylum is soil))
(rule (if superphylum is jellyback and
live.prime.in.soil is no)
(then phylum is elsewhere))
(question (variable live.prime.in.soil)
(query "Does your animal live primarily in soil?"))
(rule (if phylum is warm and
has.breasts is yes)
(then class is breasts))
(rule (if phylum is warm and
has.breasts is no)
(then type.animal is bird/penguin))
(question (variable has.breasts)
(query "Normally, does the female of your animal nurse its young with milk?"))
(rule (if phylum is cold and
always.in.water is yes)
(then class is water))
(rule (if phylum is cold and
always.in.water is no)
(then class is dry))
(question (variable always.in.water)
(query "Is your animal always in water?"))
(rule (if phylum is soil and
flat.bodied is yes)
(then type.animal is flatworm))
(rule (if phylum is soil and
flat.bodied is no)
(then type.animal is worm/leech))
(question (variable flat.bodied)
(query "Does your animal have a flat body?"))
(rule (if phylum is elsewhere and
body.in.segments is yes)
(then class is segments))
(rule (if phylum is elsewhere and
body.in.segments is no)
(then class is unified))
(question (variable body.in.segments)
(query "Is the animals body in segments?"))
(rule (if class is breasts and
can.eat.meat is yes)
(then order is meat))
(rule (if class is breasts and
can.eat.meat is no)
(then order is vegy))
(question (variable can.eat.meat)
(query "Does your animal eat red meat?"))
(rule (if class is water and
boney is yes)
(then type.animal is fish))
(rule (if class is water and
boney is no)
(then type.animal is shark/ray))
(question (variable boney)
(query "Does your animal have a boney skeleton?"))
(rule (if class is dry and
scaly is yes)
(then order is scales))
(rule (if class is dry and
scaly is no)
(then order is soft))
(question (variable scaly)
(query "Is your animal covered with scaled skin?"))
(rule (if class is segments and
shell is yes)
(then order is shell))
(rule (if class is segments and
shell is no)
(then type.animal is centipede/millipede/insect))
(question (variable shell)
(query "Does your animal have a shell?"))
(rule (if class is unified and
digest.cells is yes)
(then order is cells))
(rule (if class is unified and
digest.cells is no)
(then order is stomach))
(question (variable digest.cells)
(query "Does your animal use many cells to digest its food instead of a stomach?"))
(rule (if order is meat and
fly is yes)
(then type.animal is bat))
(rule (if order is meat and
fly is no)
(then family is nowings))
(question (variable fly)
(query "Can your animal fly?"))
(rule (if order is vegy and
hooves is yes)
(then family is hooves))
(rule (if order is vegy and
hooves is no)
(then family is feet))
(question (variable hooves)
(query "Does your animal have hooves?"))
(rule (if order is scales and
rounded.shell is yes)
(then type.animal is turtle))
(rule (if order is scales and
rounded.shell is no)
(then family is noshell))
(question (variable rounded.shell)
(query "Does the animal have a rounded shell?"))
(rule (if order is soft and
jump is yes)
(then type.animal is frog))
(rule (if order is soft and
jump is no)
(then type.animal is salamander))
(question (variable jump)
(query "Does your animal jump?"))
(rule (if order is shell and
tail is yes)
(then type.animal is lobster))
(rule (if order is shell and
tail is no)
(then type.animal is crab))
(question (variable tail)
(query "Does your animal have a tail?"))
(rule (if order is cells and
stationary is yes)
(then family is stationary))
(rule (if order is cells and
stationary is no)
(then type.animal is jellyfish))
(question (variable stationary)
(query "Is your animal attached permanently to an object?"))
(rule (if order is stomach and
multicelled is yes)
(then family is multicelled))
(rule (if order is stomach and
multicelled is no)
(then type.animal is protozoa))
(question (variable multicelled)
(query "Is your animal made up of more than one cell?"))
(rule (if family is nowings and
opposing.thumb is yes)
(then genus is thumb))
(rule (if family is nowings and
opposing.thumb is no)
(then genus is nothumb))
(question (variable opposing.thumb)
(query "Does your animal have an opposing thumb?"))
(rule (if family is hooves and
two.toes is yes)
(then genus is twotoes))
(rule (if family is hooves and
two.toes is no)
(then genus is onetoe))
(question (variable two.toes)
(query "Does your animal stand on two toes/hooves per foot?"))
(rule (if family is feet and
live.in.water is yes)
(then genus is water))
(rule (if family is feet and
live.in.water is no)
(then genus is dry))
(question (variable live.in.water)
(query "Does your animal live in water?"))
(rule (if family is noshell and
limbs is yes)
(then type.animal is crocodile/alligator))
(rule (if family is noshell and
limbs is no)
(then type.animal is snake))
(question (variable limbs)
(query "Does your animal have limbs?"))
(rule (if family is stationary and
spikes is yes)
(then type.animal is sea.anemone))
(rule (if family is stationary and
spikes is no)
(then type.animal is coral/sponge))
(question (variable spikes)
(query "Does your animal normally have spikes radiating from its body?"))
(rule (if family is multicelled and
spiral.shell is yes)
(then type.animal is snail))
(rule (if family is multicelled and
spiral.shell is no)
(then genus is noshell))
(question (variable spiral.shell)
(query "Does your animal have a spiral-shaped shell?"))
(rule (if genus is thumb and
prehensile.tail is yes)
(then type.animal is monkey))
(rule (if genus is thumb and
prehensile.tail is no)
(then species is notail))
(question (variable prehensile.tail)
(query "Does your animal have a prehensile tail?"))
(rule (if genus is nothumb and
over.400 is yes)
(then species is 400))
(rule (if genus is nothumb and
over.400 is no)
(then species is under400))
(question (variable over.400)
(query "Does an adult normally weigh over 400 pounds?"))
(rule (if genus is twotoes and
horns is yes)
(then species is horns))
(rule (if genus is twotoes and
horns is no)
(then species is nohorns))
(question (variable horns)
(query "Does your animal have horns?"))
(rule (if genus is onetoe and
plating is yes)
(then type.animal is rhinoceros))
(rule (if genus is onetoe and
plating is no)
(then type.animal is horse/zebra))
(question (variable plating)
(query "Is your animal covered with a protective plating?"))
(rule (if genus is water and
hunted is yes)
(then type.animal is whale))
(rule (if genus is water and
hunted is no)
(then type.animal is dolphin/porpoise))
(question (variable hunted)
(query "Is your animal, unfortunately, commercially hunted?"))
(rule (if genus is dry and
front.teeth is yes)
(then species is teeth))
(rule (if genus is dry and
front.teeth is no)
(then species is noteeth))
(question (variable front.teeth)
(query "Does your animal have large front teeth?"))
(rule (if genus is noshell and
bivalve is yes)
(then type.animal is clam/oyster))
(rule (if genus is noshell and
bivalve is no)
(then type.animal is squid/octopus))
(question (variable bivalve)
(query "Is your animal protected by two half-shells?"))
(rule (if species is notail and
nearly.hairless is yes)
(then type.animal is man))
(rule (if species is notail and
nearly.hairless is no)
(then subspecies is hair))
(question (variable nearly.hairless)
(query "Is your animal nearly hairless?"))
(rule (if species is 400 and
land.based is yes)
(then type.animal is bear/tiger/lion))
(rule (if species is 400 and
land.based is no)
(then type.animal is walrus))
(question (variable land.based)
(query "Is your animal land based?"))
(rule (if species is under400 and
thintail is yes)
(then type.animal is cat))
(rule (if species is under400 and
thintail is no)
(then type.animal is coyote/wolf/fox/dog))
(question (variable thintail)
(query "Does your animal have a thin tail?"))
(rule (if species is nohorns and
lives.in.desert is yes)
(then type.animal is camel))
(rule (if species is nohorns and
lives.in.desert is no and
semi.aquatic is no)
(then type.animal is giraffe))
(rule (if species is nohorns and
lives.in.desert is no and
semi.aquatic is yes)
(then type.animal is hippopotamus))
(question (variable lives.in.desert)
(query "Does your animal normally live in the desert?"))
(question (variable semi.aquatic)
(query "Is your animal semi-aquatic?"))
(rule (if species is teeth and
large.ears is yes)
(then type.animal is rabbit))
(rule (if species is teeth and
large.ears is no)
(then type.animal is rat/mouse/squirrel/beaver/porcupine))
(question (variable large.ears)
(query "Does your animal have large ears?"))
(rule (if species is noteeth and
pouch is yes)
(then type.animal is "kangaroo/koala bear"))
(rule (if species is noteeth and
pouch is no)
(then type.animal is mole/shrew/elephant))
(question (variable pouch)
(query "Does your animal have a pouch?"))
(rule (if subspecies is hair and
long.powerful.arms is yes)
(then type.animal is orangutan/gorilla/chimpanzie))
(rule (if subspecies is hair and
long.powerful.arms is no)
(then type.animal is baboon))
(question (variable long.powerful.arms)
(query "Does your animal have long, powerful arms?"))
(rule (if species is horns and
fleece is yes)
(then type.animal is sheep/goat))
(rule (if species is horns and
fleece is no)
(then subsubspecies is nofleece))
(question (variable fleece)
(query "Does your animal have fleece?"))
(rule (if subsubspecies is nofleece and
domesticated is yes)
(then type.animal is cow))
(rule (if subsubspecies is nofleece and
domesticated is no)
(then type.animal is deer/moose/antelope))
(question (variable domesticated)
(query "Is your animal domesticated?"))
(answer (prefix "I think your animal is a ") (variable type.animal) (postfix ".")))
How can I interact with CLIPS from C++ in the simple way described? Specifically, what functions do I need to call/implement in order to implement the functionality required in Test.cc?
The CLIPS Advanced Programming Guide is here: http://clipsrules.sourceforge.net/documentation/v640/apg.pdf
You can use the Load function (section 3.2.2) to load a file. There is an example of its use in section 3.6.1.
You can use the GetNextActivation function (section 12.7.1) to determine if the agenda has any activations.
The simplest way to create facts is using the AssertString function (section 3.3.1). Sections 3.6.2, 4.5.4, and 5.3 have an example use of this function. You can also use the FactBuilder functions described in section 7.1 (with an example in section 7.6.1).
If the results of your program running are represented by facts, you can use the fact query functions via the Eval function to retrieve those values from your program. Section 4.5.4 has an example.
Related
I am using Emacs, Slime, and SBCL. Simplifying a problem that I am facing, suppose I have this function working:
(defun get-answer (x y z)
(format t "Which animal would you like to be: ~s ~s ~s ~%" x y z)
(let ((answer (read-line)))
(cond ((equal answer x) (format t "user picks ~s" x))
((equal answer y) (format t "user picks ~s" y))
((equal answer z) (format t "user picks ~s" z)))))
It works for a fixed number of inputs:
CL-USER> (get-answer "fish" "cat" "owl")
Which animal would you like to be: "fish" "cat" "owl"
fish
user picks "fish"
NIL
I would like to generalize this function writing a variant argument macro that builds a variant number of cond clauses. Basically, Common Lisp macro would write the cond clause for me :)
For instance, I wish I could call it like:
CL-USER> (get-answer '("pig" "zebra" "lion" "dog" "cat" "shark"))
Or just:
CL-USER> (get-answer '("dog" "cat"))
Either way, it would generate 6 and 2 appropriate cond clauses, respectively. I tried building something to achieve this goal.
My draft/sketch focusing on the cond clause part is:
(defmacro macro-get-answer (args)
`(cond
(,#(mapcar (lambda (str+body)
(let ((str (first str+body))
(body (second str+body)))
`((string= answer ,str)
,body)))
args))))
The variable answer was supposed to hold the value inserted by the user. However, I can't manage to make it work. slime-macroexpand-1 is not being really helpful.
As an error message, I get:
The value
QUOTE
is not of type
LIST
Which is not something that I was expecting. Is there a way to fix this?
Thanks.
I don't think you need a macro. Note that there's a repeating pattern of ((equal answer x) (format t "user picks ~s" x)), so you should think how to simplify that.
So, this is your function and expected inputs:
(defun get-answer (x y z)
(format t "Which animal would you like to be: ~s ~s ~s ~%" x y z)
(let ((answer (read-line)))
(cond ((equal answer x) (format t "user picks ~s" x))
((equal answer y) (format t "user picks ~s" y))
((equal answer z) (format t "user picks ~s" z)))))
(get-answer '("pig" "zebra" "lion" "dog" "cat" "shark"))
(get-answer '("dog" "cat"))
I'd write something like this:
(defun get-answer (args)
(format t "Which animal would you like to be: ~{~s ~} ~%" args)
(let ((answer (read-line)))
(when (member answer args :test #'string=)
(format t "User picks ~s" answer)
answer)))
Tests:
(get-answer '("pig" "zebra" "lion" "dog" "cat" "shark"))
(get-answer '("dog" "cat"))
Note that your function always returned NIL, mine returns chosen string or NIL. After you recieve user input, you probably don't want to discard it immediately.
And if you have string with values, like this:
(get-answer '(("pig" 1) ("zebra" 3) ("lion" 2) ("dog" 8) ("cat" 12) ("shark" 20)))
I'd use find:
(defun get-answer (args)
(format t "Which animal would you like to be: ~{~s ~} ~%" (mapcar #'first args))
(let* ((answer (read-line))
(match (find answer args :test #'string= :key #'car)))
(when match
(format t "User picks ~s " (first match))
(second match))))
This function returns NIL or value of chosen animal.
The question is a little bit strange, but maybe the point is just to learn about Common Lisp's macros. One could just calculate the members of the condition in a first place. That means, generate a list of string= forms. Then just return a list containing the cond special form and the list of ((string= str) return-value).
(defmacro get-answer (answers)
(let ((clauses (mapcar (lambda (str+body)
(let ((str (first str+body))
(body (second str+body)))
`((string= ,str) ,body))) answers)))
`(cond ,#clauses)))
To test macros, one can use macroexpand and macroexpand-1.
> (macroexpand-1 '(get-answer (("test1" 1) ("test2" 2))))
(COND
((STRING= "test1") 1)
((STRING= "test2") 2))
But I don't personally think it is worth a macro. I think there is nothing wrong with the following function:
(defun get-answer (answer)
(cond
((string= answer "dog") 6)
((string= answer "cat") 2)))
As with Martin Půda's answer: this is not a good place where you need a macro. In particular if you want some undetermined number of options, pass a list of them: Common Lisp has extremely good list-handling functions.
In the simple case you give, the function becomes almost trivial:
(defun get-answer (options)
(format t "Which animal would you like to be (from ~{~A~^, ~})? " options)
(let ((selected (car (member (read-line) options :test #'string-equal))))
(format t "picked ~S~%" (or selected "(a bad answer)"))
selected))
If what you want to to is to map a value selected by the user to another value, then what you want is an alist or a plist:
(defun get-answer/map (option-map)
(format t "Which animal would you like to be (from ~{~A~^, ~})? "
(mapcar #'car option-map))
(let ((selected (assoc (read-line) option-map :test #'string-equal)))
(format t "picked ~A~%" (if selected (car selected) "(a bad value)"))
;; Second value tells us if fn succeeded, as first can be NIL
(values (cdr selected) selected)))
The whole purpose of functions like member and assoc is to search for entries in lists: there is no use in laboriously reimplementing half-working versions of them by writing lots of cond clauses, whether or not you do this automatically.
Now, people often say 'but I want to learn macros, so I will start by learning how to rewrite functions as macros'. That is a not where to start: macros are never useful for rewriting functions in this way, and thinking they are is very damaging.
Here's one simple example of a case where this can't work:
(get-answer (read-options-from-file *my-options-file*))
If get-answer were a macro how is this meant to work? The number of options is not only unknown at macroexpansion time, it is not even knowable, even in principle, because neither the file's name nor its contents can possibly be known at compile time.
Macros are not replacements for functions: they are are functions between languages: a macro compiles a language which is CL (+ other macros) + the language understood by the macro into a language which is CL (+ other macros).
I am slightly struggling to think of a case where a macro might be useful here, but perhaps we can imagine a language which has a with-answer-options form:
(with-answer-options (a)
("elephant" (explode-world :because-of a))
("fish" (set-fire-to-computer :blaming a)))
Note that this form now looks nothing like a function call: it is instead a little language which slightly extends CL, and which will get mapped to CL by the following macro:
(defmacro with-answer-options ((var &optional (prompt "Pick an answer"))
&body clauses)
(unless (symbolp var)
(error "~S should be a variable" var))
(let ((choices (mapcar #'car clauses)))
(unless (every #'stringp choices)
(error "choices should be (<literal string> form ...)"))
`(let ((,var (progn (format t "~A from ~{~A~^ ~}? "
,prompt ',choices)
(read-line))))
(cond
,#(mapcar (lambda (clause)
(destructuring-bind (val &body body) clause
`((string-equal ,var ',val)
,#body)))
clauses)
(t (error "~A is not one of ~{~A~^ ~}" ,var ',choices))))))
So now:
> (with-answer-options (a "Pick a bad thing")
("elephant" (explode-world :because-of a))
("fish" (set-fire-to-computer :blaming a)))
Pick a bad thing from elephant fish? frog
Error: frog is not one of elephant fish
There is a QUOTE, because your macro form contains one:
CL-USER 8 > (defmacro macro-get-answer (args) (print args) nil)
MACRO-GET-ANSWER
CL-USER 9 > (macro-get-answer '(1 2 3))
(QUOTE (1 2 3))
NIL
CL-USER 10 > (macro-get-answer (quote (1 2 3)))
(QUOTE (1 2 3))
NIL
Possible solutions:
don't use a quote
remove the quote
I have a question about lisp macros. I want to check a condition and, if it's true, to run a few things, not only one. The same for the false way. Can anybody please help??
(defmacro test (condition (&rest then) (&rest else))
`(if ,condition (progn ,#then) (progn ,#else)))
(test (= 4 3)
(print "YES") (print "TRUE")
(print "NO") (print "FALSE"))
The usual way to test macros is to use macroexpand.
Your test case misses parens (lisp reader does not care about whitespace, such as line breaks and indentation):
(macroexpand '(test (= 4 3)
(print "YES") (print "TRUE")
(print "NO") (print "FALSE")))
Error while parsing arguments to DEFMACRO TEST:
too many elements in
((= 4 3) (PRINT "YES") (PRINT "TRUE") (PRINT "NO") (PRINT "FALSE"))
to satisfy lambda list
(CONDITION (&REST THEN) (&REST ELSE)):
exactly 3 expected, but got 5
while
(macroexpand '(test (= 4 3)
((print "YES") (print "TRUE"))
((print "NO") (print "FALSE"))))
(IF (= 4 3)
(PROGN (PRINT "YES") (PRINT "TRUE"))
(PROGN (PRINT "NO") (PRINT "FALSE")))
Please note that CL has cond
which is usually used when one needs multiple forms in
if clauses.
The code is asking a y/n question to the user and making a change - simple. The statement seems to accept only integer and float types and I need only two answers, so I used 1 and 0, and excluded the rest, BUT it reads only numbers, so only the numbers are excluded, not characters.
(defrule rule01
=>
(printout t "Question (yes=1/no=0)?" crlf)
(bind ?x (read))
(if (!= ?x 1)
then
(if (= ?x 0)
then
(assert (rule01 no))
else (printout t "Use ONLY 0 OR 1 for your answers!" crlf))
else (assert (rule01 yes))))
Currently, when you try to type in a character, it returns the following:
CLIPS> (run)
Question (yes=1/no=0)?
g
[ARGACCES5] Function <> expected argument #1 to be of type integer or float
[PRCCODE4] Execution halted during the actions of defrule rule01.
How can I put in an exception for characters?
Use eq and neq in place of = and <>.
CLIPS (6.31 6/12/19)
CLIPS>
(defrule rule01
=>
(printout t "Question (yes=1/no=0)?" crlf)
(bind ?x (read))
(if (neq ?x 1)
then
(if (eq ?x 0)
then
(assert (rule01 no))
else (printout t "Use ONLY 0 OR 1 for your answers!" crlf))
else (assert (rule01 yes))))
CLIPS> (reset)
CLIPS> (run)
Question (yes=1/no=0)?
g
Use ONLY 0 OR 1 for your answers!
CLIPS>
Sometimes I end up with layers of if statements in my lisp code. Is there any alternative to doing this?
It's one of those cases where the answer, unfortunately, is "it depends". In some cases, the obvious choice is to use cond.
(if condition1
result1
(if condition2
result2
default))
;; naturally converted to:
(cond (condition1 result1)
(condition2 result2)
(t default))
At other times, cond paired with a bit of or or and may be exactly what you want.
(if condition1
(if condition2
result12
result1)
(if condition2
result2
default))
;; naturally turns intoteh answe
(cond ((and condition1 condition2) result12)
(condition1 result1)
(condition2 result2)
(t default))
NB, I have only written, not tested, this code, but in principle it should be fine.
Unfortunately, there are probably times where even the somewhat simpler-to-read cond form isn't clear enough and in those cases it's usually worth staring at the actual problem a bit harder. There may be a way of decomposing the logic in a better way (dispatch table, outer logic calling functions with suitable parameters, ...).
There are few directions you can move in to change your code.
Creating higher order functions that encapsulate conditions, or, perhaps, macros, or, maybe reusing existing macros (take a look at case macro for example). remove-if would be an example of a high-order function that can spare you writing an "if".
Use polymorphism. Lisp has classes, objects, overloads and all the instrumentation you would expect an object system to have (perhaps even a little extra ;).
Suppose you have this code:
;; Suppose your `person' is a list that has that person's
;; name as its first element:
(defun hello! (person)
(if (string= (car person) "John")
(concatenate 'string "Hello, " (car person))
(print "Hello, who are you?")))
(defun goodbye! (person)
(if (string= (car person) "John")
(concatenate 'string "Goodbye, " (car person))
(print "Goodbye, mysterious stranger!")))
;; You would use it like so:
(hello! '("John" x y z))
(goodbye! '(nil x y z))
Now, you could rewrite it as:
(defclass person () ())
(defclass friend (person)
((name :accessor name-of
:initarg :name)))
(defgeneric hello! (person))
(defgeneric goodbye! (person))
(defmethod hello! ((person person))
(print "Hello, who are you?"))
(defmethod hello! ((person friend))
(print (concatenate 'string "Hello, " (name-of person))))
(defmethod goodbye! ((person person))
(print "Goodbye, mysterious stranger!"))
(defmethod goodbye! ((person friend))
(print (concatenate 'string "Goodbye, " (name-of person))))
;; Which you would use like so:
(hello! (make-instance 'person))
(goodbye! (make-instance 'friend :name "John"))
;; Note that however the later is significantly more verbose
;; the ratio will change when you have more `if's which you
;; can systematize as objects, or states.
In other words, by encapsulating the state you can avoid explicitly writing condition statements. You would also gain some readability on the way, as you wouldn't need to memorize which piece of the list contains what info - you would now have it labelled "name".
I have a wine defined like this:
(deftemplate wine
(slot name)
(slot color)
(slot certainty (type NUMBER) (default 0)))
And the list dof wines defined like this:
(deffacts wines
(wine (name "Chardonnay") (color white))
(wine (name "Merlot") (color red))
(wine (name "Cabernet sauvignon") (color red)))
Now, in case a rule gets triggered, I'd like to increase certainty value for items in a list which have a color slot set to "red".
Any ideas how to accomplish this?
I'm new to CLIPS so I'm sure there is a better way but the following rules do what you want:
(defrule inc-wines-with-color
(increase-all-with color ?color ?amount)
(wine (name ?name) (color ?color))
=>
(assert (increase-certainty ?name ?amount)))
(defrule retract-inc-all-with
?f <- (increase-all-with $?)
=>
(retract ?f))
(defrule increase-wine-certainty
(not (increase-all-with $?))
?ic <-(increase-certainty ?name ?amount)
?wine <- (wine (name ?name) (certainty ?c))
=>
(printout t "Incrementing " ?name " from " ?c " to " (+ ?amount ?c) crlf)
(modify ?wine (certainty (+ ?amount ?c)))
(retract ?ic))
Here are the results of running it:
CLIPS> (reset)
CLIPS> (assert (increase-all-with color red 0.2))
<Fact-4>
CLIPS> (run)
Incrementing Merlot from 0 to 0.2
Incrementing Cabernet sauvignon from 0 to 0.2
CLIPS> (facts)
f-0 (initial-fact)
f-1 (wine (name "Chardonnay") (color white) (certainty 0))
f-7 (wine (name "Merlot") (color red) (certainty 0.2))
f-8 (wine (name "Cabernet sauvignon") (color red) (certainty 0.2))
For a total of 4 facts.
Note: You may need to set your conflict resolution strategy to LEX or MEA to guarantee proper ordering of the rules.