I'm trying to create a function that would test whether the given list is circular with a re-starting point being the beginning of the list.
Expected results:
(setq liste '(a b c))
(rplacd (cddr liste) liste)
(circular liste) => t
(circular '(a b c a b c)) => nil
As I simply want to test if any subsequent item is 'eq' to the first one, I don't want to build the whole tortoise and hare algorithm.
Here is my code :
(defun circular (liste)
(let (beginningliste (car liste)))
(labels ( (circ2 (liste)
(cond
((atom liste) nil)
((eq (car liste) beginningliste) t)
(t (circ2 (cdr liste)))
) ) ) ) )
It doesn't give the expected result but I don't understand where my error is
I'm not sure I'm using 'labels' correctly
Is there a way to do that without using 'labels'?
Edit. I guess I have answered my third question as I think I have found a simpler way. Would this work?
(defun circular (liste)
(cond
((atom liste) nil)
((eq (car liste) (cadr liste)) t)
(t (circular (rplacd liste (cddr liste))))
)
)
First, the behavior is undefined when you mutate constant data: when you quote something (here the list), the Lisp environment has the right to treat it as a constant. See also this question for why defparameter or defvar is preferred over setq. And so...
(setq list '(a b c))
(rplacd (cddr list) list)
... would be better written as:
(defparameter *list* (copy-list '(a b c)))
(setf (cdr (last *list*)) *list*)
Second, your code is badly formatted and has bad naming conventions (please use dashes to separate words); here it is with a conventional layout, with the help of emacs:
(defun circularp (list)
(let (first (car list)))
(labels ((circ2 (list)
(cond
((atom list) nil)
((eq (car list) first) t)
(t (circ2 (cdr list))))))))
With that formatting, two things should be apparent:
The let contains no body forms: you define local variables and never use them; you could as well delete the let line.
Furthermore, the let is missing one pair of parenthesis: what you wrote defines a variable name first and another one named car, bound to list. I presume you want to define first as (car list).
You define a local circ2 function but never use it. I would expect the circularp function (the -p is for "predicate", like numberp, stringp) to call (circ2 (cdr list)). I prefer renaming circ2 as visit (or recurse), because it means something.
With the above corrections, that would be:
(defun circularp (list)
(let ((first (car list)))
(labels ((visit (list)
(cond
((atom list) nil)
((eq (car list) first) t)
(t (visit (cdr list))))))
(visit (cdr list)))))
However, if your list is not circular but contains the same element multiple times (like '(a a b)), you will report it as circular, because you inspect the data it holds instead of the structure only. Don't look into the CAR here:
(defun circularp (list)
(let ((first list))
(labels ((visit (list)
(cond
((atom list) nil)
((eq list first) t)
(t (visit (cdr list))))))
(visit (cdr list)))))
Also, the inner function is tail recursive but there is no guarantee that a Common Lisp implementation automatically eliminates tail calls (you should check with your implementation; most can do it on request). That means you risk allocating as many call stack frames as you have elements in the list, which is bad. Better use a loop directly:
(defun circularp (list)
(loop
for cursor on (cdr list)
while (consp cursor)
thereis (eq cursor list)))
Last, but not least: your approach is a very common one but fails when the list is not one big circular chain of cells, but merely contains a loop somewhere. Consider for example:
CL-USER> *list*
#1=(A B C . #1#)
CL-USER> (push 10 *list*)
(10 . #1=(A B C . #1#))
CL-USER> (push 20 *list*)
(20 10 . #1=(A B C . #1#))
(see that answer where I explain what #1= and #1# mean)
The lists with numbers in front exhibit circularity but you can't just use the first cons cell as a marker, because you will be looping forever inside the sublist that is circular. This is the kind or problems the Tortoise and Hare algorithm solves (there might be other techniques, the most common being storing visited elements in a hash table).
After your last edit, here is what I would do if I wanted to check for circularity, in a recursive fashion, without labels:
(defun circularp (list &optional seen)
(and (consp list)
(or (if (member list seen) t nil)
(circularp (cdr list) (cons list seen)))))
We keep track of all the visited cons cells in seen, which is optional and initialized to NIL (you could pass another value, but that can be seen as a feature).
Then, we say that a list is circular with respect to seen if it is a cons cell which either: (i) already exists in seen, or (ii) is such that its CDR is circular with respect to (cons list seen).
The only additional trick here is to ensure the result is a boolean, and not the return value of member (which is the sublist where the element being searched for is the first element): if your environment has *PRINT-CIRCLE* set to NIL and the list is actually circular, you don't want it to try printing the result.
Instead of (if (member list seen) t nil), you could also use:
(when (member list seen))
(position list seen)
and of course (not (not (member list seen)))
Related
I want to implement the sorting function in common-lisp with this INSERT function
k means cons cell with number & val, and li means list where I want insert k into.
with this function, I can make a list of cell
(defun INSERT (li k) (IF (eq li nil) (cons (cons(car k)(cdr k)) nil)
(IF (eq (cdr li) nil)
(IF (< (car k)(caar li)) (cons (cons(car k)(cdr k)) li)
(cons (car li) (cons (cons(car k)(cdr k)) (cdr li)) )
)
(cond
( (eq (< (caar li) (car k)) (< (car k) (caadr li)) )
(cons (car k) (cons (cons (car k) (cdr k)) (cdr li)) ) )
(t (cons (car li) (INSERT (cdr li) k)) )))))
and what I want is the code of this function below. it has only one parameter li(non sorted list)
(defun Sort_List (li)(...this part...))
without using assignment, and using the INSERT function
Your insert function is very strange. In fact I find it so hard to read that I cn't work out what it's doing except that there's no need to check for both the list being null and its cdr being null. It also conses a lot of things it doesn't need, unless you are required by some part of the specification of the problem to make copies of the conses you are inserting.
Here is a version of it which is much easier to read and which does not copy when it does not need to. Note that this takes its arguments in the other order to yours:
(defun insert (thing into)
(cond ((null into)
(list thing))
((< (car thing) (car (first into)))
(cons thing into))
(t (cons (first into)
(insert thing (rest into))))))
Now, what is the algorithm for insertion sort? Well, essentially it is:
loop over the list to be sorted:
for each element, insert it into the sorted list;
finally return the sorted list.
And we're not allowed to use assignment to do this.
Well, there is a standard trick to do this sort of thing, which is to use a tail-recursive function with an accumulator argument, which accumulates the results. We can either write this function as an explicit auxiliary function, or we can make it a local function. I'm going to do the latter both because there's no reason for a function which is only ever used locally to be globally visible, and because (as I'm assuming this is homework) it makes it harder to submit directly.
So here is this version of the function:
(defun insertion-sort (l)
(labels ((is-loop (tail sorted)
(if (null tail)
sorted
(is-loop (rest tail) (insert (first tail) sorted)))))
(is-loop l '())))
This approach is fairly natural in Scheme, but not very natural in CL. An alternative approach which does not use assignment, at least explicitly, is to use do. Here is a version which uses do:
(defun insertion-sort (l)
(do ((tail l (rest tail))
(sorted '() (insert (first tail) sorted)))
((null tail) sorted)))
There are two notes about this version.
First of all, although it's not explicitly using assignment it pretty clearly implicitly is doing so. I think that's probably cheating.
Secondly it's a bit subtle why it works: what, exactly, is the value of tail in (insert (first tail) sorted), and why?
A version which is clearer, but uses loop which you are probably not meant to know about, is
(defun insertion-sort (l)
(loop for e in l
for sorted = (insert e '()) then (insert e sorted)
finally (return sorted)))
This, however, is also pretty explicitly using assignment.
As Kaz has pointed out below, there is an obvious way (which I should have seen!) of doing this using the CL reduce function. What reduce does, conceptually, is to successively collapse a sequence of elements by calling a function which takes two arguments. So, for instance
(reduce #'+ '(1 2 3 4))
is the same as
(+ (+ (+ 1 2) 3) 4)
This is easier to see if you use cons as the function:
> > (reduce #'cons '(1 2 3 4))
(((1 . 2) . 3) . 4)
> (cons (cons (cons 1 2) 3) 4)
(((1 . 2) . 3) . 4)
Well, of course, insert, as defined above, is really suitable for this: it takes an ordered list and inserts a new pair into it, returning a new ordered list. There are two problems:
my insert takes its arguments in the wrong order (this is possibly why the original one took the arguments in the other order!);
there needs to be a way of 'seeding' the initial sorted list, which will be ().
Well we can fix the wrong-argument-order either by rewriting insert, or just by wrapping it in a function which swaps the arguments: I'll do the latter because I don't want to revisit what I wrote above and I don't want two versions of the function.
You can 'seed' the initial null value by either just prepending it to the list of things to sort, or in fact reduce has a special option to provide the initial value, so we'll use that.
So using reduce we get this version of insertion-sort:
(defun insertion-sort (l)
(reduce (lambda (a e)
(insert e a))
l :initial-value '()))
And we can test this:
> (insertion-sort '((1 . a) (-100 . 2) (64.2 . "x") (-2 . y)))
((-100 . 2) (-2 . y) (1 . a) (64.2 . "x"))
and it works fine.
So the final question the is: are we yet again cheating by using some function whose definition obviously must involve assignment? Well, no, we're not, because you can quite easily write a simplified reduce and see that it does not need to use assignment. This version is much simpler than CL's reduce, and in particular it explicitly requires the initial-value argument:
(defun reduce/simple (f list accum)
(if (null list)
accum
(reduce/simple f (rest list) (funcall f accum (first list)))))
(Again, this is not very natural CL code since it relies on tail-call elimination to handle large lists, but it makes the point that you can do this without assignment.)
And so now we can write one final version of insertion-sort:
(defun insertion-sort (l)
(reduce/simple (lambda (a e)
(insert e a))
l '()))
And it's easy to check that this works as well.
I want to solve a lisp function that returns a NUMBER(count) of numbers which are greater than the first number in the list.The list is a linear list of numbers.
(defun foo (lst)
(cond ((null lst) 0)
(car = k)
((> (car lst) k)
(1+ (foo (cdr lst))))
(T (foo (cdr lst)))))
My problem is that I cannot keep the first element and compare it with the others.
Let's take apart your problem:
You have a set of numbers. Really, you have a “special” first number, and then the rest of them. Specifically, you probably want only real numbers, because “less than” does not make sense in terms of complex (imaginary) numbers.
You can use first to get the first number from the list, and rest for the others.
Of these, you want to count any that are not greater than the first.
So let's start with sort of pseudocode
(defun count-numbers-greater-than-first (list)
;; split out first and rest
;; call the real count function
)
Well, we know now that we can use first and rest (also, as you used, historically car and cdr), so:
(defun count-numbers-greater-than-first (list)
(count-numbers-greater-than (first list) (rest list))
You already probably know that > is used to test whether real numbers are greater than one another.
A quick look at the CLHS reveals a nice function called count-if
(defun count-numbers-not-greater-than (reference other-numbers)
(count-if ??? other-numbers))
The ??? needs to be an object of function type, or the name of a function. We need to “curry” the reference (first number) into that function. This means we want to create a new function, that is only used for one run through the count-if, that already has “closed over” the value of reference.
If we knew that number would always be, say, 100, that function would look like this:
(defun greater-than-100 (number)
(> number 100))
That function could then get used in the count-if:
(defun count-numbers-greater-than (reference other-numbers)
(count-if (function greater-than-100)
other-numbers))
(defun count-numbers-greater-than (reference other-numbers)
(count-if #'greater-than-100 other-numbers))
But that doesn't solve the problem of getting the reference number “curried” into the function.
Without reaching for Alexandria (I'll explain in a moment), you can use a lambda form to create a new, anonymous function right here. Since reference is available within count-numbers-not-greater-than, you can use its value within that lambda. Let's convert for 100 first:
(defun count-numbers-greater-than (reference other-numbers)
(count-if (lambda (number) (> number 100))
other-numbers))
Now we can use reference:
(defun count-numbers-greater-than (reference other-numbers)
(count-if (lambda (number) (> number reference))
other-numbers))
And, in fact, you could even merge this back into the other function, if you wanted:
(defun count-numbers-greater-than-first (list)
(count-if (lambda (number) (> number (first list)))
(rest list)))
That Alexandria thing
But, what about Alexandria? Alexandria is a collection of super-useful utility functions that's available in Quicklisp or elsewhere.
(ql:quickload "alexandria")
(use-package #:alexandria)
Of course, you'd normally use it in your own defpackage
(defpackage my-cool-program
(:use :common-lisp :alexandria))
Two of the things it provides are curry and rcurry functions. It turns out, that lambda function in there is a really common case. You have an existing function — here, > — that you want to call with the same value over and over, and also some unknown value that you want to pass in each time.
These end up looking a lot like this:
(lambda (x) (foo known x))
You can use curry to write the same thing more concisely:
(curry #'foo known)
It also work with any number of arguments. RCurry does the same, but it puts the unknown values “x” at the left, and your known values at the right.
(lambda (x) (foo x known)) = (rcurry #'foo known)
So another way to write the count-if is:
(defun count-numbers-greater-than-first (list)
(count-if (rcurry #'> (first list))
(rest list)))
* (count-numbers-greater-than-first '(10 9 8 7 11 12))
2
Your function indented correctly looks like this:
(defun foo (lst)
(cond ((null lst) 0)
(car = k) ; strange cond term
((> (car lst) k)
(1+ (foo (cdr lst))))
(T (foo (cdr lst)))))
I have commented the second term in your cond. It is quite strange. It first evaluates the variable car (not the function #'car). If car is not nil it first evaluates the variable = (not the function #'=) and since it is not the last consequent expression in the cond term it throws that away and returns the last which is k.
Secondly you write that you say you use the first element as comparison, however you call it k in your function but it is not defined anywhere. You need to do something before you do the recursion and thus you cannot let the actual function do the recursion since it will take the first element each time. Here is where labels can be used:
;; didn't call it foo since it's not very descriptive
(defun count-larger-than-first (list)
(let ((first (car list)))
(labels ((helper (list)
(cond ((null list) 0)
((> (car list) first)
(1+ (helper (cdr list))))
(t (helper (cdr list))))))
(helper (cdr list)))))
Of course. Since you now have the possibility to add more arguments I would have added an accumulator:
(defun count-larger-than-first (list)
(let ((first (car list)))
(labels ((helper (list acc)
(cond ((null list) acc)
((> (car list) first)
(helper (cdr list) (1+ acc)))
(t (helper (cdr list) acc)))))
(helper (cdr list) 0))))
And of course recursion might blow the stack so you should really write it without in Common Lisp:
(defun count-larger-than-first (list)
(let ((first (car list)))
(loop :for element :in (cdr list)
:counting (> element first))))
There are higher order functions that count too which might be more suitable:
(defun count-larger-than-first (list)
(let ((first (car list)))
(count-if (lambda (element) (> element first))
(cdr list))))
I am supposed to find the path from the root to a given node in LISP. Preferably using a purely functional approach.
The binary tree representation uses sublists, e.g.:
(A (B) (C (D) (E))) - A is the root, B the left child of A, C the right child of A, D the left child of C and E the right child of C.
It seems to me that there should be some way to avoid the duplication of the following function calls:
(get-path (cadr l) x)
(get-path (caddr l) x)
I am new to LISP and I don't know and can't seem to find a solution for this, but I think there must be a -purely- functional way to do it. Maybe using lambdas? Not sure how, though. Am I using a wrong approach? Any kind of help is highly appreciated.
;;; l is the list with the binary tree
;;; x is the node we are looking for
(defun get-path(l x)
(cond
;; nothing to search for anymore
((null l) nil)
;; found the node we were looking for
;; in this case we return a list containing only x
((equal (car l) x) (list x))
;; the node was found on the left branch
((not(equal (get-path (cadr l) x) nil))
(cons (car l) (get-path (cadr l) x)))
;; the node was found on the right branch
((not(equal (get-path (caddr l) x) nil))
(cons (car l) (get-path (caddr l) x)))))
What about this?
(defun root-path (tree element)
(when tree
(cons (first tree)
(unless (eql (first tree) element)
(or (root-path (second tree) element)
(root-path (third tree) element)
(return-from root-path nil))))))
You should even define meaningfully named functions, like tree-value left-subtree and right-subtree, but this is maybe overkill here.
In the above, note that when (resp. unless) is used for its nil value when the condition fails (resp. succeed). You can translate with cond or if expressions if you prefer. The only repetition here is the double (first tree) value, which might be optimized away by the compiler or manually with a surrounding let binding.
Edit
The original code was not working. The solution is to use Joshua's answer, but I won't copy paste it here, so I added the return-from expression. While it works, your teacher and/or coworker will probably not like this approach ;-)
Tests
(mapcar (lambda (n) (root-path '(A (B) (C (D) (E))) n))
'(a b c d e f))
=> ((a) (a b) (a c) (a c d) (a c e) nil)
I'd combine the final two cond clauses. You want to check the left side and see if there's a path there, and if there is, take it, and if there's not, check the right side. Then, whichever one of those yielded a path (if either did), you want to append to that. That could look like this. First, a couple of functions for convenience:
(defun element (tree)
(first tree))
(defun left (tree)
(second tree))
(defun right (tree)
(third tree))
Now, the real meat of the solution:
(defun get-path (element tree)
(cond
;; A null tree is empty and doesn't match anything.
((null tree) '())
;; If the element of this tree is the element, then we have a
;; partial path of length 1: (ELEMENT).
((eql element (element tree)) (list element))
;; Othweise, let PATH be the path on the left or the path on the
;; right, whichever exists.
(t (let ((path (or (get-path element (left tree))
(get-path element (right tree)))))
;; If there's no path on either side, then return NIL.
;; Otherwise, prepend the current element onto the path that
;; exists.
(if (null path) '()
(list* (element tree) path))))))
Note that list* does the same thing as cons, but it makes it clearer that you're working with lists, not just cons cells. You could use cons just as well.
We can confirm that this works as expected:
(defparameter *tree* '(A (B) (C (D) (E))))
(get-path 'c *tree*) ;;=> (A C)
(get-path 'd *tree*) ;;=> (A C D)
(get-path 'f *tree*) ;;=> NIL
Use labels for interior (local) functions:
(defun get-path(l x)
(labels ((prepend-path (elt)
(cons (car l) (get-path elt x))))
(cond
;; nothing to search for anymore
((null l) nil)
;; found the node we were looking for
;; in this case we return a list containing only x
((equal (car l) x) (list x))
;; the node was found on the left branch
((not(equal (get-path (cadr l) x) nil))
(prepend-path (cadr l)))
;; the node was found on the right branch
((not(equal (get-path (caddr l) x) nil))
(prepend-path (caddr l))))))
Alternatively, you could use flet instead of labels because you don't have interior functions that refer to each other. Personally, I use labels and hardly ever use flet for that reason (plus the overhead of re-indenting the function.)
What you can do is replicate the anaphoric conda and ifa macros from TXR Lisp in Common Lisp. (Source code here; good luck!)enter link description here
Then you can write it like this, referring to the get-path expressions using the anaphoric it variable.
(conda
;; nothing to search for anymore
((null l) nil)
;; found the node we were looking for
;; in this case we return a list containing only x
((equal (car l) x) (list x))
;; the node was found on the left branch
((not (equal (get-path (cadr l) x) nil)) (cons (car l) it))
;; the node was found on the right branch
((not (equal (get-path (caddr l) x) nil)) (cons (car l) it)))
conda is clever about expressions of the form (not x) and (null x) (also (false x) in TXR Lisp). If the test expression is one of these, then it recurses into the x do ferret out the "anaphoric it".
Note that it binds to places not just to values. Not only is the target of it not evaluated more than once, if the target is a place, then it refers to that place:
(ifa (< x 10)
(inc it)) ;; increments x.
This aspect of ifa is achieved with the help of the placelet macro, which doesn't exist in Common Lisp. A quick and dirty substitute would be to use symbol-macrolet. The only problem is that that a symbol macro denoting a place allows multiple evaluation of the place whereas placelet evaluates a place once. The resulting lexical symbol then denotes the storage location, rather than the overall expression.
ifa was designed to either wipe the floor with Paul Graham's aif, or else to complement it; conda is trivially based on ifa.
By the way, do not write expressions like
(not (equal whatever nil))
in Lisp! Firstly, equal equality is not particularly meaningful if you are comparing with nil; only nil is equal to nil, and that is according to eq equality, so you might as well have:
(not (eq whatever nil))
Secondly, for something not to be eq to nil means that the something is true. That is to say:
(if (not (eq foo nil)) do-this) ---same-as--> (if foo do-this)
!
If we refactor your code to get rid of this stuff, then it's better if we have the Paul Graham Style anaphoric if aif (and an acond based on it). That is to say:
(ifa (not (equal (get-path whatever) nil))) (list it))
becomes:
(aif (get-path whatever) (list it))
where the it trivially to the value of the entire test expression, rather than a somewhat cleverly selected constituent of that expression.
Under ifa, this is expressed slightly more verbosely using:
(ifa (true (get-path whatever)) (list it))
Where true can be defined as
(defun true (x) (identity x)).
Without this extra wrapping, ifa will bind it to whatever.
I have a lisp homework I am having a hard time with it.
I have to write a function that perform a union operation. The function takes 2 inputs, either in the form of either atom or list and unions every element, preserving the order and stripping off all levels of parenthesis.
The output for the function:
(my-union 'a 'b) ;; (a b)
(my-union 'a '(b)) ;; (a b)
(my-union '(a b) '(b c)) ;; (a b c)
(my-union '(((a))) '(b(c((d e))a))) ;; (a b c d e)
I am fairly new to lisp.
Here is what I have written so far and it works only for the third example:
(defun new-union (a b)
(if (not b)
a
(if (member (car b) a)
(new-union a (cdr b))
(new-union (append a (list (car b))) (cdr b)))))
Any help would be appreciated!
Since this is your first homework, and you are new to Lisp, here is a very simple top-down approach, not worrying about performance, and making good use of the tools CL offers:
In Common Lisp, there is already a function which removes duplicates: remove-duplicates. Using it with the :from-end keyword-argument will "preserve order". Now, imagine you had a function flatten, which flattens arbitrarily nested lists. Then the solution to your question would be:
(defun new-union (list1 list2)
(remove-duplicates (flatten (list list1 list2)) :from-end t))
This is how I would approach the problem when no further restrictions are given, and there is no real reason to worry much about performance. Use as much of the present toolbox as possible and do not reinvent wheels unless necessary.
If you approach the problem like this, it boils down to writing the flatten function, which I will leave as an exercise for you. It is not too hard, one easy option is to write a recursive function, approaching the problem like this:
If the first element of the list to be flattened is itself a list, append the flattened first element to the flattened rest. If the first element is not a list, just prepend it to the flattened rest of the list. If the input is not a list at all, just return it.
That should be a nice exercise for you, and can be done in just a few lines of code.
(If you want to be very correct, use a helper function to do the work and check in the wrapping function whether the argument really is a list. Otherwise, flatten will work on atoms, too, which may or may not be a problem for you.)
Now, assuming you have written flatten:
> (defun new-union (list1 list2)
(remove-duplicates (flatten (list list1 list2)) :from-end t))
NEW-UNION
> (new-union 'a 'b)
(A B)
> (new-union 'a '(b))
(A B)
> (new-union '(a b) '(b c))
(A B C)
> (new-union '(((a))) '(b (c ((d e)) a)))
(A B C D E)
One way to approach this is to separate your concerns. One is flattening; another is duplicates-removing; yet another is result-building.
Starting with empty list as your result, proceed to add into it the elements of the first list, skipping such elements that are already in the result.
Then do the same with the second list's elements, adding them to the same result list.
(defun my-union (a b &aux (res (list 1)) (p res))
(nadd-elts p a)
(nadd-elts p b)
(cdr res))
nadd-elts would add to the end of list, destructively updating its last cell (pointed to by p) using e.g. rplacd. An example is here.
To add elements, nadd-elts would emulate the flattening procedure, and add each leaf element into p after checking res for duplicates.
Working in functional style, without destructive update, the general approach stays the same: start with empty result list, add first list into it - without duplicates - then second.
(defun my-union (a b &aux res)
(setq res (add-into res a))
(setq res (add-into res b))
res)
Now we're left with implementing the add-into function.
(defun add-into (res a &aux r1 r2)
(cond
((atom a) .... )
(T (setq r1 (add-into res (car a)))
(setq r2 (............ (cdr a)))
r2)))
The above can be re-written without the auxiliary variables and without set primitives. Try to find out how... OK here's what I meant by that:
(defun my-union (a b) (add-into NIL (cons a b)))
(defun add-into (res a)
(cond
((atom a) .... )
(T (add-into (add-into res (car a))
(cdr a)))))
Unless you are not allowed to use hash table (for some reason I've encountered this as a requirement before), you could come up with an ordering function that will help you build the resulting set in the way, that you don't have to repeat the search over and over again.
Also, since nested lists are allowed your problem scales down to only removing duplicates in a tree (as you can simply append as many lists as you want before you start processing them.
Now, I'll try to show few examples of how you could do it:
;; Large difference between best and worst case.
;; Lists containing all the same items will be processed
;; in square time
(defun union-naive (list &rest lists)
(when lists (setf list (append list lists)))
(let (result)
(labels ((%union-naive (tree)
(if (consp tree)
(progn
(%union-naive (car tree))
(when (cdr tree) (%union-naive (cdr tree))))
(unless (member tree result)
(setq result (cons tree result))))))
(%union-naive list) result)))
;; Perhaps the best solution, it is practically linear time
(defun union-hash (list &rest lists)
(when lists (setf list (append list lists)))
(let ((hash (make-hash-table)) result)
(labels ((%union-hash (tree)
(if (consp tree)
(progn
(%union-hash (car tree))
(when (cdr tree) (%union-hash (cdr tree))))
(setf (gethash tree hash) t))))
(%union-hash list))
(maphash
#'(lambda (a b)
(declare (ignore b))
(push a result)) hash)
result))
;; This will do the job in more time, then the
;; solution with the hash-map, but it requires
;; significantly less memory. Memory is, in fact
;; a more precious resource some times, but you
;; have to decide what algo to use based on the
;; data size
(defun union-flatten (list &rest lists)
(when lists (setf list (append list lists)))
(labels ((%flatten (tree)
(if (consp tree)
(if (cdr tree)
(nconc (%flatten (car tree))
(%flatten (cdr tree)))
(%flatten (car tree)))
(list tree))))
;; the code below is trying to do something
;; that you could've done using
;; (remove-duplicates (%flatten list))
;; however sorting and then removing duplicates
;; may prove to be more efficient
(reduce
#'(lambda (a b)
(cond
((atom a) (list a))
((eql (car a) b) b)
(t (cons b a))))
(sort (%flatten list)
#'(lambda (a b)
(string< (symbol-name a)
(symbol-name b)))))))
(union-naive '(((a))) '(b(c((d e))a)))
(union-hash '(((a))) '(b(c((d e))a)))
(union-flatten '(((a))) '(b(c((d e))a)))
Notice that the function I've used to order elements is not universal, but you would probably be able to come up with an alternative function for any sort of data. Any fast hashing function in general would do, I've used this one for simplicity.
How can I remove nested parentheses recursively in Common LISP Such as
(unnest '(a b c (d e) ((f) g))) => (a b c d e f g)
(unnest '(a b)) => (a b)
(unnest '(() ((((a)))) ())) => (a)
Thanks
Here's what I'd do:
(ql:quickload "alexandria")
(alexandria:flatten list)
That works mainly because I have Quicklisp installed already.
(defun flatten (l)
(cond ((null l) nil)
((atom l) (list l))
(t (loop for a in l appending (flatten a)))))
I realize this is an old thread, but it is one of the first that comes up when I google lisp flatten. The solution I discovered is similar to those discussed above, but the formatting is slightly different. I will explain it as if you are new to lisp, as I was when I first googled this question, so it's likely that others will be too.
(defun flatten (L)
"Converts a list to single level."
(if (null L)
nil
(if (atom (first L))
(cons (first L) (flatten (rest L)))
(append (flatten (first L)) (flatten (rest L))))))
For those new to lisp, this is a brief summary.
The following line declares a function called flatten with argument L.
(defun flatten (L)
The line below checks for an empty list.
(if (null L)
The next line returns nil because cons ATOM nil declares a list with one entry (ATOM). This is the base case of the recursion and lets the function know when to stop. The line after this checks to see if the first item in the list is an atom instead of another list.
(if (atom (first L))
Then, if it is, it uses recursion to create a flattened list of this atom combined with the rest of the flattened list that the function will generate. cons combines an atom with another list.
(cons (first L) (flatten (rest L)))
If it's not an atom, then we have to flatten on it, because it is another list that may have further lists inside of it.
(append (flatten (first L)) (flatten (rest L))))))
The append function will append the first list to the start of the second list.
Also note that every time you use a function in lisp, you have to surround it with parenthesis. This confused me at first.
You could define it like this for example:
(defun unnest (x)
(labels ((rec (x acc)
(cond ((null x) acc)
((atom x) (cons x acc))
(t (rec (car x) (rec (cdr x) acc))))))
(rec x nil)))
(defun flatten (l)
(cond ((null l) nil)
((atom (car l)) (cons (car l) (flatten (cdr l))))
(t (append (flatten (car l)) (flatten (cdr l))))))
Lisp has the function remove to remove things. Here I use a version REMOVE-IF that removes every item for which a predicate is true. I test if the thing is a parenthesis and remove it if true.
If you want to remove parentheses, see this function:
(defun unnest (thing)
(read-from-string
(concatenate
'string
"("
(remove-if (lambda (c)
(member c '(#\( #\))))
(princ-to-string thing))
")")))
Note, though, as Svante mentions, one does not usually 'remove' parentheses.
Most of the answers have already mentioned a recursive solution to the Flatten problem. Using Common Lisp Object System's multiple dispatching you could solve the problem recursively by defining 3 methods for 3 possible scenarios:
(defmethod flatten ((tree null))
"Tree is empty list."
())
(defmethod flatten ((tree list))
"Tree is a list."
(append (flatten (car tree))
(flatten (cdr tree))))
(defmethod flatten (tree)
"Tree is something else (atom?)."
(list tree))
(flatten '(2 ((8) 2 (9 (d (s (((((a))))))))))) ; => (2 8 2 9 D S A)
Just leaving this here as I visited this question with the need of only flattening one level and later figure out for myself that (apply 'concatenate 'list ((1 2) (3 4) (5 6 7))) is a cleaner solution in that case.
This is a accumulator based approach. The local function %flatten keeps an accumulator of the tail (the right part of the list that's already been flattened). When the part remaining to be flattened (the left part of the list) is empty, it returns the tail. When the part to be flattened is a non-list, it returns that part prefixed onto the tail. When the part to be flattened is a list, it flattens the rest of the list (with the current tail), then uses that result as the tail for flattening the first part of the list.
(defun flatten (list)
(labels ((%flatten (list tail)
(cond
((null list) tail)
((atom list) (list* list tail))
(t (%flatten (first list)
(%flatten (rest list)
tail))))))
(%flatten list '())))
CL-USER> (flatten '((1 2) (3 4) ((5) 6) 7))
(1 2 3 4 5 6 7)
I know this question is really old but I noticed that nobody used the push/nreverse idiom, so I am uploading that here.
the function reverse-atomize takes out each "atom" and puts it into the output of the next call. At the end it produces a flattened list that is backwards, which is resolved with the nreverse function in the atomize function.
(defun reverse-atomize (tree output)
"Auxillary function for atomize"
(if (null tree)
output
(if (atom (car tree))
(reverse-atomize (cdr tree) (push (car tree) output))
(reverse-atomize (cdr tree) (nconc (reverse-atomize (car tree)
nil)
output)))))
(defun atomize (tree)
"Flattens a list into only the atoms in it"
(nreverse (reverse-atomize tree nil)))
So calling atomize '((a b) (c) d) looks like this:
(A B C D)
And if you were to call reverse-atomize with reverse-atomize '((a b) (c) d) this would occur:
(D C B A)
People like using functions like push, nreverse, and nconc because they use less RAM than their respective cons, reverse, and append functions. That being said the double recursive nature of reverse-atomize does come with it's own RAMifications.
This popular question only has recursive solutions (not counting Rainer's answer).
Let's have a loop version:
(defun flatten (tree &aux todo flat)
(check-type tree list)
(loop
(shiftf todo tree nil)
(unless todo (return flat))
(dolist (elt todo)
(if (listp elt)
(dolist (e elt)
(push e tree))
(push elt flat))))))
(defun unnest (somewhat)
(cond
((null somewhat) nil)
((atom somewhat) (list somewhat))
(t
(append (unnest (car somewhat)) (unnest (cdr somewhat))))))
I couldn't resist adding my two cents. While the CL spec does not require tail call optimization (TCO), many (most?) implementations have that feature.
So here's a tail recursive version that collects the leaf nodes of a tree into a flat list (which is one version of "removing parentheses"):
(defun flatten (tree &key (include-nil t))
(check-type tree list)
(labels ((%flatten (lst accum)
(if (null lst)
(nreverse accum)
(let ((elem (first lst)))
(if (atom elem)
(%flatten (cdr lst) (if (or elem include-nil)
(cons elem accum)
accum))
(%flatten (append elem (cdr lst)) accum))))))
(%flatten tree nil)))
It preserves null leaf nodes by default, with the option to remove them. It also preserves the left-to-right order of the tree's leaf nodes.
Note from Google lisp style guide about TCO:
You should favor iteration over recursion.
...most serious implementations (including SBCL and CCL) do implement proper tail calls, but with restrictions:
The (DECLARE (OPTIMIZE ...)) settings must favor SPEED enough and not favor DEBUG too much, for some compiler-dependent meanings of "enough" and "too much".
And this from SBCL docs:
... disabling tail-recursion optimization ... happens when the debug optimization quality is greater than 2.