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.
Related
I can't figure out how can I make this tail recursive Scheme function not tail recursive anymore. Anyone can help me?
(define (foldrecl f x u)
(if (null? x)
u
(foldrecl f (cdr x) (f (car x) u))))
left folds are inheritly iterative, but you can easily make them recursive by adding a continuation. eg.
(let ((value expresion-that-calculates))
value)
So in your case:
(define (foldrecl f x u)
(if (null? x)
u
(let ((result (foldrecl f (cdr x) (f (car x) u))))
result)))
While this looks promising it does not guarantee that a smart Scheme implementation figures out that result is just returned and make it a tail call instead. Right folds are easier since they are inherently recursive:
(define (fold-right proc tail lst)
(if (null? lst)
tail
(proc (car lst)
(fold-right proc tail (cdr lst)))))
Here you clearly see the recursive part needs to become a argument to cons and thus never in tail position unless it is the base case.
Also notice it's slightly simpler to see what arguments goes where when the procedure is called proc, the tail of the result tail and the list argument lst. You don't even need to read my code to know how to use it, but yours I have no idea what x and u and ti doesn't help that the argument order doesn't follow any fold implementations known in Scheme.
The recursive call is in tail position, so put it inside another procedure call like this:
(define (identity x) x)
(define (foldrecl f x u)
(if (null? x)
u
(identity (foldrecl f (cdr x) (f (car x) u)))))
now the recursive call is not in tail position, it is not tail recursive anymore.
A compiler is allowed to optimize away the identity function if it knows that it does nothing but hopefully it wont.
Instead of doing, compose a plan for doing it; only in the end, do:
(define (foldreclr f xs a)
(define (go xs)
(if (null? xs)
(lambda (a) a)
(let ((r (go (cdr xs)))) ; first, recursive call;
(lambda ; afterwards, return a plan:
(a) ; given an a, to
(r ; perform the plan for (cdr xs)
(f (car xs) a)))))) ; AFTER processing (car x) and a.
((go xs) ; when the overall plan is ready,
a)) ; use it with the supplied value
The internal function go follows the right fold pattern. It makes the recursive call first, and only afterwards it composes and returns a value, the plan to first combine the list's head element with the accumulator value, and then perform the plan for the list's tail -- just like the original foldrecl would do.
When the whole list is turned into a plan of action, that action is finally performed to transform the supplied initial accumulator value -- performing the same calculation as the original foldrecl left fold.
This is known as leaning so far right you come back left again.(*)
> (foldreclr - (list 1 2 3 4) 0) ; 4-(3-(2-(1-0)))
2
> (foldreclr - (list 4 3 2 1) 0) ; 1-(2-(3-(4-0)))
-2
See also:
Foldl as foldr
(*) Evolution of a Haskell programmer (fun read)
(sorry, these are in Haskell, but Haskell is a Lisp too.)
Working on CLISP in Sublime Text.
Exp. in CLISP : less than 1 year
It's already for a while that I'm trying to solve this exercice... without success... as you might guess.
In fact I have to create a function which will modify the list and keeps only sublists which are equals or greater than the given number (watch below)
The list on which I have to work :
(setq liste '((a b) c (d) (e f) (e g x) f))
I'm supposed to find this as result :
(lenght 2 liste) => ((a b) (e f) (e g x))
liste => ((a b) (e f) (e g x))
Here my code :
(defun lenght(number liste)
(cond
((atom liste) nil)
((listp (car liste))
(rplacd liste (lenght number (cdr liste))) )
((<= (lenght number (car liste)) number)
(I don't know what to write) )
((lenght number (cdr liste))) ) )
It will be very kind if you could give me only some clue so as to let me find the good result.
Thanks guys.
Modifying the list does not make much sense, because it gets hairy at the head of the list to retain the original reference. Return a new list.
This is a filtering operation. The usual operator in Common Lisp for that is remove-if-not (or remove-if, or remove, depending on the condition). It takes a predicate that should return whether the element should be kept. In this case, it seems to be (lambda (element) (and (listp element) (>= (length element) minlength))).
(defun filter-by-min-length (minlength list)
(remove-if-not (lambda (element)
(and (listp element)
(>= (length element) minlength)))
list))
In many cases, when the condition is known at compile time, loop produces faster compiled code:
(defun filter-by-min-length (minlength list)
(loop :for element :in list
:when (and (listp element)
(>= (length element) minlength))
:collect element))
This returns a new list that fulfills the condition. You'd call it like (let ((minlength-list (filter-by-min-length 2 raw-list))) …).
Many basic courses insist on recursively using primitive operations on cons cells for teaching purposes at first.
The first attempt usually disregards the possible stack exhaustion. At each step, you first look whether you're at the end (then return nil), whether the first element should be discarded (then return the result of recursing on the rest), or if it should be kept (then cons it to the recursion result).
If tail call optimization is available, you can refactor this to use an accumulator. At each step, instead of first recursing and then consing, you cons a kept value onto the accumulator and pass it to the recursion. At the end, you do not return nil, but reverse the accumulator and return that.
Well, I have found the answer that I was looking for, after scratching my head until blood...
Seriously, here is the solution which is working (and thanks for the correction about length which helped me to find the solution ^^) :
(defun filter-by-min-length (min-length liste)
(cond
((atom liste) nil)
((and (listp (car liste))(>= (length (car liste)) min-length))
(rplacd liste (filter-by-min-length min-length (cdr liste))) )
((filter-by-min-length min-length (cdr liste))) ) )
A non-modifying version
(defun filter-by-min-length (min-length le)
(cond ((atom le) nil)
((and (listp (car le)) (>= (length (car le)) min-length))
(cons (car le) (filter-by-min-length min-length (cdr le))))
(t (filter-by-min-length min-length (cdr le)))))
Test:
(defparameter *liste* '((a b) c (d) (e f) (e g x) f))
(filter-by-min-length 2 *liste*)
;; ((A B) (E F) (E G X))
*liste*
;; ((A B) C (D) (E F) (E G X) F) ; -> *liste* not modified
For building good habits, I would recommend to use defparameter instead of setq, since the behaviour of setq might not always be defined (see here). In the link, it is said:
use defvar, defparameter, or let to introduce new variables. Use setf
and setq to mutate existing variables. Using them to introduce new
variables is undefined behaviour
i am currently programming in scheme and i have written the following record-procedures that records a creature (= kreatur in German) with the character traits strength (= stärke), knowledge (= wissen) and readiness to assume a risk (= risikobereitschaft), i defined two creatures named "ronugor" and "garnolaf" (the names are not my idea, its from a exercise i didn't come up with ;) ) and then i wrote a procedure to mix the character traits of these two creatures (strengh -5%, knowledge unchanged, readiness to assume a risk still 0) to receive a new creature named "ronulaf".
this is my code:
(: stärke (kreatur -> number))
(: wissen (kreatur -> number))
(: risikobereitschaft (kreatur -> number))
(define-record-procedures kreatur
make-kreatur
kreatur?
(stärke
wissen
risikobereitschaft))
; check-property (i kept this out of the posted code to shorten it)
;define the creatures garnolaf and ronugor
(: make-kreatur (number number number -> kreatur))
(define garnolaf
(make-kreatur 100 0 0))
(: make-kreatur (number number number -> kreatur))
(define ronugor
(make-kreatur 0 100 0))
;signaturen
(: garnolaf? (kreatur -> boolean))
(check-expect (garnolaf? garnolaf) #t)
(check-expect (garnolaf? ronugor) #f)
(define garnolaf?
(lambda (x)
(and (= (stärke x) 100)
(= (wissen x) 0)
(= (risikobereitschaft x) 0))))
(: ronugor? (kreatur -> boolean))
(check-expect (ronugor? garnolaf) #f)
(check-expect (ronugor? ronugor) #t)
(define ronugor?
(lambda (x)
(and (= (stärke x) 0)
(= (wissen x) 100)
(= (risikobereitschaft x) 0))))
;mixing of the creatures
(: ronulaf (kreatur kreatur -> kreatur))
;this is where i am missing a check-expect, i suppose
(define ronulaf
(lambda (r g)
(make-kreatur (* 0.95 (stärke g))
(wissen r)
0)))
the question i now have is how i can write a check-expect for the procedure ronulaf. i would write is somehow like this:
(check-expect (ronulaf ronugor garnolaf) #<record:kreatur 95.0 100 0>)
but it doesn't work. does anybody have a better idea for a check-expect?
thanks already!
eva
Notice how your garnolaf? and ronugor? procedures are written? Now write something similar for ronulaf. That's it!
Try this:
(check-expect (ronulaf ronugor garnolaf) (make-kreatur 95 100 0))
Not all objects representations can be feed into read and become that object. #< in the beginning makes it look like an evaluated procedure and it's the same for those.
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).
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]