Lisp macro (or function) for nested loops - recursion

Is it possible to write a Common Lisp macro that takes a list of dimensions and variables, a body (of iteration), and creates the code consisting of as many nested loops as specified by the list?
That is, something like:
(nested-loops '(2 5 3) '(i j k) whatever_loop_body)
should be expanded to
(loop for i from 0 below 2 do
(loop for j from 0 below 5 do
(loop for k from 0 below 3 do
whatever_loop_body)))
Follow up
As huaiyuan correctly pointed out, I have to know the parameters to pass to macro at compile time. If you actually need a function as I do, look below.
If you are ok with a macro, go for the recursive solution of 6502, is wonderful.

You don't need the quotes, since the dimensions and variables need to be known at compile time anyway.
(defmacro nested-loops (dimensions variables &body body)
(loop for range in (reverse dimensions)
for index in (reverse variables)
for x = body then (list y)
for y = `(loop for ,index from 0 to ,range do ,#x)
finally (return y)))
Edit:
If the dimensions cannot be decided at compile time, we'll need a function
(defun nested-map (fn dimensions)
(labels ((gn (args dimensions)
(if dimensions
(loop for i from 0 to (car dimensions) do
(gn (cons i args) (cdr dimensions)))
(apply fn (reverse args)))))
(gn nil dimensions)))
and to wrap the body in lambda when calling.
CL-USER> (nested-map (lambda (&rest indexes) (print indexes)) '(2 3 4))
(0 0 0)
(0 0 1)
(0 0 2)
(0 0 3)
(0 0 4)
(0 1 0)
(0 1 1)
(0 1 2)
(0 1 3)
(0 1 4)
(0 2 0)
(0 2 1)
...
Edit(2012-04-16):
The above version of nested-map was written to more closely reflect the original problem statement. As mmj said in the comments, it's probably more natural to make index range from 0 to n-1, and moving the reversing out of the inner loop should improve efficiency if we don't insist on row-major order of iterations. Also, it's probably more sensible to have the input function accept a tuple instead of individual indices, to be rank independent. Here is a new version with the stated changes:
(defun nested-map (fn dimensions)
(labels ((gn (args dimensions)
(if dimensions
(loop for i below (car dimensions) do
(gn (cons i args) (cdr dimensions)))
(funcall fn args))))
(gn nil (reverse dimensions))))
Then,
CL-USER> (nested-map #'print '(2 3 4))

Sometimes an approach that is useful is writing a recursive macro, i.e. a macro that generates code containing another invocation of the same macro unless the case is simple enough to be solved directly:
(defmacro nested-loops (max-values vars &rest body)
(if vars
`(loop for ,(first vars) from 0 to ,(first max-values) do
(nested-loops ,(rest max-values) ,(rest vars) ,#body))
`(progn ,#body)))
(nested-loops (2 3 4) (i j k)
(print (list i j k)))
In the above if the variable list is empty then the macro expands directly to the body forms, otherwise the generated code is a (loop...) on the first variable containing another (nested-loops ...) invocation in the do part.
The macro is not recursive in the normal sense used for functions (it's not calling itself directly) but the macroexpansion logic will call the same macro for the inner parts until the code generation has been completed.
Note that the max value forms used in the inner loops will be re-evaluated at each iteration of the outer loop. It doesn't make any difference if the forms are indeed numbers like in your test case, but it's different if they're for example function calls.

Hm. Here's an example of such a macro in common lisp. Note, though, that I am not sure, that this is actually a good idea. But we are all adults here, aren't we?
(defmacro nested-loop (control &body body)
(let ((variables ())
(lower-bounds ())
(upper-bounds ()))
(loop
:for ctl :in (reverse control)
:do (destructuring-bind (variable bound1 &optional (bound2 nil got-bound2)) ctl
(push variable variables)
(push (if got-bound2 bound1 0) lower-bounds)
(push (if got-bound2 bound2 bound1) upper-bounds)))
(labels ((recurr (vars lowers uppers)
(if (null vars)
`(progn ,#body)
`(loop
:for ,(car vars) :upfrom ,(car lowers) :to ,(car uppers)
:do ,(recurr (cdr vars) (cdr lowers) (cdr uppers))))))
(recurr variables lower-bounds upper-bounds))))
The syntax is slightly different from your proposal.
(nested-loop ((i 0 10) (j 15) (k 15 20))
(format t "~D ~D ~D~%" i j k))
expands into
(loop :for i :upfrom 0 :to 10
:do (loop :for j :upfrom 0 :to 15
:do (loop :for k :upfrom 15 :to 20
:do (progn (format t "~d ~d ~d~%" i j k)))))
The first argument to the macro is a list of list of the form
(variable upper-bound)
(with a lower bound of 0 implied) or
(variable lower-bound upper-bounds)
With a little more love applied, one could even have something like
(nested-loop ((i :upfrom 10 :below 20) (j :downfrom 100 :to 1)) ...)
but then, why bother, if loop has all these features already?

Related

What exactly does the #. (sharpsign dot) do in Common Lisp? Is it causing a variable has no value error?

Edit: Title updated to reflect what my question should have been, and hopefully lead other users here when they have the same problem.
Little bit of a mess, but this is a work-in-progress common lisp implementation of anydice that should output some ascii art representing a probability density function for a hash-table representing dice rolls. I've been trying to figure out exactly why, but I keep getting the error *** - SYSTEM::READ-EVAL-READER: variable BAR-CHARS has no value when attempting to run the file in clisp. The error is originating from the output function.
The code is messy and convoluted (but was previously working if the inner most loop of output is replaced with something simpler), but this specific error does not make sense to me. Am I not allowed to access the outer let* variables/bindings/whatever from the inner most loop/cond? Even when I substitute bar-chars for the list form directly, I get another error that char-decimal has no value either. I'm sure there's something about the loop macro interacting with the cond macro I'm missing, or the difference between setf, let*, multiple-value-bind, etc. But I've been trying to debug this specific problem for hours with no luck.
(defun sides-to-sequence (sides)
(check-type sides integer)
(loop for n from 1 below (1+ sides) by 1 collect n))
(defun sequence-to-distribution (sequence)
(check-type sequence list)
(setf distribution (make-hash-table))
(loop for x in sequence
do (setf (gethash x distribution) (1+ (gethash x distribution 0))))
distribution)
(defun distribution-to-sequence (distribution)
(check-type distribution hash-table)
(loop for key being each hash-key of distribution
using (hash-value value) nconc (loop repeat value collect key)))
(defun combinations (&rest lists)
(if (endp lists)
(list nil)
(mapcan (lambda (inner-val)
(mapcar (lambda (outer-val)
(cons outer-val
inner-val))
(car lists)))
(apply #'combinations (cdr lists)))))
(defun mapcar* (func lists) (mapcar (lambda (args) (apply func args)) lists))
(defun dice (left right)
(setf diceprobhash (make-hash-table))
(cond ((integerp right)
(setf right-distribution
(sequence-to-distribution (sides-to-sequence right))))
((listp right)
(setf right-distribution (sequence-to-distribution right)))
((typep right 'hash-table) (setf right-distribution right))
(t (error (make-condition 'type-error :datum right
:expected-type
(list 'integer 'list 'hash-table)))))
(cond ((integerp left)
(sequence-to-distribution
(mapcar* #'+
(apply 'combinations
(loop repeat left collect
(distribution-to-sequence right-distribution))))))
(t (error (make-condition 'type-error :datum left
:expected-type
(list 'integer))))))
(defmacro d (arg1 &optional arg2)
`(dice ,#(if (null arg2) (list 1 arg1) (list arg1 arg2))))
(defun distribution-to-probability (distribution)
(setf probability-distribution (make-hash-table))
(setf total-outcome-count
(loop for value being the hash-values of distribution sum value))
(loop for key being each hash-key of distribution using (hash-value value)
do (setf (gethash key probability-distribution)
(float (/ (gethash key distribution) total-outcome-count))))
probability-distribution)
(defun output (distribution)
(check-type distribution hash-table)
(format t " # %~%")
(let* ((bar-chars (list 9617 9615 9614 9613 9612 9611 9610 9609 9608))
(bar-width 100)
(bar-width-eighths (* bar-width 8))
(probability-distribution (distribution-to-probability distribution)))
(loop for key being each hash-key of
probability-distribution using (hash-value value)
do (format t "~4d ~5,2f ~{~a~}~%" key (* 100 value)
(loop for i from 0 below bar-width
do (setf (values char-column char-decimal)
(truncate (* value bar-width)))
collect
(cond ((< i char-column)
#.(code-char (car (last bar-chars))))
((> i char-column)
#.(code-char (first bar-chars)))
(t
#.(code-char (nth (truncate
(* 8 (- 1 char-decimal)))
bar-chars)))))))))
(output (d 2 (d 2 6)))
This is my first common lisp program I've hacked together, so I don't really want any criticism about formatting/style/performance/design/etc as I know it could all be better. Just curious what little detail I'm missing in the output function that is causing errors. And felt it necessary to include the whole file for debugging purposes.
loops scoping is perfectly conventional. But as jkiiski says, #. causes the following form to be evaluated at read time: bar-chars is not bound then.
Your code is sufficiently confusing that I can't work out whether there's any purpose to read-time evaluation like this. But almost certainly there is not: the uses for it are fairly rare.

Common lisp macro not calling function

I am working on a complicated macro and have run into a roadblock.
(defmacro for-each-hashtable-band (body vars on &optional counter name)
`(block o
(with-hash-table-iterator (next-entry ,on)
(destructuring-bind
,(apply #'append vars)
(let ((current-band (list ,#(mapcar #'not (apply #'append vars)))))
(for (i 1 ,(length (apply #'append vars)) 2)
(multiple-value-bind
(succ k v) (next-entry)
(if succ
(progn
(setf (nth i current-band) k)
(setf (nth (+ 1 i) current-band) v))
(return-from o nil))))
current-band)
,#body))))
im getting "Evaluation aborted on #<UNDEFINED-FUNCTION NEXT-ENTRY {100229C693}>"
i dont understand why next-entry appears to be invisible to the macro i have created.
I've tried stripping down this to a small replicable example but i couldnt find a minimal scenario without the macro i created where next-entry would be invisible besides this scenario no matter what I tried, i've always managed to find a way to call next-entry in my other examples so im stumped as to why i cannot get it working here
I've tested the for macro ive created and it seems to generally work in most cases but for some reason it cannot see this next-entry variable. How do i make it visible?
In your code there are multiple places where the macro generates bindings in a way that is subject to variable capture (pdf).
(defmacro for-each-hashtable-band (body vars on &optional counter name)
`(block o ;; VARIABLE CAPTURE
(with-hash-table-iterator (next-entry ,on) ;; VARIABLE CAPTURE
(destructuring-bind ,(apply #'append vars)
(let ((current-band ;;; VARIABLE CAPTURE
(list ,#(mapcar #'not (apply #'append vars)))))
(for
(i ;;; VARIABLE CAPTURE
1 ,(length (apply #'append vars)) 2)
(multiple-value-bind (succ k v) ;;; VARIABLE CAPTURE
,(next-entry) ;;; WRONG EVALUATION TIME
(if succ
(progn
(setf (nth i current-band) k)
(setf (nth (+ 1 i) current-band) v))
(return-from o nil))))
current-band)
,#body))))
A simplified example of such a capture is:
`(let ((x 0)) ,#body)
Here above, the x variable is introduced, but if the code is expanded in a context where xis already bound, then body will not be able to reference that former x binding and will always see x bound to zero (you generally don't want this behavior).
Write a function instead
Instead of writing a big macro for this, let's first try understanding what you want to achieve and write instead a higher-order function, ie. a function that calls user-provided functions.
If I understand correctly, your function iterates over a hash-table by bands of entries. I assume vars holds a list of (key value) pairs of symbols, for example ((k1 v1) (k2 v2)). Then, body works on all the key/value pairs in the band.
In the following code, the function map-each-hashtable-band accepts a function, a hash-table, and instead of vars it accepts a size, the width of the band (the number of pairs).
Notice how in your code, you only have one loop, which builds a band using the hash-table iterator. But then, since the macro is named for-each-hashtable-band, I assume you also want to loop over all the bands. The macro with-hash-table-iterator provides an iterator but does not loop itself. That's why here I have two loops.
(defun map-each-hashtable-band (function hash-table band-size)
(with-hash-table-iterator (next-entry hash-table)
(loop :named outer-loop :do
(loop
:with key and value and next-p
:repeat band-size
:do (multiple-value-setq (next-p key value) (next-entry))
:while next-p
:collect key into current-band
:collect value into current-band
:finally (progn
(when current-band
(apply function current-band))
(unless next-p
(return-from outer-loop)))))))
For example:
(map-each-hashtable-band (lambda (&rest band) (print `(:band ,band)))
(alexandria:plist-hash-table
'(:a 0 :b 1 :c 2 :d 3 :e 4 :f 5 :g 6))
2)
NB. Iterating over a hash-table happens in an arbitrary order, there is no guarantee that you'll see the entries in any particular kind of order, this is implementation-dependant.
With my current version of SBCL this prints the following:
(:BAND (:A 0 :B 1))
(:BAND (:C 2 :D 3))
(:BAND (:E 4 :F 5))
(:BAND (:G 6))
Wrap the function in a macro
The previous function might not be exactly the behavior you want, so you need to adapt to your needs, but once it does what you want, you can wrap a macro around it.
(defmacro for-each-hashtable-band (vars hash-table &body body)
`(map-each-hashtable-band (lambda ,(apply #'append vars) ,#body)
,hash-table
,(length vars)))
For example:
(let ((test (alexandria:plist-hash-table '(:a 0 :b 1 :c 2 :d 3 :e 4 :f 5))))
(for-each-hashtable-band ((k1 v1) (k2 v2)) test
(format t "~a -> ~a && ~a -> ~a ~%" k1 v1 k2 v2)))
This prints:
A -> 0 && B -> 1
C -> 2 && D -> 3
E -> 4 && F -> 5
Macro-only solution, for completeness
If you want to have only one, single macro, you can start by inlining the body of the above function in the macro, you don't need to use apply anymore, but instead you need to establish bindings around the body, using destructuring-bind as you did. A first draft would be to simply as follows, but notice that this is not a proper solution:
(defmacro for-each-hashtable-band (vars hash-table &body body)
(let ((band-size (length vars)))
`(with-hash-table-iterator (next-entry ,hash-table)
(loop :named outer-loop :do
(loop
:with key and value and next-p
:repeat ,band-size
:do (multiple-value-setq (next-p key value) (next-entry))
:while next-p
:collect key into current-band
:collect value into current-band
:finally (progn
(when current-band
(destructuring-bind ,(apply #'append vars) current-band
,#body))
(unless next-p
(return-from outer-loop))))))))
In order to be free of variable capture problems with macros, each temporary variable you introduce must be named after a symbol that cannot exist in any context you expand your code. So instead we first unquote all the variables, making the macro definition fail to compile:
(defmacro for-each-hashtable-band (vars hash-table &body body)
(let ((band-size (length vars)))
`(with-hash-table-iterator (,next-entry ,hash-table)
(loop :named ,outer-loop :do
(loop
:with ,key and ,value and ,next-p
:repeat ,band-size
:do (multiple-value-setq (,next-p ,key ,value) (,next-entry))
:while ,next-p
:collect ,key into ,current-band
:collect ,value into ,current-band
:finally (progn
(when ,current-band
(destructuring-bind ,(apply #'append vars) ,current-band
,#body))
(unless ,next-p
(return-from ,outer-loop))))))))
When compiling the macro, the macro is supposed to inject symbols into the code, but here we have a compilation error that says undefined variables:
;; undefined variables: CURRENT-BAND KEY NEXT-ENTRY NEXT-P OUTER-LOOP VALUE
So now, those variables should be fresh symbols:
(defmacro for-each-hashtable-band (vars hash-table &body body)
(let ((band-size (length vars)))
(let ((current-band (gensym))
(key (gensym))
(next-entry (gensym))
(next-p (gensym))
(outer-loop (gensym))
(value (gensym)))
`(with-hash-table-iterator (,next-entry ,hash-table)
(loop :named ,outer-loop :do
(loop
:with ,key and ,value and ,next-p
:repeat ,band-size
:do (multiple-value-setq (,next-p ,key ,value) (,next-entry))
:while ,next-p
:collect ,key into ,current-band
:collect ,value into ,current-band
:finally (progn
(when ,current-band
(destructuring-bind ,(apply #'append vars) ,current-band
,#body))
(unless ,next-p
(return-from ,outer-loop)))))))))
This above is a bit verbose, but you could simplify that.
Here is what the previous for-each-hashtable-band example expands into with this new macro:
(with-hash-table-iterator (#:g1576 test)
(loop :named #:g1578
:do (loop :with #:g1575
and #:g1579
and #:g1577
:repeat 2
:do (multiple-value-setq (#:g1577 #:g1575 #:g1579) (#:g1576))
:while #:g1577
:collect #:g1575 into #:g1574
:collect #:g1579 into #:g1574
:finally (progn
(when #:g1574
(destructuring-bind
(k1 v1 k2 v2)
#:g1574
(format t "~a -> ~a && ~a -> ~a ~%" k1 v1 k2
v2)))
(unless #:g1577 (return-from #:g1578))))))
Each time you expand it, the #:gXXXX variables are different, and cannot possibly shadow existing bindings, so for example, the body can use variables named like current-band or value without breaking the expanded code.

Recursive lisp-function to solve N-Queen

UPDATED: The code should compile now without errors or warnings. Sorry about the previous one. The problem I have now is that when a run (or with any other integer)
(NxNqueen-solver 10)
The function getqueencol will return nil because there are no queens on the board in the first place, hence there will be a (= number nil) in the queen-can-be-placed-here because tcol will be nil. I think this will happen everytime there is no queen in the row passed as argument to the queen-can-be-placed-here function.
Please share some advice on how to fix this problem. Thank you in advance.
Here is the code
(defvar *board* (make-array '(10 10) :initial-element nil))
(defun getqueencol (row n)
"Traverses through the columns of a certain row
and returns the column index of the queen."
(loop for i below n
do (if (aref *board* row i)
(return-from getqueencol i))))
(defun print-board (n)
"Prints out the solution, e.g. (1 4 2 5 3),
where 1 denotes that there is a queen at the first
column of the first row, and so on."
(let ((solutionlist (make-list n)))
(loop for row below n
do (loop for col below n
do (when (aref *board* row col)
(setf (nth row solutionlist) col))))
(print solutionlist)))
(defun queen-can-be-placed-here (row col n)
"Returns t if (row,col) is a possible place to put queen, otherwise nil."
(loop for i below n
do (let ((tcol (getqueencol i n)))
(if (or (= col tcol) (= (abs (- row i)) (abs (- col tcol))))
(return-from queen-can-be-placed-here nil)))))
(defun backtracking (row n)
"Solves the NxN-queen problem with backtracking"
(if (< row n)
(loop for i below n
do (when (queen-can-be-placed-here row i n)
(setf (aref *board* row i) 't)
(return-from backtracking (backtracking (+ row 1) n))
(setf (aref *board* row i) 'nil))
(print-board n))))
(defun NxNqueen-solver (k)
"Main program for the function call to the recursive solving of the problem"
(setf *board* (make-array '(k k) :initial-element nil))
(backtracking 0 k))
You say that you compiled your code. That can't be the case, since then you would have see the compiler complaining about errors. You want to make sure that you really compile the code and correct the code, such that it compiles without errors and warnings.
You might want to get rid of the errors/problems in the code (see Renzo's comment) and then look at the algorithmic problem. I makes very little sense to look into an algorithmic problem, when the code contains errors.
SETQ does not introduce a variable, the variable has to be defined somewhere
DEFVAR makes no sense inside a function.
Something like (let (x (sin a)) ...) definitely looks wrong. The syntax of LET requires a pair of parentheses around the bindings list.
RETURN-FROM takes as first argument the name of an existing block to return from. The optional second argument is a return value. Get the syntax right and return from the correct block.
in a call to MAKE-ARRAY specify the default value: (make-array ... :initial-element nil), otherwise it's not clear what it is.
The variable *board* is undefined
Style
in LOOP: for i to (1- n) is simpler for i below n
you don't need to quote NIL and T.
(if (eq foo t) ...) might be simpler written as (if foo ...). Especially if the value of foo is either NIL or T.
(if foo (progn ...)) is simply (when foo ...)
I'm not sure what you are doing to claim that your code compiles. It does not compile.
Every function has compiler warnings. You should check the compiler warnings and fix the problems.
(defun getqueencol (row)
"Traverses through the columns of a certain row
and returns the column index of the queen."
(loop for i below n
do (if (aref board row i)
(return-from getqueencol i))))
The compiler complains:
;;;*** Warning in GETQUEENCOL: N assumed special
;;;*** Warning in GETQUEENCOL: BOARD assumed special
Where is n defined? Where is board coming from?
(defun print-board (board)
"Prints out the solution, e.g. (1 4 2 5 3),
where 1 denotes that there is a queen at the first
column of the first row, and so on."
(let (solutionlist)
(setq solutionlist (make-list n)))
(loop for row below n
do (loop for col below n
do (when (aref board row col)
(setf (nth row solutionlist) col))))
(print solutionlist))
The LET makes no sense. (let (foo) (setq foo bar) ...) is (let ((foo bar)) ...).
Why is solutionlist not defined? Look at the LET... it does not make sense.
Where is n coming from?
(defun queen-can-be-placed-here (row col)
"Returns t if (row,col) is a possible place to put queen, otherwise nil."
(loop for i below n
do (let (tcol)
(setq tcol (getqueencol i)))
(if (or (= col tcol) (= (abs (- row i)) (abs (- col tcol))))
(return-from queen-can-be-placed-here nil))))
where is n coming from? The LET makes no sense.
(defun backtracking (row)
"Solves the NxN-queen problem with backtracking"
(if (< row n)
(loop for i below n
do (when (queen-can-be-placed-here row i)
(setf (aref board row i) 't)
(return-from backtracking (backtracking (+ row 1)))
(setf (aref board row i) 'nil))
(print-board board))))
Where is n coming from? Where is board defined?
(defun NxNqueen-solver (k)
"Main program for the function call to the recursive solving of the problem"
(let (n board)
(setq n k)
(setq board (make-array '(k k) :initial-element nil)))
(backtracking 0))
Why use setq when you have a let? The local variables n and board are unused.
MAKE-ARRAY expects a list of numbers, not a list of symbols.
I propose you use a basic Lisp introduction (Common Lisp: A Gentle Introduction to Symbolic Computation - free download) and a Lisp reference (CL Hyperspec).

lisp functions ( count numbers in common lisp)

I am working on program related to the different of dealing with even numbers in C and lisp , finished my c program but still having troubles with lisp
isprime function is defined and I need help in:
define function primesinlist that returns unique prime numbers in a lis
here what i got so far ,
any help with that please?
(defun comprimento (lista)
(if (null lista)
0
(1+ (comprimento (rest lista)))))
(defun primesinlist (number-list)
(let ((result ()))
(dolist (number number-list)
(when (isprime number)
( number result)))
(nreverse result)))
You need to either flatten the argument before processing:
(defun primesinlist (number-list)
(let ((result ()))
(dolist (number (flatten number-list))
(when (isprime number)
(push number result)))
(delete-duplicates (nreverse result))))
or, if you want to avoid consing up a fresh list, flatten it as you go:
(defun primesinlist (number-list)
(let ((result ()))
(labels ((f (l)
(dolist (x l)
(etypecase x
(integer (when (isprime x)
(push x result)))
(list (f x))))))
(f number-list))
(delete-duplicates (nreverse result))))
To count distinct primes, take the length of the list returned by primesinlist.
Alternatively, you can use count-if:
(count-if #'isprime (delete-duplicates (flatten number-list)))
It sounds like you've already got a primality test implemented, but for sake of completeness, lets add a very simple one that just tries to divide a number by the numbers less than it up to its square root:
(defun primep (x)
"Very simple implementation of a primality test. Checks
for each n above 1 and below (sqrt x) whether n divides x.
Example:
(mapcar 'primep '(2 3 4 5 6 7 8 9 10 11 12 13))
;=> (T T NIL T NIL T NIL NIL NIL T NIL T)
"
(do ((sqrt-x (sqrt x))
(i 2 (1+ i)))
((> i sqrt-x) t)
(when (zerop (mod x i))
(return nil))))
Now, you need a way to flatten a potentially nested list of lists into a single list. When approaching this problem, I usually find it a bit easier to think in terms of trees built of cons-cells. Here's an efficient flattening function that returns a completely new list. That is, it doesn't share any structure with the original tree. That can be useful, especially if we want to modify the resulting structure later, without modifying the original input.
(defun flatten-tree (x &optional (tail '()))
"Efficiently flatten a tree of cons cells into
a list of all the non-NIL leafs of the tree. A completely
fresh list is returned.
Examples:
(flatten-tree nil) ;=> ()
(flatten-tree 1) ;=> (1)
(flatten-tree '(1 (2 (3)) (4) 5)) ;=> (1 2 3 4 5)
(flatten-tree '(1 () () 5)) ;=> (1 5)
"
(cond
((null x) tail)
((atom x) (list* x tail))
((consp x) (flatten-tree (car x)
(flatten-tree (cdr x) tail)))))
Now it's just a matter of flatting a list, removing the number that are not prime, and removing duplicates from that list. Common Lisp includes functions for doing these things, namely remove-if-not and remove-duplicates. Those are the "safe" versions that don't modify their input arguments. Since we know that the flattened list is freshly generated, we can use their (potentially) destructive counterparts, delete-if-not and delete-duplicates.
There's a caveat when you're removing duplicate elements, though. If you have a list like (1 3 5 3), there are two possible results that could be returned (assuming you keep all the other elements in order): (1 3 5) and (1 5 3). That is, you can either remove the the later duplicate or the earlier duplicate. In general, you have the question of "which one should be left behind?" Common Lisp, by default, removes the earlier duplicate and leaves the last occurrence. That behavior can be customized by the :from-end keyword argument. It can be nice to duplicate that behavior in your own API.
So, here's a function that puts all those considerations together.
(defun primes-in-tree (tree &key from-end)
"Flatten the tree, remove elements which are not prime numbers,
using FROM-END to determine whether earlier or later occurrences
are kept in the list.
Examples:
(primes-in-list '(2 (7 4) ((3 3) 5) 6 7))
;;=> (2 3 5 7)
(primes-in-list '(2 (7 4) ((3 3) 5) 6 7) :from-end t)
;;=> (2 7 3 5)"
;; Because FLATTEN-TREE returns a fresh list, it's OK
;; to use the destructive functions DELETE-IF-NOT and
;; DELETE-DUPLICATES.
(delete-duplicates
(delete-if-not 'primep (flatten-tree list))
:from-end from-end))

Dolist evaluation error

I'm a CommonLisp noob with a question. I have these two functions below.
A helper function:
(defun make-rests (positions rhythm)
"now make those positions negative numbers for rests"
(let ((resultant-rhythm rhythm))
(dolist (i positions resultant-rhythm)
(setf (nth i resultant-rhythm) (* (nth i resultant-rhythm) -1)))))
And a main function:
(defun test-return-rhythms (rhythms)
(let ((positions '((0 1) (0)))
(result nil))
(dolist (x positions (reverse result))
(push (make-rests x rhythms) result))))
When I run (test-return-rhythms '(1/4 1/8)), it evaluates to: ((1/4 -1/8) (1/4 -1/8))
However, I expected: (test-return-rhythms '(1/4 1/8)) to evaluate to: ((-1/4 -1/8) (-1/4 1/8)).
What am I doing wrong?
Your implementation of make-rests is destructive.
CL-USER> (defparameter *rhythm* '(1/4 1/4 1/4 1/4))
*RHYTHM*
CL-USER> (make-rests '(0 2) *rhythm*)
(-1/4 1/4 -1/4 1/4)
CL-USER> *rhythm*
(-1/4 1/4 -1/4 1/4)
So, if you run your test, the second iteration will see (-1/4 -1/8), and (make-rests '(0) '(-1/4 -1/8)) returns (1/4 -1/8). Your use of let in make-rests does not copy the list, it just creates a new binding that references it. Use copy-list in your let, or write a non-destructive version in the first place:
(defun make-rests (positions rhythm)
(loop for note in rhythm
for i from 0
collect (if (member i positions) (* note -1) note)))

Resources