From the book "ANSI Common Lisp", p. 100 ch 6.1 :
Suppose that a marble is a structure with a single field called color.
The function UNIFORM-COLOR takes a list of marbles and returns
their color, if they all have the same color, or nil if they have
different colors.
UNIFORM-COLOR is usable on a setf place in order to make the color
of each element of list of marbles be a specific color.
(defstruct marble color)
(defun uniform-color (lst &optional (color (and lst (marble-color (car lst)))))
(every #'(lambda (m) (equal (marble-color m) color)) lst))
(defun (setf uniform-color) (color lst)
(mapc #'(lambda (m) (setf (marble-color m) color)) lst))
How could you implement the defun (setf uniform) in a tail-recursive way instead of using the mapc applicative operator ?
This question is specific to the case of (defun (setf ...)), it is not a question about how recursion or tail-recursion work in general.
i guess you can just call setf recursively:
(defun (setf all-vals) (v ls)
(when ls
(setf (car ls) v)
(setf (all-vals (cdr ls)) v)))
CL-USER> (let ((ls (list 1 2 3 4)))
(setf (all-vals ls) :new-val)
ls)
;;=> (:NEW-VAL :NEW-VAL :NEW-VAL :NEW-VAL)
this is how sbcl expands this:
(defun (setf all-vals) (v ls)
(if ls
(progn
(sb-kernel:%rplaca ls v)
(let* ((#:g328 (cdr ls)) (#:new1 v))
(funcall #'(setf all-vals) #:new1 #:g328)))))
For the specific case of marbles:
(defun (setf uniform-color) (color lst)
(when lst
(setf (marble-color (car lst)) color)
(setf (uniform-color (cdr lst)) color)))
General case
The answer is the same for setf functions and regular functions.
Let's say you have another function f that you want to call to print all the values in a list:
(defun f (list)
(mapc 'print list))
You can rewrite it recursively, you have to consider the two distinct case of recursion for a list, either it is nil or a cons cell:
(defun f (list)
(etypecase list
(null ...)
(cons ...)))
Typically in the null case (this is a type), you won't do anything.
In the general cons case (this is also a type), you have to process the first item and recurse:
(defun f (list)
(etypecase list
(null nil)
(cons
(print (first list))
(f (rest list)))))
The call to f is in tail position: its return value is the return value of the enclosing f, no other processing is done to the return value.
You can do the same with your function.
Note
It looks like the setf function defined in the book does not return the value being set (the color), which is bad practice as far as I know:
all that is guaranteed is that the expansion is an update form that works for that particular implementation, that the left-to-right evaluation of subforms is preserved, and that the ultimate result of evaluating setf is the value or values being stored.
5.1.1 Overview of Places and Generalized Reference
Also, in your specific case you are subject to 5.1.2.9 Other Compound Forms as Places, which also says:
A function named (setf f) must return its first argument as its only value in order to preserve the semantics of setf.
In other words (setf uniform-color) should return color.
But apart from that, the same section guarantees that a call to (setf (uniform-color ...) ...) expands into a call to the function named (setf uniform-color), so it can be a recursive function too. This could have been a problem if this was implemented as macro that expands into the body of your function, but fortunately this is not the case.
Implementation
Setting all the colors in a list named marbles to "yellow" is done as follows:
(setf (uniform-color marbles) "yellow")
You can define (setf uniform-color) recursively by first setting the color of the first marble and then setting the color of the rest of the marbles.
A possible tail-recursive implementation that respects the semantics of setf is:
(defun (setf uniform-color) (color list)
(if list
(destructuring-bind (head . tail) list
(setf (marble-color head) color)
(setf (uniform-color tail) color))
color))
Related
I'm trying to do a recursive version of the function position called positionRec. The objective is define the position of an element in a list, and if the element is not in the list return "nil". For exemple:
(positionRec 'a '(b c d a e)) => 4
(positionRec 'a '(b c d e)) => nil
I have written:
(defun positionRec (c l)
(cond
((atom l) (return nil))
((equal c (first l)) 1)
(t (+ 1 (positionRec c (rest l)))) ) )
I don't succeed to return nil. I have an error "*** - return-from: no block named nil is currently visible"
Anyone can teach me how to do it?
Lisp is an expression language: it has only expressions an no statemends. This means that the value of a call to a function is simply the value of the last form involved in that call This is different than many languages which have both statements and expressions and where you have to explicitly litter your code with explicit returns to say what the value of a function call is.
A cond form in turn is an expression. The value of an expression like
(cond
(<test1> <test1-form1> ... <test1-formn>)
(<test2> <test1-form1> ... <test1-formn>)
...
(<testn> <testn-form1> ... <testn-formnn>))
is the <testm-formn> of the first <testm> which is true, or nil if none of them are (and as a special case, if there are no forms after a test which is true the value is the value of that test).
So in your code you just need to make sure that the last form in the test which succeeds is the value you want:
(defun positionRec (c l)
(cond
((atom l) nil)
((equal c (first l)) 1)
(t (+ 1 (positionRec c (rest l))))))
So, what use is return? Well, sometimes you really do want to say 'OK, in the middle of some complicated loop or something, and I'm done now':
(defun complicated-search (...)
(dolist (...)
(dolist (...)
(dotimes (...)
(when <found-the-interesting-thing>
(return-from complicated-search ...))))))
return itself is simply equivalent to (return-from nil ...) and various constructs wrap blocks named nil around their bodies. Two such, in fact, are dotimes and dolist, so if you want to escape from a big loop early you can do that:
(defun complicated-search (...)
(dolist (...)
(when ...
(return 3)))) ;same as (return-from nil 3)
But in general because Lisp is an expression language you need to use return / return-from much less often than you do in some other languages.
In your case, the modified function is going to fail: if you get to the ((atom l) nil) case, then it will return nil to its parent which will ... try to add 1 to that. A better approach is to keep count of where you are:
(defun position-of (c l)
(position-of-loop c l 1))
(defun position-of-loop (c l p)
(cond
((atom l) nil)
((equal c (first l)) p)
(t (position-of-loop c (rest l) (1+ p)))))
Note that this (as your original) uses 1-based indexing: zero-based would be more compatible with the rest of CL.
It would probably be idiomatic to make position-of-loop a local function:
(defun position-of (c l)
(labels ((position-of-loop (lt p)
(cond
((atom lt) nil)
((equal c (first lt)) p)
(t (position-of-loop (rest lt) (1+ p))))))
(position-of-loop l 1)))
And you could then use an iteration macro if you wanted to make it a bit more concise:
(defun position-of (c l)
(iterate position-of-loop ((lt l) (p 1))
(cond
((atom lt) nil)
((equal c (first lt)) p)
(t (position-of-loop (rest lt) (1+ p))))))
The main problem is that you're trying to deal with incommensurable values. On the one hand, you want to deak with numbers, on the other, you want to deal with the empty list. You cannot add a number to a list, but you will inherently try doing so (you have an unconditional (1+ ...) call in your default branch in your cond).
There are ways to work around that, one being to capture the value:
(cond
...
(t (let ((val (positionRec c (rest l))))
(when val ;; Here we "pun" on nil being both false and the "not found" value
(1+ val)))))
Another would be to use a method amenable to tail-recursion:
(defun positionrec (element list &optional (pos 1))
(cond ((null list) nil)
((eql element (head list)) pos)
(t (positionrec element (rest list) (1+ pos)))))
The second function can (with a sufficently smart compiler) be turned into, basically, a loop. The way it works is by passing the return value as an optional parameter.
You could build a version using return, but you would probably need to make use of labels for that to be straight-forward (if you return nil directly from the function, it still ends up in the (1+ ...), where you then have numerical incompatibility) so I would go with either "explicitly capture the value and do the comparison against nil/false" or "the version amenable to tail-call elimination" and simply pick the one you find the most readable.
I am trying to learn Common Lisp with the book Common Lisp: A gentle introduction to Symbolic Computation. In addition, I am using SBCL, Emacs and Slime.
In chapter 7, the author suggests there are three styles of programming the book will cover: recursion, iteration and applicative programming.
I am interested on the last one. This style is famous for the applicative operator funcall which is the primitive responsible for other applicative operators such as mapcar.
Thus, with an educational purpose, I decided to implement my own version of mapcar using funcall:
(defun my-mapcar (fn xs)
(if (null xs)
nil
(cons (funcall fn (car xs))
(my-mapcar fn (cdr xs)))))
As you might see, I used recursion as a programming style to build an iconic applicative programming function.
It seems to work:
CL-USER> (my-mapcar (lambda (n) (+ n 1)) (list 1 2 3 4))
(2 3 4 5)
CL-USER> (my-mapcar (lambda (n) (+ n 1)) (list ))
NIL
;; comparing the results with the official one
CL-USER> (mapcar (lambda (n) (+ n 1)) (list ))
NIL
CL-USER> (mapcar (lambda (n) (+ n 1)) (list 1 2 3 4))
(2 3 4 5)
Is there a way to implement mapcar without using recursion or iteration? Using only applicative programming as a style?
Thanks.
Obs.: I tried to see how it was implemented. But it was not possible
CL-USER> (function-lambda-expression #'mapcar)
NIL
T
MAPCAR
I also used Emacs M-. to look for the documentation. However, the points below did not help me. I used this to find the files below:
/usr/share/sbcl-source/src/code/list.lisp
(DEFUN MAPCAR)
/usr/share/sbcl-source/src/compiler/seqtran.lisp
(:DEFINE-SOURCE-TRANSFORM MAPCAR)
/usr/share/sbcl-source/src/compiler/fndb.lisp
(DECLAIM MAPCAR SB-C:DEFKNOWN)
mapcar is by itself a primitive applicative operator (pag. 220 of Common Lisp: A gentle introduction to Symbolic Computation). So, if you want to rewrite it in an applicative way, you should use some other primitive applicative operator, for instance map or map-into. For instance, with map-into:
CL-USER> (defun my-mapcar (fn list &rest lists)
(apply #'map-into (make-list (length list)) fn list lists))
MY-MAPCAR
CL-USER> (my-mapcar #'1+ '(1 2 3))
(2 3 4)
CL-USER> (my-mapcar #'+ '(1 2 3) '(10 20 30) '(100 200 300))
(111 222 333)
Technically, recursion can be implemented as follows:
(defun fix (f)
(funcall (lambda (x) (funcall x x))
(lambda (x) (funcall f (lambda (&rest y) (apply (funcall x x) y))))))
Notice that fix does not use recursion in any way. In fact, we could have only used lambda in the definition of f as follows:
(defconstant fix-combinator
(lambda (g) (funcall
(lambda (x) (funcall x x))
(lambda (x) (funcall
g
(lambda (&rest y) (apply (funcall x x)
y)))))))
(defun fix-2 (f)
(funcall fix-combinator f))
The fix-combinator constant is more commonly known as the y combinator.
It turns out that fix has the following property:
Evaluating (apply (fix f) list) is equivalent to evaluating (apply (funcall f (fix f)) list). Informally, we have (fix f) = (funcall f (fix f)).
Thus, we can define map-car (I'm using a different name to avoid package lock) by
(defun map-car (func lst)
(funcall (fix (lambda (map-func) (lambda (lst) ; We want mapfunc to be (lambda (lst) (mapcar func lst))
(if (endp lst)
nil
(cons (funcall func (car lst))
(funcall map-func (cdr lst)))))))
lst))
Note the lack of recursion or iteration.
That being said, generally mapcar is just taken as a primitive notion when using the "applicative" style of programming.
Another way you can implement mapcar is by using the more general reduce function (a.k.a. fold). Let's name the user-provided function f and define my-mapcar.
The reduce function carries an accumulator value that builds up the resulting list, here it is going take a value v, a sublist rest, and call cons with (funcall f v) and rest, so as to build a list.
More precisely, here reduce is going to implement a right-fold, since cons is right-associative (e.g. the recursive list is the "right" hand side, ie. the second argument of cons, e.g. (cons a (cons b (cons nil)))).
In order to define a right-fold with reduce, you pass :from-end t, which indicates that it builds-up a value from the last element and the initial accumulator to obtain a new accumulator value, then the second to last element with that new accumulator to build a new accumulator, etc. This is how you ensure that the resulting elements are in the same order as the input list.
In that case, the reducing function takes its the current element as its first argument, and the accumulator as a second argument.
Since the type of the elements and the type of the accumulator are different, you need to pass an :initial-value for the accumulator (the default behavior where the initial-value is taken from the list is for functions like + or *, where the accumulator is in the same domain as the list elements).
With that in mind, you can write it as follows:
(defun my-map (f list)
(reduce (lambda (v rest) (cons (funcall f v) rest))
list
:from-end t
:initial-value nil))
For example:
(my-map #'prin1-to-string '(0 1 2 3))
; => ("0" "1" "2" "3")
Working on CLISP in Sublime Text.
Exp. in CLISP : less than 1 year
It's already for a while that I'm trying to solve this exercice... without success... as you might guess.
In fact I have to create a function which will modify the list and keeps only sublists which are equals or greater than the given number (watch below)
The list on which I have to work :
(setq liste '((a b) c (d) (e f) (e g x) f))
I'm supposed to find this as result :
(lenght 2 liste) => ((a b) (e f) (e g x))
liste => ((a b) (e f) (e g x))
Here my code :
(defun lenght(number liste)
(cond
((atom liste) nil)
((listp (car liste))
(rplacd liste (lenght number (cdr liste))) )
((<= (lenght number (car liste)) number)
(I don't know what to write) )
((lenght number (cdr liste))) ) )
It will be very kind if you could give me only some clue so as to let me find the good result.
Thanks guys.
Modifying the list does not make much sense, because it gets hairy at the head of the list to retain the original reference. Return a new list.
This is a filtering operation. The usual operator in Common Lisp for that is remove-if-not (or remove-if, or remove, depending on the condition). It takes a predicate that should return whether the element should be kept. In this case, it seems to be (lambda (element) (and (listp element) (>= (length element) minlength))).
(defun filter-by-min-length (minlength list)
(remove-if-not (lambda (element)
(and (listp element)
(>= (length element) minlength)))
list))
In many cases, when the condition is known at compile time, loop produces faster compiled code:
(defun filter-by-min-length (minlength list)
(loop :for element :in list
:when (and (listp element)
(>= (length element) minlength))
:collect element))
This returns a new list that fulfills the condition. You'd call it like (let ((minlength-list (filter-by-min-length 2 raw-list))) …).
Many basic courses insist on recursively using primitive operations on cons cells for teaching purposes at first.
The first attempt usually disregards the possible stack exhaustion. At each step, you first look whether you're at the end (then return nil), whether the first element should be discarded (then return the result of recursing on the rest), or if it should be kept (then cons it to the recursion result).
If tail call optimization is available, you can refactor this to use an accumulator. At each step, instead of first recursing and then consing, you cons a kept value onto the accumulator and pass it to the recursion. At the end, you do not return nil, but reverse the accumulator and return that.
Well, I have found the answer that I was looking for, after scratching my head until blood...
Seriously, here is the solution which is working (and thanks for the correction about length which helped me to find the solution ^^) :
(defun filter-by-min-length (min-length liste)
(cond
((atom liste) nil)
((and (listp (car liste))(>= (length (car liste)) min-length))
(rplacd liste (filter-by-min-length min-length (cdr liste))) )
((filter-by-min-length min-length (cdr liste))) ) )
A non-modifying version
(defun filter-by-min-length (min-length le)
(cond ((atom le) nil)
((and (listp (car le)) (>= (length (car le)) min-length))
(cons (car le) (filter-by-min-length min-length (cdr le))))
(t (filter-by-min-length min-length (cdr le)))))
Test:
(defparameter *liste* '((a b) c (d) (e f) (e g x) f))
(filter-by-min-length 2 *liste*)
;; ((A B) (E F) (E G X))
*liste*
;; ((A B) C (D) (E F) (E G X) F) ; -> *liste* not modified
For building good habits, I would recommend to use defparameter instead of setq, since the behaviour of setq might not always be defined (see here). In the link, it is said:
use defvar, defparameter, or let to introduce new variables. Use setf
and setq to mutate existing variables. Using them to introduce new
variables is undefined behaviour
(defun lat
(lambda (l)
(cond ((null l) t)
((atom (car l))(lat (cdr l))
(t nil))))
The function takes a list as an argument. It is a recursive function that checks every element in the list. Whether it is atom or not. If every element is an atom, then it returns true else false.
Following is the error displayed
While compiling LAT :
Bad lambda list : (LAMBDA (L)
(COND ((NULL L) T) ((ATOM # #)) (T NIL)))
[Condition of type CCL::COMPILE-TIME-PROGRAM-ERROR]
Just like Hal Abelson called Scheme "lisp" in the SICP videos this book does the same, however the language in the book is a predecessor to Scheme and not Common Lisp. When you see:
(define name
(lambda (arg ...)
body ...)
This is the same as this in CL:
(defun name (arg ...)
body ...)
The reason is that in Scheme it's the same namespace for operator as well as operand bindings. A lisp-2 like Common Lisp can split it up like this:
(setf (fdefinition 'name)
(lambda (arg ...)
body ...))
This probably won't happen since you can always use defun, but in the event you return a function from a function you can do this or you must rely on funcall or apply to use the returned value:
;; This is a function that creates a function
(defun get-counter (from step)
(lambda ()
(let ((tmp from))
(incf from step)
tmp)))
When using this you might want to bind it globally:
(setf (fdefinition 'evens) (get-counter 0 2))
(evens) ; ==> 0
(evens) ; ==> 2
Or in functions you get it bound to normal variables and need to funcall or apply:
(defparameter *odds* (get-counter 1 2))
(funcall *odds*)
; ==> 1
Which one do you prefer?
(list (funcall *odds*) (evens))
; ==> (3 4)
The ? in lat? inidicated predicate and in CL a p in the end does the same. Your function latp is suppose to return nil or t so it should not return a function at all. Thus:
(defun latp (list)
(cond ((null list) t)
((atom (car list)) (latp (cdr list)))
(t nil)))
This of course is the same as:
(defun latp (list)
(or (null list)
(and (atom (car list))
(latp (cdr list)))))
Unlike Scheme using the name list as the argument does not affect the function call to list.
I am trying to find the position of an atom in the list.
Expected results:
(position-in-list 'a '(a b c d e)) gives 0
(position-in-list 'b '(a b c d e)) gives 1
(position-in-list 'Z '(a b c d e)) gives nil.
I have a function that gives the position correctly when the item is in the list:
(defun position-in-list (letter list)
(cond
((atom list) nil)
((eq (car list) letter) 0)
(t (+ 1 (position-in-list letter (cdr list))))))
The problem is that it doesn't return nil when the item is not present, as if it reaches (atom list) nil it will give this error: *** - 1+: nil is not a number as when it unstacks, it will try to add the values to nil.
Is there a way to adapt this function (keeping the same structure) so that it correctly returns nil when the item is not in the list?
Notes:
I know that there is a position function in the library, but I don't want to use it.
I know my question is similar to this one, but the problem I mention above is not addressed.
* edit *
Thanks to all of you for your answers. Although I don't have the necessary knowledge to understand all the suggestions you mentioned, it was helpful.
I have found another fix to my problem:
(defun position-in-list (letter liste)
(cond
((atom liste) nil)
((equal letter (car liste)) 0)
((position-in-list letter (cdr liste)) (+ 1 (position-in-list letter (cdr liste)))) ) )
One possible solution is to make the recursive function a local function from another function. At the end one would then return from the surrounding function - thus you would not need to return the NIL result from each recursive call.
Local recursive function returns from a function
Local recursive functions can be defined with LABELS.
(defun position-in-list (letter list)
(labels ((position-in-list-aux (letter list)
(cond
((atom list) (return-from position-in-list nil))
((eql (first list) letter) 0)
(t (+ 1 (position-in-list-aux
letter (cdr list)))))))
(position-in-list-aux letter list)))
This RETURN-FROM is possible because the function to return from is visible from the local function.
Recursive function returns to another function
It's also possible to return control to another function using CATCH and THROW:
(defun position-in-list (letter list)
(catch 'position-in-list-catch-tag
(position-in-list-aux letter list)))
(defun position-in-list-aux (letter list)
(cond
((atom list) (throw 'position-in-list-catch-tag nil))
((eql (first list) letter) 0)
(t (+ 1 (position-in-list-aux
letter (cdr list))))))
Test function EQL
Note also that the default test function by convention is EQL, not EQ. This allows also numbers and characters to be used.
You need to check the value returned by the recursive call:
(defun position-in-list (letter list)
(cond
((atom list) nil)
((eq (car list) letter) 0)
(t
(let ((found (position-in-list letter (cdr list))))
(and found
(1+ found))))))
Please note that this implementation is not tail-recursive.
In general, it's useful to provide a :test keyword parameter to pick what equality function we should use, so we do that. It's also handy to give the compiler the ability to tail-call-optimise (note, TCO is not required in Common Lisp, but most compilers will do so with the right optimisation settings, consult your compiler manual), so we use another keyword parameter for that. It also means that whatever we return from the innermost invocation is returned exactly as-is, so it does not matter if we return a number or nil.
(defun position-in-list (element list &key (test #'eql) (position 0))
(cond ((null list) nil)
((funcall test element (car list)) position)
(t (position-in-list element
(cdr list)
:test test :position (1+ position)))))
Of course, it is probably better to wrap the TCO-friendly recursion in an inner function, so we (as Rainer Joswig correctly points out) don't expose internal implementation details.
(defun position-in-list (element list &key (test #'eql)
(labels ((internal (list position)
(cond ((null list) nil)
((eql element (car list)) position)
(t (internal (cdr list) (1+ position))))))
(internals list 0)))