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"
Related
I'm new to Scheme, and I've hit a wall. I have my sort and average functions, and I'm trying to change a median function I found on this site. However, no matter what I try, I keep getting errors where I have more than one expression in the median function, or when I try to use sort in the median function it's "undefined".
(define (sort1 L)
(if (or (null? L) (<= (length L) 1)) L
(let loop ((l null) (r null)
(pivot (car L)) (rest (cdr L)))
(if (null? rest)
(append (append (sort1 l) (list pivot)) (sort1 r))
(if (<= (car rest) pivot)
(loop (append l (list (car rest))) r pivot (cdr rest))
(loop l (append r (list (car rest))) pivot (cdr rest)))))))
(define (avg lst)
(let loop ((count 0) (sum 0) (args lst))
(if (not (null? args))
(loop (add1 count) (+ sum (car args)) (cdr args))
(/ sum count))))
(define (median L)
(if (null? L) (error "The list is empty")
(let loop ((L1 L) (L2 L))
(cond ((null? (cdr L2)) (car L1))
((null? (cddr L2)) (list (car L1) (cadr L1)))
(else (loop (cdr L1) (cddr L2)))))))
I'm trying to edit the median function to first sort the list, and if there are an even number of elements, I need to take the average of the list, and use the element closest to the average.
Any help would be appreciated, thank you in advance.
Like I said in a comment, what you want isn't a let, it's function composition.
Your current median function is this:
(define (median L)
(if (null? L)
(error "The list is empty")
(let loop ((L1 L) (L2 L))
(cond ((null? (cdr L2)) (car L1))
((null? (cddr L2)) (list (car L1) (cadr L1)))
(else (loop (cdr L1) (cddr L2)))))))
But as Oscar Lopez pointed out, this doesn't properly compute the median. However, it does some of the work, so keep it. Rename it to median-helper or something.
(define (median-helper L)
(if (null? L)
(error "The list is empty")
(let loop ((L1 L) (L2 L))
(cond ((null? (cdr L2)) (car L1))
((null? (cddr L2)) (list (car L1) (cadr L1)))
(else (loop (cdr L1) (cddr L2)))))))
Then you can use function composition to define the "real" median function:
(define (median lst)
(median-helper (sort1 lst)))
This returns the middle element for odd-length lists, and the middle-two elements for even length lists. If this is want you wanted, great. If not, then you can fix median-helper by returning the average in the second case of the cond. So instead of (list (car L1) (cadr L1)) there, you would have (avg (list (car L1) (cadr L1))).
;; median-helper : (Listof Number) -> Number
(define (median-helper L)
(if (null? L)
(error "The list is empty")
(let loop ((L1 L) (L2 L))
(cond ((null? (cdr L2)) (car L1))
((null? (cddr L2)) (avg (list (car L1) (cadr L1))))
(else (loop (cdr L1) (cddr L2)))))))
;; median : (Listof Number) -> Number
(define (median lst)
(median-helper (sort1 lst)))
I think you're misunderstanding the definition of a median. A very simple (if not particularly efficient) implementation follows:
(define (my-sort L)
(sort L <))
(define (average x y)
(exact->inexact (/ (+ x y) 2)))
(define (median L)
(if (null? L)
(error "The list is empty")
(let* ((n (length L))
(sorted (my-sort L))
(half (quotient n 2)))
(if (odd? n)
(list-ref sorted half)
(average (list-ref sorted half)
(list-ref sorted (sub1 half)))))))
It works as defined:
(median '())
=> The list is empty
(median '(3 2 1 5 4))
=> 3
(median '(6 4 3 1 2 5))
=> 3.5
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))
...
...)
I need to write a scheme function that returns as a function which then takes another argument, eg a list and in turn return the desired result. In this example (c?r "arg") would return -- (car(cdr -- which then subsequently takes the list argument to return 2
> ((c?r "ar") '(1 2 3 4))
2
> ((c?r "ara") '((1 2) 3 4))
2
The problem I have is how can I return a function that accepts another arg in petite?
Here's how you might write such a function:
(define (c?r cmds)
(lambda (lst)
(let recur ((cmds (string->list cmds)))
(if (null? cmds)
lst
(case (car cmds)
((#\a) (car (recur (cdr cmds))))
((#\d) (cdr (recur (cdr cmds))))
(else (recur (cdr cmds))))))))
Note that I'm using d to signify cdr, not r (which makes no sense, to me). You can also write this more succinctly using string-fold-right (requires SRFI 13):
(define (c?r cmds)
(lambda (lst)
(string-fold-right (lambda (cmd x)
(case cmd
((#\a) (car x))
((#\d) (cdr x))
(else x)))
lst cmds)))
Just wanted to add my playing with this. Uses SRFI-1.
(import (rnrs)
(only (srfi :1) fold)) ;; require fold from SRFI-1
(define (c?r str)
(define ops (reverse (string->list str)))
(lambda (lst)
(fold (lambda (x acc)
((if (eq? x #\a) car cdr) ; choose car or cdr for application
acc))
lst
ops)))
Its very similar to Chris' version (more the previous fold-right) but I do the reverseso i can use fold in the returned procedure. I choose which of car or cdr to call by looking at the character.
EDIT
Here is an alternative version with much more preprocessing. It uses tail-ref and list-tail as shortcuts when there are runs of #\d's.
(define (c?r str)
(let loop ((druns 0) (ops (string->list str)) (funs '()))
(cond ((null? ops)
(let ((funs (reverse
(if (zero? druns)
funs
(cons (lambda (x)
(list-tail x druns))
funs)))))
(lambda (lst)
(fold (lambda (fun lst)
(fun lst))
lst
funs))))
((eq? (car ops) #\d) (loop (+ druns 1) (cdr ops) funs))
((= druns 0) (loop 0 (cdr ops) (cons car funs)))
(else (loop 0 (cdr ops) (cons (lambda (x)
(list-ref x druns))
funs))))))
This can be made even simpler in #!racket. we skip the reverse and just do (apply compose1 funs).
(define (c?r str)
(let loop ((druns 0) (ops (string->list str)) (funs '()))
(cond ((null? ops)
(let ((funs (if (zero? druns)
funs
(cons (lambda (x)
(list-tail x druns))
funs))))
(apply compose1 funs)))
((eq? (car ops) #\d) (loop (+ druns 1) (cdr ops) funs))
((= druns 0) (loop 0 (cdr ops) (cons car funs)))
(else (loop 0 (cdr ops) (cons (lambda (x)
(list-ref x druns))
funs))))))
Assuming a compose procedure:
(define (compose funs . args)
(if (null? funs)
(apply values args)
(compose (cdr funs) (apply (car funs) args))))
(compose (list cdr car) '(1 2 3 4))
=> 2
c?r can be defined in terms of compose like so:
(define (c?r funs)
(lambda (e)
(compose
(map
(lambda (f) (if (char=? f #\a) car cdr))
(reverse (string->list funs)))
e)))
then
((c?r "ar") '(1 2 3 4))
=> 2
((c?r "ara") '((1 2) 3 4))
=> 2
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)))
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