I got a tree:
(A . ((C . ((D . nil)(E . nil)))
(B . ((F . nil)(G . nil)))))
I want to transform this tree into:
((A C D) (A C E) (A B F) (A B G))
I already implemented this function for doing so:
(defun tree->paths (tree &optional buff)
(labels ((recurse (follow-ups extended-list)
(if follow-ups
(append (list (tree->paths (car follow-ups) extended-list))
(recurse (cdr follow-ups) extended-list))
nil)))
(rstyu:aif (cdr tree)
(recurse it (append buff (list (car tree))))
(append buff (list (car tree))))))
But applying it results in:
(tree->paths '(A . ((C . ((D . nil) (E . nil)))
(B . ((F . nil) (G . nil))))))
=>
(((A C D) (A C E)) ((A B F) (A B G)))
I must be missing some kind of append/merge within the recursion but I am not seeing it.
You must remove the list in (append (list (tree->paths
The tree->paths returns a list of paths; so does recurse. So, they may be appended without wrapping in a list call.
Here, I've tried to rewrite it so that it would work linearly (because your original function would exhaust stack space). However, while doing so, I've discovered something, which you might consider in general re' your original idea:
(defun tree-to-paths (tree)
(loop with node = tree
with trackback = nil
with result = nil
with head = nil
with head-trackback = nil
while (or node trackback) do
(cond
((null node)
(setf node (car trackback)
trackback (cdr trackback)
result (cons head result)
head (car head-trackback)
head-trackback (cdr head-trackback)))
((consp (car node))
(setf trackback (cons (cdr node) trackback)
head-trackback (cons head head-trackback)
head (copy-list head)
node (car node)))
(t (setf head (cons (car node) head)
node (cdr node))))
finally (return (nreverse (mapcar #'nreverse result)))))
In your example data the result you want to receive seems intuitively correct, but you can think of it also as if there were more paths, such as for example:
A -> C -> NIL - From looking at your data, this result seems redundant, but in general, you may want to have these results too / it would be hard to filter them all out in general.
I started over and chose the reverse approach by going leaf to root instead of root to leaf as I tried in the question:
(defun tree->paths2 (tree)
(labels ((recurse (follow-ups)
(if follow-ups
(append (tree->paths2 (car follow-ups))
(recurse (cdr follow-ups)))
nil)))
(rstyu:aif (cdr tree)
(mapcar #'(lambda(arg)
(cons (car tree) arg))
(recurse it))
(list tree))))
(tree->paths2 '(A . ((C . ((D . nil) (E . nil)))
(B . ((F . nil) (G . nil))))))
=>
((A C D) (A C E) (A B F) (A B G))
But if there is a way to fix my first approach I'd prefer to accept such fix as an answer.
Related
I am trying to reverse a general list using Scheme. How can I reverse a complex list?
I can make a single list like (A B C D) works using my function, but for some complex list inside another list like (F ((E D) C B) A), the result is just (A ((E D) C B) F). How can I improve it?
(define (reverse lst)
(if (null? lst)
lst
(append (reverse (cdr lst)) (list (car lst)))))
Any comments will be much appreciated!
Here is another way that uses a default parameter (r null) instead of the expensive append operation -
(define (reverse-rec a (r null))
(if (null? a)
r
(reverse-rec (cdr a)
(cons (if (list? (car a))
(reverse-rec (car a))
(car a))
r))))
(reverse-rec '(F ((E D) C B) A))
; '(A (B C (D E)) F)
Using a higher-order procedure foldl allows us to encode the same thing without the extra parameter -
(define (reverse-rec a)
(foldl (lambda (x r)
(cons (if (list? x) (reverse-rec x) x)
r))
null
a))
(reverse-rec '(F ((E D) C B) A))
; '(A (B C (D E)) F)
There are several ways of obtaining the expected result. One is to call reverse recursively also on the car of the list that we are reversing, of course taking care of the cases in which we must terminate the recursion:
(define (reverse x)
(cond ((null? x) '())
((not (list? x)) x)
(else (append (reverse (cdr x)) (list (reverse (car x)))))))
(reverse '(F ((E D) C B) A))
'(A (B C (D E)) F)
(A ((E D) C B) F) is the correct result, if your goal is to reverse the input list. There were three elements in the input list, and now the same three elements are present, in reverse order. Since it is correct, I don't suggest you improve its behavior!
If you have some other goal in mind, some sort of deep reversal, you would do well to specify more clearly what result you want, and perhaps a solution will be easier to find then.
Given an s-expression '((a . b) . (c . d)) and a list '(e f g h), how can I traverse the s-expression create an s-expression with the same shape, but with elements taken from the list? E.g., for the s-expression and list above, the result would be '((e . f) g . h)?
Traversing a tree of pairs in left to right order isn't particularly difficult, as car and cdr let you get to both sides, and cons can put things back together. The tricky part in a problem like this is that to "replace" elements in the right hand side of a tree, you need to know how many of the available inputs you used when processing the left hand side of the tree. So, here's a procedure reshape that takes a template (a tree with the shape that you want) and a list of elements to use in the new tree. It returns as multiple values the new tree and any remaining elements from the list. This means that in the recursive calls for a pair, you can easily obtain both the new left and right subtrees, along with the remaining elements.
(define (reshape template list)
;; Creates a tree shaped like TEMPLATE, but with
;; elements taken from LIST. Returns two values:
;; the new tree, and a list of any remaining
;; elements from LIST.
(if (not (pair? template))
(values (first list) (rest list))
(let-values (((left list) (reshape (car template) list)))
(let-values (((right list) (reshape (cdr template) list)))
(values (cons left right) list)))))
(reshape '((a . b) . (c . d)) '(e f g h))
;=> ((e . f) g . h)
;=> ()
(reshape '((a . b) . (c . d)) '(e f g h i j k))
;=> ((e . f) g . h)
;=> (i j k) ; leftovers
I'll assume that you want to create a new s-expression with the same shape of the s-expression given as the first parameter, but with the elements of the list from the second parameter.
If that's right, here's one possible solution using a list to save the point where we are in the replacement list and Racket's begin0 to keep the list updated (if that's not available in you interpreter use a let, as suggested by Chris and Joshua in the comments):
(define (transform sexp lst)
(let loop ((sexp sexp)) ; the s-expression list to be traversed
(cond ((null? sexp) '()) ; if it's empty, we're finished
((not (pair? sexp)) ; if it's an atom
(begin0 ; then (alternatively: use a `let`)
(car lst) ; return first element in replacements list
(set! lst (cdr lst)))) ; and update replacements to next element
(else ; otherwise advance recursion
(cons (loop (car sexp)) ; over both the `car` part of input
(loop (cdr sexp))))))) ; and the `cdr` part
For example:
(transform '((a . b) . (c . d)) '(e f g h))
=> '((e . f) g . h)
(transform '((a . b) (c d (x y) . z) . t) '(e f g h i j k m))
=> '((e . f) (g h (i j) . k) . m)
The solution is similar to my previous answer:
(define (transform sxp lst)
(let loop ((sxp sxp))
(cond ((null? sxp) sxp)
((pair? sxp) (cons (loop (car sxp)) (loop (cdr sxp))))
(else (begin0 (car lst) (set! lst (cdr lst)))))))
then
> (transform '((a . b) . (c . d)) '(e f g h))
'((e . f) g . h)
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 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.
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.