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)))
Related
I want to get a list which has nth version deleted from the original list. I could manage following code which is imperative:
(define (list-removeN slist n)
(define outl '())
(for ((i (length slist)))
(when (not (= i n))
(set! outl (cons (list-ref slist i) outl))))
(reverse outl))
What can be the functional equivalent of this? I tried for/list, but I have to insert #f or at that position, removing which is not ideal because #f or may occur at other positions in list also.
You can do it recursively with an accumulator. Something like
#lang racket
(define (remove-nth lst n)
(let loop ([i 0] [lst lst])
(cond [(= i n) (rest lst)]
[else (cons (first lst) (loop (add1 i) (rest lst)))])))
(remove-nth (list 0 1 2 3 4 5) 3)
(remove-nth (list 0 1 2 3) 3)
(remove-nth (list 0 1 2) 0)
This produces
'(0 1 2 4 5)
'(0 1 2)
'(1 2)
You could do it with for/list but this version traverses the list twice because of the length call.
(define (remove-nth lst n)
(for/list ([i (length lst)]
[elem lst]
#:when (not (= i n)))
elem))
There's also split-at, but again this may not be as optimal as it creates two lists and appends them.
(define (remove-nth lst n)
(let-values ([(left right) (split-at lst n)])
(append left (rest right))))
A typical roll your own implementation that is recursive and uses O(n) time and O(n) space.
(define (remove-nth lst i)
(let aux ((lst lst) (i i))
(cond ((null? lst) '()) ;; what if (< (length lst) i)
((<= i 0) (cdr lst)) ;; what if (< i 0)
(else (cons (car lst)
(aux (cdr lst) (sub1 i)))))))
A interative version that uses append-reverse from srfi-1. O(n) time and O(1) space.
(define (remove-nth lst i)
(let aux ((lst lst) (i i) (acc '()))
(cond ((null? lst) (reverse acc)) ;; what if (< (length lst) i)
((<= i 0) (append-reverse acc (cdr lst))) ;; what if (< i 0)
(else (aux (cdr lst) (sub1 i) (cons (car lst) acc))))))
tScheme novice question:
I need to determine if a list contains an even or odd amount of atoms using recursion. I know the easy way is to get list length and determine if it is even or odd, but I would like to see hows it's done using recursion.
(oddatom
(LIST 'x 'y 'v 'd 'r 'h 'y))
should return #t, while
(oddatom
'((n m) (f p) l (u k p)))
should return #f
appreciate the help.
Here's my version of the solution:
(define (oddatom? lst)
(let recur ((odd #f)
(x lst))
(cond ((null? x) odd)
((pair? x) (recur (recur odd (car x)) (cdr x)))
(else (not odd)))))
I like Chris Jester-Young's answer, but I think it's worth providing a tail-recursive version that maintains its own stack as well. Note that this is an exercise in converting non-tail recursion into tail recursion, which is an imporant technique for some algorithms in Scheme. In this case, though, it's probably not all that important, and the code in Chris Jester-Young's answer does feel much more natural. So take this as an exercise, not necessarily a significant improvement.
The idea here is that the inner function, odd?, takes a list of things, and a value indicating whether an odd number of atoms (other than the empty list) have been seen so far.
(define (oddatom? thing)
(let odd? ((things (list thing))
(result #f))
(cond
;; We're out of things to see. Did we see an odd number of things?
((null? things)
result)
;; Our list of things has the form ((x . y) …), so we recurse on
;; (x y …), with the *same* value for result, since we haven't
;; "seen" x or y yet, we've just "unwrapped" them.
((pair? (car things))
(odd? (cons (caar things) (cons (cdar things) (cdr things))) result))
;; Our list of things has the form (() …), so we recurse on
;; (…), with the *same* value for result, since we haven't "seen" any
;; additional atoms.
((null? (car things))
(odd? (cdr things) result))
;; Our list of things has the form (<atom> …), so we recurse on (…),
;; but with a flipped value for result, since we've seen one more atom.
(else
(odd? (cdr things) (not result))))))
The last two cases could be combined, making the second recursive argument based on the value of (null? (car things)) as:
(define (oddatom? thing)
(let odd? ((things (list thing))
(result #f))
(cond
((null? things)
result)
((pair? (car things))
(odd? (cons (caar things) (cons (cdar things) (cdr things))) result))
(else
(odd? (cdr things) (if (null? (car things))
result
(not result)))))))
I'd go for this:
(define (oddatom lst)
(cond
((null? lst) #f)
((not (pair? lst)) #t)
(else (not (eq? (oddatom (car lst)) (oddatom (cdr lst)))))))
which means:
the empty list is not odd (#f)
an atom is odd (#t)
otherwise, one and only one of the car or the cdr of the list may be odd (exclusive or).
Test cases (in Racket), including improper lists:
(require rackunit)
(check-equal? (oddatom (list 'x 'y 'v 'd 'r 'h 'y)) #t)
(check-equal? (oddatom '((n m) (f p) l (u k p))) #f)
(check-equal? (oddatom '(a (b) c)) #t)
(check-equal? (oddatom (cons 1 2)) #f)
(check-equal? (oddatom 1) #t)
(check-equal? (oddatom '(1 (2 . 3))) #t)
Here is one:
(define (odd-atom? obj)
(and (not (null? obj))
(or (not (pair? obj))
(let ((this? (odd-atom? (car obj)))
(rest? (odd-atom? (cdr obj))))
(or (and (not this?) rest?)
(and (not rest?) this?))))))
or, learning from #uselpa to simplify the 'or this? rest?' logic above, another one:
(define (odd-atom? obj)
(and (not (null? obj))
(or (not (pair? obj))
(not (eq? (odd-atom? (car obj))
(odd-atom? (cdr obj)))))))
If '() is an atom (like it is in CommonLisp where '() is also T), it should be (odd-atom? '(() () ())) is #t:
(define (odd-atom? obj)
(and (not (null? obj))
(or (not (pair? obj))
(let ((this? (or (null? (car obj))
(odd-atom? (car obj))))
(rest? (odd-atom? (cdr obj))))
(not (eq? this? rest?))))))
> (odd-atom? '())
#f
> (odd-atom? '(()))
#t
> (odd-atom? '(() () ()))
#t
> (odd-atom? '(() ()))
#f
> (odd-atom? '(() (a)))
#f
> (odd-atom? '(() (a b)))
#t
> (odd-atom? '((a) (a b)))
#t
> (odd-atom? '((a b) (a b)))
#f
>
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"
What it the proper way to sort a list with values in Scheme? For example I have the values which are not ordered:
x1, x5, x32 .... xn
or
3, 4, 1, 3, 4, .. 9
First I want to for them by increase number and display them in this order:
x1, xn, x2, xn-1
or
1, 6, 2, 5, 3, 4
Any help will be valuable.
This is the same question you posted before, but with a small twist. As I told you in the comments of my answer, you just have to sort the list before rearranging it. Here's a Racket solution:
(define (interleave l1 l2)
(cond ((empty? l1) l2)
((empty? l2) l1)
(else (cons (first l1)
(interleave l2 (rest l1))))))
(define (zippy lst)
(let-values (((head tail) (split-at
(sort lst <) ; this is the new part
(quotient (length lst) 2))))
(interleave head (reverse tail))))
It works as expected:
(zippy '(4 2 6 3 5 1))
=> '(1 6 2 5 3 4)
This R6RS solution does what Chris Jester-Young proposes and it really is how to do it the bad way. BTW Chris' and Óscar's solutions on the same question without sorting is superior to this zippy procedure.
#!r6rs
(import (rnrs base)
(rnrs sorting)) ; list-sort
(define (zippy lis)
(let loop ((count-down (- (length lis) 1))
(count-up 0))
(cond ((> count-up count-down) '())
((= count-up count-down) (cons (list-ref lis count-down) '()))
(else (cons (list-ref lis count-down)
(cons (list-ref lis count-up)
(loop (- count-down 1)
(+ count-up 1))))))))
(define (sort-rearrange lis)
(zippy (list-sort < lis)))
Here is a simple, tail-recursive approach that uses a 'slow/fast' technique to stop the recursion when half the list is traversed:
(define (interleave l)
(let ((l (list-sort < l)))
(let merging ((slow l) (fast l) (revl (reverse l)) (rslt '()))
(cond ((null? fast)
(reverse rslt))
((null? (cdr fast))
(reverse (cons (car slow) rslt)))
(else
(merging (cdr slow) (cddr fast) (cdr revl)
(cons (car revl) (cons (car slow) rslt))))))))
So, you don't mind slow and just want a selection-based approach, eh? Here we go....
First, we define a select1 function that gets the minimum (or maximum) element, followed by all the other elements. For linked lists, this is probably the simplest approach, easier than trying to implement (say) quickselect.
(define (select1 lst cmp?)
(let loop ((seen '())
(rest lst)
(ext #f)
(extseen '()))
(cond ((null? rest)
(cons (car ext) (append-reverse (cdr extseen) (cdr ext))))
((or (not ext) (cmp? (car rest) (car ext)))
(let ((newseen (cons (car rest) seen)))
(loop newseen (cdr rest) rest newseen)))
(else
(loop (cons (car rest) seen) (cdr rest) ext extseen)))))
Now actually do the interweaving:
(define (zippy lst)
(let recur ((lst lst)
(left? #t))
(if (null? lst)
'()
(let ((selected (select1 lst (if left? < >))))
(cons (car selected) (recur (cdr selected) (not left?)))))))
This approach is O(n²), whereas the sort-and-interleave approach recommended by everybody else here is O(n log n).
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