finding nodes at depth N in a tree with racket - recursion

I've written a piece of code which returns the nodes which are at depth N of a tree. The root is considered to be at depth 1.
#lang racket
(define (depth n tree) (
cond [(= n 1) (car tree)]
[(> n 1) (
cond [(and (null? (cadr tree)) (null? (caddr tree)))
(null)]
[(and (not (null? (cadr tree))) (null? (caddr tree)))
(cons (depth (- n 1) (cadr tree)) null)]
[(and (null? (cadr tree)) (not (null? (caddr tree))))
(cons (depth (- n 1) (caddr tree)) null)]
[(and (not (null? (cadr tree))) (not (null? (caddr tree))))
(cons (depth (- n 1) (cadr tree)) (depth (- n 1) (caddr tree)))]
)]
)
)
Which works fine for depth 1, 2 and 3.
(define sampleTree
`(A
(B
(D () ())
(E () ())
)
(C
()
(F
(G () ())
()
)
)
)
)
(depth 1 sampleTree)
(depth 2 sampleTree)
(depth 3 sampleTree)
gives
'A
'(B . C)
'((D . E) F)
But for some reason, this does not work for depth 4.
(depth 4 sampleTree)
application: not a procedure;
expected a procedure that can be applied to arguments
given: '()
I honestly have no idea why this happens. It seems like the null in the first branch of > n 1 is getting applied to something.
Any help on debugging this code is appreciated.

The problem is (null). null is bound to the value '(). Putting parentheses around it tries to apply it as a procedure.
> null
'()
> (null)
application: not a procedure;
expected a procedure that can be applied to arguments
given: '()
[,bt for context]
May I suggest the following code formatting:
(define (depth n tree)
(cond
[(= n 1) (car tree)]
[(> n 1)
(cond
[(and (null? (cadr tree)) (null? (caddr tree))) '()]
[(and (not (null? (cadr tree))) (null? (caddr tree)))
(cons (depth (- n 1) (cadr tree)) null)]
[(and (null? (cadr tree)) (not (null? (caddr tree))))
(cons (depth (- n 1) (caddr tree)) null)]
[(and (not (null? (cadr tree))) (not (null? (caddr tree))))
(cons (depth (- n 1) (cadr tree)) (depth (- n 1) (caddr tree)))])]))
You may also want to ask yourself what type of value depth should return. In your example output, 'A is a symbol, '(B . C) is a pair, and '((D . E) F) is a proper list (with a pair as the first element).

As Peter pointed out, your result, with all the improper pairs, is probably not what you want - a proper list of values makes more sense. Here's a version that gives that, by using list and append instead of cons:
#lang racket/base
(require racket/list) ; For first, second, etc.
;;; Use functions to access parts of the tree structure to be clearer about what's being looked at
;;; and to make it easier to change to a struct or other more efficient implementation.
(define (node-value node)
(first node))
(define (node-left-child node)
(second node))
(define (node-right-child node)
(third node))
(define (depth desired-depth head)
(cond
((= desired-depth 1)
(list (node-value head)))
((> desired-depth 1)
(append (if (null? (node-left-child head)) '() (depth (- desired-depth 1) (node-left-child head)))
(if (null? (node-right-child head)) '() (depth (- desired-depth 1) (node-right-child head)))))))
(define sampleTree
'(A
(B
(D () ())
(E () ()))
(C
()
(F
(G () ())
()))))
(depth 1 sampleTree) ; '(A)
(depth 2 sampleTree) ; '(B C)
(depth 3 sampleTree) ; '(D E F)
(depth 4 sampleTree) ; '(G)

Related

Why does List function call return runtime error in Scheme?

Getting an error for my binary search tree that I created in scheme.
$gosh main.sc
*** ERROR: list required, but got 5
Stack Trace:
_______________________________________
This is my code. I think the error has to do with how I am calling the functions, but I am not sure what exactly is wrong. I am calling the insert function with the two required parameters: tree, and a value of 5.
(define (member? t v)
(cond
((null? t)
#f
)
((< node (car t))
(member? (cadr t) v))
((> node (car t))
(member? (caddr t) v))
(else
#t
)
)
)
(define (insert t v)
(cond
((null? t)
(list v '() '())
)
((< v (car t))
(list (car t) (insert (cadr t) v) (caddr t))
)
((>= v (car t))
(list (car t) (cadr t) (insert (caddr t) v))
)
(else
t
)
)
)
(define (fold func val lst)
(if (null? lst) val (fold func (func val (car lst)) (cdr lst))))
(define (build lst)
(fold (lambda (t v) (insert t v)) '() lst))
(define t (list 10 '() '()))
(insert t 5)
display (member t 5)
display t
You care calling (member t 5) which is the same as (member '(10 '() '()) 5). Now member is not the same as your defined member? since it has a different name. member is the core library that looks like this:
(define (member obj lst)
(cond ((null? lst) #f)
((equal? obj (car lst)) lst)
(else (member obj (cdr lst)))))
Your member? has the two parameters swapped so when you miswrote the name and used the report version member 5 is not null, then it will do (car 5) and that will fail miserably. The error message that 5 is not of the required type list is pretty decent. It might spell the beans that it was member that failed though.
Another thing. If you replace the call to member with a call to member? you hit more problems. You use a variable node that is not defined anywhere.
The indentation and placing of parentheses is not goo lisp style. Your code should be written like this:
;; node doesn't exist in OPs code, but my implementation doesn't like member? without it
(define node 5)
;; possible typo by using the variable node ?
(define (member? t v)
(cond
((null? t)
#f)
((< node (car t))
(member? (cadr t) v))
((> node (car t))
(member? (caddr t) v))
(else
#t)))
(define (insert t v)
(cond
((null? t)
(list v '() '()))
((< v (car t))
(list (car t) (insert (cadr t) v) (caddr t)))
((>= v (car t))
(list (car t) (cadr t) (insert (caddr t) v)))
(else
t)))
(define (fold func val lst)
(if (null? lst) val (fold func (func val (car lst)) (cdr lst))))
(define (build lst)
(fold (lambda (t v) (insert t v)) '() lst))
(define t (list 10 '() '()))
(insert t 5)
;; NB doesn't call a procedure, just evaluates it.
display
;; Here the arguments are the wrong order and you don't use memeber?
(member t 5)
;; NB doesn't call a procedure, just evaluates it.
display
t

scheme:: contract violation: recursive procedure

I have a requirement to write a scheme procedure that takes a list as a parameter, which defines points awarded, player A score, and player B score. The function should determine who is the winner based on the scores:
For example, this the list of lists of scores I use below:
(define scores '(
(5 . (5 . 3)) ; points awarded = (car (car scores)) 5; player A score = cadr (car scores)) 5; player B score (cddr (car scores)) 3;
(5 . (6 . 2))
(5 . (8 . 4))
(5 . (5 . 1))))
So just to clarify, breaking down the first list in the list:
5 = points awarded (car (car scores)) ;
A = Player A Score (cadr (car scores)) ; (which is 5 on the first element, 6 on the 2nd, etc.)
B = Player B Score (cddr (car scores)) ; (which is 3 on the first element, 2 on the 2nd, etc.)
The problem is I have made a recursive function which blows up on the 1st iteration of the recursion. But I don't understand why?
#lang scheme
(define (game-winner scores)
(define A 0)
(define B 0)
(cond
((empty? scores) '()))
(if ( > (cadr (car scores)) (cddr (car scores)) )
(+ A (car (car scores)))
(+ B (car (car scores))))
(game-winner (cdr scores)))
OUTPUT:
car: contract violation
expected: pair?
given: ()
The part that confuses me is that when I simulate running through the 1st iteration of the recursion and get the values the function should have, I get correct values:
;first loop through function
(car (car scores)) ; 5
(cadr (car scores)) ; 5
(cddr (car scores)) ; 3
;second loop (1st recursive call)
(cadr (car (cdr scores))) ; 6
(cddr (car (cdr scores))) ; 2
So if I don't understand why it's blowing up? It should work in the same way as the first call before the recursion. But I obviously am missing something. Any ideas?
P.S.
if I just return the A or B instead of the recursive call I get 0:
(define (game-winner scores)
(define A 0)
(define B 0)
(cond
((empty? scores) '()))
(if ( > (cadr (car scores)) (cddr (car scores)) )
(+ A (car (car scores)))
(+ B (car (car scores))))
A)
OUTPUT:
0
How come the value of A (which should be 5) after the first call doesn't show when I oupout A? Is A only in scope of the if loop? If so, how do I get it to exist outside that scope?
based on feedback from #Sylwester I modified by procedure to:
#lang scheme
(define (game-winner scores)
(define A 0)
(define B 0)
(cond
((empty? scores) '())
(( > (cadr (car scores)) (cddr (car scores)))
(cons (+ A (car (car scores))) (game-winner (cdr scores))))
(cons (+ B (car (car scores))) (game-winner (cdr scores)))))
OUTPUT:
(5 5 5 5)
So I feel like I'm getting closer. But I need to be able to add these all together for A or for B and output the winner (A or B). How do I build on top of this to get that to work?
You code has a lot of dead code that is never used no matter what is the outcome and in the end the last expression will do (cdr scores) no matter if it's empty or not.
(define (game-winner scores)
;; Two constants that never change from 0
(define A 0)
(define B 0)
;; Dead code. Werther it's '() or #<undefined>
(cond
((empty? scores) '()))
;; Dead code. Becomes (+ 0 (car scores)) but never used
(if ( > (cadr (car scores)) (cddr (car scores)) )
(+ A (car (car scores))) ; + never mutates A
(+ B (car (car scores)))) ; + never mutates B
;; Infinite recursion. Happens no matter what is the outcome of the dead code
(game-winner (cdr scores)))
So when you write a cond or if it should handle all the things that happen so that it is the last expression:
(define (game-winner scores)
; local defines
(define some-var some-expression)
...
; one expression, the result of this is the result of the procedure.
(if (empty? scores)
'()
(if ....)))
EDIT
Here is an example of a recursion using arguments to accumulate the scores and in the end determine who has the highest score:
(define (game-winner scores)
(let loop ((scores scores) (a 0) (b 0))
(if (empty? scores)
(cond ((> a b) 'A)
((< a b) 'B)
(else 'TIE)))
(loop (cdr scores)
(+ a (cadar scores))
(+ b (cddar scores))))))
(game-winner scores)
; ==> A

Remove subsequence function (deep recursion) in scheme

Im trying to write a function called removesub* which accepts two arguments (l1 and l2). The function needs to return the second list with the first occurence of the subsequence removed. So, if the first list is '(a b c), the first a if the second list is removed, the first b that appears after the removed a is removed, and the first c that appears after the removed b is removed - no matter how deep the atoms are nested.
Working Example
Input: (removesub* '(a b) '(w (x b) ((a) ((y z))) b a))
Output: (w (x b) (() ((y z))) a)
My current attempt doesnt seem to work because I have no way of sharing the l1 argument between nested recursive calls i.e. ((pair? (car l2)) (cons (removesub* l1 (car l2)) (removesub* l1 (cdr l2)))) splits l1 into two separate instances resulting in the following result. How can I share the l1 value so every recursive calls knows if the others have found the first instance of a value in l1?
Working Example
Input: (removesub* '(a b) '(w (x b) ((a) ((y z))) b a))
Output: (w (x b) (() ((y z))) b)
Attempted Solution - Scheme
(define removesub*
(lambda (l1 l2)
(cond
((or (null? l1) (null? l2)) l2)
((pair? (car l2)) (cons (removesub* l1 (car l2)) (removesub* l1 (cdr l2))))
((eq? (car l1) (car l2)) (removesub* (cdr l1) (cdr l2)))
(else (cons (car l2) (removesub* l1 (cdr l2)))))))
You need to pass the resulting symbols to search for to the next iteration. THere are many ways to do this.
You can use a compound return in the helper
(define (removesub* elements-in-order haystack)
;; just use a pair to pass result and the
;; elements to continue searching for
(define (result eio h)
(cons eio h))
(cdr
(let rec ((eio elements-in-order)
(h haystack))
(cond ((or (not (pair? eio))
(not (pair? h)))
(result eio h))
((pair? (car h))
(let* ((r (rec eio (car h)))
(r2 (rec (car r) (cdr h))))
(result (car r2) (cons (cdr r) (cdr r2)))))
((eq? (car eio) (car h))
(rec (cdr eio) (cdr h)))
(else
(let ((r (rec eio (cdr h))))
(result (car r) (cons (car h) (cdr r)))))))))
Notice I do car first then use both parts of the result to do the next.
Scheme/Racket can return more than one value with values
(define (removesub* elements-in-order haystack)
(define (helper eio h)
(cond ((or (not (pair? eio))
(not (pair? h)))
(values eio h))
((pair? (car h))
(let*-values ([(eiocar hcar) (helper eio (car h))]
[(eiocdr hcdr) (helper eiocar (cdr h))])
(values eiocdr (cons hcar hcdr))))
((eq? (car eio) (car h))
(helper (cdr eio) (cdr h)))
(else
(let-values ([(eiocdr hcdr) (helper eio (cdr h))])
(values eiocdr (cons (car h) hcdr))))))
(let-values ([(eio result) (helper elements-in-order haystack)])
result))
Not really a semantic difference over the first, but it might be a tad faster since in theory the results can stay on the stack rather than each result having to create a cons that can be GC-ed as fast as the stack unrolls.
You can use continuation passing style:
(define (removesub* elements-in-order haystack)
(let cps ((eio elements-in-order)
(h haystack)
(c (lambda (eio h) h)))
(cond ((or (not (pair? eio))
(not (pair? h)))
(c eio h))
((pair? (car h))
(cps eio
(car h)
(lambda (eio hcar)
(cps eio
(cdr h)
(lambda (eio hcdr)
(c eio (cons hcar hcdr)))))))
((eq? (car eio) (car h))
(cps (cdr eio) (cdr h) c))
(else
(cps eio
(cdr h)
(lambda (eio res)
(c eio (cons (car h) res))))))))
This works by the helper has a continuation argument. This is close to what many Scheme implementations actually do to your code before running.
You can use mutation
Probably the fastest and easiest, but then you need to use #!r6rs or another standard Scheme rather than #!racket as implementation language.

Scheme reverse a list

I am trying to reverse a list in Scheme using DrRacket.
Code:
(define rev
(lambda(l)
(if (null? l)
'()
(append (rev (cdr l)) (list (car l))))))
If I input (rev '(a((b)(c d)(((e)))))), the output is (((b) (c d) (((e)))) a).
I want it to be (((((e)))(d c)(b))a). I looked here: How to Reverse a List? but I get an even worse output. What am I doing wrong? Any help would be appreciated!
This is trickier than it looks, you're trying to do a "deep reverse" on a list of lists, not only the elements are reversed, but also the structure … here, try this:
(define (rev l)
(let loop ((lst l)
(acc '()))
(cond ((null? lst) acc)
((not (pair? lst)) lst)
(else (loop (cdr lst)
(cons (rev (car lst))
acc))))))
It works as expected:
(rev '(a ((b) (c d) (((e))))))
=> '(((((e))) (d c) (b)) a)
This code will do it:
(define (rev-list lst)
(if (null? lst)
null
(if (list? lst)
(append (rev-list (cdr lst)
(list (rev-list (car lst))))
lst)))
And the result is:
>>> (display (rev-list '((1 7) 5 (2 4 (5 9))) ))
(((9 5) 4 2) 5 (7 1))
The idea is simple: Return the arg if it's not a list, return rev-list(arg) otherwise.

Preorder Notation in Scheme

Assume that my "map-diff" function works properly for the following code. I am wondering how to take an arithmetic parse tree and output it in preorder notation. I want to be able to use my "map-diff" function inside my "preorder" function, but I can't figure out how to go about doing this. Are my base cases here correct?
(define (make-tree value left right) (list value left right))
(define (value tree) (car tree))
(define (left tree) (cadr tree))
(define (right tree) (caddr tree))
(define (prepare x)
(cond ((number? x) (number->string x))
((char? x) (string x))))
(define x
(map-diff (lambda (x) (prepare x))
(list #\+
(list #\*
(list 3 '() '())
(list 9 '() '()))
(list #\+
(list #\/ (list 5 '() '()) '())
(list 4 '() '())))))
(define (preorder T)
(cond ((null? T) "")
((eq? (value T) "+")
(cons (value T) (cons (preorder (left T)) (preorder (right T)))))
((eq? (value T) "*")
(cons (value T) (cons (preorder (left T)) (preorder (right T)))))
((eq? (value T) "-")
(cons "-" (preorder (left T))))
((eq? (value T) "/")
(cons "/" (preorder (left T))))
(else (value T))))
(preorder x)
First , don't mix your ADT and primative types together. If you define an ADT stick with it thoughout the program. X should be defined in terms of make-tree rather than list). And make-tree rather than cons in preorder. The way you have it now your going to get a dotted list as output rather than a nice proper list form.
I'm not sure what your trying to do with prepare, casting things to strings to parse them is fairly unusual, considering lisps dynamic typing.
Anyways here is one possibility
(define (preorder T)
(let ((top (prepare (value T))))
(cond ((null? T) "")
((eq? top "+")
(cons top (cons (preorder (left T)) (preorder (right T)))))
((eq? top "*")
(cons top (cons (preorder (left T)) (preorder (right T)))))
((eq? top "-")
(cons "-" (preorder (left T))))
((eq? top "/")
(cons "/" (preorder (left T))))
(else top)))
;; helper
(define (list-ref-at n)
(lambda (l) (list-ref l n)))
;; node data type
(define (make-node value left right)
`(NODE ,value ,left ,right))
(define node-value (list-ref-at 1))
(define node-left (list-ref-at 2))
(define node-right (list-ref-at 3))
;; leaf data type (as special node)
(define (make-leaf value)
(make-node value '() '()))
(define (node-is-leaf? node)
(and (null? (node-left node))
(null? (node-right node))))
;; convert to list
(define (node->preorder-list node)
(if (node-is-leaf? node)
(node-value node)
(let ((v (node-value node))
(l (node-left node))
(r (node-right node)))
(assert (not (null? l)))
(if (null? r)
(list v (node->preorder-list l)) ; unop
(list v (node->preorder-list l) (node->preorder-list r)))))) ;binop
;; test
> (define x (make-node '* (make-node '+ (make-leaf 1) (make-leaf 2)) (make-leaf 10))
> (node->preorder-list x)
(* (+ 1 2) 10)
> (set! x (make-node '- x '()))
> (node->preorder-list x)
(- (* (+ 1 2) 10))

Resources