I managed to get my quicksort function to work but I'm confused why a slight change of the code causes the function to behave strangely.
This is the working code:
(defun low (mylist)
(setq result (list))
(loop
for x in mylist
do (if (< x (car mylist))
(setq result (cons x result))))
result)
(defun high (mylist)
(setq result (list))
(loop
for x in mylist
do (if (> x (car mylist))
(setq result (cons x result))))
result)
(defun qsort (mylist)
(if (null mylist)
nil
(progn
;(setq l1 (low mylist))
;(setq l2 (high mylist))
(append (qsort (low mylist))
(list (car mylist))
(qsort (high mylist))))))
However in the qsort function, if I try to store the partitions in l1 and l2 and then call qsort the function no longer works:
(defun qsort (mylist)
(if (null mylist)
nil
(progn
(setq l1 (low mylist))
(setq l2 (high mylist))
(append (qsort l1)
(list (car mylist))
(qsort l2)))))
With this (qsort (list -3 5 4 3 1 2)) returns (-3 1 2)
I know that storing the partitions beforehand is not necessary, but is there a reason why this is not supposed to work?
The problem is that you are using incorrectly variables in Common Lisp – and this is signalled in most implementations:
CL-USER> (defun low (mylist)
(setq result (list))
(loop for x in mylist do
(if (< x (car mylist))
(setq result (cons x result))))
result)
;Compiler warnings :
; In LOW: Undeclared free variable RESULT
LOW
Note that the compiler gives you a warning, and not an error, for two reasons:
You could introduce later on a global variable named result, and then the function execution would be correct;
The semantics of (setq x y) is such that, if no variable x is defined, then the value y is assigned to the symbol x, which is, in some sense, a kind of global variable.
And it is for this second reason that your function does not work correctly, since in your recursive definition you are using l1 and l2 as if they were local variables, instantiated with a different value at each recursive call, while instead they are globally assigned between the different calls, producing an incorrect result.
For a more thorough dicussion on the subject, see for instance the chapter on variables of the excellent book Practical Common Lisp.
The solution
You should introduce local variables with the let special form before using them. For instance, you could write the function low in this way:
(defun low (mylist)
(let ((result (list)))
(loop for x in mylist
if (< x (car mylist))
do (setq result (cons x result)))
result))
The let introduces the new variable, that you can later assign with the setq operator. Here, for instance, is a correct version of qsort:
(defun qsort (mylist)
(if (null mylist)
nil
(let ((l1 (low mylist))
(l2 (high mylist)))
(append (qsort l1) (list (car mylist)) (qsort l2)))))
Finally, note that you could write more concisely and more idiomatically the function low in this way (and similarly for high):
(defun low (mylist)
(loop for x in mylist
when (< x (car mylist))
collect x))
Final note
Your algorithm (and my rewriting) does not sort correctly a list, since it eliminates duplicate elements (try for instance to apply it to the list (7 3 2 2 4 9 1)).
A way of correcting it is to modify one of the two auxiliary functions so to get all the elements which are, for instance, less then or equal to the car of the sublist. Here is the rewriting of the low function that produces a correct algorithm:
(defun low (mylist)
(loop for x in (cdr mylist)
when (<= x (car mylist))
collect x))
As it was answered by Renzo, l1 and l2 are global variables. If you trace their values through your definition of qsort you get the following trace for the call (qsort '(-1 4 2 3 0 1)):
L1 = NIL L2 = (1 0 3 2 4)
L1 = (0) L2 = (4 2 3)
L1 = NIL L2 = NIL
(-1 0 1)
Meanwhile if you use let form, the trace shows:
L1 = NIL L2 = (1 0 3 2 4)
L1 = (0) L2 = (4 2 3)
L1 = NIL L2 = NIL
L1 = (3 2) L2 = NIL
L1 = (2) L2 = NIL
L1 = NIL L2 = NIL
So, l1 and l2 get assigned NIL deeper in the recursive call, whereas at the top of it their values were expected to contain non-empty lists.
In general, it is a bad idea to mix up a recursion (read functional programming) and assignment.
Renso has the answer but since you already use loop you should tap it's potential. Thus you could do this
(defun partition (number-list pivot)
(loop :for number :in number-list
:if (<= number pivot)
:collect number :into small
:else
:collect number :into large
:finally (return (values small large))))
qsort could be done like this to make use of it:
(defun qsort (number-list)
(if (not (cdr number-list))
number-list
(multiple-value-bind (small large)
(partition (cdr number-list)
(car number-list))
(nconc (qsort small)
(list (car number-list))
(qsort large)))))
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!
I am trying to write a function that takes only a list as a parameter and counts the number of times the symbol a appears in the list, without counting any a's in a sublist within the list.
I am very new to Lisp so please use as basic code as possible so I could understand what it is doing, even if it is inefficient.
(defun times (l)
(setf x 'a)
(cond
((null l) nil)
((equal x (car l)) (+ 1 (times x (cdr L))))
(t (times x(cdr l)))))
So (times '(a b (a) c)) should return 1. However I am getting the error that with this line times is getting two arguments when it should be getting one.
There are multiple ways to implement this in Common Lisp. The example should be small enough for you to follow (test them).
Recursive implementation
Your approach is fine, except you have small errors (in addition to the other ones reported in comments):
Do not use SETF for undeclarded variables.
Do not return NIL in the base case: your function should return a number.
Also, your code coud be better formatted, and you should use longer names (lowercase l in particular is hard to read)
Here is a modified version:
(defun times (list element)
(cond
((null list) 0)
((equal (car list) element) (1+ (times (cdr list) element)))
(t (times (cdr list) element))))
Example
Let's TRACE the function:
CL-USER> (trace times)
Here is the execution trace:
CL-USER> (times '(a b c d a f a) 'a)
0: (TIMES (A B C D A F A) A)
1: (TIMES (B C D A F A) A)
2: (TIMES (C D A F A) A)
3: (TIMES (D A F A) A)
4: (TIMES (A F A) A)
5: (TIMES (F A) A)
6: (TIMES (A) A)
7: (TIMES NIL A)
7: TIMES returned 0
6: TIMES returned 1
5: TIMES returned 1
4: TIMES returned 2
3: TIMES returned 2
2: TIMES returned 2
1: TIMES returned 2
0: TIMES returned 3
3
You can see that the call stack grows for each and every element visited in the list. It is usually a bad practice, especially when the recursive function is basically implementing a loop.
Loops
Use a simple LOOP:
(defun times (list element)
(loop for value in list count (equal value element)))
Alternatively, use DOLIST:
(defun times (list element)
(let ((counter 0))
(dolist (value list counter)
(when (equal element value)
(incf counter)))))
Here above, counter is a local variable introduced by LET. It is incremented with INCF inside the loop, only WHEN the comparison holds. Finally, counter is returned from the dolist (the third parameter indicates which form to evaluate to have the result value). The return value of dolist is also the return value of the let and the whole function.
This can be rewritten also with DO:
(defun times (list element)
(do ((counter 0)) ((null list) counter)
(when (equal element (pop list))
(incf counter))))
The first list in do introduces bindings, the second list is a termination test (here we stop when the list is empty) followed by a result form (here, the counter). Inside the body of the loop, we POP elements from the input list and do the comparison, as before.
Tail-recursive implementation
If you want to keep a recursive implementation, add an accumulator and compute all the intermediate results before entering a recursive evaluation. If all results are passed as function arguments, there is no need to keep track of intermediate results at each step of the recursion, which eliminates the need to even allocate stack frames. The ability to perform tail-call elimination is not expressly required by the specification of the language, but it is typically available in most implementations.
(defun times (list element)
(labels ((recurse (list counter)
(cond
((null list) counter)
((equal (first list) element)
(recurse (rest list) (1+ counter)))
(t (recurse (rest list) counter)))))
(recurse list 0)))
Here above, recurse is a local recursive function introduced by LABELS, which accepts a counter parameter. The difference with the original recursive function is that when the list is empty, it returns the current value of counter instead of zero. Here, the result of recurse is always the same as the value returned by recursive invocations: the compiler can just rebind inputs and perform a jump instead of allocating intermediate frames.
Higher-order functions
Here are yet two other ways, based on higher-order functions.
First, the usual way to define functions with accumulators is with REDUCE (known as fold in other languages). There is no explicit mutation:
(defun times (list element)
(reduce (lambda (counter value)
(if (equal value element)
(1+ counter)
counter))
list
:initial-value 0))
The anonymous function accepts the current state of the accumulator, the current value being visited in the list, and shall compute the next state of the accumulator (the counter).
Alternatively, call MAP with a nil first argument, so that the iteration is only done for effects. The anonymous function established by the LAMBDA form closes over the local counter variable, and can increment it when comparison holds. It is similar to the previous dolist example w.r.t. incrementing the counter through side-effects, but the iteration is done implicitly with map.
(defun times (list element)
(let ((counter 0))
(map ()
(lambda (value)
(when (equal value element)
(incf counter)))
list)
counter))
Built-in
For your information, there is a built-in COUNT function:
(defun times (list element)
(count element list :test #'equal))
Here is some code which might help. It uses tail recursion and defines a helper function which is called recursively and keeps track of the number of times the symbol 'a appears with the argument count. The helper function takes two arguments, but the functino count-a takes one. Count-a calls the helper with the list l and the total number of times it has counted the symbol 'a at the beginning, which is zero to kick off the recursive calls.
(defun count-a (l)
(labels ((helper (x count)
(if (equalp 'a (car x)) (incf count))
(cond ((null x) count)
(t (helper (cdr x) count)))))
(helper l 0)))
You can also use the loop macro:
(defun count-a-with-a-loop (l)
(loop for i in l count (equalp 'a i))\
Or as Coredump points out:
(defun count-a-with-count (l)
(count 'a l :test #'equal))
Note the '# character before equal lets the Lisp interpreter know that equal is a function, known as a reader macro.
If you use a Lisp compiler (like SBCL) you might see this:
* (defun times (l)
(setf x 'a)
(cond
((null l) nil)
((equal x (car l)) (+ 1 (times x (cdr L))))
(t (times x(cdr l)))))
; in: DEFUN TIMES
; (TIMES X (CDR L))
;
; caught WARNING:
; The function was called with two arguments, but wants exactly one.
;
; caught WARNING:
; The function was called with two arguments, but wants exactly one.
;
; caught WARNING:
; undefined variable: X
;
; compilation unit finished
; Undefined variable:
; X
; caught 3 WARNING conditions
The Lisp compiler tells you that there are three errors in your code.
Let's fix the undefined variable problem first, by introducing a local variable x:
(defun times (l)
(let ((x 'a))
(cond
((null l) nil)
((equal x (car l)) (+ 1 (times x (cdr L))))
(t (times x (cdr l))))))
Now, we look at the other two: you call TIMES with two arguments.
We can just remove the x argument, since it is not needed:
(defun times (l)
(let ((x 'a))
(cond
((null l) nil)
((equal x (car l)) (+ 1 (times (cdr L))))
(t (times (cdr l))))))
It may be more useful to be able to search for more things, so we add x to the argument list and add it to the call arguments.
(defun times (x l)
(cond
((null l) nil)
((equal x (car l)) (+ 1 (times x (cdr L))))
(t (times x (cdr l)))))
Now the function should always return a number, not NIL for an empty list:
(defun times (x l)
(cond
((null l) 0)
((equal x (car l)) (+ 1 (times x (cdr L))))
(t (times x (cdr l)))))
Since Lisp has functions like first and rest, we can replace car and cdr:
(defun times (x l)
(cond
((null l) 0)
((equal x (first l)) (+ 1 (times x (rest l))))
(t (times x (rest l)))))
I am a LISP newbie.
To get the running sum of a list, I am writing like --
(setf sum 0.0)
(mapcar #'(lambda(x)
(setf sum (+ sum x)) sum) values))
For example, if you give '(1 2 3 4) as input, the above code returns '(1 3 6 10) as output and so forth.
Is it possible to do the same thing (in a more elegant way) without using the global variable sum ?
(loop for x in '(1 2 3 4) sum x into y collect y)
scanl is a oneliner:
(defun scanl (f init xs)
(loop for x in xs collect (setf init (funcall f init x))))
You could use loop, like this:
(defun running-sum (xs)
(loop with sum = 0
for x in xs
collect (setf sum (+ sum x))))
(running-sum '(1 2 3 4))
It's fundamentally the same thing, but it uses a local variable instead of a global one, and might be more clear.
Alternatively, you could define a recursive function, and a wrapper function:
(defun running-sum-recursive (xs)
(running-sum-recursive2 0 xs))
(defun running-sum-recursive2 (sum xs)
(if (eq xs nil)
nil
(let ((new-sum (+ sum (car xs))))
(cons new-sum (running-sum-recursive2 new-sum (cdr xs))))))
(running-sum-recursive '(1 2 3 4))
However this seems needlessly complicated to me when loop is available.
Note that in Haskell, you could do a running sum like this:
runningSum xs = scanl1 (+) xs
runningSum [1, 2, 3, 4]
The key here is the scanl1 function. It's possible that something similar exists in Lisp (and we've very nearly written it twice now), but I haven't used Lisp in a while.
Edit: After some searching, I don't think Common Lisp includes anything quite like scanl or scanl1, so here they are:
(defun scanl (f val xs)
(loop for x in xs
collect (setf val (funcall f val x))))
(defun scanl1 (f xs)
(cons (car xs)
(scanl f (car xs) (cdr xs))))
(scanl1 #'+ '(1 2 3 4))
Edit: Thanks to huaiyuan's answer for a suggestion about how the loops could be shortened.
Or you could use higher-order functions
(define (running-sum ls)
(cdr (reverse (foldl (lambda (y xs) (cons (+ (car xs) y) xs)) '(0) ls))))
Haskell does have a rich inventory of functions for list recursion, but we've got reduce at least. Here is an elementary (i. e. without the loop magic) functional solution:
(defun running-sum (lst)
(reverse (reduce (lambda (acc x)
(cons (+ (first acc) x) acc))
(rest lst)
:initial-value (list (first lst)))))
I'm using the head of the original list as the initial value and walk through the rest of the list adding sums at the head (because it's natural to add at the head), finally reversing the list thus obtained.
One can use reduce in most cases when there's a need to traverse a sequence accumulating a value.
Here is an elementary iterative solution using the push-nreverse idiom:
(defun running-sum (lst)
(let ((sums (list (first lst))))
(dolist (x (rest lst))
(push (+ x (first sums)) sums))
(nreverse sums)))
In Scheme I would calculate the sum of the list recursively using an accumulator. Like so:
; Computes a list of intermediary results of list summation
(define list-sum
(lambda (l)
(letrec ((recsum (lambda (lst acc acclst)
(if (pair? lst)
(recsum (cdr lst) (+ acc (car lst)) (cons acc acclst))
(cons acc acclst)))))
(recsum (cdr l) (car l) '()))))
Output:
> (list-sum '(1 2 3 4))
(10 6 3 1)
> (list-sum '(2 4 6 8 10))
(30 20 12 6 2)
>
The trick to recurse over a list is to take the first element/car off each time and pass the rest/cdr. You can keep intermediary results by using an extra parameter (called an accumulator) and pass the sum in that. I've used two accumulators above: one for the last sum and one for a list of all previous sums.
I've never done anything in LISP, so I can't tell if this translates directly to your dialect(?), but it's conceptually simple and I'm sure it's doable in LISP as well.
Do ask if something is not immediately clear. It's been a while since I've used this family of languages :)
I apologize for the bad English..
I have a task to write a function called "make-bag" that counts occurences of every value in a list
and returns a list of dotted pairs like this: '((value1 . num-occurences1) (value2 . num-occurences2) ...)
For example:
(make-bag '(d c a b b c a))
((d . 1) (c . 2) (a . 2) (b . 2))
(the list doesn't have to be sorted)
Our lecturer allows us to us functions MAPCAR and also FILTER (suppose it is implemented),
but we are not allowed to use REMOVE-DUPLICATES and COUNT-IF.
He also demands that we will use recursion.
Is there a way to count every value only once without removing duplicates?
And if there is a way, can it be done by recursion?
First of, I agree with Mr. Joswig - Stackoverflow isn't a place to ask for answers to homework. But, I will answer your question in a way that you may not be able to use it directly without some extra digging and being able to understand how hash-tables and lexical closures work. Which in it's turn will be a good exercise for your advancement.
Is there a way to count every value only once without removing duplicates? And if there is a way, can it be done by recursion?
Yes, it's straight forward with hash-tables, here are two examples:
;; no state stored
(defun make-bag (lst)
(let ((hs (make-hash-table)))
(labels ((%make-bag (lst)
(if lst
(multiple-value-bind (val exists)
(gethash (car lst) hs)
(if exists
(setf (gethash (car lst) hs) (1+ val))
(setf (gethash (car lst) hs) 1))
(%make-bag (cdr lst)))
hs)))
(%make-bag lst))))
Now, if you try evaluate this form twice, you will get the same answer each time:
(gethash 'a (make-bag '(a a a a b b b c c b a 1 2 2 1 3 3 4 5 55)))
> 5
> T
(gethash 'a (make-bag '(a a a a b b b c c b a 1 2 2 1 3 3 4 5 55)))
> 5
> T
And this is a second example:
;; state is stored....
(let ((hs (make-hash-table)))
(defun make-bag (lst)
(if lst
(multiple-value-bind (val exists)
(gethash (car lst) hs)
(if exists
(setf (gethash (car lst) hs) (1+ val))
(setf (gethash (car lst) hs) 1))
(make-bag (cdr lst)))
hs)))
Now, if you try to evaluate this form twice, you will get answer doubled the second time:
(gethash 'x (make-bag '(x x x y y x z z z z x)))
> 5
> T
(gethash 'x (make-bag '(x x x y y x z z z z x)))
> 10
> T
Why did the answer doubled?
How to convert contents of a hash table to an assoc list?
Also note that recursive functions usually "eat" lists, and sometimes have an accumulator that accumulates the results of each step, which is returned at the end. Without hash-tables and ability of using remove-duplicates/count-if, logic gets a bit convoluted since you are forced to use basic functions.
Well, here's the answer, but to make it a little bit more useful as a learning exercise, I'm going to leave some blanks, you'll have to fill.
Also note that using a hash table for this task would be more advantageous because the access time to an element stored in a hash table is fixed (and usually very small), while the access time to an element stored in a list has linear complexity, so would grow with longer lists.
(defun make-bag (list)
(let (result)
(labels ((%make-bag (list)
(when list
(let ((key (assoc (car <??>) <??>)))
(if key (incf (cdr key))
(setq <??>
(cons (cons (car <??>) 1) <??>)))
(%make-bag (cdr <??>))))))
(%make-bag list))
result))
There may be variations of this function, but they would be roughly based on the same principle.
I'm having issues trying to form code for a problem I want to resolve. It goes like this:
~ Goal: flatten a nested list into one number
If the object is a list, replace the list with the sum of its atoms.
With nested lists, flatten the innermost lists first and work from there.
Example:
(CONDENSE '(2 3 4 (3 1 1 1) (2 3 (1 2)) 5))
(2 3 4 (6) (2 3 (3)) 5)
(2 3 4 (6) (8) 5)
(28)
=> 28
I've tried to implement the flatten list function for this problem and I ended up with this:
(defun condense (lst)
(cond
((null lst) nil)
((atom lst) (list lst)))
(t (append (flatten (apply #'+ (cdr lst))))))
But it gives me errors :(
Could anyone explain to me what is wrong with my processing/code? How can I improve it?
UPDATE: JUNE 5 2012
(defun condense(lxt)
(typecase lxt
(number (abs lxt))
(list
(if (all-atoms lxt)
(calculate lxt)
(condense (mapcar #'condense lxt))))))
So here, in this code, my true intent is shown. I have a function calculate that performs a calculation based off the values in the list. It is not necessarily the same operation each time. Also, I am aware that I am returning the absolute value of the number; I did this because I couldn't find another way to return the number itself. I need to find a way to return the number if the lxt is a number. And I had it recurse two times at the bottom, because this is one way that it loops on itself infinitely until it computes a single number. NOTE: this function doesn't implement a flatten function anymore nor does it use anything from it.
Imagine you have your function already. What does it get? What must it produce?
Given an atom, what does it return? Given a simple list of atoms, what should it return?
(defun condense (x)
(typecase x
(number
; then what?
(condense-number x))
(list
; then what?
(if (all-atoms x)
(condense-list-of-atoms x) ; how to do that?
(process-further-somehow
(condense-lists-inside x))))
; what other clauses, if any, must be here?
))
What must condense-lists-inside do? According to your description, it is to condense the nested lists inside - each into a number, and leave the atoms intact. So it will leave a list of numbers. To process that further somehow, we already "have" a function, condense-list-of-atoms, right?
Now, how to implement condense-lists-inside? That's easy,
(defun condense-lists-inside (xs)
(mapcar #'dowhat xs))
Do what? Why, condense, of course! Remember, we imagine we have it already. As long as it gets what it's meant to get, it shall produce what it is designed to produce. Namely, given an atom or a list (with possibly nested lists inside), it will produce a number.
So now, fill in the blanks, and simplify. In particular, see whether you really need the all-atoms check.
edit: actually, using typecase was an unfortunate choice, as it treats NIL as LIST. We need to treat NIL differently, to return a "zero value" instead. So it's better to use the usual (cond ((null x) ...) ((numberp x) ...) ((listp x) ...) ... ) construct.
About your new code: you've erred: to process the list of atoms returned after (mapcar #'condense x), we have a function calculate that does that, no need to go so far back as to condense itself. When you substitute calculate there, it will become evident that the check for all-atoms is not needed at all; it was only a pedagogical device, to ease the development of the code. :) It is OK to make superfluous choices when we develop, if we then simplify them away, after we've achieved the goal of correctness!
But, removing the all-atoms check will break your requirement #2. The calculation will then proceed as follows
(CONDENSE '(2 3 4 (3 1 1 1) (2 3 (1 2)) 5))
==
(calculate (mapcar #'condense '(2 3 4 (3 1 1 1) (2 3 (1 2)) 5)))
==
(calculate (list 2 3 4 (condense '(3 1 1 1)) (condense '(2 3 (1 2))) 5))
==
(calculate (list 2 3 4 (calculate '(3 1 1 1))
(calculate (list 2 3 (calculate '(1 2)))) 5))
==
(calculate (list 2 3 4 6 (calculate '(2 3 3)) 5))
==
(calculate (list 2 3 4 6 8 5))
==
28
I.e. it'll proceed in left-to-right fashion instead of the from the deepest-nested level out. Imagining the nested list as a tree (which it is), this would "munch" on the tree from its deepest left corner up and to the right; the code with all-atoms check would proceed strictly by the levels up.
So the final simplified code is:
(defun condense (x)
(if (listp x)
(reduce #'+ (mapcar #'condense x))
(abs x)))
a remark: Looking at that last illustration of reduction sequence, a clear picture emerges - of replacing each node in the argument tree with a calculate application. That is a clear case of folding, just such that is done over a tree instead of a plain list, as reduce is.
This can be directly coded with what's known as "car-cdr recursion", replacing each cons cell with an application of a combining function f on two results of recursive calls into car and cdr components of the cell:
(defun condense (x) (reduce-tree x #'+ 0))
(defun reduce-tree (x f z)
(labels ((g (x)
(cond
((consp x) (funcall f (g (car x)) (g (cdr x))))
((numberp x) x)
((null x) z)
(T (error "not a number")))))
(g x)))
As you can see this version is highly recursive, which is not that good.
Is this homework? If so, please mark it as such. Some hints:
are you sure the 'condensation' of the empty list in nil? (maybe you should return a number?)
are you sure the condensation of one element is a list? (maybe you should return a number?)
are you sure the condensation of the last case is a list? (shouldn't you return a number)?
In short, how is your condense ever going to return 28 if all your returned values are lists?
Task: With nested lists, flatten the innermost lists first and work from there
sum
flatten lists
For sum use REDUCE, not APPLY.
For flatten lists you need a loop. Lisp already provides specialized mapping functions.
Slightly more advanced: both the sum and the flatten can be done by a call to REDUCE.
You can also write down the recursion without using a higher-order function like APPLY, REDUCE, ... That's a bit more work.
Here's added the explanation of the errors you were having, actually you were close to solving your problem, just a bit more effort and you would get it right.
; compiling (DEFUN CONDENSE ...)
; file: /tmp/file8dCll3
; in: DEFUN CONDENSE
; (T (APPEND (FLATTEN (APPLY #'+ (CDR LST)))))
;
; caught WARNING:
; The function T is undefined, and its name is reserved
; by ANSI CL so that even
; if it were defined later, the code doing so would not be portable.
;
; compilation unit finished
; Undefined function:
; T
; caught 1 WARNING condition
;STYLE-WARNING: redefining CONDENSE in DEFUN
(defun condense (lst)
(cond
((null lst) nil)
((atom lst) (list lst)))
;.------- this is a function call, not a condition
;| (you closed the parens too early)
(t (append (flatten (apply #'+ (cdr lst))))))
;; Argument Y is not a NUMBER: (3 1 1 1)
;; [Condition of type SIMPLE-TYPE-ERROR]
(defun condense (lst)
(cond
((null lst) nil)
((atom lst) (list lst)); .-- not a number!
;You are calling #'+ -------. |
;on something, which | '(3 4 (3 1 1 1) (2 3 (1 2)) 5)
; is not a number. | |
(t (append (flatten (apply #'+ (cdr lst)))))))
;; You probably wanted to flatten first, and then sum
(defun condense (lst)
(cond
((null lst) nil); .--- returns just the
((atom lst) (list lst)); / atom 28, you can
; .---------------------/ just remove it.
(t (append (apply #'+ (flatten lst))))))
;; Now, you are lucky that append would just return the
;; atom if it's not a list
(defun condense (lst)
(cond
((null lst) nil)
((atom lst) (list lst))
(t (apply #'+ (flatten lst)))))
;; Again, you are lucky because (apply can take enough arguments
;; while your list is reasonably small - this will not always be
;; the case, that is why you need to use something more durable,
;; for example, reduce.
(defun condense (lst)
(cond
((null lst) nil)
((atom lst) (list lst))
(t (reduce #'+ (flatten lst)))))
;; Whoa!
(condense '(2 3 4 (3 1 1 1) (2 3 (1 2)) 5))
This is all given the flatten function actually works.
If your lisp already implements flatten and reduce functions (such as Clojure, which I will use here), you can just do something like:
user=> (defn condense [l] (reduce + 0 (flatten l)))
#'user/condense
user=> (condense [1 [2 [[3 4] 5]]])
15
user=>
Failing that, a naive implementation of those functions might be:
(defn flatten [l]
(cond (nil? l) l
(coll? l) (let [[h & t] l]
(concat (flatten h) (flatten t)))
true [l]))
and:
(defn reduce [op initial-value [h & t]]
(if (nil? t)
(op initial-value h)
(op initial-value (reduce op h t))))
But make sure to check the semantics of the particular Lisp you are using. Also, if you are implementing reduce and flatten, you may want to make them tail recursive which I didn't so as to maintain clarity.
In Common Lisp you would do something like:
(defun flatten (l)
(cond ((null l) l)
((atom l) (list l))
(t (append (flatten (car l))
(flatten (cdr l))))))
and use apply instead of reduce:
(defun condense (l) (apply #'+ (flatten l)))