I have this code:
(define graph `(A (B (C)) (D (E)) (C (E))))
(define (prog1 graph)
(let ([seen `()])
(define (sub g)
(cond
[(member (car g) seen) `()]
[else
(set! seen (cons (car g) seen))
(cond
[(null? (cdr g)) (list (car g))]
[else
(cons (car g) (map sub (cdr g)))])]))
(sub graph)))
It prints a connected graph where all the nodes appear once. However, if a node has already been visited I return the empty list `(). This causes a problem with the output and I don't know how to fix it:
When running (prog1 graph) The current output is: (A (B (C)) (D (E)) ())
However, I want the output to be (A (B (C)) (D (E)))
Any hint on how I can modify the code to achieve this would be great.
If the empty lists only occur at the topmost level in the list, you could filter them out. Replace the last line in your procedure with this:
(filter (negate null?) (sub graph))
Or simply this:
(remove '() (sub graph))
If the empty lists occur at any nesting level, you can apply the same idea (filtering out empty lists) recursively, at each step in the traversal.
Related
I have the following recursive function in Lisp
(defun f (item tree)
(when tree
(if (equal item (car tree)) tree
(if (and (listp (car tree))
(equal item (caar tree)))
(car tree)
(if (cdr tree)
(f item (cdr tree)))))))
This function receives a tree and an item to look for in its immediate leaves. If item is the car of any sublist, then it will return that sublist. That is,
(f 'c '(a b c)) => (c)
(f 'b '(a b c)) => (b c)
(f 'a '((a 1 2) b c)) => (a 1 2)
I've recently been informed that (Emacs Lisp) doesn't do tail recursion optimization, so I've been advised to turn this into a while loop. All of my training in Lisp has been in avoidance of loops like this. (I maintain that they are un-functional, but that's borderline pedantic.) I've made the following attempt for more conformative style:
(defun f (item tree)
(let ((p tree))
(while p
(cond
((equal item (car p)) p)
((and (listp (car p))
(equal item (caar p)))
(car tree))
(t (f item (cdr p))))
(setq p (cdr p)))))
I've shortened the function name for brevity/clarity, but do have a look at where it is being used if you are a power-user of emacs.
Your "iterative" solution is still recursing. It's also not returning the values found in the cond expression.
The following version sets a variable to the found result. Then the loop ends if a result has been found, so it can be returned.
(defun f (item tree)
(let ((p tree)
(result nil))
(while (and p (null result))
(cond ((equal item (car p)) (setq result p))
((and (listp (car p))
(equal item (caar p)))
(setq result (car tree)))
(t (setq p (cdr p)))))
result))
I've been trying to figure out an algorithm that will do the following:
The algorithm will be handed a list like this:
((start a b c) (d e f (start g h i) (j k l) (end)) (end) (m n o))
It will then concatenate the list containing the element start with all lists up to the list containing the element end. The list returned then should look like this:
((start a b c (d e f (start g h i (j k l)))) (m n o))
The algorithm must be able to handle lists containing start within other lists containing start.
Edit:
What I have now is this:
(defun conc-lists (l)
(cond
((endp l) '())
((eq (first (first l)) 'start)
(cons (cons (first (first l)) (conc-lists (rest (first l)))))
(conc-lists (rest l)))
((eq (first (first l)) 'end) '())
(t (cons (first l) (conc-lists (rest l))))))
but it's not working. Maybe I should list or append instead of consing?
Edit 2:
The program above shouldn't work since I'm trying to get the first element from a non-list. This is what I have come up with so far:
(defun conc-lists (l)
(cond
((endp l) '())
((eq (first (first l)) 'start)
(append (cons (first (first l)) (rest (first l)))
(conc-lists (rest l))))
((eq (first (first l)) 'end) '())
(t (cons (first l) (conc-lists (rest l))))))
This is the result I'm getting:
(conc-lists ((START A B C) (D E F (START G H I) (J K L) (END)) (END) (M N O)))
1. Trace: (CONC-LISTS '((START A B C) (D E F (START G H I) (J K L) (END)) (END) (M N O)))
2. Trace: (CONC-LISTS '((D E F (START G H I) (J K L) (END)) (END) (M N O)))
3. Trace: (CONC-LISTS '((END) (M N O)))
3. Trace: CONC-LISTS ==> NIL
2. Trace: CONC-LISTS ==> ((D E F (START G H I) (J K L) (END)))
1. Trace: CONC-LISTS ==> (START A B C (D E F (START G H I) (J K L) (END)))
(START A B C (D E F (START G H I) (J K L) (END)))
I'm also a relative beginner to CL, but this seemed like an interesting challenge, so I had a go at it. Experienced lispers, comments please on this code! #user1176517, if you find any bugs, let me know!
A couple comments first: I wanted to make it O(n), not O(n^2), so I made the recursive functions return both the head and tail (i.e. last cons) of the lists resulting from recursively processing the branches of the tree. This way, in conc-lists-start, I can nconc the last cons of one list onto the first cons of another, without nconc having to walk down a list. I used multiple return values to do this, which unfortunately bloats the code a fair bit. In order to make sure that tail is the last cons of the resulting list, I need to check whether the cdr is null before recurring.
There are two recursive functions which process the tree: conc-lists and conc-lists-first. When conc-lists sees a (start), recursive processing continues with conc-lists-start. Likewise, when conc-lists-start sees an (end), recursive processing continues with conc-lists.
I'm sure it could use more comments... I may add more later.
Here's the working code:
;;; conc-lists
;;; runs recursively over a tree, looking for lists which begin with 'start
;;; such lists will be nconc'd with following lists a same level of nesting,
;;; up until the first list which begins with 'end
;;; lists which are nconc'd onto the (start) list are first recursively processed
;;; to look for more (start)s
;;; returns 2 values: head *and* tail of resulting list
;;; DESTRUCTIVELY MODIFIES ARGUMENT!
(defun conc-lists (lst)
(cond
((or (null lst) (atom lst)) (values lst lst))
((null (cdr lst)) (let ((head (conc-process-rest lst)))
(values head head)))
(t (conc-process-rest lst))))
;;; helper to factor out repeated code
(defun conc-process-rest (lst)
(if (is-start (car lst))
(conc-lists-start (cdar lst) (cdr lst))
(multiple-value-bind (head tail) (conc-lists (cdr lst))
(values (cons (conc-lists (car lst)) head) tail))))
;;; conc-lists-start
;;; we have already seen a (start), and are nconc'ing lists together
;;; takes *2* arguments so that 'start can easily be stripped from the
;;; arguments to the initial call to conc-lists-start
;;; recursive calls don't need to strip anything off, so the car and cdr
;;; are just passed directly
(defun conc-lists-start (first rest)
(multiple-value-bind (head tail) (conc-lists first)
(cond
((null rest) (let ((c (list head))) (values c c)))
((is-end (car rest))
(multiple-value-bind (head2 tail2) (conc-lists (cdr rest))
(values (cons head head2) tail2)))
(t (multiple-value-bind (head2 tail2) (conc-lists-start (car rest) (cdr rest))
(nconc tail (car head2))
(values (cons head (cdr head2)) tail2))))))
(defun is-start (first)
(and (listp first) (eq 'start (car first))))
(defun is-end (first)
(and (listp first) (eq 'end (car first))))
I wrote a big program that use car and cdr, and do:
(map car (append (map caddr lists) (map cadr lists))
When lists is list of lists in the next format ((a (b) (c)) (d (e) (f))...(x (y) (z)))
When I did it I got one list (b c e f... y z)
(Note: b,c,...y,z is a list of numbers; a,d...x is a symbol)
But now, I found that b,c,...,y,z can be also empty list, and It gives the next error:
car: expects argument of type <pair>; given ()
What can I do?
Have you tried filtering away empty lists before your map? Something like this:
(map car (filter pair? (append (map caddr lists) (map cadr lists))))
The fundamental issue is that () is not a pair while car only acts on pairs. The simplest solution is just to get rid of everything that isn't a pair before mapping car onto the list; this is what (filter pair? ...) does.
Here's my shot. It's a straight solution, without using map, filter; in that way, I avoid going over and over the elements of the list constructing intermediate lists - except that I used a reverse operation for preserving the original order of the elements, if that's not an issue, remove reverse. For each element in the original list, if either the (b)... or (c)... part is empty, it's skipped.
(define (process lists)
(let loop ((l (reverse lists))
(a '())
(b '()))
(cond ((null? l)
(append b a))
((or (not (pair? (cadar l))) (not (pair? (caddar l))))
(loop (cdr l) a b))
(else
(loop (cdr l) (cons (caadar l) a) (cons (car (caddar l)) b))))))
This is the function that removes the last element of the list.
(define (remove-last ll)
(if (null? (cdr ll))
'()
(cons (car ll) (remove-last (cdr ll)))))
So from my understanding if we cons a list (eg. a b c with an empty list, i.e. '(), we should get
a b c. However, testing in interaction windows (DrScheme), the result was:
If (cons '() '(a b c))
(() a b c)
If (cons '(a b c) '())
((a b c))
I'm like what the heck :(!
Then I came back to my problem, remove all elements which have adjacent duplicate. For example,
(a b a a c c) would be (a b).
(define (remove-dup lst)
(cond ((null? lst) '())
((null? (cdr lst)) (car lst))
((equal? (car lst) (car (cdr lst))) (remove-dup (cdr (cdr lst))))
(else (cons (car lst) (car (cdr lst))))
)
)
It was not correct, however I realize the answer have a . between a b. How could this happen?
`(a . b)`
There was only one call to cons in my code above, I couldn't see which part could generate this .. Any idea?
Thanks,
cons build pairs, not lists. Lisp interpreters uses a 'dot' to visually separate the elements in the pair. So (cons 1 2) will print (1 . 2). car and cdr respectively return the first and second elements of a pair. Lists are built on top of pairs. If the cdr of a pair points to another pair, that sequence is treated as a list. The cdr of the last pair will point to a special object called null (represented by '()) and this tells the interpreter that it has reached the end of the list. For example, the list '(a b c) is constructed by evaluating the following expression:
> (cons 'a (cons 'b (cons 'c '())))
(a b c)
The list procedure provides a shortcut for creating lists:
> (list 'a 'b 'c)
(a b c)
The expression (cons '(a b c) '()) creates a pair whose first element is a list.
Your remove-dup procedure is creating a pair at the else clause. Instead, it should create a list by recursively calling remove-dup and putting the result as the second element of the pair. I have cleaned up the procedure a bit:
(define (remove-dup lst)
(if (>= (length lst) 2)
(if (eq? (car lst) (cadr lst))
(cons (car lst) (remove-dup (cddr lst)))
(cons (car lst) (remove-dup (cdr lst))))
lst))
Tests:
> (remove-dup '(a b c))
(a b c)
> (remove-dup '(a a b c))
(a b c)
> (remove-dup '(a a b b c c))
(a b c)
Also see section 2.2 (Hierarchical Data and the Closure Property) in SICP.
For completeness, here is a version of remove-dup that removes all identical adjacent elements:
(define (remove-dup lst)
(if (>= (length lst) 2)
(let loop ((f (car lst)) (r (cdr lst)))
(cond ((and (not (null? r))(eq? f (car r)))
(loop f (cdr r)))
(else
(cons (car lst) (remove-dup r)))))
lst))
Here in pseudocode:
class Pair {
Object left,
Object right}.
function cons(Object left, Object right) {return new Pair(left, right)};
So,
1. cons('A,'B) => Pair('A,'B)
2. cons('A,NIL) => Pair('A,NIL)
3. cons(NIL,'A) => Pair(NIL,'A)
4. cons('A,cons('B,NIL)) => Pair('A, Pair('B,NIL))
5. cons(cons('A 'B),NIL)) => Pair(Pair('A,'B),NIL)
Let's see lefts and rights in all cases:
1. 'A and 'B are atoms, and whole Pair is not a list, so (const 'a 'b) gives (a . b) in scheme
2. NIL is an empty list and 'A is an atom, (cons 'a '()) gives list (a)
3. NIL and 'A as above, but as left is list(!), (cons '() 'a) gives pair (() . a)
4. Easy case, we have proper list here (a b).
5. Proper list, head is pair (a . b), tail is empty.
Hope, you got the idea.
Regarding your function. You working on LIST but construct PAIRS.
Lists are pairs (of pairs), but not all pairs are lists! To be list pair have to have NIL as tail.
(a b) pair & list
(a . b) pair not list
Despite cons, your function has errors, it just don't work on '(a b a a c c d). As this is not related to your question, I will not post fix for this here.
how can I write a function to take the last element of the list?
find the last of a list:
(define (last l)
(cond ((null? (cdr l)) (car l))
(else (last (cdr l)))))
use map to map last to a list:
(map last '((a b) (c d) (e f)))
==> (b d f)
so a new function:
(define (last-list l)
(map last l)
)
(last-list '((a b) (c d) (e f)))
==> (b d f)
May not be the most efficient, but certainly one of the simplest:
(define (last lst)
(car (reverse lst)))
Examples:
(last '(1 2 3 4)) => 4
(last '((a b) (b c) (d e))) => (d e)
The code you've written - to take the last element of a list - is correctly returning the last element of the list. You have a list of lists. There is an outer list
(x y z)
where
x = (a b)
y = (c d)
z = (e f)
So you're getting the last element of the list, z, which is (e f)
Did you want your last function to do something different? If you want it to return the last element of the last nested list, you need to change your base case. Right now you return the car. Instead, you want to check if the car is a list and then call your nested-last function on that.
Make sense?
Your last function is good, but you have to think about what you want to do with it now.
You have a list of lists, and you want to take the last of all those.
So recurse down your list applying it each time:
(define (answer lst)
(cond ((null? (cdr l)) null)
(else (cons (last (car l)) (answer (cdr lst))))
Yet another possibility:
(define (last thelist)
(if
(null? (cdr thelist)) (car thelist)
(last (cdr thelist))))
(define (all-last lists) (map last lists))
Edit: just saw that you don't know map, and want a solution without it:
(define (all-last lists)
(if
(null? lists) `()
(cons (last (car lists)) (all-last (cdr lists)))))
As far as getting an empty list goes, I'd guess you're trying to use this map-like front-end with your original definition of last, whereas it's intended to work with the definition of last I gave above. Try the following definitions:
(define (last thelist) (if
(null? (cdr thelist)) (car thelist)
(last (cdr thelist))))
(define (all-last lists) (if
(null? lists) `()
(cons (last (car lists)) (all-last (cdr lists)))))
and running a quick test:
(all-last `((a b) (c d) (e f)))
The result should be:
(b d f)
(define last
(lambda (ls)
(list-ref ls (- (length ls) 1))))
I like short, sweet, fast, tail-recursive procedures.
Named let is my friend.
This solves the original problem and returns #f if the list has no last element.
(define (last L) (let f ((last #f) (L L)) (if (empty? L) last (f (car L) (cdr L)))))
The best way to get what you want:
(define (last lst)
(cond [(empty? lst) empty]
[(empty? (rest lst)) (first lst)]
[else (last (rest lst))]))