I am working on a program in LISP, using CLISP to run the program.
My function has a while statement in it, but CLISP is returning
*** - EVAL: undefined function WHILE
Function is nothing fancy,
(defun heap-insert (heap item key)
"Put an item into a heap. [Page 150 CL&R]."
;; Note that ITEM is the value to be inserted, and KEY is a function
;; that extracts the numeric value from the item.
(vector-push-extend nil heap)
(let ((i (- (length heap) 1))
(val (funcall key item)))
(while (and (> i 0) (>= (heap-val heap (heap-parent i) key) val))
do (setf (aref heap i) (aref heap (heap-parent i))
i (heap-parent i)))
(setf (aref heap i) item)))
You missed loop before your while
try:
(defun heap-insert (heap item key)
"Put an item into a heap. [Page 150 CL&R]."
;; Note that ITEM is the value to be inserted, and KEY is a function
;; that extracts the numeric value from the item.
(vector-push-extend nil heap)
(let ((i (- (length heap) 1))
(val (funcall key item)))
(loop while (and (> i 0) (>= (heap-val heap (heap-parent i) key) val))
do (setf (aref heap i) (aref heap (heap-parent i))
i (heap-parent i)))
(setf (aref heap i) item)))
There's no function or macro (or "statement") with the name while in Common Lisp, so CLISP is right to give you that error message.
Maybe you meant to use the loop macro, which accepts while as part of its syntax.
There is no standard while looping construct in Common Lisp, there is one in Emacs Lisp. However, if you want one, it is relatively simple to make that happen.
(defmacro while (condition &body body)
`(loop while ,condition
do (progn ,#body)))
Related
I am trying to convert this code to lisp code.
But don't know how to do it
is it right?
for (j=i-1; j>=0 && list[j]>key; j--) {
list[j+1] = list[j];
}
(loop (set j (- i 1))
(setq (aref x(+ j 1) (aref x j))
(setq j (- j 1)
(when (or(>= j 0)
(> (aref x j) key)
(return-from foo 0))
The most straightforward way is to use the extended loop:
(loop :for j :downfrom (1- i)
:while (and (not (minusp j))
(> (aref list j) key))
:do (setf (aref list (1+ j))
(aref list j)))
(Note: I prefer to use keywords for loop keywords, because that gives me nice syntax highlighting for free. You will often also find them as plain symbols, e. g. for instead of :for.)
though it's not a word-by-word translation, i would probably go with something like this:
(let* ((data (vector 1 2 3 4 5 6 7 8 9))
(key 3)
(pos (or (position-if (lambda (x) (<= x key)) data :from-end t)
0)))
(setf (subseq data (1+ pos))
(subseq data pos))
data)
Looks more like a CL style to me.
I was trying to use standard loop facilities to collect into a result but it just returns nil. Why is this? it feels like this should work:
(defun coll-intersects (bounds mv)
(let ((res (list))
(loop for x from (first bounds) to (+ (first bounds) (third bounds)) do
(loop for y from (second bounds) to (+ (second bounds) (fourth bounds))
if (not (member (cl-byte (aref mapa x y)) mv))
collect (aref mapa x y) into res
))))
but no, i have to do this:
(defun coll-intersects (bounds mv)
(let ((res (list)))
(loop for x from (first bounds) to (+ (first bounds) (third bounds)) do
(loop for y from (second bounds) to (+ (second bounds) (fourth bounds))
do
(if (not (member (cl-byte (aref mapa x y)) mv))
(push (aref mapa x y) res))
))
res))
why? i was really confused why the first one was not working
As Ehvince's answer says, the problem is that
(loop ...
collect ... into x
...)
binds x. The purpose of this construct is really so you can collect multiple lists:
(defun partition (l)
(loop for e in l
if (evenp e)
collect e into evens
else
collect e into odds
finally (return (values evens odds))))
for instance.
In the case where you want to collect a single list from nested loops and you care about order you can do this trick:
(defun sublist-evens (l)
(loop for s in l
nconcing
(loop for e in s
when (evenp e)
collect e)))
Here the outer loop essentially nconcs together the results from the inner loop. This can nest of course:
(loop ...
nconcing
(loop ...
nconcing
(loop ...
collect ...)))
will work. It is also possible that loop is smart enough to keep a tail pointer to the list it's building with nconc / nconcing, although you'd have to check that.
However in cases where you want to build some list in-order from some deeply-nested loop (or any other search process) I find it's almost always more pleasant to use a collecting macro to do that (disclaimer: I wrote this one). With such a macro the above sublist-evens function looks like this:
(defun sublist-evens (l)
(collecting
(dolist (s l)
(dolist (e s)
(when (evenp e) (collect e))))))
and
> (sublist-evens '((1 2 3) (4 5 6)))
(2 4 6)
And you can do better:
(defun tree-partition (tree)
(with-collectors (evens odds)
(labels ((search (it)
(typecase it
(list
(dolist (e it)
(search e)))
(integer
(if (evenp it)
(evens it)
(odds it)))
(t
(warn "unexpected ~A" (type-of it))))))
(search tree))))
and now
> (tree-partition '(((1 2 3) (4)) 5))
(2 4)
(1 3 5)
(And for hack value you can use another macro to express the above more concisely:
(defun tree-partition (tree)
(with-collectors (evens odds)
(iterate search ((it tree))
(typecase it
(list
(dolist (e it)
(search e)))
(integer
(if (evenp it)
(evens it)
(odds it)))
(t
(warn "unexpected ~A" (type-of it)))))))
Disclaimer: I wrote that macro too.)
Here's the first snippet, with the let parenthesis corrected, simplified to be made reproducible:
(defun coll-intersects (bounds mv)
(let ((res (list))) ;; <-- third closing paren
(loop for x from (first bounds) to (+ (first bounds) (third bounds)) do
(loop for y from (second bounds) to (+ (second bounds) (fourth bounds))
if (evenp y)
collect y into res
))))
Now when I enter it into the REPL, SBCL warns me about an unused res:
; caught STYLE-WARNING:
; The variable RES is defined but never used.
That's a big hint.
The issues I see:
you use do for the outer loop, not collect, and you don't return res, so the functions always returns nil.
collect … into presumably uses an internal variables, not your res :S In addition the loop doesn't say what to do with it. I added finally (return res) and I get results. You can also use push like in the second example. But it doesn't seem necessary to use into, just use collect y.
it is usually not necessary to declare intermediate variables with an outer let.
Here's a simpler function that returns (dumb) results:
(defun coll-intersects (bounds)
(loop for x from (first bounds) to (+ (first bounds) (third bounds)) collect
(loop for y from (second bounds) to (+ (second bounds) (fourth bounds))
if (evenp y)
collect y)))
(coll-intersects '(1 2 3 4))
((2 4 6) (2 4 6) (2 4 6) (2 4 6))
If you use nconcing instead of the first collect, you'll get a flat list (as pointed out by #tfb).
or:
(defun coll-intersects (bounds)
(let ((res (list)))
(loop for x from (first bounds) to (+ (first bounds) (third bounds)) do
(loop for y from (second bounds) to (+ (second bounds) (fourth bounds))
if (evenp y)
do (push y res)
))
res))
(coll-intersects '(1 2 3 4))
(6 4 2 6 4 2 6 4 2 6 4 2)
In your first example, the return value from the function is the return value from the outer loop. It doesn't collect any values (the inner loop does) and thus most probably just returns a nil.
In your second example, your function explicitly returns the value of res.
I've been fiddling with Lisp programs for a little while and one thing that I can never seem to figure out is how to use a loop on a list inside a function. I'm trying to create a function that will take a list as the parameters while using a do... loop. I know how to do it with if statements but now I need to use a loop. Does anyone have a clue on how to do that?
(defun maximum (a_list)
(if (= (length a_list) 1)
(car a_list)
(if (> (car a_list) (maximum (cdr a_list)))
(car a_list)
(maximum (cdr a_list))))
(format t "~d" a_list))
Here's what I have so far on the if statements. They might not work right but at least they work.
Here another set of possibilities, in addition to those proposed in another answers.
First of all, when writing a function, one should also test for special cases, while you do not check for an empty list. So the structure of the function could be something of this type:
(defun maximum (l)
(if (null l)
nil ; or give an error
...normal solution...))
In case of returning nil, this structure in Common Lisp is identical to the following one, given that and evaluates its arguments in sequence, and returns nil as soon as an argument is evaluated to nil, otherwise returns the value of the last argument:
(defun maximum (l)
(and l ...normal solution...))
Here the alternative solutions.
Without loop or recursion, with predefined functions reduce (manual) and max (manual).
(defun maximum (l)
(and l (reduce #'max l)))
With the construct dolist (manual), that iterates a variable over a list:
(defun maximum (l)
(and l (let ((result (car l)))
(dolist (x (cdr l) result)
(when (> x result)
(setf result x))))))
And finally, with a compact version of do (manual):
(defun maximum (l)
(and l (do ((maximum-so-far (car l) (max (pop l) maximum-so-far)))
((null l) maximum-so-far))))
With loop the solution is trivial:
(loop for x in '(1 2 7 4 5) maximize x)
I assume therefore that what you intend to do is to write the function with a do loop. In this case you have to traverse the list keeping track of the maximum element so far, and updating this value if you find a larger value:
(setq list '(1 2 7 4 5))
(do* ((l list (cdr l))
(x (car l) (car l))
(max x) )
((null l) max)
(if (> x max)
(setq max x) ))
(defun maximum (list)
(let ((result)) ;; short for ((result nil))
(dolist (x list)
(if result
(when (> x result)
(setf result x))
(setf result x)))
result))
(dolist (x list) ... ) is like Python's [... for x in list]
It is typical imperative style to create a variable with
let and setf to it to change its value.
I want to access arrays with the indices being in a list. Let's call this utility arefl, and it's defined as follows:
(arefl array '(x y z ...)) equals (aref array x y z ...)
My goal is to create some generic functions that operate on matrices of any size.
I have failed to implement such a thing with macros and just aref. The closest thing that I have is:
(defmacro arefl (array is)
"Access array by a list of indices"
`(apply #'aref (cons ,array ,is)))
which works, and actually it also works with (setf (arefl array is) value) but the compiler, at least sbcl, throws a warning telling me that I'm redefining setf for (I guess) apply. The warning is:
; in: DEFUN (SETF AREFL**)
; (SETF (APPLY #'AREF ARRAY (REDUCE 'CONS ARGS :FROM-END T)) NEW-VALUE)
; --> LET* MULTIPLE-VALUE-BIND LET APPLY MULTIPLE-VALUE-CALL
; ==>
; #'(SETF AREF)
;
; caught STYLE-WARNING:
; defining as a SETF function a name that already has a SETF macro:
; (SETF AREF)
;
; compilation unit finished
; caught 1 STYLE-WARNING condition
--
Is there a better way? I'm looking for an implementation that works well with setf and does not need a call to another function like apply nor does do any cons
Ok, define-setf-expander is overkill for this.
(defun arefl (array list)
(apply #'aref array list))
(defun (setf arefl) (x array list)
(setf (apply #'aref array list) x))
See "APPLY Forms as Places": http://clhs.lisp.se/Body/05_abe.htm
First, though I recognize that you said
I'm looking for an implementation that works well with setf and does not need a call to another function like apply nor does do any cons
however, you can simply use apply 'aref here, and you don't need to do any consing, since only apply's final argument needs to be a list. That means that all the following are equivalent:
(aref array 0 1)
(apply 'aref (list array 0 1))
(apply 'aref array (list 0 1))
(apply 'aref array 0 (list 1))
(apply 'aref array 0 1 '())
Most importantly, if you want to avoid calling cons, it means that you can do
(apply 'aref array indices)
You can use setf with this too (although you will have to use #'array, and not 'array):
(setf (apply #'aref array indices) new-value)
Since apply works here, you just need to make your aref* and (setf aref*) functions (to be analogous with list*):
(defun aref* (array &rest args)
(apply 'aref array (reduce 'cons args :from-end t)))
(defun (setf aref*) (new-value array &rest args)
(setf (apply #'aref array (reduce 'cons args :from-end t)) new-value))
The (reduce 'cons args :from-end t) in those is used to support spreadable argument list designators, which are what apply uses. Using this idiom, you can pass exactly the same kinds of arguments to (aref* ...) that you could use in (apply #'aref ...). That might be a bit more complex than the use cases that you've described, but it means that rather than having to specifically describe what sorts of arguments aref* takes, you can simply say (like the documentation for apply does), that aref*'s args are a spreadable argument list designator, and that aref* applies aref to the args.
Here are some I could come up with, but I'm not happy with either of them:
(defsubst i-swap (array a b)
(let ((c (aref array a)))
(aset array a (aref array b))
(aset array b c) array))
(defun i-permute-recursive (array offset length)
(if (= offset length)
(message "array: %s" array)
(let ((i offset))
(while (< i length)
(i-permute-recursive (i-swap array i offset) (1+ offset) length)
(i-swap array i offset)
(incf i)))))
(defun i-permute-johnson-trotter (array)
(let ((i 0) largest largest-pos largest-sign swap-to
(markers (make-vector (length array) nil)))
(while (< i (length array))
(aset markers i (cons '1- i))
(incf i))
(setcar (aref markers 0) nil)
(while (some #'car markers)
(setq i 0 largest nil)
(while (< i (length array))
(destructuring-bind (tested-sign . tested-value)
(aref markers i)
(when (and tested-sign
(or (not largest)
(< largest tested-value)))
(setq largest tested-value largest-pos i
largest-sign tested-sign)))
(incf i))
(when largest
(setq swap-to (funcall largest-sign largest-pos))
(i-swap array largest-pos swap-to)
(i-swap markers largest-pos swap-to)
(when (or (= swap-to 0) (= swap-to (1- (length array)))
(> (cdr (aref markers
(funcall largest-sign swap-to)))
largest))
(setcar (aref markers swap-to) nil))
(setq i 0)
(while (< i (length array))
(setq swap-to (cdr (aref markers i)))
(when (> swap-to largest)
(setcar (aref markers i)
(if (< i largest-pos) '1+ '1-)))
(incf i))
(message "array: %s <- makrers: %s" array markers)))))
The recursive variant both does extra swapping and it being recursive makes me very unhappy (I'm not concerned with the size of the stack as I'm concerned with ease of debugging - recursive functions look terrible in debugger...)
The other version I implemented from it's description on Wiki, here if you are interested: http://en.wikipedia.org/wiki/Steinhaus%E2%80%93Johnson%E2%80%93Trotter_algorithm but it is both too long (just the code itself is very long) and it's O(n*m) more or less, which, for short arrays is almost like quadratic. (m being the length of the array, and n being the number of permutations.)
From looking at recursive version I hope that there must be a *plain* O(n) variant, but I just can't wrap my head around it...
If you feel more comfortable writing it in another Lisp, you are welcome!
This is what I've got for now, thanks to this blog: http://www.quickperm.org/
(defun i-permute-quickperm (array)
(let* ((len (length array))
(markers (make-vector len 0))
(i 1) j)
(while (< i len)
(if (< (aref markers i) i)
(progn
(setq j (if (oddp i) (aref markers i) 0))
(i-swap array j i)
(message "array: %s" array)
(aset markers i (1+ (aref markers i)))
(setq i 1))
(aset markers i 0)
(incf i)))))
But please feel free to suggest a better one. (Though this looks pretty to me, so idk :P)
(defun map-permutations (fn vector)
"Call function FN on each permutation of A, with each successive
permutation one swap away from previous one."
(labels ((frob (n)
(if (zerop n) (funcall fn vector)
(dotimes (i n (frob (1- n)))
(frob (1- n))
(rotatef (aref vector n)
(aref vector (if (oddp n) i 0)))))))
(frob (1- (length vector)))))
Example (if using Emacs-Lisp, replace #'print with #'message and C-he to see the result):
CL-USER> (map-permutations #'print "123")
"123"
"213"
"312"
"132"
"231"
"321"