How to give propertyList a name via variable in CLISP? - common-lisp

Let my code be:
(defun ct (x)
(setq x '( (man noun singular)
(woman noun singular)
(likes verb singular)
(a article)
(man verbIplural)
)
)
)
if i call it like (ct '(myplist))
it won't work how can I fix this?

CL-USER 20 > (defun ct (symbol)
(set symbol '((man noun singular)
(woman noun singular)
(likes verb singular)
(a article)
(man verbIplural))))
CT
CL-USER 21 > (ct 'myplist)
((MAN NOUN SINGULAR) (WOMAN NOUN SINGULAR)
(LIKES VERB SINGULAR) (A ARTICLE) (MAN VERBIPLURAL))
CL-USER 22 > myplist
((MAN NOUN SINGULAR) (WOMAN NOUN SINGULAR)
(LIKES VERB SINGULAR) (A ARTICLE) (MAN VERBIPLURAL))
In Lisp that list is not really a property list, but an assoc list.

Related

Dtrace from Touretzky

I am trying to learn lisp with the book "Common LISP a Gentle Introduction to Symbolic Computation" written by Touretzky. There is a utility in the book, Dtrace(I use dtrace.generic). Example of using dtrace:
(defun add-to-end (x y)
(append x (list y)))
(defun repeat-first (phrase)
(add-to-end phrase (first phrase)))
> (dtrace add-to-end repeat-first)
(ADD-TO-END REPEAT-FIRST)
> (repeat-first ’(for whom the bell tolls))
----Enter REPEAT-FIRST
| PHRASE = (FOR WHOM THE BELL TOLLS)
| ----Enter ADD-TO-END
| | X = (FOR WHOM THE BELL TOLLS)
| | Y = FOR
| \--ADD-TO-END returned
| (FOR WHOM THE BELL TOLLS FOR)
\--REPEAT-FIRST returned
(FOR WHOM THE BELL TOLLS FOR)
(FOR WHOM THE BELL TOLLS FOR)
Unfortunately in Clozure (on Win7) the result is:
? (repeat-first '(for whom the bell tolls))
----Enter REPEAT-FIRST
| Arg-1 = (FOR WHOM THE BELL TOLLS)
| ----Enter ADD-TO-END
| | Arg-1 = (FOR WHOM THE BELL TOLLS)
| | Arg-2 = FOR
| \--ADD-TO-END returned (FOR WHOM THE BELL TOLLS FOR)
\--REPEAT-FIRST returned (FOR WHOM THE BELL TOLLS FOR)
(FOR WHOM THE BELL TOLLS FOR)
Function argument names are lost. It should depend on the fetch-arglist function. Based on this answer, I wrote fetch-arglist as:
(defun fetch-arglist (x) (arglist x))
In fact:
? (arglist #'add-to-end)
(X Y)
:ANALYSIS
Unfortunately, the result is the same. Is there a way, in Clozure, to make the argument names of functions appear in dtrace?
Update:
Solution is (in dtrace.generic):
(defun fetch-arglist (x) (ccl:arglist x))
Update2:
dtrace prints strange results as:
((CCC (? AAA . #1=(0)) (? BBB . #1#)))
While trace of Clozure prints correctly:
((CCC (? AAA 0) (? BBB 0)))
Update3(and hopefully last):
Solution due to Vsevolod Dyomkin:
(defparameter *dtrace-print-circle* nil)
*print-circle* shows common substructure:
CL-USER> (setf *print-circle* t)
T
CL-USER> (let ((l '((a b c) (d e f))))
(list l (copy-list l)))
;=> ((#1=(A B C) #2=(D E F)) (#1# #2#))

Clips rules - conditional firings of rules

I am trying to use rules for an agriculture based system
So for example,
based on location --> list crops --> based on crop selected --> select seed
This is a forward chaining problem
I am only able to define the rules statically. Meaning, defining rules for every possible scenario
Is there a way to code, say if I select a location, I get a list of all crops, and when the user selects the crop , I get the list of seeds
How do I make sure, the rules are fired based on the output of the previous rule?
One approach you can take is to represent the questions as facts and then write general rules for processing those facts. First define some deftemplates to represent the questions, the branching from one question to another based on the user's response, and the user's response.
(deftemplate question
(slot name)
(slot text)
(slot display-answers (allowed-values yes no))
(slot last-question (default none)))
(deftemplate branch
(slot question)
(slot answer)
(slot next-question)
(multislot next-answers))
(deftemplate response
(slot question)
(slot answer))
Next, define your questions and the branches between them:
(deffacts questions
(question (name location)
(text "Country")
(display-answers no)
(last-question none))
(question (name crop-type)
(text "Crop Type")
(display-answers yes)
(last-question location))
(question (name seed)
(text "Seed")
(display-answers yes)
(last-question crop-type)))
(deffacts locations
(branch (question location)
(answer "United States")
(next-question crop-type)
(next-answers food fiber))
(branch (question location)
(answer "India")
(next-question crop-type)
(next-answers food fiber))
(branch (question location)
(answer "China")
(next-question crop-type)
(next-answers food fiber))
(branch (question location)
(answer "Brazil")
(next-question crop-type)
(next-answers food fiber))
(branch (question location)
(answer "Pakistan")
(next-question crop-type)
(next-answers fiber)))
(deffacts crop-types
(branch (question crop-type)
(answer fiber)
(next-question seed)
(next-answers cotton hemp flax))
(branch (question crop-type)
(answer food)
(next-question seed)
(next-answers corn wheat rice)))
Define some utility deffunctions for processing user responses. These will allow the program to ignore differences in alphabetic case in the user response.
(deffunction lenient-eq (?v1 ?v2)
(if (eq ?v1 ?v2)
then
(return TRUE))
(if (eq (lowcase (str-cat ?v1)) (lowcase (str-cat ?v2)))
then
(return TRUE))
(return FALSE))
(deffunction lenient-member$ (?value $?allowed-values)
(loop-for-count (?i (length$ ?allowed-values))
(bind ?v (nth$ ?i ?allowed-values))
(if (lenient-eq ?value ?v)
then
(return ?i)))
(return FALSE))
(deffunction ask-question (?question $?allowed-values)
(printout t ?question)
(bind ?answer (lowcase (readline)))
(while (not (lenient-member$ ?answer ?allowed-values)) do
(printout t ?question)
(bind ?answer (lowcase (readline))))
?answer)
Add some rules to handle the case where the list of valid answers are not displayed when the question is asked (because there may be a large number of them).
;;; Ask question without valid answers displayed or checked
(defrule ask-question-without-answers
;; There is a question that should be
;; displayed without valid answers.
(question (name ?question)
(text ?text)
(display-answers no)
(last-question ?last-question))
;; There is no prior question or
;; the prior question has a response.
(or (test (eq ?last-question none))
(response (question ?last-question)))
;; There is no response to the question.
(not (response (question ?question)))
=>
;; Ask the question
(printout t ?text ": ")
;; Assert a response with the question and answer.
(assert (response (question ?question)
(answer (lowcase (readline))))))
;;; Check for valid response to a question
(defrule bad-answer-to-question
;; There is a question that should be
;; displayed without valid answers.
(question (name ?question)
(display-answers no))
;; There is a response to the question.
?r <- (response (question ?question)
(answer ?answer))
;; The response to the question does
;; not branch to another question.
(not (branch (question ?question)
(answer ?a&:(lenient-eq ?a ?answer))))
=>
;; Print the list of valid answers for the question.
(printout t "Valid answers are:" crlf)
(do-for-all-facts ((?b branch))
(eq ?b:question ?question)
(printout t " " ?b:answer crlf))
;; Retract the response so that the
;; question will be asked again.
(retract ?r))
Finally, add a rule to handle the case where the question is asked with the list of valid answers displayed and is immediately check by the ask-question deffunction.
;;; Ask questions with valid answers displayed and checked
(defrule ask-question-with-answers
;; There is a question that should be
;; displayed including valid answers.
(question (name ?question)
(text ?text)
(display-answers yes)
(last-question ?last-question))
;; The preceding question has been answered.
(response (question ?last-question)
(answer ?last-answer))
;; There is a branch from the preceding question
;; and its answer to this question and the allowed
;; values for the answer.
(branch (answer ?a&:(lenient-eq ?a ?last-answer))
(next-question ?question)
(next-answers $?next-answers))
=>
;; Construct the question text including the possible answers.
(bind ?text (str-cat ?text " [" (implode$ ?next-answers) "]: "))
;; Ask the question.
(bind ?answer (ask-question ?text ?next-answers))
;; Assert a response fact with the question and answer.
(assert (response (question ?question) (answer ?answer))))
The output when this program is run:
CLIPS (6.31 6/12/19)
CLIPS> (load "seeds.clp")
%%%$$$!!!***
TRUE
CLIPS> (reset)
CLIPS> (run)
Country: Sweden
Valid answers are:
United States
India
China
Brazil
Pakistan
Country: China
Crop Type [food fiber]: food
Seed [corn wheat rice]: wheat
CLIPS>
To allow the first question to display the valid responses, redefine the questions deffacts to include an initial question that has already been answered:
(deffacts questions
(question (name location)
(text "Country")
(display-answers yes)
(last-question start-program))
(question (name crop-type)
(text "Crop Type")
(display-answers yes)
(last-question location))
(question (name seed)
(text "Seed")
(display-answers yes)
(last-question crop-type))
(response (question start-program)
(answer yes))
(branch (question start-program)
(answer yes)
(next-question location)
(next-answers "United States" "India" "China" "Brazil" "Pakistan")))
The output will then look like this:
CLIPS> (run)
Country ["United States" "India" "China" "Brazil" "Pakistan"]: Sweden
Country ["United States" "India" "China" "Brazil" "Pakistan"]: China
Crop Type [food fiber]: food
Seed [corn wheat rice]: wheat
CLIPS>

common lisp function/macro aliases

I would like to set aliases in common lisp(clisp to be exact) for commands that are used a lot, such as "defun" and "lambda" etc, is it possible to do this?
This is actually kind of a duplicate of this question, but I can not comment and the solution does not work for defun or lambda in both sbcl and clisp
Macros:
CL-USER 5 > (setf (macro-function 'dm) (macro-function 'defmethod))
#<Function DEFMETHOD 410009A014>
CL-USER 6 > (dm m1+ ((v vector)) (map 'vector #'1+ v))
#<STANDARD-METHOD M1+ NIL (VECTOR) 4130003913>
CL-USER 7 > (m1+ #(1 2 3 4))
#(2 3 4 5)
The whole point by macros is to provide a source rewriting service.. Thus I want to give you this and you can make that out of it:
(defmacro df (name (&rest arguments) &body body)
`(defun ,name ,arguments ,#body))
(df test (x) (+ x x))
(test 5) ; ==> 10
We have just shortened the name.. Lets make another one:
(defmacro df1 (name &body body)
`(defun ,name (_) ,#body))
(df1 test (+ _ _))
(test 5) ; ==> 10
And so on...

Usage of &allow-other-keys in common lisp

I want to make the most generic function and decided to go with keys as arguments.
I want to use allow-other-keys since I want to use the function with any key.
Let me show you:
(defun myfunc (a &rest rest &key b &allow-other-keys)
;; Print A
(format t "A = ~a~%" a)
;; Print B if defined
(when b
(format t "B = ~a~%" b))
;; Here ... I want to print C or D or any other keys
;; ??
)
(myfunc "Value of A")
(myfunc "Value of A" :b "Value of B")
(myfunc "Value of A" :b "Value of B" :c "Value of C" :d "Value of D")
I know that restis the remaining args but it has an array. It does not bind values c or d or even build them like an associative list (i.e to do sth like (cdr (assoc 'c rest)))
Do you have a clue or a solution ? Or maybe I am going in the wrong direction ?
Thanks in advance
Since when is &REST an array? The standard says list. In the case of keyword arguments, this is a property list. See getf to access elements of a property list.
One can also use DESTRUCTURING-BIND to access the contents of that property list:
CL-USER 15 > (defun foo (a &rest args &key b &allow-other-keys)
(destructuring-bind (&key (c nil c-p) ; var default present?
(d t d-p)
(e 42 e-p)
&allow-other-keys)
args
(list (list :c c c-p)
(list :d d d-p)
(list :e e e-p))))
FOO
; c-p, d-p, e-p show whether the argument was actually present
; otherwise the default value will be used
CL-USER 16 > (foo 10 :b 20 :d 30)
((:C NIL NIL) (:D 30 T) (:E 42 NIL))
But the same could have been done in the argument list already...

str makes a string of its enclosed map

When I map inside str, I get a stringification of clojure.lang.LazySeq.
user=> (str (map inc (range 3)))
"clojure.lang.LazySeq#7861"
I've found and tried many answers - apply, doall, doseq, different mappings, mapping custom functions that use doall and other things, trying different repls, etc. - but can't seem to get map to eval before being stringified.
Update: This should also work in more general case uses of str:
user=> (str "pre string " (map inc (range 3)) " post string")
Desired output:
user=> "pre string 123 post string"
You need something like this?
(apply str (map inc (range 3)))
=> "123"
Show us your desired output to make sure that we are on the same page.
Still, I don't know what is your desired output.
(str "pre string " (apply str (map inc (range 3))) " post string")
=> "pre string 123 post string"
use seq
(str (seq (map inc (range 3))))
"(1 2 3)"

Resources