Given a list/tree of the form : (node1 (node2) (node3 (node4) (node5)) (node6))
I should be able to find out the depth at which a searched node resides.
This is what I've done so far:
(defun search-it (lst level n)
(cond ((null lst) nil)
((and (atom (car lst)) (equal (car lst) n)) level)
((atom (car lst)) (search-it (cdr lst) level n))
(t (cons (search-it (car lst) (+ 1 level) n)
(search-it (cdr lst) level n)))))
(defun search-node (l n)
(search-it l 0 n))
For this particular implementation I have a correct solution, but what bothers me is that I can't get rid of some nil lists. For example:
(search-node '(1 (2) (3 (4) (6) (7) (8 (9) (10)))) 6)
(NIL (NIL 2 NIL (NIL NIL)))
The solution is correct if we consider the root node at depth 0.
Now of course I could add some code to the search-node function to remove everything except the solutions, I can't help but feel that it's not the most elegant way to do this.
LE: The expected result should be the depth or a list of depths in case the number appears more than once.
Some pointers anyone?
PS: lisp newbie
Generally return a list of depths. So, if an item is found, then return the list of the single depth. If you branch to the first and rest of the list, then don't 'cons', but 'append'.
Note also that your code does not find all depths.
CL-USER 6 > (search-node '(6 (6)) 6)
0
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 have to make a recursive function in lisp which takes a list and makes another list with only the elements on odd position in the given list.
If I have (1 2 3 4 5) I have to output (1 3 5)
I have a code here:
(defun pozpar(lst) (do(
(l lst (cddr l))
(x '() (cons x (car l))))
((null l) x)))
This outputs:
(5 3 1)
I know cons adds the elements at the beginning and I tried with append or list but nothing worked.
I think this is a way easier solution:
(defun popzar (lst)
(cond ((null lst) nil)
(t (cons (car lst)
(popzar (cdr (cdr lst)))))))
It first checks if the list is empty and if not it creates a new list with the first element and the result of calling itself again with the rest of the list except for the second element.
The easiest way is to reverse the result:
(defun pozpar (lst)
(do ((l lst (cddr l))
(x '() (cons (car l) x)))
((null l)
(nreverse x))))
(pozpar '(1 2 3 4 5))
==> (1 3 5)
Notes
This returns, not outputs the value you want.
Prepending values and reverting the result is a common Lisp coding pattern.
Since append is linear in the length of its argument, using it in a loop produces quadratic code.
I formatted the code in the standard Lisp way. If you use this style, lispers will have an easier time reading your code, and, consequently, more willing to help you.
With using loop it's very easy to get the elements in the order you processed them. It is also the most effective and the only one guaranteed to work with all length arguments:
(defun pozpar1 (lst)
(loop :for e :in lst :by #'cddr
:collect e)))
If you really want recursion I would have done it with an accumulator with a linear update reverse in the end:
(defun pozpar2 (lst)
(labels ((helper (lst acc)
(if (endp lst)
(nreverse acc)
(helper (cddr lst) (cons (car lst) acc)))))
(helper lst '())))
However a classical not tail recursive version would look like this:
(defun pozpar3 (lst)
(if (endp lst)
'()
(cons (car lst) (pozpar3 (cddr lst)))))
I start studying Lisp and I find a code on the book as example but I do not understand what is it for. Are you able to help me understanding that? I don't know if it is the right place to do it. Thanks everyone
(defun compress (l1)
(cond ((null (cdr l1)) '())
(t (accumula (car l1) 1 (cdr l1)))))
(defun accumula (val acc lst)
(cond ((null lst) (cons (comp-list val acc) nil))
((eq val (car lst)) (accumula val (1+ acc) (cdr lst)))
(t (cons (comp-list val acc) (accumula (car lst) 1 (cdr lst))))))
(defun comp-list (val acc)
(if (> acc 1) (list acc val) val))
It's a compression function, of the Run Length Encoding variety.
(compress '(3 3 4 3 3 2 1 1 1 1 0))
will yield
((2 3) 4 (2 3) 2 (4 1) 0)
where the first number in each sublist is the number of times the second number repeats in the original sequence.
It doesn't look like much from the example, but for long sequences where numbers repeat a lot, you can get significant savings in storage costs.
This is an answer to problem 13 in The 99 Lisp problems (L99). It has a bug:
(compress '(a))
; ==> nil
The correct result would have been (a).
This question already has answers here:
Flatten a list using only the forms in "The Little Schemer"
(3 answers)
Closed 9 years ago.
If I have an s expression, for example '(1 2 (3) (4 (5)) 6 7), how would I convert that into a list like (1 2 3 4 5 6 7)? I basically need to extract all of the atoms from the s expression. Is there a built in function that would help me do it?
(define (convert-to-list s) ... )
My algorithm so far is, if the first element is an atom append it onto a list. If the first element is a list then get the car of that element and then call the function (convert-to-list) with that function so it catches the base case of the recursion. And append the cdr of that list being invoked on convert-to-list to car of it. I'm trying to teach myself scheme from Structure and Interpretation of Computer Programs and I'm just trying out random things. Doing this recursively is proving to be more difficult than I anticipated.
To literally answer your question, "Is there a built in function to help me do this?", in Racket yes there is. flatten does exactly this: "Flattens an arbitrary S-expression structure of pairs into a list."
Examples:
> (flatten '((a) b (c (d) . e) ()))
'(a b c d e)
> (flatten 'a)
'(a)
However it's a great exercise to think about how you would write flatten yourself.
Chris Jester-Young's comment has a link to an elegant way. If she'd posted that as an answer, instead of as a comment, I'd suggest marking her answer as accepted, not mine. :)
Your algorithm doesn't look bad, it's just missing a step or two.
(define (flatten lst) ; 'flatten' is a better name for this function IMO
(cond
((null lst) nil)
;; Don't worry that I'm calling (flatten (cdr lst)) without any checking;
;; the above case handles it
((atom (car lst)) ; The car's okay
(cons (car lst) (flatten (cdr lst))))
((cons? (car lst)) ; The car still needs flattening; note the use of
; 'append' here (the car-list may have any number of elements)
(append (flatten (car lst)) (flatten (cdr lst))))))
Between the (flatten (car lst)) calls dealing with the first element and the (flatten (cdr lst)) calls recursively dealing with the rest of the list, the input list ends up a flat list (i.e. no elements are conses).
(Warning: I'm not a Scheme guru; the above code may contain errors.)
Your cases should cover the empty list, an atom, (car s) being an atom, and (car s) being a list.
This works, though I bashed out a list append function because I didn't remember what the built-in one was. Works in Racket Advanced Student.
(define (list-glue left-list right-list)
(cond
((null? left-list) right-list)
(else (cons (car left-list) (list-glue (cdr left-list) (right-list))))))
(define (convert-to-list s)
(cond
((null? s) '())
((not (list? s)) (cons s (quote ())))
((not (list? (car s))) (cons (car s) (convert-to-list (cdr s))))
(else
(list-glue
(convert-to-list (car s))
(convert-to-list (cdr s))))))
Now, if you want a faster implementation, you don't need append at all.
The idea is to pass around what you would append onto as a parameter. I call this tail.
If you have an empty s-exp, you just return the tail, since there is nothing to add to it.
I've got the code, flat and flat2, where flat uses a match statement, things in racket, and flat2 just uses a cond, which I find a little harder to read, but I provide it in case you haven't seen match yet.
#lang racket
(define (flat s-exp tail)
(match s-exp
['() tail]
[(cons fst rst)
(let ([new-tail (flat rst tail)])
(flat fst new-tail))]
[atom
(cons atom tail)]))
(define (flat
(cond
[(empty? s-exp) tail]
[(list? s-exp)
(let* ([fst (first s-exp)]
[rst (rest s-exp)]
[new-tail (flat])
(flat fst new-tail))]
[#t
(cons s-exp tail)]))
To use them, call them like so (flat '(1 () (2 (3)) 4) '()) ===> '(1 2 3 4).
You need to supply the empty list for them to start off on.
This can be done simply by recursing on sublists and rest-lists. You can see how easily this code reads. Like such:
(define (convert-to-list list)
(if (null? list)
'()
(let ((next (car list))
(rest (cdr list)))
(if (list? next)
(append (convert-to-list next) (convert-to-list rest))
(cons next (convert-to-list rest))))))
> (convert-to-list '(a b c))
(a b c)
> (convert-to-list '((a b) (((c d) e f) g h) i j))
(a b c d e f g h i j)
>
I'm new to Common Lisp and functional programming, but I have a lot of experience in languages like C, C++, C#, Java and so on. I'm having trouble finding the most nested list inside a list. My input is something like this:
(0 1 (2 3) 4 (5 (6 (7) 8)) 9)
I would like to get the most nested list inside this list which in this case is
(7)
I did have an idea that I could flatten the list somehow, until there was only one sub-list left. To illustrate what I mean, here is a few steps:
Step 1. - input:
(0 1 (2 3) 4 (5 (6 (7) 8)) 9)
Step 2. - flatten on "first level":
(0 1 2 3 4 5 (6 (7) 8) 9)
Step 3. - flatten on "second level":
(0 1 2 3 4 5 6 (7) 8 9)
Now there's only one nested list left, which means that was the most nested list. But I see a problem here, when two or more such lists would occur. Please share your thoughts on this.
I'm having problems putting this procedure to reality in Common Lisp, so I would be grateful for some pointers in the right direction, maybe some example code and so on. This is a homework assignment, so I don't really expect a full solution, but would be glad if someone pointed out perhaps an easier and better solution and its implementation.
Here's my solution, using a similar approach to the OP's. (In the case of multiple deepest items, they are all returned.)
I wrote it in Scheme, which probably won't be immediately translatable to Common Lisp, so I don't feel that it'd be a complete giveaway. Still, it has the potential to be spoilery, so tread with caution.
(define (deepest lst)
(let ((filtered (filter pair? lst)))
(cond ((null? filtered) lst)
(else (deepest (concatenate filtered))))))
Here is my (not very clean) solution in CL:
(defun deepest-list (lst)
(let ((max-depth 0) ret)
(labels ((inner-deepest-lst (lst depth)
(cond
((null lst) depth)
((listp (car lst))
(let ((local-max (max
(inner-deepest-lst (first lst) (1+ depth))
(inner-deepest-lst (rest lst) (1+ depth)))))
(and (> local-max max-depth) (setf ret (first lst) max-depth local-max))
local-max))
(t (inner-deepest-lst (rest lst) depth)))))
(inner-deepest-lst lst 1))
ret))
edit:
After a second thought, this is a slightly cleaner solution:
(defun deepest-list (lst)
(labels ((dl (lst depth)
(cond
((atom lst) (cons 0 lst))
((every #'atom lst) (cons depth lst))
(t (funcall (lambda (x y) (if (> (car x) (car y)) x y))
(dl (car lst) (1+ depth))
(dl (cdr lst) depth))))))
(rest (dl lst 0))))
Your approach of iteratively flattening the list should probably work fine, although it's not the most efficient or (subjectively) elegant way to do it.
If there are more than one such list, the correct output would depend on the specification -- should you return all of them, or just the first one, or throw an error?
If I were you, I'd look in to coming up with a recursive function to solve the problem. Each level of recursion would basically process the elements of a given level of the nested lists. Think of what each recursive call should do -- it's very simple if once it clicks!