So I am trying to write a function that will calculate the root of a binary tree in scheme. The root is calculated by the following criteria: the value at the root is the maximum of the values at its two children, where each of those values is the minimum for its two children, etc. Alternating between maximizing the children and minimizing the children.
so (TREEMAX '((3 (2 5)) (7 (2 1))) would return 3, because 5 is the max of 2 and 5. 3 is the minimum of 3 and 5. 2 is the max of 2 and 1. 2 is the min of 7 and 2. And finally to get root 3 is the max of 3 and 2. The code I have so far is as follows:
(define TREEMAX
(lambda (a)
(cond ((list? (car a)) TREEMIN (car a))
((list? (cdr a)) TREEMIN (cdr a))
((> (car a) (cdr a)) (car a))
(#t (cdr b)))))
(define TREEMIN
(lambda (a)
(cond ((list? (car a)) TREEMAX (car a))
((list? (cdr a)) TREEMAX (cdr a))
((< (car a) (cdr a)) (car a))
(#t (cdr b)))))
But my code is not returning the right number. Where could I be going wrong?
If I understand your description correctly, this should do:
(define (root lst (res null) (maxmin #t))
(if (null? lst)
(apply (if maxmin max min) res)
(let ((c (car lst)))
(root (cdr lst)
(cons (if (list? c) (root c null (not maxmin)) c) res)
maxmin))))
then
> (root '((3 (2 5)) (7 (2 1))))
3
> (root '((3 (2 (1 5))) (7 ((2 7) 1))))
2
> (root '(1 2))
2
To see how it works, here's a version with a debugging printf:
(define (root lst (res null) (maxmin #t))
(if (null? lst)
(let* ((op (if maxmin max min)) (vl (apply op res)))
(printf "~a ~a = ~a\n" op res vl)
vl)
(let ((c (car lst)))
(root (cdr lst)
(cons (if (list? c) (root c null (not maxmin)) c) res)
maxmin))))
which outputs, for your example:
#<procedure:max> (5 2) = 5
#<procedure:min> (5 3) = 3
#<procedure:max> (1 2) = 2
#<procedure:min> (2 7) = 2
#<procedure:max> (2 3) = 3
When you apply the function car you use (car a) but when you apply the function TREEMAX you use TREEMAX (car a)?
The syntax of your code is wrong; you were unlucky that the errors are not flagged as syntax errors. Here is a fix:
(define TREEMAX
(lambda (a)
(cond ((list? (car a)) (TREEMIN (car a)))
((list? (cdr a)) (TREEMIN (cdr a)))
((> (car a) (cdr a)) (car a))
(else (cdr b))))
No idea if this solves your specific problem, but at least you'll be able to trust the computed value.
Related
I am writing a scheme program that takes two lists and displays the union of the lists. This is my code.
(define (union a b)
(cond ((null? b) a)
((element? (car b) a)
(union a (cdr b)))
(else (union (cons (car b) a) (cdr b)))))
When I go to call the method using (union '(1 2 3) '(2 4 2))I get an error that reads
Exception: variable element? is not bound.
What am I doing wrong when I call the method? Thank you.
It only means that definition of "element?" is not found. Replacing it with "member" (a built-in function in Racket) makes it work:
(define (union a b)
(cond ((null? b) a)
((member (car b) a)
(union a (cdr b)))
(else (union (cons (car b) a) (cdr b)))))
(union '(1 2 3) '(2 4 2))
Output:
'(4 1 2 3)
I'm working on sorting a list of lists by their first element for example
(sort (list '(2 1 6 7) '(4 3 1 2 4 5) '(1 1))))
expected output => ('(1 1) '(2 1 6 7) '(4 3 1 2 4 5))
The algorithm I used is bubble sort. And I modified it to deal with lists. However, the code doesn't compile. The error is
mcar: contract violation
expected: mpair?
given: 4
Can someone correct my code and explain it. Thank you
(define (bubble L)
(if (null? (cdr L))
L
(if (< (car (car L)) (car (cadr L)))
(list (car L)
(bubble (car (cdr L))))
(list (cadr L)
(bubble (cons (car (car L)) (car (cddr L))))))))
(define (bubble-sort N L)
(cond ((= N 1) (bubble L))
(else
(bubble-sort (- N 1) (bubble L)))))
(define (bubble-set-up L)
(bubble-sort (length L) L))
(define t3 (list '(2 1 6 7) '(4 3 1 2 4 5) '(1 2 3) '(1 1)))
(bubble-set-up t3)
How about (sort (lambda (x y)(< (car x)(car y))) <YOUR_LIST>)?
I have fixed a few mistakes. There is at least one mistake left.
Consider the case where L only contains one element.
#lang r5rs
(define (bubble L)
(if (null? (cdr L))
L
(if (< (car (car L)) (car (cadr L)))
(cons (car L)
(bubble (cdr L)))
(cons (cadr L)
(bubble (cons (car L) (cddr L)))))))
(define (bubble-sort N L)
(cond ((= N 1) (bubble L))
(else
(bubble-sort (- N 1) (bubble L)))))
(define (bubble-set-up L)
(bubble-sort (length L) L))
(define t3 (list '(2 1 6 7) '(4 3 1 2 4 5) '(1 2 3) '(1 1)))
(display (bubble-set-up t3))
(newline)
I want to show the last appearance of an element from a given list. For example: For the list '(1 1 2 1 3 3 4 3 5 6), the result will be '(2 1 4 3 5 6)
This is the code I have:
(define (func L res)
(if (not (null? L))
(foldl (lambda (e)
(if (not (member e (cdr L)))
(cons e (remove-duplicates-right (cdr L)))
(remove-duplicates-right (cdr L))))
res L)
res))
(define (show-last-app L)
(func L '()))
The next error occurs: "foldl: given procedure does not accept 2 arguments"
This is how I solved it only with recursion but I want to use only foldl or filter and don't use functions with side effects:
(define (show-last-app L)
(cond
((null? L)
'())
((not (member (car L) (cdr L)))
(append (list (car L)) (show-last-app (cdr L))))
(else (show-last-app (cdr L)))))
I think you misunderstand how folds work in Scheme. This is closer to what you were aiming for:
(define (show-last-app L)
(foldr (lambda (e acc)
(if (not (member e acc))
(cons e acc)
acc))
'()
L))
If you really, really have to use foldl:
(define (show-last-app L)
(foldl (lambda (e acc)
(if (not (member e acc))
(cons e acc)
acc))
'()
(reverse L)))
Either way, it works as expected:
(show-last-app '(1 2 4 1 5 3 1 6 2))
=> (4 5 3 1 6 2)
(define unzip (lambda (l)
(define front (lambda (a)
(if (null? a)
'()
(cons (car (car a)) (unzip (cdr a)))
)))
(define back (lambda (b)
(if (null? b)
'()
(cons (car (cdr (car b))) (unzip (cdr b)))
)))
(list (front l) (back l))))
(unzip '((1 2) (3 4) (5 6)))
this call is supposed to return ((1 3 5) (2 4 6))
and if I replace the last line of code "(list (front l) (back l)) with just (front l) or (back l) i get the correct lists but i cant seem to put them together it justs keeps spitting out weird outputs every time i try.
Your code structure is very unconventional and I suspect you're rather new to scheme/racket. Your procedure can be written in a much more idiomatic way.
The first criticism I'd probably make about your code is that it makes the assumption that the lists you're unzipping will only have 2 elements each.
What about unzipping 3 lists of 5 elements or 5 lists of 3 elements ?
What about unzipping 4 lists of 4 elemens ?
What about unzipping 1 list of 7 elements or 7 lists of 1 element ?
What about unzipping nothing ?
These questions all point to a fundamental concept that helps shape well-structured procedures:
"What is a "total" procedure ?"
A total procedure is one that is defined for all values of an accepted type. What that means to us is that, if we write an unzip procedure, it should
accept an empty list
accept any number of lists
accept lists of any length1
Let's take a look at an unzip procedure that does that now. It's likely this procedure can be improved, but at the very least, it's easy to read and comprehend
(define (unzip xs (ys empty))
; if no xs are given, return ys
(cond [(empty? xs) empty]
; if the first input is empty, return the final answer; reversed
[(empty? (car xs)) (reverse ys)]
; otherwise, unzip the tail of each xs, and attach each head to ys
[else (unzip (map cdr xs) (cons (map car xs) ys))]))
(unzip '((1 2) (3 4) (5 6)))
; => '((1 3 5) (2 4 6))
Let's step through the evaluation.
; initial call
(unzip '((1 2) (3 4) (5 6)))
; (empty? xs) nope
; (empty? (car xs)) nope
; (unzip (map cdr xs) (cons (map car xs) ys))
; substitue values
(unzip (map cdr '((1 2) (3 4) (5 6)))
(cons (map car '((1 2) (3 4) (5 6))) empty))
; eval (map cdr xs)
(unzip '((2) (4) (6))
(cons (map car '((1 2) (3 4) (5 6))) empty))
; eval (map car xs)
(unzip '((2) (4) (6))
(cons '(1 3 5) empty))
; eval cons
; then recurse unzip
(unzip '((2) (4) (6))
'((1 3 5)))
; (empty? xs) nope
; (empty? (car xs)) nope
; (unzip (map cdr xs) (cons (map car xs) ys))
; substitue values
(unzip (map cdr '((2) (4) (6)))
(cons (map car '((2) (4) (6))) '((1 3 5))))
; eval (map cdr xs)
(unzip '(() () ())
(cons (map car '((2) (4) (6))) '((1 3 5))))
; eval (map car xs)
(unzip '(() () ())
(cons '(2 4 5) '((1 3 5))))
; eval cons
; then recurse
(unzip '(() () ())
'((2 4 5) (1 3 5)))
; (empty? xs) nope
; (empty? (car xs)) yup!
; (reverse ys)
; substituion
(reverse '((2 4 5) (1 3 5)))
; return
'((1 3 5) (2 4 5))
Here's another thing to think about. Did you notice that unzip is basically doing the same thing as zip ? Let's look at your input little closer
'((1 2)
(3 4)
(5 6))
^ ^
Look at the columns. If we were to zip these, we'd get
'((1 3 5) (2 4 6))
"Wait, so do you mean that a unzip is just another zip and vice versa ?"
Yup.
(unzip '((1 2) (3 4) (5 6)))
; => '((1 3 5) (2 4 6))
(unzip (unzip '((1 2) (3 4) (5 6))))
; '((1 2) (3 4) (5 6))
(unzip (unzip (unzip '((1 2) (3 4) (5 6)))))
; '((1 3 5) (2 4 6))
Knowing this, if you already had a zip procedure, your definition to unzip becomes insanely easy
(define unzip zip)
Which basically means:
You don't need an unzip procedure, just re-zip it
(zip '((1 2) (3 4) (5 6)))
; => '((1 3 5) (2 4 6))
(zip (zip '((1 2) (3 4) (5 6))))
; '((1 2) (3 4) (5 6))
(zip (zip (zip '((1 2) (3 4) (5 6)))))
; '((1 3 5) (2 4 6))
Anyway, I'm guessing your unzip procedure implementation is a bit of homework. The long answer your professor is expecting is probably something along the lines of the procedure I originally provided. The sneaky answer is (define unzip zip)
"So is this unzip procedure considered a total procedure ?"
What about unzipping 3 lists of 5 elements or 5 lists of 3 elements ?
(unzip '((a b c d e) (f g h i j) (k l m n o p)))
; => '((a f k) (b g l) (c h m) (d i n) (e j o))
(unzip '((a b c) (d e f) (g h i) (k l m) (n o p)))
; => '((a d g k n) (b e h l o) (c f i m p))
What about unzipping 4 lists of 4 elemens ?
(unzip '((a b c d) (e f g h) (i j k l) (m n o p)))
; => '((a e i m) (b f j n) (c g k o) (d h l p))
What about unzipping 1 list of 7 elements or 7 lists of 1 element ?
(unzip '((a b c d e f g)))
; => '((a) (b) (c) (d) (e) (f) (g))
(unzip '((a) (b) (c) (d) (e) (f) (g)))
; => '((a b c d e f g))
What about unzipping nothing ?
(unzip '())
; => '()
What about unzipping 3 empty lists ?
(unzip '(() () ()))
; => '()
1 We said that unzip should "accept lists of any length" but we're bending the rules just a little bit here. It's true that unzip accepts lists of any length, but it's also true that each list much be the same length as the others. For lists of varying length, an objective "correct" solution is not possible and for this lesson, we'll leave the behavior for mixed-length lists as undefined.
; mixed length input is undefined
(unzip '((a) (b c d) (e f))) ; => ???
A couple side notes
Things like
(car (car x))
(car (cdr (car x)))
Can be simplified to
(caar x)
(cadar x)
The following pair accessor short-hand procedures exist
caar ; (car (car x))
cadr ; (car (cdr x))
cdar ; (cdr (car x))
cddr ; (cdr (cdr x))
caaar ; (car (car (car x)))
caadr ; (car (car (cdr x)))
cadar ; (car (cdr (car x)))
caddr ; (car (cdr (cdr x)))
cdaar ; (cdr (car (car x)))
cdadr ; (cdr (car (cdr x)))
cddar ; (cdr (cdr (car x)))
cdddr ; (cdr (cdr (cdr x)))
caaaar ; (car (car (car (car x))))
caaadr ; (car (car (car (cdr x))))
caadar ; (car (car (cdr (car x))))
caaddr ; (car (car (cdr (cdr x))))
cadaar ; (car (cdr (car (car x))))
cadadr ; (car (cdr (car (cdr x))))
caddar ; (car (cdr (cdr (car x))))
cadddr ; (car (cdr (cdr (cdr x))))
cdaaar ; (cdr (car (car (car x))))
cdaadr ; (cdr (car (car (cdr x))))
cdadar ; (cdr (car (cdr (car x))))
cdaddr ; (cdr (car (cdr (cdr x))))
cddaar ; (cdr (cdr (car (car x))))
cddadr ; (cdr (cdr (car (cdr x))))
cdddar ; (cdr (cdr (cdr (car x))))
cddddr ; (cdr (cdr (cdr (cdr x))))
It is combining the lists correctly, but it's not combining the correct lists.
Extracting the local definitions makes them testable in isolation:
(define (front a)
(if (null? a)
'()
(cons (car (car a)) (unzip (cdr a)))))
(define (back b)
(if (null? b)
'()
(cons (car (cdr (car b))) (unzip (cdr b)))))
(define (unzip l)
(list (front l) (back l)))
(define test '((1 2) (3 4) (5 6)))
Test:
> (front test)
'(1 (3 (5 () ()) (6 () ())) (4 (5 () ()) (6 () ())))
> (front '((1 2)))
'(1 () ())
> (back '((1 2)))
'(2 () ())
Weird...
> (unzip '())
'(() ())
> (unzip '((1 2)))
'((1 () ()) (2 () ()))
It looks like something is correct, but the lists' tails are wrong.
If you look carefully at the definitions of front and back, they're recursing to unzip.
But they should recurse to themselves - front is the "first first" followed by the rest of the "firsts", and back is the "first second" followed by the rest of the "seconds".
unzip has nothing to do with this.
(define (front a)
(if (null? a)
'()
(cons (car (car a)) (front (cdr a)))))
(define (back b)
(if (null? b)
'()
(cons (car (cdr (car b))) (back (cdr b)))))
And now...
> (front test)
'(1 3 5)
> (back test)
'(2 4 6)
> (unzip test)
'((1 3 5) (2 4 6))
I am trying to produce a list of lists which has *.
Here is what I have so far:
(define (position loc count)
(cond [(empty? loc)empty]
[else (cons (list (first loc) count)
(position (rest loc) (add1 count)))]
))
So:
(position (string->list "**.*.***..") 0)
would produce:
(list
(list #\* 0) (list #\* 1) (list #\. 2) (list #\* 3) (list #\. 4) (list #\* 5)
(list #\* 6) (list #\* 7) (list #\. 8) (list #\. 9))
Basically I am trying to get
(list (list (list #\* 0) (list #\* 1))
(list (list #\* 3))
(list (list #\* 5)(list #\* 6) (list #\* 7)))
I thought about using foldr but not sure if that will work. Any help would be appreciated.
It's not exactly a foldr solution though, you need a function that modifies it's behaviour based on prior input in order to group the continuous star characters. Check out my use of a boolean to switch behaviour upon finding a match.
(define (combine-continuous char L)
(let loop ((L L) (acc '()) (continuing? #t))
(cond ((null? L) (list (reverse acc)))
((equal? (caar L) char)
(if continuing?
(loop (cdr L) (cons (car L) acc) #t)
(cons (reverse acc)
(loop (cdr L) (list (car L)) #t))))
(else (loop (cdr L) acc #f)))))
(combine-continuous #\* (position (string->list "**.*.***..") 0))
=->
;Value 19: (((#\* 0) (#\* 1)) ((#\* 3)) ((#\* 5) (#\* 6) (#\* 7)))