conditional :for after a :when (in loop macro) - common-lisp

I would like to bind a variable inside a LOOP macro, but only conditionally.
Example:
(loop :for (num div) :in '((1 2) (4 2) (3 0) (1 4))
:when (/= 0 div)
:for res = (/ num div)
:collect num
:do (format T "~A divided by ~A = ~A~%" num div res))
This doesn't work as written:
:FOR does not introduce a LOOP clause that can follow WHEN.
current LOOP context: :FOR RES.
[Condition of type SB-INT:SIMPLE-PROGRAM-ERROR]
Is there a way to do this inside a single loop call? Any solutions I can think of, involve breaking out of the loop somehow which has considerable drawbacks. Among others you lose access to the loop context (:collect etc).

You can't do that with loop. You can work around it as below if you have to use loop, although coredump's answer is better since a variable binding that is used exactly once might as well not exist.
(loop for (num div) in '((1 2) (4 2) (3 0) (1 4))
for q? = (and (not (zerop div)) (/ num div))
when q?
collect num
and do (format T "~A divided by ~A = ~A~%" num div q?))
However you can also just write Lisp rather than loop's fragile pseudo-fortran. The following uses Tim Bradshaw's collecting macro to factor value collection out of a looping construct (it also collects the quotient rather than numerator, so that there is some purpose to the binding):
(collecting
(dolist (v '((1 2) (4 2) (3 0) (1 4)))
(destructuring-bind (numerator denominator) v
(unless (zerop denominator)
(let ((quotient (/ numerator denominator)))
(collect quotient)
(format T "~A divided by ~A = ~A~%" numerator denominator quotient))))))
If the combination of iteration and destructuring is something you do a lot, then (using, this time, metatronic macros to make things a little easier):
(defmacro/m destructuring-dolist ((ll list &optional (value 'nil)) &body forms)
`(dolist (<v> ,list ,value)
(destructuring-bind ,ll <v>
,#forms)))
And now
(collecting
(destructuring-dolist ((numerator denominator) '((1 2) (4 2) (3 0) (1 4)))
(unless (zerop denominator)
(let ((quotient (/ numerator denominator)))
(collect quotient)
(format T "~A divided by ~A = ~A~%" numerator denominator quotient)))))
If you want the numerators and the quotients, well:
(with-collectors (numerator quotient)
(destructuring-dolist ((numerator denominator) '((1 2) (4 2) (3 0) (1 4)))
(unless (zerop denominator)
(let ((quotient (/ numerator denominator)))
(quotient quotient)
(numerator numerator)
(format T "~A divided by ~A = ~A~%" numerator denominator quotient)))))
And of course, if you want to, now you can rely on the fact that you actually have fully-fledged destructuring lambda lists rather than whatever loop supports:
(with-collectors (numerator quotient)
(destructuring-dolist ((numerator denominator &aux
(valid (not (zerop denominator)))
(quotient (when valid (/ numerator denominator))))
'((1 2) (4 2) (3 0) (1 4)))
(when valid
(quotient quotient)
(numerator numerator)
(format T "~A divided by ~A = ~A~%" numerator denominator quotient))))

With the loop construct you can use unless with a positive test and use let inside the do, so that the variable is only bound when necessary (but here it is not strictly necessary as it is used only once):
(loop
for (num div) in '((1 2) (4 2) (3 0) (1 4))
unless (= 0 div)
collect num
and do (let ((res (/ num div)))
(format t "~a divided by ~a = ~a~%" num div res)))

Related

Asking for the idomatic way respectively for avoiding a duplicate in the code

(Just for fun) I figured out a way to represent this:
250 : 8 = 31 + 2
31 : 8 = 3 + 7
∴ (372)8
in the following procedure:
(defun dec->opns (n base)
(do* ((lst nil (append lst (list pos))) ; this is also not so nice
(m n (truncate m base))
(pos (rem m base) (rem m base)) ) ; <<<<<<
((< m base) (reverse (append lst (list m)))) ))
The procedure does what it is supposed to do until now.
CL-USER> (dec->opns 2500000 8)
(1 1 4 2 2 6 4 0)
At this point, I simply ask myself, how to avoid the two times
(rem m base).
First of all because of duplicates are looking daft. But also they may be a hint that the solution isn't the elegant way. Which also is not a problem. I am studying for becoming a primary school teacher (from 1st to 6nd class) and am considering examples for exploring math in a sense of Paperts Mindstorms. Therefore exploring all stages of creating and refining a solution are welcome.
But to get a glimpse of the professional solution, would you be so kind to suggest a more elegant way to implement the algorithm in an idiomatic way?
(Just to anticipate opposition to my "plan": I have no intentions to overwhelm the youngsters with Common Lisp. For now, I am using Common Lisp for reflecting about my study content and using the student content for practicing Common Lisp. My intention in the medium term is to write a "common (lisp) Logo setup" and a Logo environment with which the examples in Harveys Computer Science Logo style (vol. 1), Paperts Mindstorms, Solomons et. al LogoWorks, and of course in Abelsons et. al Turtle Geometry can be implemented uncompromisingly. If I will not cave in, the library will be found with quickload in the still more distant future under the name "c-logo-s" and be called cλogos ;-) )
The closest to your code
You can reduce the reversing of the reversing and append -> by using cons only. The duplication of (rem m base) is only an optical issue, since the first (rem m base) gets executed only the first time the loop runs and the second (rem m base) in all other cases. Thus they are actually not a duplication. One cannot use a let here, because of the required syntax within the macro. (<variable> <initial-value> <progression-for-each-round>)
(defun dec->ops (n base)
(do* ((acc nil (cons r acc))
(m n (truncate m base))
(r (rem m base) (rem m base)))
((zerop m) acc)))
The most Common Lispy version
The rosetta solutions for Common Lisp seems to give the most Common Lisp-like ways - either using write-to-string/parse-integer or even some format quircks.
(defun decimal->base-n (n base)
(write-to-string n :base base))
(defun base-n->decimal (base-n base)
(parse-integer (format nil "~a" base-n) :radix base))
(defun decimal-to-base-n (number &key (base 16))
(format nil (format nil "~~~dr" base) number))
(defun base-n-to-decimal (number &key (base 16))
(read-from-string (format nil "#~dr~d" base number)))
;; or:
(defun change-base (number input-base output-base)
(format nil "~vr" output-base (parse-integer number :radix input-base)))
Source: https://rosettacode.org/wiki/Non-decimal_radices/Convert#Common_Lisp
(decimal-to-base-n 2500000 :base 8)
;;=> "11422640"
Solution without format or write-to-string/parse-integer
Use tail call recursion:
(defun dec->ops (n base &optional (acc nil))
(if (< n base)
(cons n acc)
(multiple-value-bind (m r) (truncate n base)
(dec->ops m base (cons r acc)))))
Try it:
[41]> (dec->ops 250 8)
(3 7 2)
[42]> (dec->ops 250000 8)
(7 5 0 2 2 0)
[43]> (dec->ops 2500000 8)
(1 1 4 2 2 6 4 0)
The do/do* macros are in this case not so nice, because one cannot capture the multiple values returned by truncate nicely (truncate is mod and rem in one function - one should use this fact).
If you really wants to use do*
(defun dec->ops (n base)
(do* ((acc nil (cons (second values) acc))
(values (list n) (multiple-value-list (truncate (first values) base))))
((< (first values) base) (nbutlast (cons (first values) (cons (second values) acc))))))
This works
[69]> (dec->ops 250 8)
(3 7 2)
[70]> (dec->ops 2500000 8)
(1 1 4 2 2 6 4 0)
I would go with the following implementation when trying to avoid recursion:
(defun digits-in-base (number base)
(check-type number (integer 0))
(check-type base (integer 2))
(loop
:with remainder
:do (multiple-value-setq (number remainder) (truncate number base))
:collect remainder
:until (= number 0)))
Multiple values are not directly handled by LOOP so instead of converting the values to a list I prefer using MULTIPLE-VALUE-SETQ to update multiple values at once.
The code first does some type checks because otherwise it can loop infinitely: the inputs are expected to be respectively positive or null, and greater than 1.
I put the :until condition at the end so that 0 gives (0).
Note that the digits are sorted from the smallest to the highest rank:
(digits-in-base 4 2)
=> (0 0 1)
(digits-in-base 250 8)
=> (2 7 3)
Alternatively, for the reverse order:
(defun digits-in-base (number base)
(check-type number (integer 0))
(check-type base (integer 2))
(loop
:with remainder :and digits
:do (multiple-value-setq (number remainder) (truncate number base))
:do (push remainder digits)
:until (= number 0)
:finally (return digits)))
(digits-in-base 4 2)
=> (1 0 0)
(digits-in-base 250 8)
=> (3 7 2)
In a previous version of this answer I said the first one (from low to high digits) is better for further manipulation of the digits, but I am not so sure.
Converting back to a number is quite easy with number arranged from high to low digits (all the code below use the second version):
(defun digits-to-number (digits base)
(reduce (lambda (n d) (+ d (* n base)))
digits
:initial-value 0))
So is formatting to a string:
(defun number-string-base (number base)
(format nil
(if (<= base 10)
"(~{~d~})~d"
"(~{~d~^'~})~d")
(digits-in-base number base)
base))
(number-string-base 250 8)
=> "(372)8"
(number-string-base 250 16)
=> "(15'10)16"
Since you expressed interest in various approaches, one thing worth remembering is that Lisp's great strength is creating and extending languages. Indeed all the iteration constructs in Common Lisp are such extensions: CL has no primitive iteration constructs at all.
So there is nothing preventing anyone writing their own, which will be just as good as the ones the language provides. For instance Tim Bradshaw's simple loops provides an 'applicative looping construct', looping, which makes this quite simple to implement:
(defun dec->ops (n base)
(looping ((m n)
(a '()))
(when (< (abs m) base)
(return (cons m a)))
(multiple-value-bind (q r) (truncate m base)
(values q (cons r a)))))
Using looping, the variables bound in the loop are updated by the values of the last form in the loop's body.
Of course this is rather close to the classic tail-recursive implementation (here using iterate):
(defun dec->ops (n base)
(iterate next ((m n)
(a '()))
(if (< (abs m) base)
(cons m a)
(multiple-value-bind (q r) (truncate m base)
(next q (cons r a))))))
People tend not to like things like this because they are 'not idiomatic CL' of course.

lisp illegal function call

I'm just starting to learn Common Lisp, and I was giving the first Project Euler problem a try (summing all numbers below x that are divisible by 3 or 5). I tried to define a macro to generalize the process to numbers that are divisible by a given list of factors, and ran into trouble: when I run the macro it says that there was an illegal function call with setf, and warned that sum is undefined. Other people have posted this question before and had problems with parentheses, but I made an example of what I hoped the macro would expand into, and that function works fine, and the parentheses are exactly in the same places. Here's the code for the example function (which works fine) and the macro (which throws the errors):
;;; Example function for macro
(defun count-multiples-example (limit)
(let ((sum 0))
(dotimes (n (1+ limit) sum)
(dolist (each '(3 5))
(when (= 0 (mod n each))
(setf sum (+ n sum))
(return))))))
;;; Macro for arbitrary numbers to divide by (eventually)
(defmacro count-arbitrary (limit &rest divisors)
(let ((sum 0))
`(dotimes (n (1+ ,limit) ,sum)
(dolist (each ,divisors)
(when (= 0 (mod n each))
(setf sum (+ n ,sum))
(return))))))
I'm using SBCL with lispstick. Thanks!
CL-USER 28 > (defmacro count-arbitrary (limit &rest divisors)
(let ((sum 0))
`(dotimes (n (1+ ,limit) ,sum)
(dolist (each ,divisors)
(when (= 0 (mod n each))
(setf sum (+ n ,sum))
(return))))))
COUNT-ARBITRARY
Let's look at the expansion:
CL-USER 29 > (pprint (macroexpand-1 '(count-arbitrary 30 3 5)))
(DOTIMES (N (1+ 30) 0)
(DOLIST (EACH (3 5))
(WHEN (= 0 (MOD N EACH))
(SETF SUM (+ N 0)) (RETURN))))
You can see that the LET for the sum variable is missing, (3 5) lacks a quote (it is thus an illegal function call) and both comma before sum are wrong.
Generally the macro makes little sense, since you can provide the numbers as an additional parameter to the function:
(defun count-multiples-example (limit divisors &aux (sum 0))
(dotimes (n (1+ limit) sum)
(dolist (each divisors)
(when (= 0 (mod n each))
(incf sum n)
(return)))))
or this:
CL-USER 35 > (defun count-multiples-example (limit &rest divisors &aux (sum 0))
(dotimes (n (1+ limit) sum)
(dolist (each divisors)
(when (zerop (mod n each))
(incf sum n)
(return)))))
COUNT-MULTIPLES-EXAMPLE
CL-USER 36 > (count-multiples-example 30 3 5)
225
If I move the small dots around a little, this works for me:
(defmacro count-arbitrary (limit &rest divisors)
`(let ((sum 0))
(dotimes (n (1+ ,limit) sum)
(dolist (each ',divisors)
(when (= 0 (mod n each))
(setf sum (+ n sum))
(return))))))

Generating a list of all possible combinations of true or false for n given variables in LISP

I want to define a function that takes an input "n" (the number of variables) and return all possible truth values. Here, I represent the truth values for a variable i (1 <= i <= n) with +i representing true, and -i representing false.
For example:
(generate-values 2)
should return:
((2 1)(2 -1)(-2 1)(-2 -1))
(generate-values 3)
should return:
((3 2 1)(3 2 -1)(3 -2 1)(3 -2 -1)(-3 2 1)(-3 2 -1)(-3 -2 1)(-3 -2 -1))
Here is my incorrect attempt:
(defun generate-values (n)
(cond
((equal n 0) nil)
(t (list (cons n (generate-values (- n 1)))
(cons (- 0 n) (generate-values (- n 1)))))))
I know why this is incorrect, but I am not able to find a way to generate (3 2 1) and then move on to (3 2 -1). My program outputs:
((3 (2 (1) (-1)) (-2 (1) (-1))) (-3 (2 (1) (-1)) (-2 (1) (-1))))
Any help with this question qould be thoroughly appreciated! Thanks!
It might be easiest to approach this in the easiest way possible, and then to figure out how to make it a bit simpler or more efficient afterward.
If you're doing this recursively, it's important to consider what the bases cases are. A reasonable base case here is probably when n = 0. The function is always supposed to return a list of lists. In the n = 0 case, there are no "variables", so the result has to be a list of the empty list: (()).
For the case that n is anything else, consider what the function returns for n-1. It's a list of all the combinations on n-1 "variables". All you need to do is prepend n to each of those, and prepend -n to each of those, and then make sure you end up with a list of all of those.
Encoding that directly, we end up with something like this:
(defun table (n)
(if (zerop n)
'(())
(let* ((table (table (1- n)))
(plus-pos-n (mapcar (lambda (subtable)
(list* n subtable))
table))
(plus-neg-n (mapcar (lambda (subtable)
(list* (- n) subtable))
table)))
(nconc plus-pos-n plus-neg-n))))
CL-USER> (table 3)
((3 2 1) (3 2 -1) (3 -2 1) (3 -2 -1) (-3 2 1) (-3 2 -1) (-3 -2 1) (-3 -2 -1))
Now, let's look at what your current implementation is doing differently, noting that it doesn't have to be exactly the same algorithm, of course.
(defun generate-values (n)
(cond
((equal n 0)
nil)
(t
(list (cons n
(generate-values (- n 1)))
(cons (- 0 n)
(generate-values (- n 1)))))))
Stylistically, since there are only two branches, I'd prefer if to cond here, but that's not a problem. Before attacking the base case, lets look at the recursive case, when n ≠ 0. First, you're calling generate-values twice; it would be more efficient to call it once and save the result. That could end up being important later if you're calling this function with big values of n, but it doesn't make the function incorrect. But remember what generate-values returns; it returns a list of the different combinations. That means that your call to (cons n (generate-values …)) is returning a list whose first element is n, and whose remaining elements are the combinations for n-1. E.g., you're doing something like:
CL-USER> (table 1)
((1) (-1))
CL-USER> (cons 2 (table 1))
(2 (1) (-1))
But that's not what you want. You really want to add n to each of those lists:
CL-USER> (mapcar (lambda (x)
(cons 2 x))
(table 1))
((2 1) (2 -1))
That's the issue in the recursive case. There's an issue in the base case, too. In the recursive case, you want to add n and -n to each of the sublists from the n-1 case. So what happens when you have n = 1? You want to be getting (cons 1 '()) and (cons -1 '()). But since the second argument to cons is going to be each list inside of the result of (generate-values 0), you really need to have something in the list returned by (generate-values 0). What needs to be there? The empty list needs to be there. So the base case needs to return (()), not (). So, after making those changes, your code would be:
(defun generate-values (n)
(cond
((equal n 0)
'(()))
(t
(list (mapcar (lambda (x)
(cons n x))
(generate-values (- n 1)))
(mapcar (lambda (x)
(cons (- 0 n) x))
(generate-values (- n 1)))))))
CL-USER> (generate-values 3)
(((3 (2 (1)) (2 (-1))) (3 (-2 (1)) (-2 (-1))))
((-3 (2 (1)) (2 (-1))) (-3 (-2 (1)) (-2 (-1)))))
That's closer, but it's still not quite right. There's another in the recursive case. You end up generating the values that have n in the beginning (a list of them), and the values that have -n in the beginning (a list of them), but then you're using list to combine them. That returns a single list with two values. Instead, you want a single list that has the values from each of them. You want to combine them with append (or, since all the structure is newly generated, you could use nconc):
(defun generate-values (n)
(cond
((equal n 0)
'(()))
(t
(append (mapcar (lambda (x)
(cons n x))
(generate-values (- n 1)))
(mapcar (lambda (x)
(cons (- 0 n) x))
(generate-values (- n 1)))))))
CL-USER> (generate-values 3)
((3 2 1) (3 2 -1) (3 -2 1) (3 -2 -1) (-3 2 1) (-3 2 -1) (-3 -2 1) (-3 -2 -1))
This final implementation isn't exactly what I started with, but it's essentially the same in terms of the algorithm. The differences are mostly stylistic, but there are some efficiency concerns, too. Using nconc instead of append would save some memory, and it really would be good to cache the results from the recursive call, rather than recomputing it. Stylistic issues that don't affect correctness might be using if instead of cond, using list* instead of cons (to indicate that we're working with lists, not trees of cons cells), and it's nice to note that you don't have to do (- 0 n), - with a single argument returns the argument's negation. That is, (- n) = -n.

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))

Resources