I am trying to write scheme code (DrRaket or MIT) that remove left and right children if they are null.
;;definition of make-tree;;
(define (make-tree entry left right)
(list entry left right))
;;input tree;;
(define tree (8 (5 (2 () ()) (4 () ())) (3 () (10 () ()))))
if I do (print tree) suppose to change the input tree to
;;expected output;;
(8 (5 (2)(4)) (3 () (10)))
;;
(define (print tree)
(cond ((and (null? (cadr tree)) (null? (caddr tree)))
(cons (car tree) '())
(make-tree (car tree) (cadr tree) (caddr tree))
(print tree)
)))
But I get linefeed after attempting (print tree). Could someone help me get the expected output?
In reply to soegaard 33's solution
(define (prune tree)
(cond tree
((list x '() '()) (list x))
((list x left '()) (list (prune left) (list x)))
((list x '() right) (list (list x) (prune right)))
((list x left right) (make-tree x (prune left) (prune right)))))
Output
Welcome to DrRacket, version 6.1.1 [3m].
Language: R5RS; memory limit: 128 MB.
. tree: bad syntax in: tree
>
This solution uses match from Racket.
(define (prune tree)
(match tree
[(list x '() '()) (list x)]
[(list x left '()) (list (prune left) (list x))]
[(list x '() right) (list (list x) (prune right))]
[(list x left right) (make-tree x (prune left) (prune right))]))
The tree has four different shapes.
Each clause handles a different shape.
If you can't use match change it to a cond with four cases.
Update:
(match tree
((list x '() '()) (list x))
...
...)
becomes
(cond
((and (list? tree)
(null? (cadr tree)) ; the second element is '()
(null? (caddr tree))) ; the third element is '()
(list x))
...
...)
Related
I am trying to solve the exercise 2.20 from SICP book. The exercise -
Write a procedure same-parity that takes one or more integers and returns a list of
all the arguments that have the same even-odd parity as the first argument. For example,
(same-parity 1 2 3 4 5 6 7)
(1 3 5 7)
(same-parity 2 3 4 5 6 7)
(2 4 6)
My code -
(define same-parity (lambda (int . l)
(define iter-even (lambda (l2 rl)
(cons ((null? l2) rl)
((even? (car l2))
(iter-even (cdr l2) (append rl (car l2))))
(else (iter-even (cdr l2) rl)))))
(define iter-odd (lambda (l2 rl)
(cons ((null? l2) rl)
((odd? (car l2))
(iter-odd (cdr l2) (append rl (car l2))))
(else (iter-odd (cdr l2) rl)))))
(if (even? int) (iter-even l (list int))
(iter-odd l (list int)))))
For some reason I am getting an error saying "The object (), passed as the first argument to cdr, is not the correct type". I tried to solve this for more than two hours, but I cant find any reason why it fails like that. Thanks for hlep.
Try this:
(define same-parity
(lambda (int . l)
(define iter-even
(lambda (l2 rl)
(cond ((null? l2) rl)
((even? (car l2))
(iter-even (cdr l2) (append rl (list (car l2)))))
(else (iter-even (cdr l2) rl)))))
(define iter-odd
(lambda (l2 rl)
(cond ((null? l2) rl)
((odd? (car l2))
(iter-odd (cdr l2) (append rl (list (car l2)))))
(else (iter-odd (cdr l2) rl)))))
(if (even? int)
(iter-even l (list int))
(iter-odd l (list int)))))
Explanation:
You are using cons instead of cond for the different conditions
in the part where append is called, the second argument must be a proper list (meaning: null-terminated) - but it is a cons-pair in your code. This was causing the error, the solution is to simply put the second element inside a list before appending it.
I must say, using append to build an output list is frowned upon. You should try to write the recursion in such a way that cons is used for creating the new list, this is more efficient, too.
Some final words - as you're about to discover in the next section of SICP, this problem is a perfect fit for using filter - a more idiomatic solution would be:
(define (same-parity head . tail)
(if (even? head)
(filter even? (cons head tail))
(filter odd? (cons head tail))))
First, I check the first element in the list. If it is even, I call the procedure that forms a list out of only the even elements. Else, I call the procedure that forms a list out of odd elements.
Here's my code
(define (parity-helper-even B)(cond
((= 1 (length B)) (cond
((even? (car B)) B)
(else '())
))
(else (cond
((even? (car B)) (append (list (car B)) (parity-helper-even (cdr B))))
(else (parity-helper-even(cdr B)))
))))
(define (parity-helper-odd B)(cond
((= 1 (length B)) (cond
((odd? (car B)) B)
(else '())
))
(else (cond
((odd? (car B)) (append (list (car B)) (parity-helper-odd (cdr B))))
(else (parity-helper-odd (cdr B)))
))))
(define (same-parity first . L) (cond
((even? first) (parity-helper-even (append (list first) L)))
(else (parity-helper-odd (append (list first) L)))))
(same-parity 1 2 3 4 5 6 7)
;Output (1 3 5 7)
While you are traversing the list, you might as well just split it into even and odd parities. As the last step, choose the one you want.
(define (parities args)
(let looking ((args args) (even '()) (odd '()))
(if (null? args)
(values even odd)
(let ((head (car args)))
(if (even? head)
(looking (cdr args) (cons head even) odd)
(looking (cdr args) even (cons head odd)))))))
(define (same-parity head . rest)
(let-values ((even odd) (parities (cons head rest)))
(if (even? head)
even
odd)))
Except for homework assignments, if you are going to look for one then you are likely to need the other. Said another way, you'd find yourself using parities more frequently in practice.
You could simply filter elements by parity of first element:
(define (same-parity x . y)
(define (iter z filter-by)
(cond ((null? z) z)
((filter-by (car z))
(cons (car z) (iter (cdr z) filter-by)))
(else (iter (cdr z) filter-by))))
(iter (cons x y) (if (even? x) even? odd?)))
And try:
(same-parity 1 2 3 4 5 6 7)
(same-parity 2 3 4 5 6 7)
Using the string "ABCDEFGHIJKLMNOPQRSTUVWXYZ". Initially starting on the index "0" of the alphabet, I am to keep track of each time the "planchette" moves left or right. If the planchette hovers, then I am to record that letter. I am to use string-length, string-ref, and list->string in my function.
(define alphabet "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
(trace-define ouija
(lambda (ls1 ls2)
(ouija-help ls1 alphabet 0)))
(trace-define ouija-help
(lambda (ls1 ls2 x)
(cond
[(and (equal? (car ls1) 'left) (equal? (string-ref ls2 x) 'a)) (list->string (cons 'a (ouija-help (cdr ls1) ls2 x)))]
[(and (equal? (car ls1) 'right) (equal? (string-ref ls2 x) 'z)) (list->string (cons 'z (ouija-help (cdr ls1) ls2 x)))]
[(equal? (car ls1) 'right) (string-ref (string-ref ls2 x) (+ x 1))]
[(equal? (car ls1) 'left) (string-ref (string-ref ls2 x) (+ x 1))]
[(equal? (car ls1) 'hover) (list->string (cons (string-ref ls2 x) (ouija-help (cdr ls1) ls2 x)))]
)))
Examples of correct input/output:
~ (ouija '() alphabet)
""
~(ouija '(hover) alphabet)
"A"
~(ouija '(right hover hover hover hover hover) alphabet)
"BBBBB"
~(ouija '(hover right hover right hover) alphabet)
"ABC"
~(ouija '(right right right hover left hover left hover right hover) alphabet)
"DCBC"
I would go for something like this:
(define (ouija actions board)
(define imax (- (string-length board) 1))
(define (helper actions i)
(if (null? actions)
'()
(case (car actions)
((hover) (cons (string-ref board i) (helper (cdr actions) i)))
((left) (helper (cdr actions) (if (> i 0) (- i 1) i)))
((right) (helper (cdr actions) (if (< i imax) (+ i 1) i))))))
(list->string (helper actions 0)))
or
(define helper
(lambda (actions board i)
(if (null? actions)
'()
(case (car actions)
((hover) (cons (string-ref board i) (helper (cdr actions) board i)))
((left) (helper (cdr actions) board (if (> i 0) (- i 1) i)))
((right) (helper (cdr actions) board (if (< i (- (string-length board) 1)) (+ i 1) i)))))))
(define ouija
(lambda (actions board)
(list->string (helper actions board 0))))
Here is another way that is commonly used when implementing the tapes of Turing machines:
Turn the alphabet into a list and then take off the car and cdr splitting the list into three parts: left, center, right; thus unzipping the list. The actions effect the list in the same way as a list zipper.
Note that there are no indexes or even numbers.
(define (ouija-helper actions left center right)
(if (null? actions)
'()
(case (car actions)
((hover) (cons center (ouija-helper (cdr actions) left center right)))
((left) (if (null? left)
(ouija-helper (cdr actions) left center right)
(ouija-helper (cdr actions) (cdr left) (car left) (cons center right))))
((right) (if (null? right)
(ouija-helper (cdr actions) left center right)
(ouija-helper (cdr actions) (cons center left) (car right) (cdr right)))))))
(define (ouija actions alphabet)
(let ((alphabet (string->list alphabet)))
(list->string (ouija-helper actions '() (car alphabet) (cdr alphabet)))))
Don't process the alphabet as you walk the 'hover' list; instead think of the 'hover' list as producing indices based on left -> subtract one and right -> add one. With this the top-level function wold be:
(define ouija
(lambda (actions alphabet)
(list->string (map (lambda (index) (string-ref alphabet index))
(actions->indices actions 0)))))
Now, walk the actions to create a list of indices after adding or subtracting.
(define actions->indices
(lambda (actions index)
(if (null? actions)
'()
(let ((rest (cdr actions)))
(case (car actions)
((hover) (cons index (actions->indices rest index)))
((left ) (actions->indices rest (- index 1)))
((right) (actions->indices rest (+ index 1))))))))
> (actions->indices '(hover hover) 0)
(0 0)
> (actions->indices '(hover right left hover) 0)
(0 0)
> (actions->indices '(right right hover right right hover) 0)
(2 4)
And then finally:
> (ouija '(hover right right hover) "ABCDEF")
"AC"
I'm making a program that takes a tree and randomly picks a branch (left or right) and returns those values in a list. For some reason it's not working. Any help?
Example:
~(rand-walk (tree 1 (leaf 2) (leaf 3)))
(1 2)
This is what I have so far:
(define (rand-walk tr)
(if (empty-tree? tr) '()
(if (leaf? tr) tr
(if (equal? (random 1) 0)
(cons ((root-value tr)(root-value (left-subtree tr))) '())
(cons ((root-value tr)(root-value (right-subtree tr))) '())))))
You got a number of problems in your code. Here is a proper implementation:
(define (rand-walk tr)
(cond ((empty-tree? tr) '())
((leaf? tr) (list (root-value tr)))
((equal? (random 1) 0)
(cons (root-value tr) (rand-walk (left-subtree tr))))
(else
(cons (root-value tr) (rand-walk (right-subtree tr))))))
If I was writing this I would use a tail recursive approach as:
(define (rand-walk tr)
(assert (not (empty-tree? tr)))
(let walking ((l '()) (tr tr))
(let ((value (root-value tr)))
(if (leaf? tr)
(reverse (cons value l))
(walking (cons value l))
((if (zero? (random 1)) left-subtree right-subtree) tr))))))
Disclaimer: I have never written in Scheme, but I had a brief encounter with LISP about 15 years ago =)
Your recursive part isn't recursive. You should be calling rand-walk on the subtree and consing that.
(cons ((root-value tr)(rand-walk (left-subtree tr))) '())
(cons ((root-value tr)(rand-walk (right-subtree tr))) '())))))
If you want to traverse it then you should return a list when you reach a leaf:
(if (leaf? tr) (cons tr '())
And in you recursive steps you should cons with some recursive call:
(cons (root-value tr) (rand-walk (left-subtree tr)))
In an application I'm working on in Racket I need to take a list of numbers and partition the list into sub-lists of consecutive numbers:
(In the actual application, I'll actually be partitioning pairs consisting of a number and some data, but the principle is the same.)
i.e. if my procedure is called chunkify then:
(chunkify '(1 2 3 5 6 7 9 10 11)) -> '((1 2 3) (5 6 7) (9 10 11))
(chunkify '(1 2 3)) -> '((1 2 3))
(chunkify '(1 3 4 5 7 9 10 11 13)) -> '((1) (3 4 5) (7) (9 10 11) (13))
(chunkify '(1)) -> '((1))
(chunkify '()) -> '(())
etc.
I've come up with the following in Racket:
#lang racket
(define (chunkify lst)
(call-with-values
(lambda ()
(for/fold ([chunk '()] [tail '()]) ([cell (reverse lst)])
(cond
[(empty? chunk) (values (cons cell chunk) tail)]
[(equal? (add1 cell) (first chunk)) (values (cons cell chunk) tail)]
[else (values (list cell) (cons chunk tail))])))
cons))
This works just fine, but I'm wondering given the expressiveness of Racket if there isn't a more straightforward simpler way of doing this, some way to get rid of the "call-with-values" and the need to reverse the list in the procedure etc., perhaps some way comepletely different.
My first attempt was based very loosely on a pattern with a collector in "The Little Schemer" and that was even less straightforward than the above:
(define (chunkify-list lst)
(define (lambda-to-chunkify-list chunk) (list chunk))
(let chunkify1 ([list-of-chunks '()]
[lst lst]
[collector lambda-to-chunkify-list])
(cond
[(empty? (rest lst)) (append list-of-chunks (collector (list (first lst))))]
[(equal? (add1 (first lst)) (second lst))
(chunkify1 list-of-chunks (rest lst)
(lambda (chunk) (collector (cons (first lst) chunk))))]
[else
(chunkify1 (append list-of-chunks
(collector (list (first lst)))) (rest lst) list)])))
What I'm looking for is something simple, concise and straightforward.
Here's how I'd do it:
;; chunkify : (listof number) -> (listof (non-empty-listof number))
;; Split list into maximal contiguous segments.
(define (chunkify lst)
(cond [(null? lst) null]
[else (chunkify/chunk (cdr lst) (list (car lst)))]))
;; chunkify/chunk : (listof number) (non-empty-listof number)
;; -> (listof (non-empty-listof number)
;; Continues chunkifying a list, given a partial chunk.
;; rchunk is the prefix of the current chunk seen so far, reversed
(define (chunkify/chunk lst rchunk)
(cond [(and (pair? lst)
(= (car lst) (add1 (car rchunk))))
(chunkify/chunk (cdr lst)
(cons (car lst) rchunk))]
[else (cons (reverse rchunk) (chunkify lst))]))
It disagrees with your final test case, though:
(chunkify '()) -> '() ;; not '(()), as you have
I consider my answer more natural; if you really want the answer to be '(()), then I'd rename chunkify and write a wrapper that handles the empty case specially.
If you prefer to avoid the mutual recursion, you could make the auxiliary function return the leftover list as a second value instead of calling chunkify on it, like so:
;; chunkify : (listof number) -> (listof (non-empty-listof number))
;; Split list into maximal contiguous segments.
(define (chunkify lst)
(cond [(null? lst) null]
[else
(let-values ([(chunk tail) (get-chunk (cdr lst) (list (car lst)))])
(cons chunk (chunkify tail)))]))
;; get-chunk : (listof number) (non-empty-listof number)
;; -> (values (non-empty-listof number) (listof number))
;; Consumes a single chunk, returns chunk and unused tail.
;; rchunk is the prefix of the current chunk seen so far, reversed
(define (get-chunk lst rchunk)
(cond [(and (pair? lst)
(= (car lst) (add1 (car rchunk))))
(get-chunk (cdr lst)
(cons (car lst) rchunk))]
[else (values (reverse rchunk) lst)]))
I can think of a simple, straightforward solution using a single procedure with only primitive list operations and tail recursion (no values, let-values, call-with-values) - and it's pretty efficient. It works with all of your test cases, at the cost of adding a couple of if expressions during initialization for handling the empty list case. It's up to you to decide if this is concise:
(define (chunkify lst)
(let ((lst (reverse lst))) ; it's easier if we reverse the input list first
(let loop ((lst (if (null? lst) '() (cdr lst))) ; list to chunkify
(cur (if (null? lst) '() (list (car lst)))) ; current sub-list
(acc '())) ; accumulated answer
(cond ((null? lst) ; is the input list empty?
(cons cur acc))
((= (add1 (car lst)) (car cur)) ; is this a consecutive number?
(loop (cdr lst) (cons (car lst) cur) acc))
(else ; time to create a new sub-list
(loop (cdr lst) (list (car lst)) (cons cur acc)))))))
Yet another way to do it.
#lang racket
(define (split-between pred xs)
(let loop ([xs xs]
[ys '()]
[xss '()])
(match xs
[(list) (reverse (cons (reverse ys) xss))]
[(list x) (reverse (cons (reverse (cons x ys)) xss))]
[(list x1 x2 more ...) (if (pred x1 x2)
(loop more (list x2) (cons (reverse (cons x1 ys)) xss))
(loop (cons x2 more) (cons x1 ys) xss))])))
(define (consecutive? x y)
(= (+ x 1) y))
(define (group-consecutives xs)
(split-between (λ (x y) (not (consecutive? x y)))
xs))
(group-consecutives '(1 2 3 5 6 7 9 10 11))
(group-consecutives '(1 2 3))
(group-consecutives '(1 3 4 5 7 9 10 11 13))
(group-consecutives '(1))
(group-consecutives '())
I want to play.
At the core this isn't really anything that's much different from what's
been offered but it does put it in terms of the for/fold loop. I've
grown to like the for loops as I think they make for much
more "viewable" (not necessarily readable) code. However, (IMO --
oops) during the early stages of getting comfortable with
racket/scheme I think it's best to stick to recursive expressions.
(define (chunkify lst)
(define-syntax-rule (consecutive? n chunk)
(= (add1 (car chunk)) n))
(if (null? lst)
'special-case:no-chunks
(reverse
(map reverse
(for/fold ([store `((,(car lst)))])
([n (cdr lst)])
(let*([chunk (car store)])
(cond
[(consecutive? n chunk)
(cons (cons n chunk) (cdr store))]
[else
(cons (list n) (cons chunk (cdr store)))])))))))
(for-each
(ƛ (lst)
(printf "input : ~s~n" lst)
(printf "output : ~s~n~n" (chunkify lst)))
'((1 2 3 5 6 7 9 10 11)
(1 2 3)
(1 3 4 5 7 9 10 11 13)
(1)
()))
Here's my version:
(define (chunkify lst)
(let loop ([lst lst] [last #f] [resint '()] [resall '()])
(if (empty? lst)
(append resall (list (reverse resint)))
(begin
(let ([ca (car lst)] [cd (cdr lst)])
(if (or (not last) (= last (sub1 ca)))
(loop cd ca (cons ca resint) resall)
(loop cd ca (list ca) (append resall (list (reverse resint))))))))))
It also works for the last test case.
I have a deep reverse for a basic tree data structure in Scheme
(define (deep-reverse t)
(cond ((null? t) '())
((not (pair? t)) t)
(else (cons (deep-reverse (cdr t)) (deep-reverse (car t))))))
(define stree (cons (list 1 2) (list 3 4)))
1 ]=> (deep-reverse stree)
;Value: (((() . 4) . 3) (() . 2) . 1)
I feel like a cleaner, better result would be:
(4 3 (2 1))
Can anyone provide some guidance as to where I'm going wrong in my deep-reverse function? Thank you.
It's better to split the task into simple operations instead of trying to do all at once. What you want to achieve can be described like this: Reverse the current list itself, then deep-reverse all sublists in it (or the other way round, the order of the two steps doesn't really matter. I choose this order because it results in nicer formatting of the source code).
Now, there already is a function in the standard library for simply reversing a list, reverse. So all you need to do is to combine that with the recursion on those elements that are sublists:
(define (deep-reverse t)
(map (lambda (x)
(if (list? x)
(deep-reverse x)
x))
(reverse t)))
Try this:
(define (deep-reverse t)
(let loop ((t t)
(acc '()))
(cond ((null? t) acc)
((not (pair? t)) t)
(else (loop (cdr t)
(cons (loop (car t) '()) acc))))))
Call it like this:
(define stree (cons (list 1 2) (list 3 4)))
(deep-reverse stree)
> (4 3 (2 1))
For creating a reversed list, one technique is to accumulate the answer in a parameter (I usually call it acc). Since we're operating on a list of lists, the recursion has to be called on both the car and the cdr part of the list. Lastly, I'm using a named let as a shorthand for avoiding the creation of an extra function, but the same result could be obtained by defining a helper function with two parameters, the tree and the accumulator:
(define (deep-reverse t)
(aux t '()))
(define (aux t acc)
(cond ((null? t) acc)
((not (pair? t)) t)
(else (aux (cdr t)
(cons (aux (car t) '()) acc)))))
I think it better to reverse a list based on its element count:
an empty list is reverse, a single element list is also reverted, more than 1 element is concatenation of the reverse of tail and head.
(defun deep-reverse (tree)
(cond ((zerop (length tree)) nil)
((and (= 1 (length tree)) (atom (car tree))) tree)
((consp (car tree)) (append (deep-reverse (cdr tree))
(list (deep-reverse (car tree)))))
(t (append (deep-reverse (cdr tree)) (list (car tree))))))
The following worked for me:
(define (deep-reverse tree)
(define (deep-reverse-iter items acc)
(cond
((null? items) acc)
((not (pair? items)) items)
(else (deep-reverse-iter
(cdr items)
(cons (deep-reverse (car items)) acc)))))
(deep-reverse-iter tree ()))
(define x (list (list 1 2) (list 3 4 (list 5 6))))
(newline)
(display (deep-reverse x))
It prints (((6 5) 4 3) (2 1)) as expected and uses the minimum of standard library functions: pair? to check if the tree is a cons and null? to check for an empty tree/list.
This solution for trees is a generalization of the reverse function for lists:
(define (reverse items)
(define (reverse-iter items acc)
(cond
((null? items) acc)
((not (pair? items)) items)
(else (reverse-iter (cdr items) (cons (car items) acc)))))
(reverse-iter items ()))
the difference being that deep-reverse is also applied to car items