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.
Related
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.
This is my code to generate a cartesian product:
(defun cartesian-product (LIST)
(LOOP FOR X IN LIST
NCONC
(LOOP FOR Y IN LIST
COLLECT (LIST X Y))))
I tried outputting one of the cartesian products with this:
(defun cartesian-product-generator (CALLBACK LIST)
(LOOP FOR X IN LIST
NCONC
(LOOP FOR Y IN LIST
DO(FUNCALL CALLBACK (LIST X Y)))))
However there are errors when I tried testing it with:
(cartesian-product-generator '(A B C))
Error: Too few arguments in call to #<Compiled-function cartesian-product-generator #x30200097E60F>:
1 argument provided, at least 2 required. While executing: cartesian-product-generator, in process listener(1).
I am new to LISP and would like to know why there's an error and how to fix this error. Ultimately, I would like to output each cartesian product per call of the function.
For example, if the lists consists of ((1 1) (1 2) (2 1) (2 2)).
I would like to generate (1 1). Then (1 2). Then (2 1). Lastly, (2 2).
Your first code does work correctly.
(defun cartesian-product (list)
(loop
for x in list
nconc (loop for y in list
collect (list x y))))
Calling it with '(a b c) returns a list:
((A A) (A B) (A C) (B A) (B B) (B C) (C A) (C B) (C C))
You want to avoid building a list and use a callback instead.
To simplify, first try to only print elements instead of collecting them.
That means that you do not care about returning the generated values
up to the caller: you just want to generate them and print them as
soon as they are available.
Basically, you can replace all nconc and collect keywords by do, and add a call to print:
(defun cartesian-product (list)
(loop
for x in list
do (loop for y in list
do (print (list x y)))))
A quick test on the REPL with '(a b c) should print the same
elements as previously, each one on a separte line.
Now, you can just generalize print and call anything you want:
(defun map-cartesian-product (function list)
(loop
for x in list
do (loop for y in list
do (funcall function (list x y)))))
Just to see if it still works, do a quick test:
(map-cartesian-product #'print '(a b c))
This should have the same behaviour as before.
Since you only iterate over a list for side-effects, you can use
DOLIST:
(defun map-cartesian-product (function list)
(dolist (x list)
(dolist (y list)
(funcall function (list x y)))))
Again, you can test that it still works as previously.
You may want to look into the cl-coroutine library available via quicklisp. Then your cartesian-product could be written as
(cl-coroutine:defcoroutine cartesian-product (list)
(loop for x in list
do (loop for y in list
do (cl-coroutine:yield (list x y)))))
An example use could be:
(cl-coroutine:with-coroutine (cartesian-product)
(let ((x (list 1 2 3)))
(loop for y = (cartesian-product x)
while y do (print y))))
; outputs (1 1) (1 2) ... (3 3)
Just want to leave my 2 cents here.
You can also do this with a macro
(defmacro cartesian-product (lists)
(let* ((indices (loop for i from 1 to (length lists)
collect (gensym (format nil "~a-i-" i))))
(initial-value `(loop for ,(car (last indices)) in ',(car (last lists))
collect `(,,#indices))))
(reduce
(lambda (x y)
`(loop for ,(car x) in ',(cadr x)
nconc ,y))
(mapcar #'list (butlast indices) (butlast lists))
:from-end t
:initial-value initial-value)))
which expands with
(cartesian-product ((H P) (a b c) (1 2 3 5)))
to
(loop for #:|1-i-806| in '(h p)
nconc (loop for #:|2-i-807| in '(a b c)
nconc (loop for #:|3-i-808| in '(1 2 3 5)
collect `(,#:|1-i-806| ,#:|2-i-807| ,#:|3-i-808|))))
and results into
((H A 1) (H A 2) (H A 3) (H A 5) (H B 1) (H B 2) (H B 3) (H B 5) (H C 1) (H C 2) (H C 3) (H C 5)
(P A 1) (P A 2) (P A 3) (P A 5) (P B 1) (P B 2) (P B 3) (P B 5) (P C 1) (P C 2) (P C 3) (P C 5))
I like it because it is quite simple and does not require recursion.
Let me give a more basic answer (without loops), but more general, i.e., cartesian products of two, three and four lists (your case is binary cartesian product with two identical arguments):
(defun make-tuples-with-object (obj lst)
(mapcar #'(lambda (x) (list obj x)) lst))
(defun cartesian-product (list-1 list-2)
(apply #'append (mapcar #'(lambda (x) (make-tuples-with-object x list-2)) list-1)))
(defun cartesian-product-ternary (list-1 list-2 list-3)
(mapcar #'(lambda (x) (cons (car x) (second x)))
(cartesian-product list-1 (cartesian-product list-2 list-3))))
(defun cartesian-product-quaternary (list-1 list-2 list-3 list-4)
(mapcar #'(lambda (x) (cons (car x) (second x)))
(cartesian-product list-1 (cartesian-product-ternary list-2 list-3 list-4))))
I've recently started learning lisp and i thought an interesting problem would be the Count Change algorithm which has been attempted many times however i've found it very difficult to even sort out how to approach this and thought i would try using loops but it just isn't working. I'll put my two useless attempts below but if anyone has any suggestions of even how i should be thinking about this problem in terms of lisp it would be really appreciated.
I would much prefer to use a recursive solution aswell.
I've been looking through the questions on here about counting change but they all tend to be object orientated while i need something more functional.
It's not home work, just private study!
(defun dollar (amount)
(let ((l 0) (j 0) (array (make-array '(5 10 20 50 100 200 500 1000 2000 5000 100000))) (results (make-array 50 :initial-element nil))
(do (l 10 (+ l 1))
(do ((= j (aref array l)) amount (+ j 1))
(+ (aref array j) (- (aref results j) (aref array l))))))
))
(defun coin-change (amount coins)
(cond ((< amount 0) 0)
((= amount 5) 1)
((null coins) 0)
(t (+ (make-change-with-coins (- amount (car coins)) coins)
(make-change-with-coins amount (cdr coins)))))
)
sample input would be (coin-change 20 '(5 10 20 50 100 200 500 1000 2000 5000 100000)) which would return 4
Standard formatting helps getting the code structure right. Reading some kind of documentation about a new language helps even more.
This is what you have written:
(defun dollar (amount)
(let ((l 0)
(j 0)
(array (make-array '(5 10 20 50 100 200 500 1000 2000 5000 100000)))
(results (make-array 50 :initial-element nil))
(do (l 10 (+ l 1))
(do ((= j (aref array l)) amount (+ j 1))
(+ (aref array j) (- (aref results j) (aref array l))))))))
Dollar doesn't get the semantics right. Make-array takes the dimensions as first argument, and you most likely wanted the do form as a body of the let. I'd use a vector literal here.
(defun dollar (amount)
(let ((l 0)
(j 0)
(array #(5 10 20 50 100 200 500 1000 2000 5000 100000))
(results (make-array 50 :initial-element nil)))
(do (l 10 (+ l 1))
(do ((= j (aref array l)) amount (+ j 1))
(+ (aref array j) (- (aref results j) (aref array l)))))))
Do takes first a list of bindings, then a form containing an end condition and return forms and finally forms that form a body.
(defun dollar (amount)
(let ((l 0)
(j 0)
(array #(5 10 20 50 100 200 500 1000 2000 5000 100000))
(results (make-array 50 :initial-element nil)))
(do ((l 10 (+ l 1)))
(#| end condition here |#
#| some more forms
that return something |#)
(do ((= j (aref array l)) ; uh, so this binds the variable "=" to j
; and updates it to (aref array l) on iteration
amount ; an empty binding, initially nil
(+ j 1)) ; binds the variable "+" to j and updates it to 1
(+ ; tries to evaluate the variable "+" as a form...
(aref array j) ; no effect
(- (aref results j) (aref array l))))))) ; would return this
I tried to correct the shape of the outer do and annotated the inner do. It makes no sense at all, as you can see.
(defun coin-change (amount coins)
(cond ((< amount 0) 0)
((= amount 5) 1)
((null coins) 0)
(t (+ (make-change-with-coins (- amount (car coins)) coins)
(make-change-with-coins amount (cdr coins))))))
This looks at least semantically correct, but I cannot tell how it is supposed to work (and I don't know what make-change-with-coins does).
I think it would be prudent to perhaps read a good introductory book first (I like Practical Common Lisp) and peruse the Common Lisp Hyperspec (CLHS).
It's not clear to me what the first function is supposed to do.
The second one almost ok, this is a fixed version:
(defun coin-change (amount coins)
(cond
((< amount 0) 0)
((= amount 0) 1)
((= (length coins) 0) 0)
(t (+ (coin-change (- amount (first coins)) coins)
(coin-change amount (rest coins))))))
The idea is:
A negative amount cannot be matched (0 ways)
Zero can be matched in exactly one way (not giving any coin)
If amount is >0 and we've no coin types remaining then there are no ways
Otherwise we can either A) give one piece of the first coin type and count how many ways we can match the remaining part, B) computing the ways without using the first coin type. The answer is A+B
Note that this is going to give huge computing times for large amounts because it doesn't take advantage of the important fact that the number of ways to match a certain amount starting with a certain coin type doesn't depend on how we got to this amount (i.e. the past history).
By adding caching you can get a dynamic-programming solution that is much faster because does each computation only once.
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"
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)))