Exercise 11.22d of David Touretzky's "A Gentle Introduction to Symbolic Computation" states:
"[...] Write a function COUNT-BASES that
counts the number of bases of each type in a DNA strand, and returns
the result as a table. Your function should work for both single-and
double-stranded DNA. Example: (COUNT-BASES '((G C) (A T) (T A) (T A) (C G))) should return ((A 3) (T 3) (G 2) (C 2)), whereas
(COUNT-BASES '(A G T A C T C T)) should return ((A 2) (T 3) (G 1) (C 2)). [...]"
My solution:
(defun count-bases (strand)
(labels ((flatten (tree)
(cond
((atom tree) (list tree))
(t (append (flatten (car tree))
(and (cdr tree)
(flatten (cdr tree))))))))
(let ((flat-strand (flatten strand))
(cnt-list '((a 0) (t 0) (c 0) (g 0))))
(dolist (el flat-strand cnt-list)
(incf (cadr (assoc el cnt-list)))))))
So the idea is to first flatten STRAND and then count with assoc and incf.
The problem is that this somehow retains the state of cnt-list, like so:
(count-bases '((g c) (a t) (t a) (t a) (c g))) ;; ((A 3) (T 3) (C 2) (G 2))
(count-bases '((g c) (a t) (t a) (t a) (c g))) ;; ((A 6) (T 6) (C 4) (G 4))
;; etc
I am aware that incf is de/con-structive, nonetheless cnt-list should reset after the function returns, right?
You're modifying a quoted list which is undefined behavior. If you want to construct a list to modify, you should use (list ...) instead of '(...).
If you initialize cnt-list to (list (list 'a 0) (list 't 0) (list 'c 0) (list 'g 0)), it should work as intended.
One can call (copy-tree '((a 0) (t 0) (c 0) (g 0))) to get a tree with fresh cons cells.
I think that something Lisp people tend to do is to write over-general solutions to problems while not paying enough attention to domain knowledge.
Strands of DNA are, well, strands: they're chains of either bases or pairs of bases. No strand contains both single bases and pairs of bases. There are exactly four possible bases. There are exactly two possible base pairs.
So while it's nice to be able to treat a strand as a general tree and flatten it, it's not actually a very good approach: it deals with objects which are far more general than DNA strands actually are, and also almost certainly does not detect errors in the data its being asked to process.
And while it's nice to use an alist to record the counts, and it certainly will be useful when we need to deal with alien DNA with some large number of bases, it's not actually very useful in this case.
Furthermore both these techniques make the program much slower and much consier than it needs to be. (I have a suspicion one of the other answers also turns a linear problem into a quadratic one). And so of course the old myth that lisp is slow will be reinforced, again, and that helps no-one.
(And of course, we all know that alien DNA is DAG-structured, so the tree-flattening approach, which seems like it might be useful, will horribly double-count the bases.)
Here's a solution which relies on some domain knowledge, and also does some checking of the data it gets. You can call it with an optional 'be more fussy' argument which makes it be more fussy. It's longer than the clever/general answers, but, well. Inevitably it will have some idiot bug [it did].
(defun count-bases (strand &key (carefully nil))
(let ((adenine 0) (thymine 0) (guanine 0) (cytosine 0)
(double (consp (first strand))))
(dolist (base/pair strand `((a ,adenine)
(t ,thymine)
(g ,guanine)
(c ,cytosine)))
(typecase base/pair
(symbol
(when double
(error "horrible aliens ahavere eaten my brain"))
(case base/pair
((a) (incf adenine))
((t) (incf thymine))
((g) (incf guanine))
((c) (incf cytosine))
(otherwise (error "aliens have horribly eaten my brain"))))
(cons
(unless double
(error "aliens have eaten my horrible brain"))
(when carefully
(unless (member base/pair '((a t) (t a) (c g) (g c)) :test #'equal)
(error "horrible brains have eaten my alien")))
(case (first base/pair)
((a t) (incf adenine) (incf thymine))
((c g) (incf cytosine) (incf guanine))
(otherwise (error "brains have horribly eaten my alien"))))
(t
(error "brains have eaten my horrible alien"))))))
Related
Is there a standard function in Common Lisp that can check against improper lists (i.e. circular and dotted lists) without signaling an error? list-length can check against circular lists (it returns nil for them), but signals type-error when given a dotted list.
Scheme's list? traverses the whole list to make sure it is not dotted or circular; Common Lisp's listp only checks that it's given nil or a cons cell.
Here's the simplest I could come up with:
(defun proper-list-p (x)
(not (null (handler-case (list-length x) (type-error () nil)))))
Since several implementations have been suggested and many unexpected problems have been found, here's a test suite for aspiring proper-list-p writers:
(defun circular (xs)
(let ((xs (copy-list xs)))
(setf (cdr (last xs)) xs)
xs))
(assert (eql t (proper-list-p '())))
(assert (eql t (proper-list-p '(1))))
(assert (eql t (proper-list-p '(1 2))))
(assert (eql t (proper-list-p '(1 2 3))))
(assert (not (proper-list-p 1)))
(assert (not (proper-list-p '(1 . 2))))
(assert (not (proper-list-p '(1 2 . 3))))
(assert (not (proper-list-p '(1 2 3 . 4))))
(assert (not (proper-list-p (circular '(1)))))
(assert (not (proper-list-p (circular '(1 2)))))
(assert (not (proper-list-p (circular '(1 2 3)))))
(assert (not (proper-list-p (list* 1 (circular '(2))))))
(assert (not (proper-list-p (list* 1 2 (circular '(3 4))))))
There is no standard function to do this, perhaps because such a function was seen as rather expensive if it was to be correct, but, really, this just seems like am omission from the language to me.
A minimal (not very performant) implementation, which does not rely on handling errors (Python people think that's a reasonable way to program, I don't, although this is a stylistic choice), is, I think
(defun proper-list-p (l)
(typecase l
(null t)
(cons
(loop for tail = l then (cdr tail)
for seen = (list tail) then (push tail seen)
do (cond ((null tail)
(return t))
((not (consp tail))
(return nil))
((member tail (rest seen))
(return nil)))))))
This takes time quadratic in the length of l, and conses proportional to the length of l. You can obviously do better using an hashtable for the occurs check, and you can use a tortoise-&-hare algorithm do avoid the occurs check (but I'm not sure what the complexity of that is off the top of my head).
I am sure there are much better functions than this in libraries. In particular Alexandria has one.
While thinking about this question, I also wrote this function:
(defun classify-list (l)
"Classify a possible list, returning four values.
The first value is a symbol which is
- NULL if the list is empty;
- LIST if the list is a proper list;
- CYCLIC-LIST if it contains a cycle;
- IMPROPER-LIST if it does not end with nil;
- NIL if it is not a list.
The second value is the total number of conses in the list (following
CDRs only). It will be 0 for an empty list or non-list.
The third value is the cons at which the cycle in the list begins, or
NIL if there is no cycle or the list isn't a list.
The fourth value is the number if conses in the cycle, or 0 if there is no cycle.
Note that you can deduce the length of the leading element of the list
by subtracting the total number of conses from the number of conses in
the cycle: you can then use NTHCDR to pull out the cycle."
;; This is written as a tail recursion, I know people don't like
;; that in CL, but I wrote it for me.
(typecase l
(null (values 'null 0 nil 0 0))
(cons
(let ((table (make-hash-table)))
(labels ((walk (tail previous-tail n)
(typecase tail
(null
(values 'list n nil 0))
(cons
(let ((m (gethash tail table nil)))
(if m
(values 'cyclic-list n tail (- n m))
(progn
(setf (gethash tail table) n)
(walk (cdr tail) tail (1+ n))))))
(t
(values 'improper-list n previous-tail 0)))))
(walk l nil 0))))
(t (values nil 0 nil 0))))
This can be used to get a bunch of information about a list: how long it is, if it is proper, if not if it's cyclic, and where the cycle is. Beware that in the cases of cyclic lists this will return circular structure as its third value. I believe that you need to use an occurs check to do this – tortoise & hare will tell you if a list is cyclic, but not where the cycle starts.
in addition, something slightly less verbose, than the accepted answer:
(defun improper-tail (ls)
(do ((x ls (cdr x))
(visited nil (cons x visited)))
((or (not (consp x)) (member x visited)) x)))
(defun proper-list-p (ls)
(null (improper-tail ls)))
or just like this:
(defun proper-list-p (ls)
(do ((x ls (cdr x))
(visited nil (cons x visited)))
((or (not (consp x)) (member x visited)) (null x))))
seen to pass all the op's test assertions
After our hopeless attempts with tailp, here, sth which uses the
sharp-representation of circular lists :) .
With regex (to detect circular sublist)
(setf *print-circle* t)
(ql:quickload :cl-ppcre)
(defun proper-listp (lst)
(or (null lst) ; either a `'()` or:
(and (consp lst) ; a cons
(not (cl-ppcre::scan "#\d+=(" (princ-to-string lst)))) ; not circular
(null (cdr (last lst)))))) ; not a dotted list
Without regex (cannot detect circular sublists)
(defun proper-listp (lst)
(or (null lst) ; either a `'()` or:
(and (consp lst) ; a cons
(not (string= "#" (subseq (princ-to-string lst) 0 1))) ; not circular
(null (cdr (last lst)))))) ; not a dotted list
(tailp l (cdr l)) is t for circular lists but nil for non-circular lists.
Credits to #tfp and #RainerJoswig who taught me this here .
So, your function would be:
(defun proper-listp (lst)
(or (null lst) ; either a `'()` or:
(and (consp lst) ; a cons
(not (tailp lst (cdr lst))) ; not circular
(null (cdr (last lst)))))) ; not a dotted list
By the way, I use proper-listp by purpose. Correct would be - by convetion proper-list-p. However, this name is already occupied in the CLISP implementation by SYSTEM::%PROPER-LIST-Pwhy the definition of the function raises a continuable error.
Conclusion of our discussion in the comment section:
The behavior of tailp for circular lists is undefined. Therefore this answer is wrong! Thank you #Lassi for figuring this out!
Just learning Common Lisp for a few days, but Professor had assigned an exercise for me. However, my code is not able to compile, Can anyone show me where I did wrong with my coding part?
(defun( MIN-2 a b)
(cond
((and (numberp a) (numberp b) (<= a b)) a b)
((and (numberp a) (numberp b) nil) ERROR)
)
)
Literal translation:
(defun min-2 (a b) ; Define a Lisp function MIN-2 … takes two arguments A and B
(cond ((and (every #'numberp (list a b)) (<= a b)) a) ; if … A <= B, returns A
((and (every #'numberp (list a b)) (> a b)) b) ; if … A > B, returns B
(t 'error) ; if A or B is not a number (i. e. “else”), returns ERROR
Improvement: check for numbers just once beforehand.
(defun min-2 (a b)
(cond ((not (every #'numberp (list a b))) 'error)
((<= a b) a)
((> a b) b)))
And please indent your code and don't leave the parentheses lying around.
Why your code fails
Can anyone show me where I did wrong with my coding part?
(defun( MIN-2 a b)
(cond
((and (numberp a) (numberp b) (<= a b)) a b)
((and (numberp a) (numberp b) nil) ERROR)
)
)
Let me reformat your code (auto-indent + compress parentheses):
(defun (MIN-2 a b) ;; << bad syntax, as already pointed out in another answer
(cond
((and (numberp a) (numberp b) (<= a b))
a
b)
((and (numberp a) (numberp b) nil)
ERROR)))
Let's fix the syntax of defun:
(defun MIN-2 (a b)
(cond
((and (numberp a) (numberp b) (<= a b))
a
b)
((and (numberp a) (numberp b) nil)
ERROR)))
Error (I am compiling the code under Emacs + SBCL):
Undefined variable: ERROR
Indeed, error is a free variable here. You need to quote it.
(defun MIN-2 (a b)
(cond
((and (numberp a) (numberp b) (<= a b))
a
b)
((and (numberp a) (numberp b))
'ERROR)))
Warning:
Deleting unreachable code (ERROR is underlined).
Indeed, the condition here is a and expression where at least one of the
expression is NIL, which means the conjunction is always false. The case can never happen, which is why the was optimized away.
Also, the first clause's test is:
(and (numberp a) (numberp b) (<= a b))
And the clause body is a followed by b, which means a is evaluated, its value discarded (it is never used), then b is evaluated and its value is the value of the cond expression: you always return b when both inputs are numbers such that a <= b.
Clearly, this is not what you should do. Other answers already covered good solutions.
Alternatives
I am also here to offer alternative, not necessarily homework-friendly answers:
Catch exceptions
(defun min-2 (a b)
(handler-case (if (<= a b) a b)
(error () 'error)))
Catch exceptions (bis)
(defun min-2 (a b)
(or (ignore-errors (if (<= a b) a b))
'error))
Use generic functions
(defgeneric min-2 (a b)
(:method ((a number) (b number)) (if (<= a b) a b))
(:method (a b) 'error))
You are using the wrong syntax for defining a function. Use defun function-name (args)
(defun MIN-2 (a b)
(cond
((and (numberp a) (numberp b) (<= a b)) a b)
((and (numberp a) (numberp b) nil) ERROR)
)
)
I think it's worth writing functions like this in a way which makes clear what is the sanity check and what is the actual computation. So in this case the sanity check is: 'are both arguments numbers?' and the computation is the comparison of them if they are. So separate these two things rather than bundling it all into one conditional:
(defun min-2 (a b)
(if (and (numberp a) (numberp b))
;; sanity check OK, so compare them
(if (<= a b)
a
b)
'error))
Unfortunately, of course, the sanity check is not adequate:
> (min-2 1 2)
1
> (min-2 1 'a)
error
> (min-2 1 #c(1 1))
Error: In <= of (1 #C(1 1)) arguments should be of type real.
Oops: what the sanity check should be is whether the two arguments are real numbers. Fortunately, there's a predicate for that, which is realp. So a correct version of min-2 is:
(defun min-2 (a b)
(if (and (realp a) (realp b))
;; sanity check OK, so compare them
(if (<= a b)
a
b)
'error))
Preface: I'm currently taking a condensed course that is apparently taught in LISP and I've never worked with LISP in my life so I had to learn the language over a weekend. I apologize in advance for the abysmal code. I'm just familiar enough with LISP's syntax to get the code working and not much more.
I'm currently working on a program that solves the map coloring problem. This code takes a sequence where the first element of each sub sequence is a state and the second element represents a color. ex: '((A R) (B G) (C G) (D Y) (E B) (F B)) and then checks to make sure that no state has the same color as a state it's constrained by (defined by the constraint list). I know there are probably a lot of cleaner and simpler ways to do this but what I'm currently struggling with is having my dolist loops immediately return the value T whenever the if statement is met. So far I've been unable to get the functions to simply return a value and had to resort to this really ugly/wrong method of setting a variable to true and waiting for the loop to finish in order to make the code work. I've tried using return and just having T inside the if statements but, in both cases, the loop would finish instead of returning a value and I have no idea why.
(setq constraint '((A (B C E)) (B (A E F)) (C (A E F)) (D (F)) (E (A B C F)) (F (B C D E))))
(defun check_constraint (f s)
(setf ans nil)
(dolist (state constraint)
(if (eq (first state) f)
(if (search (list s) (second state))
(setf ans T) ;;where I want it to just return T
)
)
)
ans
)
;;ex: ((A R) (B R) (C B) (D R) (E B) (F G))
(defun check_conflict (lst)
(setf anb nil)
(dolist (state lst)
(dolist (neighbor (remove state lst))
(if (check_constraint (first state) (first neighbor))
(if (eq (second state) (second neighbor))
(setf anb T)) ;;where I want it to just return T
)
)
)
anb
)
EDIT: I ended up just fixing this with recursion. The code is cleaner now but I'd still love to know what my issue was. This is the recursive code.
(setq constraint '((A (B C E)) (B (A E F)) (C (A E F)) (D (F)) (E (A B C F)) (F (B C D E))))
(defun check_constraint (lst f s)
(COND
((null lst) nil)
((search (list (car (car lst))) f)
(if (search s (second (car lst))) T))
(t (check_constraint (cdr lst) f s))
)
)
(defun check_neighbor (check lst)
(COND
((null lst) nil)
((check_constraint constraint (list (car check)) (list (first (first lst))))
(if (eq (second check) (second (car lst))) T))
(t (check_neighbor check (cdr lst)))
)
)
;;(check_state '((A R) (B R) (C B) (D R) (E B) (F G)))
(defun check_state (lst)
(COND
((null lst) nil)
((check_neighbor (car lst) (cdr lst)) T)
(t (check_state (cdr lst)))
)
)
First a few style issues. You should use DEFVAR or DEFPARAMETER to declare global variables. Those should also have asterisks around the name to show that they are global (or special actually).
(defparameter *constraint*
'((A (B C E))
(B (A E F))
(C (A E F))
(D (F))
(E (A B C F))
(F (B C D E))))
The lisp convention for naming things is to use dashes between words (CHECK-CONSTRAINT instead of CHECK_CONSTRAINT). You should also prefer full words for variable names instead of abbreviations (LIST instead of LST). The closing parentheses should not be written on their own line.
Then the actual problem. You can use RETURN to return a value from a block named NIL. Loops establish such a block, so you can write the first function like
(defun check-constraint (first second)
(dolist (state *constraint*)
(when (and (eq first (first state))
(member second (second state)))
(return t))))
It's better to use WHEN instead of IF when there's only a then-branch. I also combined the two IFs into one using AND. Since you were wrapping S in a list for using SEARCH, I figured you probably want to use MEMBER instead (although I'm not sure since I don't exactly know what the code is supposed to do). You can change that back if it's wrong.
You probably could also simplify it to
(defun check-constraint (first second)
(member second (second (find first *constraint* :key #'first))))
In the second function you have two loops. If you use RETURN to return from the inner one, you just end up continuing the outer loop and ignoring the return value. So you have to use RETURN-FROM to return from the function instead of the inner loop.
(defun check-conflict (list)
(dolist (state list)
(dolist (neighbor (remove state list))
(when (and (check-constraint (first state) (first neighbor))
(eq (second state) (second neighbor)))
(return-from check-conflict t)))))
I would like to write a function that reverses the elements of a list, but it should happen in place (that is, don't create a new reversed list).
Something like:
>> (setq l ' (a b c d))
((a b c d)
>> (rev l)
(d c b a)
>> l
(d c b a)
What flags should I follow to achieve this?
Have a look at nreverse which will modify the list in place (see HyperSpec).
As per the comments, do note the comments that #Barmar made and this bit from the spec:
For nreverse, sequence might be destroyed and re-used to produce the result. The result might or might not be identical to sequence. Specifically, when sequence is a list, nreverse is permitted to setf any part, car or cdr, of any cons that is part of the list structure of sequence.
It's not difficult to implement this (ignoring fault cases). The keys are to use (setf cdr) to reuse a given cons cell and not to lose the reference to the prior cdr.
(defun nreverse2 (list)
(recurse reving ((list list) (rslt '()))
(if (not (consp list))
rslt
(let ((rest (cdr list)))
(setf (cdr list) rslt)
(reving rest list)))))
(defmacro recurse (name args &rest body)
`(labels ((,name ,(mapcar #'car args) ,#body))
(,name ,#(mapcar #'cadr args))))
[edit] As mentioned in a comment, to do this truly in-place (and w/o regard to consing):
(defun reverse-in-place (l)
(let ((result l))
(recurse reving ((l l) (r (reverse l))
(cond ((not (consp l)) result)
(else (setf (car l) (car r))
(reving (cdr l) (cdr r)))))))
> (defvar l '(1 2 3))
> (reverse-in-place l))
(3 2 1)
> l
(3 2 1)
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.