I am writing code to test if two trees are equal (in data and structure) in Scheme, and I have to assume that I only have at most two children for each node. My code is as follows:
(define (make-tree value left right)
(list value left right))
(define (value tree)
(car tree))
(define (left tree)
(car (cdr tree)))
(define (right tree)
(car (cdr (cdr tree))))
(define (tree-equal? T1 T2)
(if (and (null? T1) (null? T2))
#t
(if (= (value T1) (value T2))
(tree-equal? (left T1) (left T2))
(tree-equal? (right T1) (right T2)))))
(tree-equal? '(1 2 3) '(1 2 3))
The output that I am getting is car:
car: contract violation
expected: pair?
given: 2
Can anyone explain to me what I am doing wrong? Why is (value T1) giving this error? Should I rewrite my value function to check if the tree is null?
The problem leading to the error
There are a few places in your code where you could end up calling car with something that's not a pair, (and so violate the contract that car's argument should be a pair). One such thing, as the error message indicates, is 2. In particular, after checking that (= 1 1) (since 1 is the value of (1 2 3) and (1 3 2)), you recurse into the left branches of the trees with
(tree-equal? (left T1) (left T2))
Now, (left T1) produces 2, and (left T2) produces 3. Neither is null, so you end up getting to the following line with 2 == T1 and 3 == T2.
(= (value T1) (value T2))
Since value is defined as car, you're trying to call car with 2.
Some other issues…
After that's resolved, there are still some issues with your comparison function, some of which are simply stylistic, and some of which are actually going to cause problems.
(define (tree-equal? T1 T2)
(if (and (null? T1) (null? T2))
#t
(if (= (value T1) (value T2))
(tree-equal? (left T1) (left T2))
(tree-equal? (right T1) (right T2)))))
You're right to check that if both trees are null?, then they are the same. What happens if one of them is null? and the other isn't, though? You'll continue by calling value on (), which is no good. If the other isn't null?, but isn't a list either, you'll try calling value on it, and that would fail too. In the case that you do get two trees, and they happen to have the same value, then you check their left sides, and if they don't have the same value, you check their right sides. (This is how if works.) I expect that you really want to check that they have the same value and have the same left and have the same right.
You can actually simplify this with some boolean logic (the comments to the right should help). This uses a tree? predicate which you haven't defined yet, but it's not difficult, and it makes this code much easier to read.
(define (tree-equal? T1 T2) ; T1 and T2 are tree-equal iff
(or (eq? T1 T2) ; 1. are the same (this covers both being null), OR
(and (tree? T1) (tree? T2) ; 2. a. both are trees, AND
(eq? (value T1) (value T2)) ; b. values are eq, AND
(tree-equal? (left T1) (left T2)) ; c. lefts are tree-equal, AND
(tree-equal? (right T1) (right T2))))) ; d. rights are tree-equal
On the traditional meaning of “tree” in Lisps
Now, I understand that you're using binary trees that have elements at each intermediate nodes, but I'll point out that “tree” is often used in Lisp contexts to denote an arbitrary structure built out of cons cells (i.e., pairs). The same approach can be used to compare them, but it's a little bit cleaner:
(define (tree-eq? t1 t2)
(or (eq? t1 t2)
(and (pair? t1) (pair? t2)
(tree-eq? (car t1) (car t2))
(tree-eq? (cdr t1) (cdr t2)))))
This comparison function will, coincidentally, work for your type of tree as well, since one of your nodes has the form
(value . (left . (right . ())))
so the recursive calls would still end up processing the values, lefts, and rights from two trees at the same time. Of course, this would also recognize equivalent trees (in the traditional sense) that aren't actually legal trees (in the sense of your question). That's why it's important to have a corresponding tree? function (pair? serves just fine for the traditional case).
Related
I have the following problem with Racket.
I'm trying to implement tree pre-order, post-order traversal for a generic tree.
The struct definition is:
(define-struct eempty [])
(define-struct branch [left value right])
I can't use the unless/when operator, just if and cond.
I can't really come up with a solution. I've looked at the wikipedia pseudocode but it's not really helping due to racket programming paradigm.
(define (inorder tree x)
(cond [(and (branch? tree) (branch? (branch-left tree))) (inorder (branch-left tree) x)]
[(and (branch? tree) (branch? (branch-right tree))) (inorder (branch-right tree) x)]
This is what I've done until now, but it has problems when matching an empty struct.
Update:
What I am trying to do is display / printing node value in-order or/and post-order.
I know I have to implement (somehow) 2 more conditions:
(and (branch? tree) (empty? (branch-left tree))) do-something x)
(and (branch? tree) (empty? (branch-right tree))) do-something x)
What do I have to do in do-something? I think I'm missing this point.
Any help?
We start with what we have:
#lang racket
(define-struct empty []) ; no fields
(define-struct branch [left value right]) ; three fields
We can try to make some trees:
(define t1 (empty))
(define t2 (branch t1 7 t1))
Now we can try playing with it a little:
> t2
#<branch>
> (branch-left t2)
#<empty>
> (branch-left t1)
branch-left: contract violation
expected: branch?
given: #<empty>
> (branch? t2)
#t
> (branch? t1)
#f
> (empty? t2)
#f
> (empty? t1)
#t
>
So that is our repertoire. Racket's struct macro defines various functions for us to use -- constructors, accessors, predicates, ... .
How to print a value? Say,
(define (display-value v)
(display #\ )
(display v))
So now we can
> (display-value (branch-value t2))
7
empty has no value field, only branch does:
(define (display-tree-inorder t)
(cond
((empty? t)
(display-empty) ) ; define it later
((branch? t)
(display-branch-inorder ; define it later
(branch-left t)
(branch-value t)
(branch-right t)))))
In defining this, we have followed the type: our trees are either empty, or a branch. This is how we defined them, with those two struct definitions.
All that's left is to complete the missing definitions for display-empty and display-branch-inorder.
But before we do this, we can also have
(define (display-tree-preorder t)
(cond
((empty? t)
(display-empty) )
((branch? t)
(display-branch-preorder
(branch-left t)
(branch-value t)
(branch-right t)))))
(define (display-tree-postorder t)
(cond
((empty? t)
(display-empty) )
((branch? t)
(display-branch-postorder
(branch-left t)
(branch-value t)
(branch-right t)))))
So what is display-empty doing? It does nothing:
(define (display-empty)
#f)
And what about display-branch-inorder?
(define (display-branch-inorder lt val rt)
according to Wikipedia I'm sure, it starts by displaying its left sub-tree,
(display-tree-inorder .... )
then it gets to display its value
(display-value .... )
and it finishes up by displaying the right sub-tree:
.... )
Same for the other two variants.
After you've done all this, you'll feel the urge to abstract, and to generalize, by following the principle of separation of concerns. Good. Our display-tree-inorder lumps together several things: it traverses a tree, according to this or that notion of order, and it does something with each node's value. All these can be abstracted over and made into arguments to a generalized procedure, say, traverse-tree.
So you see, it's quite simple: follow the types! and everything will fall in line for you.
It looks like you're missing a 'cond' branch for the 'empty' struct. You can refer to the How To Design Programs textbook for help on this, specifically the "template" step associated with mixed self-referential data.
I am trying to evaluate each atom of a list and see if it's equal to the number provided and remove if its not but I am running into a slight problem.
I wrote the following code:
(defun equal1(V L)
(cond((= (length L) 0))
(T (cond( (not(= V (car(equal1 V (cdr L))))) (cdr L) )))
)
)
(equal1 5 '(1 2 3 4 5))
I obtain the following error
Error: Cannot take CAR of T.
If I add (write "hello") for the action if true, the following error is obtained:
Error: Cannot take CAR of "hello".
I'm still quite new to LISP and was wondering what exactly is going on and how could I fix this so I could evaluate each atom properly and remove it if its not, thus the cdr L for the action.
car and cdr are accessors of objects of type cons. Since t and "hello" are not cons you get an error message.
To fix it you need to know what types your function returns and not car unless you know that it's a cons
EDIT
First off ident and clean up the code.. The nested cond are uneccesary since cond is a if-elseif-else structure by default:
(defun remove-number (number list)
(cond ((= (length list) 0)
t)
((not (= number (car (remove-number number (cdr list)))))
(cdr list))))
(t
nil)))
I want you to notice I've added the default behaviour of returning t when a consequent is not given as we know = returns either t or nil so it returns t when the length is 0 in this case.
I've added the default case where none of the two previous predicates were truthy and it defaults to returning nil.
I've named it according to the functions used. = can only be used for numeric arguments and thus this will never work on symbols, strings, etc. You need to use equal if you were after values that look the same.
Looking at this now we can see that the functions return value is not very easy to reason about. We know that t, nil and list or any part of the tail of list are possible and thus doing car might not work or in the case of (car nil) it may not produce a number.
A better approach to doing this would be:
check if the list is empty, then return nil
check if the first element has the same numeric value as number, then recurse with rest of the list (skipping the element)
default case should make cons a list with the first element and the result fo the recursion with the rest of the list.
The code would look something like this:
(defun remove-number (number list)
(cond ((endp list) '())
((= (car list) number) (remove-number ...))
(t (cons ...))))
There are a couple of things you could do to improve this function.
Firstly, let's indent it properly
(defun equal1 (V L)
(cond
((= (length L) 0))
(T (cond
((not (= V (car (equal1 V (cdr L))))) (cdr L))))))
Rather than saying (= (length l) 0), you can use (zerop (length l)). A minor sylistic point. Worse is that branch returns no value. If the list L is empty what should we return?
The issue with the function is in the T branch of the first cond.
What we want to do is
remove any list item that is the same value as V
keep any item that is not = to V
The function should return a list.
The expression
(cond
((not (= V (car (equal1 V (cdr L))))) (cdr L)))
is trying (I think) to deal with both conditions 1 and 2. However it's clearly not working.
We have to recall that items are in a list and the result of the equal function needs to be a list. In the expression above the result of the function will be a boolean and hence the result of the function call will be boolean.
The function needs to step along each element of the list and when it sees a matching value, skip it, otherwise use the cons function to build the filtered output list.
Here is a skeleton to help you out. Notice we don't need the embedded cond and just have 3 conditions to deal with - list empty, filter a value out, or continue to build the list.
(defun equal-2 (v l)
(cond
((zerop (length L)) nil)
((= v (car l)) <something goes here>) ;skip or filter the value
(t (cons (car l) <something goes here>)))) ;build the output list
Of course, this being Common Lisp, there is a built-in function that does this. You can look into remove-if...
I'm new to Racket and trying to learn it. I'm working through some problems that I'm struggling with. Here is what the problem is asking:
Write a definition for the recursive function occur that takes a data expression a and a list s and returns the number of times that the data expression a appears in the list s.
Example:
(occur '() '(1 () 2 () () 3)) =>3
(occur 1 '(1 2 1 ((3 1)) 4 1)) => 3 (note that it only looks at whole elements in the list)
(occur '((2)) '(1 ((2)) 3)) => 1
This is what I have written so far:
(define occur
(lambda (a s)
(cond
((equal? a (first s))
(else (occur a(rest s))))))
I'm not sure how to implement the count. The next problem is similar and I have no idea how to approach that. Here is what this problem says:
(This is similar to the function above, but it looks inside the sublists as well) Write a recursive function atom-occur?, which takes two inputs, an atom a and a list s, and outputs the Boolean true if and only if a appears somewhere within s, either as one of the data expressions in s, or as one of the data expression in one of the data expression in s, or…, and so on.
Example:
(atom-occur? 'a '((x y (p q (a b) r)) z)) => #t
(atom-occur? 'm '(x (y p (1 a (b 4)) z))) => #f
Any assistance would be appreciated. Thank you.
In Racket, the standard way to solve this problem would be to use built-in procedures:
(define occur
(lambda (a s)
(count (curry equal? a) s)))
But of course, you want to implement it from scratch. Don't forget the base case (empty list), and remember to add one unit whenever a new match is found. Try this:
(define occur
(lambda (a s)
(cond
((empty? s) 0)
((equal? a (first s))
(add1 (occur a (rest s))))
(else (occur a (rest s))))))
The second problem is similar, but it uses the standard template for traversing a list of lists, where we go down on the recursion on both the first and the rest of the input list, and only test for equality when we're in an atom:
(define atom-occur?
(lambda (a s)
(cond
((empty? s) #f)
((not (pair? s))
(equal? a s))
(else (or (atom-occur? a (first s))
(atom-occur? a (rest s)))))))
I am trying to delete a node from a Binary Search Tree in scheme, but I am having trouble with the removing part of the code. How can I delete a node value without creating a new tree in scheme?
(define (delete-node v T)
(cond ((null? T) '())
((< v (value T))
(delete-node v (left T)))
((> v (value T))
(delete-node v (right T)))
(else
(cond ((and (null? (right T))(not (null? (left T)))) '())
;promote the (left T) to the node
;repeat
((and (null? (left T))(not (null? (right T)))) '())
;promote the (right T) to the node
;repeat
For deleting a node in-place, your tree would have to be mutable - meaning: that either the value, the right subtree or the left subtree of a node can be modified in-place with new values.
It's easier to just build a new tree while traversing it, but even so there are a couple of implementation choices that must be made. Here's a sketch of a solution:
(define (delete-node v T)
(cond ((null? T) '())
((< v (value T))
; see how we build the new tree
(make-node (value T)
(delete-node v (left T))
(right T)))
((> v (value T))
; see how we build the new tree
(make-node (value T)
(left T)
(delete-node v (right T))))
(else
(cond ((and (null? (right T)) (and (null? (left T))))
; this case was missing
'())
((and (null? (right T)) (not (null? (left T))))
(left tree))
((and (null? (left T)) (not (null? (right T))))
(right tree))
(else
; implementation detail: if both subtrees of the
; node to be deleted are non-null, who should take
; the place of the deleted node? the new subtree
; must preserve the order property of the tree
<???>)))))
The interesting case is marked with <???>. There are several options, it's up to you to pick and implement one. For instance, in a sorted tree (which I assume is the case here), one could pick the biggest element from the left subtree, and recursively delete it before moving it into place.
Notice that if the tree has to remain balanced after deleting the node (according to the balancing definition in use), the algorithm is trickier - I'm assuming that the tree is not balanced.
I've been teaching myself functional programming, and I'm currently writing different higher order functions using folds. I'm stuck implementing scan (also known as prefix sum). My map implementation using fold looks like:
(define (map op sequence)
(fold-right (lambda (x l) (cons (op x) l)) nil sequence))
And my shot at scan looks like:
(define (scan sequence)
(fold-left (lambda (x y) (append x (list (+ y (car (reverse x)))))) (list 0) sequence))
My observation being that the "x" is the resulting array so far, and "y" is the next element in the incoming list. This produces:
(scan (list 1 4 8 3 7 9)) -> (0 1 5 13 16 23 32)
But this looks pretty ugly, with the reversing of the resulting list going on inside the lambda. I'd much prefer to not do global operations on the resulting list, since my next attempt is to try and parallelize much of this (that's a different story, I'm looking at several CUDA papers).
Does anyone have a more elegant solution for scan?
BTW my implementation of fold-left and fold-right is:
(define (fold-left op initial sequence)
(define (iter result rest)
(if (null? rest)
result
(iter (op result (car rest)) (cdr rest))))
(iter initial sequence))
(define (fold-right op initial sequence)
(if (null? sequence)
initial
(op (car sequence) (fold-right op initial (cdr sequence)))))
Imho scan is very well expressible in terms of fold.
Haskell example:
scan func list = reverse $ foldl (\l e -> (func e (head l)) : l) [head list] (tail list)
Should translate into something like this
(define scan
(lambda (func seq)
(reverse
(fold-left
(lambda (l e) (cons (func e (car l)) l))
(list (car seq))
(cdr seq)))))
I wouldn’t do this. fold can actually be implemented in terms of scan (last element of the scanned list). But scan and fold are in fact orthogonal operations. If you’ve read the CUDA papers you’ll notice that a scan consists of two phases: the first yields the fold result as a by-product. The second phase is only used for the scan (of course, this only counts for parallel implementations; a sequential implementation of fold is more efficient if it doesn’t rely on scan at all).
imho Dario cheated by using reverse since the exercise was about expressing in terms of fold not a reverse fold. This, of course, is a horrible way to express scan but it is a fun exercise of jamming a square peg into a round hole.
Here it is in haskell, I don't know lisp
let scan f list = foldl (\ xs next -> xs++[f (last xs) next]) [0] list
scan (+) [1, 4, 8, 3, 7, 9]
[0,1,5,13,16,23,32]
of course, using teh same trick as Dario one can get rid of that leading 0:
let scan f list = foldl (\ xs next -> xs++[f (last xs) next]) [head list] (tail list)
scan (+) [1, 4, 8, 3, 7, 9]
[1,5,13,16,23,32]