I'm working on a problem in a book where I have a binary tree and I need to check if the sum of all the atoms on the left and right subtree are equal and if they're not, return nil. I managed to do it in two functions but when I try to do it in one I get an error because it tries to add a number to nil.
The code is
(defun foo (list)
(cond ((null list) 0)
((atom list) list)
((/= (foo (cadr list))
(foo (caddr list))) nil)
( T (+ (foo (car list))
(foo (cdr list))))))
edit: the problem was two fold.
1) with the previous structure it would try to evaluate (cdr '(number)) so it would return null when it hit a list that looked like '(a (b c) d) since it would try to access (cdr '(d))
2) i used /= which only works if both arguments are numbers
The code that worked:
(defun foo (list)
(cond ((null list) 0)
((atom list) list)
((null (cdr list)) (car list))
((null (equal(foo (cadr list)) (foo (caddr list)))) nil)
(T (+ (car list)
(foo (cadr list))
(foo (caddr list))))))
After having defined how you represent a binary tree, I mean the right subtree could be the cdr or the cadr, I would separate the two problems:
(defun sum-of-subtree (tree)
(cond ((null tree) 0)
((atom tree) tree)
(t (+ (sum-of-subtree (car tree))
(sum-of-subtree (cdr tree))))))
(defun foo (tree)
(cond ((null tree) t) ;or whatever you want
((atom tree) t)
((= (sum-of-subtree (car tree))
(sum-of-subtree (cdr tree))) t)
(t nil)))
Like that, you will not be confusing the value of the sum of the subtree with the comparison. Other languages have stronger typing, which avoids mixing the purposes of different functions
Note: I'm assuming your binary trees are lists of (val left-sub right-sub), which seems to match your code.
I'm not sure that there's a clean way to do that with recursion and a single function, since the recursive process (summing the left and right subtrees) is different from the value your function needs to return (whether or not the left and right subtrees are equal).
However, if you absolutely have to solve it with one function, you could cheat a little. I see two options:
Option 1
Local function
(defun foo (list)
(labels ((sum-subtrees (list)
(cond
((null list) 0)
((atom list) list)
(t (+ (car list)
(sum-subtrees (cadr list))
(sum-subtrees (caddr list)))))))
(= (sum-subtrees (cadr list))
(sum-subtrees (caddr list)))))
This works by defining a local function to handle the recursive bit- #'sum-subtrees- and then just relies on that to compute the final output.
Option 2
Multiple value return
(defun foo (list)
(cond
((null list) (values t 0))
((atom list) (values t list))
(t (let ((left-sub (nth-value 1 (foo (cadr list))))
(right-sub (nth-value 1 (foo (caddr list)))))
(values (= left-sub right-sub)
(+ (car list)
left-sub
right-sub))))))
This solution exploits how common lisp functions can return multiple values. Basically, the function returns both the original condition (= left-subtree right-subtree) and the sum of the tree. Any other code which is expecting just a single value will get the first return value (the condition), so any code that would use this function should not notice the extra return value, but the data is there if you ask for it.
The way we return multiple values is with the values function. In this code, for example, we return (values t 0) in the case of list being nil to indicate that its "left and right subtrees" are equal and its sum is 0, and
(values (= left-sub right-sub)
(+ (car list)
left-sub
right-sub))
to produce the recursive return value.
There are a few ways to get access to the extra return values, but the one used here is #'nth-value, which returns the nth value returned instead of the first. That's why, when we make the recursive call to compute the size of the subtree, we use (nth-value 1 (foo <subtree>)).
NOTE: Please never actually use that solution for this- multiple value return is very useful and powerful, but in this case it is more confusing than it's really worth.
The code that worked:
(defun foo (list)
(cond ((null list) 0)
((atom list) list)
((null (cdr list)) (car list))
((null (equal(foo (cadr list)) (foo (caddr list)))) nil)
(T (+ (car list)
(foo (cadr list))
(foo (caddr list))))))
Related
I've got a homework assignment that has stumped me! I have to create a function goo(A L) that will remove every A in L and it has to work on nested lists also.
Here's what I've got so far
(defun goo(A L)
(cond ((null L) nil) ; if list is null, return nil
(T ; else list is not null
(cond ((atom (car L))) ;if car L is an atom
((cond ((equal A (car L)) (goo A (cdr L))) ;if car L = A, call goo A cdr L
(T (cons (car L) (goo A (cdr L)))))) ;if car L != A,
(T (cons (goo A (car L)) (goo A (cdr L)))))) ;else car L is not atom, call goo on car L and call goo on cdr L
))
This function returns True no matter what I give it.
You parens are messed up. Move the last paren around (atom (car L)) to include the next cond expression. I suggest using an IDE which shows matching parens.
As for styling, if you didn't know, cond can accept multiple clauses. This way you don't need to have the t and then the cond again. You can also use 'if' if you are only testing a single predicate and making a decision based solely on that.
Note: this was originally posted as an edit to the question by the original asker in revision 2.
I tried another approach and it's working now.
(defun goo(A L)
(cond ((null L) nil)
((atom (car L)) (cond ((equal A (car L)) (goo A (cdr L)))
(T (cons (car L) (goo A (cdr L))))))
(T (cons (goo A (car L)) (goo A (cdr L))))
))
Note 2: this should conventionally be formatted like this to show the program structure:
(defun goo (a l)
(cond ((null l) nil)
((atom (car l))
(cond ((equal a (car l))
(goo a (cdr l)))
(t (cons (car l)
(goo a (cdr l))))))
(t (cons (goo a (car l))
(goo a (cdr l))))))
I think it might be easier to look at this a replacement into trees problem. It's easy to define a function that takes a tree and replaces subtrees in it that satisfy a test. There's a standard function subst-if that does that, but it replaces every matching subtree with the same thing. It will be more useful to us if we replace the element with a value computed from the subtree:
(defun %subst-if (new test tree)
"Replace subtrees of TREE that satisfy TEST with the result
of calling NEW with the subtree."
(cond
;; If tree satifies the test, return (new tree).
((funcall test tree)
(funcall new tree))
;; If tree is a cons, recurse.
((consp tree)
(cons (%subst-if new test (car tree))
(%subst-if new test (cdr tree))))
;; Otherwise, just return the leaf.
(tree)))
With this, its easy to define the kind of function we need. When an element X appears somewhere in a nested list structure, it means that there is a cons cell whose car is X. We want to replace that cons cell with its cdr, but to also recurse on the cdr of the cell. This isn't hard:
(defun replace* (x list &key (test 'eql))
"Remove occurrences of X in LIST and its sublists."
(%subst-if
(lambda (cons)
"Replace elements of the form (X . more) with
(replace* x more :test test)."
(replace* x (cdr cons) :test test))
(lambda (subtree)
"Detect subtrees of the form (X . more)."
(and (consp subtree)
(funcall test x (car subtree))))
list))
(replace* 'a '(1 a (2 a 3) a 4 a 5))
;=> (1 (2 3) 4 5)
So I am new to Scheme and have encountered a problem. What I am trying to do is the following. It's a rather simple problem nevertheless I am receiving several errors:
I try to sum up the elements of lists (which only consists of numbers). If the total amount is even, the procedure should return <'divisible_by_2>.
If the total amount is odd, it should return <'not_divisible_by_2>.
The initial sstep was to build a procedure that sums up the lists. This one works. The second step was to build an if function which takes the sum of lists and returns <'divisible_by_2> if the sum is even and <'not_divisible_by_2> if it is odd.
What I wrote so far:
(define (divisible_or_not list-sum lst)
(if (odd? list-sum lst)
(lambda (list-sum lst)
(cond
((null? lst)
0)
((pair? (car lst))
(+(list-sum (car lst)) (list-sum (cdr lst)))
(else
(+ (car lst) (list-sum (cdr lst)))
)
)
)
('divisible_by_2)
('not_divisible_by_2)
)
)
)
Version 2.0 (lst=tree; tree-count=sum-lst):
(define (divisible-or-not tree)
(define (tree-count tree)
(cond
((null? tree)
0)
((pair? (car tree))
(+(tree-count (car tree)) (tree-count (cdr tree)))
(else
(+ (car tree) (tree-count (cdr tree))))))
(if (odd? tree-count tree)
('divisible-by-2)
('not-divisible-by-2))))
Your code, properly indented, looks like so:
(define (divisible_or_not list-sum lst)
(if (odd? list-sum lst)
(lambda (list-sum lst)
(cond
((null? lst)
0)
((pair? (car lst))
(+(list-sum (car lst)) (list-sum (cdr lst)))
(else
(+ (car lst) (list-sum (cdr lst))))))
('divisible_by_2)
('not_divisible_by_2))))
The structure of your program looks like this:
(if ...
(lambda (...) ...))
In other words, if your test succeeds, you return an anonymous function, and if the test fails, you return nothing (in Scheme, the value is undefined in that case).
Inside your lambda, the code is a list of three expressions, a cond, the form ('divisible_by_2) and the form ('not_divisible_by_2).
First of all, do not use underscores for separating words in Lisp/Scheme, use dashes, like so: divisible-by-2.
Secondly, only the last expression's value is returned from the lambda, so the intermediate cond, since it has no side-effect, is basically doing work for nothing. The second form, ('divisible_by_2), looks like a function call but is going to give you an error. If you want to return a symbol, just quote it, without parentheses: 'divisible-by-2.
Since you already have an intermediate function, you can associate it to a name:
(define tree-count (sum tree)
(cond ...))
I named it tree-count because you also recurse into the car of your lists.
Once you have this function, you only need to apply it:
(if (even? (tree-count tree))
'divisible-by-2
'not-divisible-by-2)
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've got a homework assignment that has stumped me! I have to create a function goo(A L) that will remove every A in L and it has to work on nested lists also.
Here's what I've got so far
(defun goo(A L)
(cond ((null L) nil) ; if list is null, return nil
(T ; else list is not null
(cond ((atom (car L))) ;if car L is an atom
((cond ((equal A (car L)) (goo A (cdr L))) ;if car L = A, call goo A cdr L
(T (cons (car L) (goo A (cdr L)))))) ;if car L != A,
(T (cons (goo A (car L)) (goo A (cdr L)))))) ;else car L is not atom, call goo on car L and call goo on cdr L
))
This function returns True no matter what I give it.
You parens are messed up. Move the last paren around (atom (car L)) to include the next cond expression. I suggest using an IDE which shows matching parens.
As for styling, if you didn't know, cond can accept multiple clauses. This way you don't need to have the t and then the cond again. You can also use 'if' if you are only testing a single predicate and making a decision based solely on that.
Note: this was originally posted as an edit to the question by the original asker in revision 2.
I tried another approach and it's working now.
(defun goo(A L)
(cond ((null L) nil)
((atom (car L)) (cond ((equal A (car L)) (goo A (cdr L)))
(T (cons (car L) (goo A (cdr L))))))
(T (cons (goo A (car L)) (goo A (cdr L))))
))
Note 2: this should conventionally be formatted like this to show the program structure:
(defun goo (a l)
(cond ((null l) nil)
((atom (car l))
(cond ((equal a (car l))
(goo a (cdr l)))
(t (cons (car l)
(goo a (cdr l))))))
(t (cons (goo a (car l))
(goo a (cdr l))))))
I think it might be easier to look at this a replacement into trees problem. It's easy to define a function that takes a tree and replaces subtrees in it that satisfy a test. There's a standard function subst-if that does that, but it replaces every matching subtree with the same thing. It will be more useful to us if we replace the element with a value computed from the subtree:
(defun %subst-if (new test tree)
"Replace subtrees of TREE that satisfy TEST with the result
of calling NEW with the subtree."
(cond
;; If tree satifies the test, return (new tree).
((funcall test tree)
(funcall new tree))
;; If tree is a cons, recurse.
((consp tree)
(cons (%subst-if new test (car tree))
(%subst-if new test (cdr tree))))
;; Otherwise, just return the leaf.
(tree)))
With this, its easy to define the kind of function we need. When an element X appears somewhere in a nested list structure, it means that there is a cons cell whose car is X. We want to replace that cons cell with its cdr, but to also recurse on the cdr of the cell. This isn't hard:
(defun replace* (x list &key (test 'eql))
"Remove occurrences of X in LIST and its sublists."
(%subst-if
(lambda (cons)
"Replace elements of the form (X . more) with
(replace* x more :test test)."
(replace* x (cdr cons) :test test))
(lambda (subtree)
"Detect subtrees of the form (X . more)."
(and (consp subtree)
(funcall test x (car subtree))))
list))
(replace* 'a '(1 a (2 a 3) a 4 a 5))
;=> (1 (2 3) 4 5)
i've seen several examples of implementing append an element to a list, but all are not using tail recursion. how to implement such a function in a functional style?
(define (append-list lst elem)
expr)
The following is an implementation of tail recursion modulo cons optimization, resulting in a fully tail recursive code. It copies the input structure and then appends the new element to it, by mutation, in the top-down manner. Since this mutation is done to its internal freshly-created data, it is still functional on the outside (does not alter any data passed into it and has no observable effects except for producing its result):
(define (add-elt lst elt)
(let ((result (list 1)))
(let loop ((p result) (lst lst))
(cond
((null? lst)
(set-cdr! p (list elt))
(cdr result))
(else
(set-cdr! p (list (car lst)))
(loop (cdr p) (cdr lst)))))))
I like using a "head-sentinel" trick, it greatly simplifies the code at a cost of allocating just one extra cons cell.
This code uses low-level mutation primitives to accomplish what in some languages (e.g. Prolog) is done automatically by a compiler. In TRMC-optimizing hypothetical Scheme, we would be able to write the following tail-recursive modulo cons code, and have a compiler automatically translate it into some equivalent of the code above:
(define (append-elt lst elt) ;; %% in Prolog:
(if (null lst) ;; app1( [], E,R) :- Z=[X].
(list elt) ;; app1( [A|D],E,R) :-
(cons (car lst) ;; R = [A|T], % cons _before_
(append-elt (cdr lst) elt)))) ;; app1( D,E,T). % tail call
If not for the cons operation, append-elt would be tail-recursive. This is where the TRMC optimization comes into play.
2021 update: of course the whole point of having a tail-recursive function is to express a loop (in a functional style, yes), and so as an example, in e.g. Common Lisp (in the CLISP implementation), the loop expression
(loop for x in '(1 2) appending (list x))
(which is kind of high-level specification-y if not even functional in its own very specific way) is translated into the same tail-cons-cell tracking and altering style:
[20]> (macroexpand '(loop for x in '(1 2) appending (list x)))
(MACROLET ((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-ERROR)))
(BLOCK NIL
(LET ((#:G3047 '(1 2)))
(PROGN
(LET ((X NIL))
(LET ((#:ACCULIST-VAR-30483049 NIL) (#:ACCULIST-VAR-3048 NIL))
(MACROLET ((LOOP-FINISH NIL '(GO SYSTEM::END-LOOP)))
(TAGBODY SYSTEM::BEGIN-LOOP (WHEN (ENDP #:G3047) (LOOP-FINISH))
(SETQ X (CAR #:G3047))
(PROGN
(LET ((#:G3050 (COPY-LIST (LIST X))))
(IF #:ACCULIST-VAR-3048
(SETF #:ACCULIST-VAR-30483049
(LAST (RPLACD #:ACCULIST-VAR-30483049 #:G3050)))
(SETF #:ACCULIST-VAR-30483049
(LAST (SETF #:ACCULIST-VAR-3048 #:G3050))))))
(PSETQ #:G3047 (CDR #:G3047)) (GO SYSTEM::BEGIN-LOOP) SYSTEM::END-LOOP
(MACROLET
((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-WARN) '(GO SYSTEM::END-LOOP)))
(RETURN-FROM NIL #:ACCULIST-VAR-3048)))))))))) ;
T
[21]>
(with the mother of all structure-mutating primitives spelled R.P.L.A.C.D.) so that's one example of a Lisp system (not just Prolog) which actually does something similar.
Well it is possible to write a tail-recursive append-element procedure...
(define (append-element lst ele)
(let loop ((lst (reverse lst))
(acc (list ele)))
(if (null? lst)
acc
(loop (cdr lst) (cons (car lst) acc)))))
... but it's more inefficient with that reverse thrown in (for good measure). I can't think of another functional (e.g., without modifying the input list) way to write this procedure as a tail-recursion without reversing the list first.
For a non-functional answer to the question, #WillNess provided a nice Scheme solution mutating an internal list.
This is a functional, tail recursive append-elt using continuations:
(define (cont-append-elt lst elt)
(let cont-loop ((lst lst)
(cont values))
(if (null? lst)
(cont (cons elt '()))
(cont-loop (cdr lst)
(lambda (x) (cont (cons (car lst) x)))))))
Performance-wise it's close to Will's mutating one in Racket and Gambit but in Ikarus and Chicken Óscar's reverse did better. Mutation was always the best performer though. I wouldn't have used this however, but a slight version of Óscar's entry, purely because it is easier to read.
(define (reverse-append-elt lst elt)
(reverse (cons elt (reverse lst))))
And if you want mutating performance I would have done:
(define (reverse!-append-elt lst elt)
(let ((lst (cons elt (reverse lst))))
(reverse! lst)
lst))
You can't naively, but see also implementations that provide TCMC - Tail Call Modulo Cons. That allows
(cons head TAIL-EXPR)
to tail-call TAIL-EXPR if the cons itself is a tail-call.
This is Lisp, not Scheme, but I am sure you can translate:
(defun append-tail-recursive (list tail)
(labels ((atr (rest ret last)
(if rest
(atr (cdr rest) ret
(setf (cdr last) (list (car rest))))
(progn
(setf (cdr last) tail)
ret))))
(if list
(let ((new (list (car list))))
(atr (cdr list) new new))
tail)))
I keep the head and the tail of the return list and modify the tail as I traverse the list argument.