This function should return the transitive closure of L. For Examples:
(Transitive-Closure'((a b) (b c) (a c))) ---> '((a b) (b c) (a c))
(Transitive-Closure'((a a) (b b) (c c))) ---> '((a a) (b b) (c c))
(Transitive-Closure'((a b) (b a))) ---> '((a b) (b a) (a a) (b b)))
(Transitive-Closure'((a b) (b a) (a a)))---> '((a b) (b a) (a a) (b b))
(Transitive-Closure'((a b) (b a) (a a) (b b)))---> '((a b) (b a) (a a) (b b))
(Transitive-Closure'())---> '()
Here is what I have in Racket:
(define (Transitive-Closure L)
(apply append
; Iterate over each pair (a b) in L,
(map (lambda (x)
;Iterate over each pair (c d) in L,
(map (lambda (y)
(let ([a (car x)]
[b (cadr x)]
[c (car y)]
[d (cadr y)])
;if b equal to c, and (a d) does not exist in L, it will add (a d) to L . Otherwise, return L.
(if (and (eq? b c) (not (member (list a d) L)))
(list a d)
(append x))))L)) L)))
My code only works when it's not transitive. How can I modify my code to avoid returning duplicate pairs when it's transitive?
For example, my Output:
;This is wrong. It should return '((a b)(b c)(a c))
(Transitive-Closure '((a b)(b c)(a c))) ---> '((a b) (a b) (a b) (b c) (b c) (b c) (a c) (a c) (a c))
; This is right.
(Transitive-Closure '((a b)(b a)))---> '((a b) (a a) (b b) (b a))
This isn't a map problem this is a foldr problem because you aren't modifying the list in place, you are condensing the list down into one item. That item happens to be a list but importantly that list can be smaller than what map can return. Also you can check if you should add or not in another if statement based on if the pair already exists in our accumulator.
This works if order doesn't matter (which I am assuming, you just want the set, let me know if this is not the case)
(define (Transitive-Closure L)
; Iterate over each pair (a b) in L,
(foldr (lambda (x transitive-pairs)
;Iterate over each pair (c d) in L,
(foldr (lambda (y sofar)
(let ([a (car x)]
[b (cadr x)]
[c (car y)]
[d (cadr y)])
;if b equal to c, and (a d) does not exist in L, it will add (a d) to L . Otherwise, return L.
(cond [(and (eq? b c) (not (member (list a d) L))) (cons (list a d) sofar)]
[(not (member x sofar)) (cons x sofar)]
[else sofar])))
transitive-pairs L)) '() L))
(check-expect (Transitive-Closure '((a b) (b c) (a c))) '((a b) (b c) (a c)))
(check-expect (Transitive-Closure '((a a) (b b) (c c))) '((a a) (b b) (c c)))
(check-expect (Transitive-Closure '((a b) (b a))) '((a b) (a a) (b b) (b a)))
(check-expect (Transitive-Closure '((a b) (b a) (a a))) '((a b) (b b) (b a) (a a)))
(check-expect (Transitive-Closure '((a b) (b a) (a a) (b b))) '((a b) (b a) (a a) (b b)))
Related
I'm trying to write a scheme function that does the following (taken from SICP):
Exercise 1.3. Define a procedure that takes three numbers as arguments
and returns the sum of the squares of the two larger numbers.
Here's my attempt:
(define (square-sum-larger a b c)
(cond ((and (< a b) (< a c))) (+ (* b b) (* c c)))
(cond ((and (< b c) (< b a))) (+ (* a a) (* c c)))
(cond ((and (< c a) (< c b))) (+ (* b b) (* a a)))
)
When I enter this into the biwa scheme interpreter, I get the following:
(square-sum-larger 4 5 6)
16
Since 4 is less than 5 and 6, shouldn't the first condition be evaluated, meaning that the sum of the squares of 5 and 6 should be returned?
(define (square-sum-larger a b c)
(cond ((and (< a b) (< a c))) (+ (* b b) (* c c))) ;; this is thrown away
(cond ((and (< b c) (< b a))) (+ (* a a) (* c c))) ;; this is thrown away
(cond ((and (< c a) (< c b))) (+ (* b b) (* a a)))
)
Only the last of the three cond does anything useful; the previous cond expressions do not have any side effect, since they perform only calculations, and their value is not used. The are dead code which a Scheme compiler can eliminate entirely.
You probably wanted to combine all of the clauses into a single cond:
(define (square-sum-larger a b c)
(cond ((and (< a b) (< a c))) (+ (* b b) (* c c))
((and (< b c) (< b a))) (+ (* a a) (* c c))
((and (< c a) (< c b))) (+ (* b b) (* a a))))
(define (square-sum-larger a b c)
(cond ((and (< a b) (< a c))) (+ (* b b) (* c c)))
(cond ((and (< b c) (< b a))) (+ (* a a) (* c c)))
(cond ((and (< c a) (< c b))) (+ (* b b) (* a a)))
)
Is basically this in JS:
function squareSumLarge(a, b, c) {
// not tail position , dead code regardless if the test is truthy
if (a < b && a < c) {
b * b + c * c;
}
// not tail position , dead code regardless if the test is truthy
if (b < c && b < a) {
a * a + c * c;
}
if (c < a && c < b0 {
// return because cond is in tail position
return b * b + a * a;
} else {
// if the last cond term didn't hit it returns an implementation chosen value
return undefined;
}
}
Know that this pattern:
if (test1) {
return expression1;
} elseif (test2) {
return expression2;
} else {
return expression3;
}
is done like this with cond when the cond is in tail position:
(cond
(test1 expression1)
(test2 expression2)
(else expression3))
I am trying to implement a function called funPower, which takes a function f, an integer n and returns the function f^n. For example ((funPower sqrt 2) 16) should return 2, which is (sqrt (sqrt 16)).
This is what I have so far but it is not giving me correct output
(define (funPower f n)
(lambda(x) (if (<= n 1)
(f x)
(f (funPower f (- n 1)) x))))
First, you're missing one more pair of parens.
(define (funPower1 f n)
(lambda (x) (if (<= n 1)
(f x)
;; (f ( funPower1 f (- n 1)) x))))
(f ( ( funPower1 f (- n 1)) x)))) )
;; ^^^ ^^^
because (funPower1 f (- n 1)) returns a function to be called on x, the future argument value, as you show with the example, ((funPower sqrt 2) 16).
Second, it's <= 0, not <= 1, and the function f shouldn't be called at all in such a case:
(define (funPower2 f n)
(lambda (x) (if (<= n 0)
;; (f x) ^^^
x
(f ( ( funPower2 f (- n 1)) x)))) )
Now that it's working, we see that it defers the decisions to the final call time, of ((funPower f n) x). But it really could do all the decisions upfront -- the n is already known.
To achieve that, we need to swap the (lambda and the (funPower, to push the lambda "in". When we do, it'll become an additional argument to such augmented funPower:
(define (funPower3 f n)
(if (<= n 0) (lambda (x)
x )
(funPower3 f (- n 1) (lambda (x) (f x)))) )
Now this is completely out of sync. Where's that third argument?
(define (funPower4 f n fun)
(if (<= n 0) fun
(funPower4 f (- n 1) (lambda (x) (fun (f x)))) ))
That's a little bit better, but what's the fun, originally? Where does it come from? It must always be (lambda (x) x) at first or else it won't be right. The solution is to make it an internal definition and use that, supplying it the correct argument the first time we call it:
(define (funPower5 f n)
(define (loop n fun)
(if (<= n 0) fun
(loop (- n 1)
(lambda (x) (fun (f x))))))
(loop n (lambda (x) x)))
This kind of thing would normally be coded as a named let,
(define (funPower5 f n)
(let loop ((n n)
(fun (lambda (x) x)))
(if (<= n 0) fun
(loop (- n 1)
(lambda (x) (fun (f x)))))))
We could also try creating simpler functions in the simpler cases. For instance, we could return f itself if n is 1:
(define (funPower6 f n)
(cond
((zero? n) .....)
((= n 1) .....)
((< n 0) .....)
(else
(let loop ((n n)
(fun .....))
(if (= n .....) fun
(loop (- n 1)
(lambda (x) (fun (f x)))))))))
Complete it by filling in the blanks.
More substantive further improvement is to use exponentiation by repeated squaring -- both in constructing the resulting function, and to have it used by the function we construct!
try this:
(define funpow
(lambda (f n)
((lambda (s) (s s n (lambda (x) x)))
(lambda (s n o)
(if (zero? n)
o
(s s (- n 1)
(lambda (x)
(o (f x)))))))))
(define sqrt_2 (funpow sqrt 2))
(define pow2_2 (funpow (lambda (x) (* x x)) 2))
(sqrt_2 16)
(pow2_2 2)
I have to make a Dr. Racket program that removes letters from a list if they are following the same letter as itself. For example: (z z f a b b d d) would become
(z f a b d). I have written code for this but all it does is remove the first letter from the list.
Can anyone help?
#lang racket
(define (remove-duplicates x)
(cond ((null? x)
'())
((member (car x) (cons(car(cdr x)) '())))
(remove-duplicates (cdr x))
(else
(cons (car x) (remove-duplicates (cdr x))))))
(define x '( b c c d d a a))
(remove-duplicates x)
(define (remove-dups x)
(cond
[(empty? x) '()]
[(empty? (cdr x)) (list (car x))]
[(eq? (car x) (cadr x)) (remove-dups (cdr x))]
[else (cons (car x) (remove-dups (cdr x)))]))
(cadr x) is short for (car (cdr x)) in case you didn't know.
Also, pattern matching makes list deconstruction often much more readable. In this case not so much, but it's still better than the other version:
(define (rmv-dups x)
(match x
[(list) (list)]
[(list a) (list a)]
[(cons a (cons a b)) (rmv-dups (cdr x))]
[__ (cons (car x) (rmv-dups (cdr x)))]))
This problem will be simpler if you introduce a helper function.
I recommend something like this (where angle brackets mean you need to fill out the details):
(define (remove-duplicates x)
(cond
[ <x is empty> '()] ; no duplicates in empty list
[ <x has one element> x] ; no duplicates in a list with one element
[ <first and second element in x is equal> (cons (car x) (remove-from-front (car x) (cdr x)))]
[else (cons (car x) (remove-duplicates (cdr x)))]))
(define (remove-from-front e x)
(cond
[ <x is empty> '()] ; e is not the first element of x
[ <e equals first element of x> (remove-from-front e (cdr x))] ; skip duplicate
[else (remove-duplicates x)])) ; no more es to remove
I'm trying to implement an algorithm to multiply two bit-lists of 1s and 0s as a simulation to binary multiplication. It should return a like list, but I am having a hard time building on what I already have. Some help would be appreciated...
;;Function designed to accept two bit-list binary numbers (reverse order) and produce their product, a bitlist in reverse order.
;;Example: (multiply '(0 1 1 0 1) '(1 0 1)) should produce '(0 1 1 1 0 1 1)
(define (multiply x y)
(cond
;[(= null? y) 0]
[(zero? y) 0]
(#t (let ((z (multiply x (rest y )))) (cond
[(num_even? y) (cons 0 z)]
(#t (addWithCarry x (cons 0 z) 1)))))))
;This is to check if the current value of parameter x is the number 0
(define (zero? x)
(cond
((null? x) #t)
((=(first x) 1) #f)
(#t (zero? (rest x)))))
;This is to check if the current parameter x is 0 (even) or not.
(define (num_even? x)
(cond
[(null? x) #t]
[(=(first x) 0)#t]
[#t (num_even? (rest x))]))
;To add two binary numbers
(define(addWithCarry x y carry)
(cond
((and (null? x) (null? y)) (if (= carry 0) '( ) '(1)))
((null? x) (addWithCarry '(0) y carry))
((null? y) (addWithCarry x '(0) carry))
(#t (let ((bit1 (first x))
(bit2 (first y)))
(cond
((=(+ bit1 bit2 carry) 0) (cons 0 (addWithCarry (rest x)(rest y) 0)))
((=(+ bit1 bit2 carry) 1) (cons 1 (addWithCarry (rest x)(rest y) 0)))
((=(+ bit1 bit2 carry) 2) (cons 0 (addWithCarry (rest x)(rest y) 1)))
(#t (cons 1 (addWithCarry (rest x) (rest y) 1))))))))
Based on my previous answer for a base-10 multiplication, here's a solution that works for binary numbers (in the correct order):
(define base 2)
(define (car0 lst)
(if (empty? lst)
0
(car lst)))
(define (cdr0 lst)
(if (empty? lst)
empty
(cdr lst)))
(define (apa-add l1 l2) ; apa-add (see https://stackoverflow.com/a/19597007/1193075)
(let loop ((l1 (reverse l1))
(l2 (reverse l2))
(carry 0)
(res '()))
(if (and (null? l1) (null? l2) (= 0 carry))
res
(let* ((d1 (car0 l1))
(d2 (car0 l2))
(ad (+ d1 d2 carry))
(dn (modulo ad base)))
(loop (cdr0 l1)
(cdr0 l2)
(quotient (- ad dn) base)
(cons dn res))))))
(define (mult1 n lst) ; multiply a list by one digit
(let loop ((lst (reverse lst))
(carry 0)
(res '()))
(if (and (null? lst) (= 0 carry))
res
(let* ((c (car0 lst))
(m (+ (* n c) carry))
(m0 (modulo m base)))
(loop (cdr0 lst)
(quotient (- m m0) base)
(cons m0 res))))))
(define (apa-multi l1 l2) ; full multiplication
(let loop ((l2 (reverse l2))
(app '())
(res '()))
(if (null? l2)
res
(let* ((d2 (car l2))
(m (mult1 d2 l1))
(r (append m app)))
(loop (cdr l2)
(cons '0 app)
(apa-add r res))))))
so that
(apa-multi '(1 0 1 1 0) '(1 0 1))
=> '(1 1 0 1 1 1 0)
I need help finishing up an unzip function which takes a zipped list and returns a list of two lists. The result I want is as follows...
(unzip '((a b) (1 2)))
'((a 1) (b 2))
(unzip '((a 1) (b 2) (c 3)))
'((a b c) (1 2 3))
(unzip '(unzip '()))
'(() ())
I can get my code to work for the null case and with a list containing two lists, but I'm having a hard time figuring out how to make it recursive and work for more than 2 lists such as the second example.
(define (unzip l)
(if (null? l)
'(() ())
(map list (car l) (car (cdr l)))))
This will work fine for an empty list or two lists, but I have a hard time setting up the recursive part to work with three or possibly more lists.
This is a pretty standard operation, it's equivalent to finding the transpose of a list of lists. It's usually implemented like this:
(define (unzip lst)
(apply map list lst))
It'll work for the first two examples. The third, I believe is ill-defined, but if you want to make it work for that weird case, I'll leave that as an exercise ;)
Notice that if you unzip an unzipped list you get back the original input ... meaning that unzip is also zip!
(unzip '((a b) (1 2) (x y)))
=> '((a 1 x) (b 2 y))
(unzip '((a 1 x) (b 2 y)))
=> '((a b) (1 2) (x y))
(apply map list '((a 1) (b 2) (c 3) (d 4) (e 5)))
;Value 16: ((a b c d e) (1 2 3 4 5))
this does it. BTW the same trick does it for zipping as well, provided all the lists are of the same length:
(apply map list (list '(a b c d e) '(1 2 3 4 5)))
;Value 17: ((a 1) (b 2) (c 3) (d 4) (e 5))
Are you aware that in Scheme a function can return multiple values?
(define (unzip list)
(values (map car list)
(map cadr list)))
and then use it like this:
(let-values ([(z1 z2) (unzip '((a 1) (b 2)))])
;; Use z1 and z2
...)