I wrote this function, that returns t if the arguments given match, else nil.
(defun match (input-form pattern)
(cond
((and (not input-form) (not pattern)) t)
((not pattern) nil)
((eq (car pattern) '*) (or (match input-form (cdr pattern)) (match (cdr input-form) pattern)))
((not input-form) nil)
((and (> (length (string (car pattern))) 1) (eq (char (string (car pattern)) 0) '#\?))
(match (cdr input-form) (cdr pattern)) )
((eql (car input-form) (car pattern)) (match (cdr input-form) (cdr pattern))) ) )
When I do this :
(setq patterns
'(((bonjour *) bonjour) ((salut *) salut)) )
(assoc '(bonjour Eliza) patterns :test #'match)
It works well and returns : ((bonjour *) bonjour)
and (assoc '(hello Eliza) patterns :test #'match)
works well too and returns nil.
But when I add patterns to the variable patterns like this :
(setq patterns
'(((bonjour *) bonjour) ((salut) salut) ((* mere * pere *) parlez-moi de vos parents) ((mere *) la mere de qui) ((* mere) parlez-moi de votre mere)) )
When I ask for something that matches, it works, but when I ask for something that doesn't match, I get a stack overflow error message.
What I am doing wrong?
If you (trace match), you will get the answer right away (just remember to hit Ctrl-C quickly enough :-):
0: (MATCH (BONJOUR2 ELIZA) (BONJOUR *))
0: MATCH returned NIL
0: (MATCH (BONJOUR2 ELIZA) (SALUT))
0: MATCH returned NIL
0: (MATCH (BONJOUR2 ELIZA) (* MERE * PERE *))
1: (MATCH (BONJOUR2 ELIZA) (MERE * PERE *))
1: MATCH returned NIL
1: (MATCH (ELIZA) (* MERE * PERE *))
2: (MATCH (ELIZA) (MERE * PERE *))
2: MATCH returned NIL
2: (MATCH NIL (* MERE * PERE *))
3: (MATCH NIL (MERE * PERE *))
3: MATCH returned NIL
3: (MATCH NIL (* MERE * PERE *))
4: (MATCH NIL (MERE * PERE *))
4: MATCH returned NIL
4: (MATCH NIL (* MERE * PERE *))
5: (MATCH NIL (MERE * PERE *))
5: MATCH returned NIL
5: (MATCH NIL (* MERE * PERE *))
I.e., you need to test for (null input-form) before stepping through the pattern:
(defun match (input-form pattern)
(cond
((and (null input-form) (null pattern)) t)
((or (null pattern) (null input-form)) nil)
((eq (car pattern) '*)
(or (match input-form (cdr pattern))
(match (cdr input-form) pattern)))
((and (> (length (string (car pattern))) 1)
(char= (char (string (car pattern)) 0) #\?))
(match (cdr input-form) (cdr pattern)))
((eql (car input-form) (car pattern))
(match (cdr input-form) (cdr pattern)))))
Please note the indentation and whitespace changes I made to your code, as well as using null instead of not when checking for empty lists (might consider endp instead too).
Related
I'm trying to make a code in lisp to count occurrences of atoms in a list in lisp.
The problem is the code works for all atoms except the atom (), which appears as NIL.
Example in the code:
(defun flatten (list_)
(cond ((atom list_) (list list_))
((null list_) NIL)
(t (append (flatten (car list_)) (flatten (cdr list_))) )
)
)
(defun toUniqueList (list_ out)
(cond ((null list_) NIL)
((not (member (car list_) out)) (append (list (car list_)) (toUniqueList (cdr list_) (append (list (car list_)) out)) ))
(t (toUniqueList (cdr list_) out))
)
)
(defun countOccurences (list_ x)
(cond ((null list_) 0)
((eql (car list_) x) (+ (countOccurences (cdr list_) x) 1))
(t (countOccurences (cdr list_) x))
)
)
(defun countOccurencesAll (list_)
(setq flatList (flatten list_))
(setq parsed (toUniqueList flatList '()))
(setq result '())
(dolist (x parsed)
(setq result (append result (list (list x (countOccurences flatList x)) ))))
result
)
(write (countOccurencesAll '(x y z 4.6 (a x) () (5 z x) ())))
; ((X 3) (Y 1) (Z 2) (4.6 1) (A 1) (NIL 5) (5 1))
Any idea in how to show () rather than NIL?
The expressions nil, 'nil, (), and '() all gets evaluated to nil which is displayed as nil unless it is the cdr of a pair in which it will just close the list. eg. '(() . ()) gets evaluated to (NIL . NIL) and it is displayed as (NIL). There is nothing you can do about that.
So the question is then, because ((a) (()) (c)) is really ((a . nil) . ((nil . nil) . ((c . nil) . nil))) should it count nil/() 5 times or ignore when nil in the cdr of a pair and just count it as one?
BTW using setq in countOccurencesAll on undefined bindings means your code is in the mercy of the implementation. The hyperspec does not define how it should be handled and SBCL makes warnings about how it interprets the code and other might just choose an interpretation. A better approach would be to use let to define the bindings. Using a hash and iterate over the list once would make an O(n) solution.
I'm writing a macro to generate codes used by another macro in Common Lisp. But I'm new at this and have difficulty in constructing a macro that takes in a list (bar1 bar2 ... barn) and produces the following codes by a loop.
`(foo
,#bar1
,#bar2
...
,#barn)
I wonder whether this can be achieved not involving implement-dependent words such as SB-IMPL::UNQUOTE-SPLICE in sbcl.
Maybe I didn't give a clear description about my problem. In fact I want to write a macro gen-case such that
(gen-case
(simple-array simple-vector)
('(dotimes ($1 $5)
(when (and (= (aref $4 $2 $1) 1) (zerop (aref $3 $1)))
$0))
'(dolist ($1 (aref $4 $2))
(when (zerop (aref $3 $1))
$0)))
objname body)
produces something like
`(case (car (type-of ,objname))
(simple-array
,#(progn
(setf temp
'(dotimes ($1 $5)
(when (and (= (aref $4 $2 $1) 1) (zerop (aref $3 $1)))
$0)))
(code-gen body)))
(simple-vector
,#(progn
(setf temp
'(dolist ($1 (aref $4 $2))
(when (zerop (aref $3 $1))
$0)))
(code-gen body))))
In general cases, the lists taken in by gen-case may contain more than two items.
I have tried
``(case (car (type-of ,,objname))
,',#(#|Some codes that produce target codes|#))
but the target codes are inserted to the quote block and thus throw an exception in the macro who calls the macro gen-case. Moreover, I have no way to insert ,# to the target codes as a straightforward insertion will cause a "comma not inside a backquote" exception.
The codes generated are part of another macro
(defmacro DSI-Layer ((obj-name tag-name) &body body)
"Data Structure Independent Layer."
(let ((temp))
(defun code-gen (c)
(if (atom c) c
(if (eq (car c) tag-name)
(let ((args (cadr c)) (codes (code-gen (cddr c))) (flag nil))
(defun gen-code (c)
(if (atom c) c
(if (eq (car c) *arg*)
(let ((n (cadr c)))
(if (zerop n) (progn (setf flag t) codes)
(nth (1- n) args)))
(let ((h (gen-code (car c))))
(if flag
(progn
(setf flag nil)
(append h (gen-code (cdr c))))
(cons h (gen-code (cdr c))))))))
(gen-code temp))
(cons (code-gen (car c)) (code-gen (cdr c))))))
`(case (car (type-of ,obj-name))
(simple-array
,#(progn
(setf temp
'(dotimes ($1 $5)
(when (and (= (aref $4 $2 $1) 1) (zerop (aref $3 $1)))
$0)))
(code-gen body)))
(simple-vector
,#(progn
(setf temp
'(dolist ($1 (aref $4 $2))
(when (zerop (aref $3 $1))
$0)))
(code-gen body))))))
and I've set up a read-macro
(defvar *arg* (make-symbol "ARG"))
(set-macro-character #\$
#'(lambda (stream char)
(declare (ignore char))
(list *arg* (read stream t nil t))))
The intention of DSI-Layer is to add a piece of code to determine the type of input parameters. For example, the codes
(defun BFS (G v)
(let* ((n (car (array-dimensions G)))
(visited (make-array n :initial-element 0))
(queue (list v))
(vl nil))
(incf (aref visited v))
(DSI-Layer (G next-vertex)
(do nil ((null queue) nil)
(setf v (pop queue)) (push v vl)
(next-vertex (i v visited G n)
(setf queue (nconc queue (list i)))
(incf (aref visited i)))))
vl))
will be converted to
(defun BFS (G v)
(let* ((n (car (array-dimensions G)))
(visited (make-array n :initial-element 0))
(queue (list v))
(vl nil))
(incf (aref visited v))
(case (car (type-of G))
(simple-array
(do nil ((null queue) nil)
(setf v (pop queue))
(push v vl)
(dotimes (i n)
(when (and (= (aref G v i) 1) (zerop (aref visited i)))
(setf queue (nconc queue (list i)))
(incf (aref visited i))))))
(simple-vector
(do nil ((null queue) nil)
(setf v (pop queue))
(push v vl)
(dolist (i (aref G v))
(when (zerop (aref visited i))
(setf queue (nconc queue (list i)))
(incf (aref visited i)))))))))
Now I just wonder that whether the DSI-Layer can be generated from another macro gen-case by passing the type names and corresponding code templates to it or not.
By the way, I don't think the specific meaning of generated codes matters in my problem. They are just treated as data.
Don't be tempted to use internal details of backquote. If you have the lists you want to append in distinct variables, simply append them:
`(foo
,#(append b1 b2 ... bn))
If you have a list of them in some single variable (for instance if they've come from an &rest or &body argument) then do something like
`(foo
,#(loop for b in bs
appending b))
I see your problem - you need it not for a function call
but for a macro-call with case.
One cannot use dynamically macros - in a safe way.
One has to use eval but it is not safe for scoping.
#tfb as well as me answered in this question for type-case
lengthily.
previous answer (wrong for this case)
No need for a macro.
`(foo
,#bar1
,#bar2
...
,#barn)
with evaluation of its result
by pure functions would be:
(apply foo (loop for bar in '(bar1 bar2 ... barn)
nconc bar))
nconc or nconcing instead of collect fuses lists together and is very useful in loop. - Ah I see my previous answerer used append btw appending - nconc nconcing however is the "destructive" form of "append". Since the local variable bar is destructed here which we don't need outside of the loop form, using the "destructive" form is safe here - and comes with a performance advantage (less elements are copied than when using append). That is why I wired my brain always to use nconc instead of append inside a loop.
Of course, if you want to get the code construct, one could do
`(foo ,#(loop for bar in list-of-lists
nconc bar))
Try it out:
`(foo ,#(loop for bar in '((1 2 3) (a b c) (:a :b :c)) nconc bar))
;; => (FOO 1 2 3 A B C :A :B :C)
The answers of all of you inspired me, and I came up with a solution to my problem. The macro
(defmacro Layer-Generator (obj-name tag-name callback body)
(let ((temp (gensym)) (code-gen (gensym)))
`(let ((,temp))
(defun ,code-gen (c)
(if (atom c) c
(if (eq (car c) ,tag-name)
(let ((args (cadr c)) (codes (,code-gen (cddr c))) (flag nil))
(defun gen-code (c)
(if (atom c) c
(if (eq (car c) *arg*)
(let ((n (cadr c)))
(if (zerop n) (progn (setf flag t) codes)
(nth (1- n) args)))
(let ((h (gen-code (car c))))
(if flag
(progn
(setf flag nil)
(append h (gen-code (cdr c))))
(cons h (gen-code (cdr c))))))))
(gen-code ,temp))
(cons (,code-gen (car c)) (,code-gen (cdr c))))))
(list 'case `(car (type-of ,,obj-name))
,#(let ((codes nil))
(dolist (item callback)
(push
`(cons ',(car item)
(progn
(setf ,temp ,(cadr item))
(,code-gen ,body)))
codes))
(nreverse codes))))))
produces codes which are not the same as DSI-Layer but produce codes coincident with what the latter produces. Because the codes
`(case (car (type-of ,obj-name))
(tag1
,#(#|codes1|#))
(tag2
,#(#|codes2|#))
...)
are equivalent to
(list 'case `(car (type-of ,obj-name))
(cons 'tag1 (#|codes1|#))
(cons 'tag2 (#|codes2|#))
...)
And now we can use a loop to generate it just as what the Layer-Generator does.
I have this function which gives me the element at given position in a list and need to rewrite it with cond instead of if. Also I want to change it a bit so If I give a negative value it returns nil for example
(getn 2 '(a b c)) => (c)
(getn -1 '(a b c)) => nil
The function :
(defun getn (n lst)
(if
(zerop n)
(car lst)
(getn (1- n) (cdr lst)) ) )
I did that but doesn't work :
(defun getn (nb liste)
(cond
((= 0 nb) liste)
(getn (1- n) (cdr liste)) )
Your first version is almost right. Note that when you call getn recursively you are shortening the list, so there will be a point where you are passing nil as the lst argument. You have to check for this condition before anything else and return nil if lst is nil.
cond is like a list of sequential if's. In your case you can write:
(cond ((null lst) nil)
((< n 0) nil)
((= n 0) (car lst))
...
)
(defun getn (n lst)
(cond ((or (null lst) (< n 0)) nil)
((= n 0) (car lst))
(t (getn (- n 1) (cdr lst)))))
For the case, that the nth element of the list is itself nil,
in lisp often one sends additional information. A second value, which is t,
if an element was found, and nil if no element was found.
So nil; t means the nth element was nil, while nil; nil means no element
was found.
(defun getn (n lst)
(cond ((or (null lst) (< n 0)) (values nil nil))
((= n 0) (values (car lst) t))
(t (getn (- n 1) (cdr lst)))))
[8]> (getn 1 '(1 nil 3))
NIL ;
T
;; an element was found -> T as second value, and the element was `nil`
[9]> (getn 1 '(1))
NIL ;
NIL
;; no element was found -> nil as second value, and therefore first value is also `nil`.
A very good book to learn recursive thinking and programming in lisp is The little schemer or the older version the little lisper. I learned through it thinking recursively.
I am new to LISP apparently... I am writing a function that takes a list and returns that list with all the duplicates removed, so (myPurge '(p a c e p c))->(a e p c)
This is my (edited)code:
(defun myPurge (L)
(if (eq L nil) ;if empty return nil
nil
(if(eq (car L)(car(cdr L)) ) ;if I find a match call function on
;rest of list
(myPurge (cdr L))
;else return that term and than call on
(progn ;rest of list
(car L)
(myPurge(cdr L)) ))))
*BUTTTTTTTT, when I call this function I get NIL!
*:
Why am i getting NIL instead of it returning car L ?
******Thank you all, this is my finished code that I ended up using( it uses another function 'myMember' I defined earlier.******
(defun myPurge (L)
(if (eq L nil)
nil
(if(myMember(car L)(cdr L))
(myPurge(cdr L))
(cons (car L)(myPurge(cdr L))))))))
****here is myMember*****it returns true if X is a member of L
(defun myMember (X L)
(if(eq L nil)
nil
(if(eq X(car L))
t
(myMember X(cdr L)) )) )
After reformatting your code looks like this:
(defun myPurge (L)
(if (eq L nil)
nil
(if (eq (car L) (car (cdr L)))
(myPurge (cdr L))
(car L)
(myPurge (cdr L)))))
As you can see, the last if is called with 4 arguments. But if only takes 3 arguments (condition, then-part, else-part).
Your code:
(defun myPurge (L)
(if (eq L nil) ;if empty return nil
nil
(if(eq (car L)(car(cdr L)) ) ;if I find a match call function on rest
;of list
(myPurge (cdr L))
;else return that term and than call on
(progn ;rest of list
(car L)
(myPurge(cdr L)) ))))
Correctly indented/formatted/named:
(defun my-purge (list)
(if (null list)
nil
(if (eql (first list) (second list))
(myPurge (rest list))
(progn
(first list)
(my-purge (rest list))))))
What looks strange? See the comment below.
(defun my-purge (list)
(if (null list)
nil
(if (eql (first list) (second list))
(myPurge (rest list))
(progn
(first list) ; <- what does this do?
(my-purge (rest list))))))
Bonus: you can get rid of the nested IFs:
(defun my-purge (list)
(cond ((null list)
nil)
((eql (first list) (second list))
(myPurge (rest list)))
(t
(first list)
(my-purge (rest list)))))
I am trying to check if a list has a mountain aspect or not in lisp.
e.g:1,5,9,6,4,3
l is my list and aux is 0-the ascending part of l or 1-the descending part of the list.
muntemain just call munte starting with aux=0,the ascending part
my error is :
Badly formed lambda: (AND (< (CAR L) (CAR (CDR L))) (EQ AUX 0))
and I can't see the problem.Can someone help please?
(defun munte (l aux)
(cond
((and (atom l) (null aux)) NIL)
((and (null l) (null aux)) NIL)
((and (atom l) (eq aux 1)) T)
((and (null l) (eq aux 1) T)
((and (< (car l) (car(cdr l))) (eq aux 0)) (munte(cdr l) 0))
((and (or (> (car l) (cadr l)) (= (car l) (cadr l))) (eq aux 0))(munte(cdr l) 1))
( and (> (car l) (cadr l)) (eq aux 1)) (munte(cdr l) 1))
(T NIL)
)
)
(defun muntemain (l)
(cond
((> (car l) (cadr l)) NIL)
((< (length l) 2) NIL)
(T (munte l 0))
)
)
Formatting
As noted by Barmar, you really need to use an editor to help you with the parenthesis. There are many tutorials for installing Emacs+Slime. Take some time to install proper tools.
Don't use EQ for numbers and characters
An implementation is permitted to make "copies" of characters and
numbers at any time. The effect is that Common Lisp makes no guarantee
that eq is true even when both its arguments are "the same thing" if
that thing is a character or number.
Factorize tests
((and (atom l) (null aux)) NIL)
((and (null l) (null aux)) NIL)
((and (atom l) (eq aux 1)) T)
((and (null l) (eq aux 1) T)
From the definition of atom, NIL is an atom, so you don't need (null L). The different cases for aux can be grouped too. The clause below is sufficient to account for all the above ones:
((atom L) (eql aux 1))
But I don't understand why aux is not a boolean in the first place if you always bind it to 0 or 1. Just use t and nil and return aux in the above clause.
Use meaningful functions
(< (car l) (car(cdr l)))
Of course, (car(cdr ..)) is known as (cadr ..), but also as second. The above test is equivalent to:
(< (first L) (second L))
And what if your list has no second element? You will compare a number against nil and signal an error (not what you want). You need more tests. In muntemain, you seem to have a special case for when length is below 2, but the test is done only if the previous returns nil, which won't happen if an error is signaled.
An iterative alternative
Here is a completely different way to attack the problem, just to give you ideas.
(lambda (list)
(loop
;; memories
for px = nil then x
for pdx = nil then dx
;; current element
for x in list
;; first and second "derivatives" (signs only)
for dx = 1 then (signum (- x px))
for ddx = 0 then (signum (- dx pdx))
;; checks
sum ddx into total
always (and (<= dx 0) (<= -1 total 0))
finally (return (= total -1))))