Currently I have
(define filter
(λ (f xs)
(letrec [(filter-tail
(λ (f xs x)
(if (empty? xs)
x
(filter-tail f (rest xs)
(if (f (first xs))
(cons (first xs) x)
'()
)))))]
(filter-tail f xs '() ))))
It should be have as a filter function
However it outputs as
(filter positive? '(-1 2 3))
>> (3 2)
but correct return should be (2 3)
I was wondering if the code is correctly done using tail-recursion, if so then I should use a reverse to change the answer?
I was wondering if the code is correctly done using tail-recursion.
Yes, it is using a proper tail call. You have
(define (filter-tail f xs x) ...)
Which, internally is recursively applied to
(filter-tail f
(some-change-to xs)
(some-other-change-to x))
And, externally it's applied to
(filter-tail f xs '())
Both of these applications are in tail position
I should use a reverse to change the answer?
Yep, there's no way around it unless you're mutating the tail of the list (instead of prepending a head) as you build it. One of the comments you received alluded to this using set-cdr! (see also: Getting rid of set-car! and set-cdr!). There may be other techniques, but I'm unaware of them. I'd love to hear them.
This is tail recursive, requires the output to be reversed. This one uses a named let.
(define (filter f xs)
(let loop ([ys '()]
[xs xs])
(cond [(empty? xs) (reverse ys)]
[(f (car xs)) (loop (cons (car xs) ys) (cdr xs))]
[else (loop ys (cdr xs))])))
(filter positive? '(-1 2 3)) ;=> '(2 3)
Here's another one using a left fold. The output still has to be reversed.
(define (filter f xs)
(reverse (foldl (λ (x ys) (if (f x) (cons x ys) ys))
'()
xs)))
(filter positive? '(-1 2 3)) ;=> '(2 3)
With the "difference-lists" technique and curried functions, we can have
(define (fold c z xs)
(cond ((null? xs) z)
(else (fold c (c (car xs) z) (cdr xs)))))
(define (comp f g) (lambda (x) ; ((comp f g) x)
(f (g x))))
(define (cons1 x) (lambda (y) ; ((cons1 x) y)
(cons x y)))
(define (filter p xs)
((fold (lambda (x k)
(if (p x)
(comp k (cons1 x)) ; nesting's on the left
k))
(lambda (x) x) ; the initial continuation, IC
xs)
'()))
(display (filter (lambda (x) (not (zero? (remainder x 2)))) (list 1 2 3 4 5)))
This builds
comp
/ \
comp cons1 5
/ \
comp cons1 3
/ \
IC cons1 1
and applies '() to it, constructing the result list in the efficient right-to-left order, so there's no need to reverse it.
First, fold builds the difference-list representation of the result list in a tail recursive manner by composing the consing functions one-by-one; then the resulting function is applied to '() and is reduced, again, in tail-recursive manner, by virtues of the comp function-composition definition, because the composed functions are nested on the left, as fold is a left fold, processing the list left-to-right:
( (((IC+k1)+k3)+k5) '() ) ; writing `+` for `comp`
=> ( ((IC+k1)+k3) (k5 '()) ) ; and `kI` for the result of `(cons1 I)`
<= ( ((IC+k1)+k3) l5 ) ; l5 = (list 5)
=> ( (IC+k1) (k3 l5) )
<= ( (IC+k1) l3 ) ; l3 = (cons 3 l5)
=> ( IC (k1 l3) )
<= ( IC l1 ) ; l1 = (cons 1 l3)
<= l1
The size of the function built by fold is O(n), just like the interim list would have, with the reversal.
Related
The problem is when lists have a different length, any idea of how to do it?
I have to use functions like map or something like that
This is the code I wrote so far, it works with lists of the same length but it also needs to work with lists of different lengths. Thank you.
(define (interleave list1 list2)
(flatten [map (lambda (x y) (cons x (cons y null))) list1 list2]))
if lists have different length this is what I get:
map: all lists must have same size; arguments were: # '(1 2 3 4 5) '(a b c)
I'm trying to get (1 a 2 b 3 c 4 5)
#lang racket
(define (weave xs ys)
(match (list xs ys)
[(list (cons x xs) (cons y ys)) (cons x (cons y (weave xs ys)))]
[(list '() ys) ys]
[(list xs '()) xs]))
I'm assuming your desired behavior is that the lists are interleaved for as long as this is possible, and then whatever is left over from the nonempty list is appended to the end. In that case one possible implementation is
(define (interleave a b)
(if (null? a)
b
(cons (car a)
(interleave b (cdr a)))))
I think this is probably the simplest possible way to write what you're looking for.
Neither map nor fold-right would work because they either signal an error when one list is smaller than the other or they tend to stop at the shortest list. eg. SRFI-1's map (interleave '(1 2 3 4) (circular-list 9 8)) ; ==> (1 9 2 8 3 9 4 8). For a different behavior you need to roll your own.
A solution using simple list manipulation functions might be:
(define (interleave list1 list2)
(cond ((empty? list1) list2)
((empty? list2) list1)
(else
(append
(list (car list1) (car list2))
(interleave (cdr list1) (cdr list2))))))
Testing...
> (interleave '(1 2 3 4 5) '(a b c))
(1 a 2 b 3 c 4 5)
> (interleave '(1 2 3 4 5) '())
(1 2 3 4 5)
> (interleave '() '(a b c))
(a b c)
>
I think it is fairly self-documenting.
"There ain't nothin' you can't not do with fold-right and some of them con-tin-uations thingies", said a cowboy to another, spittin' into the campfire and puffin' on his cigar in the evening, sippin' his black coffee from his rugged banged up tin mug. "Yessa, nothin' in the whole darn world."
(define (interleave xs ys)
;; interleave xs ys = foldr g n xs ys
;; where
;; g x r (y:ys) = x : y : r ys
;; g x r [] = x : r []
;; n ys = ys
((foldr
(lambda (x r)
(lambda (ys)
(cond ((null? ys) (cons x (r '())))
(else (apply (lambda (y . ys)
(cons x (cons y (r ys))))
ys)))))
(lambda (ys) ys)
xs)
ys))
After figuring out the recursive version of this algorithm, I'm attempting to create an iterative (tail-recursive) version.
I'm quite close, but the list that is returned ends up being reversed.
Here is what I have so far:
(define (first-n-iter lst n)
(define (iter lst lst-proc x)
(cond
((= x 0) lst-proc)
(else (iter (cdr lst) (cons (car lst) lst-proc) (- x 1)))))
(if (= n 0)
'()
(iter lst '() n)))
i.e. Calling (first-n-iter '(a b c) 3) will return (c b a).
Could someone suggest a fix? Once again, I'd like to retain the tail-recursion.
note: I'd prefer you not suggest just calling (reverse lst) on the returned list..
You can do the head sentinel trick to implement a tail recursive modulo cons
(define (first-n-iter lst n)
(define result (cons 'head '()))
(define (iter tail L-ns x)
(cond
((= x 0) (cdr result))
((null? L-ns)
(error "FIRST-N-ITER input list " lst " less than N" n))
(else
(begin (set-cdr! tail (list (car L-ns)))
(iter (cdr tail) (cdr L-ns) (- x 1))))))
(iter result lst n))
(first-n-iter '(a b c d e f g h i j k l m n o p q r s t u v w x y z) 8))
;Value 7: (a b c d e f g h)
Also added a cond clause to catch the case where you try to take more elements than are actually present in the list.
You could flip the arguments for your cons statement, list the last (previously first) arg, and change the cons to append
(define (first-n-iter lst n)
(define (iter lst acc x)
(cond
[(zero? x) acc]
[else (iter (cdr lst) (append acc (list (car lst))) (sub1 x))]))
(iter lst empty n))
which will work as you wanted. And if you're doing this as a learning exercise, then I think that's all you need. But if you're actually trying to make this function, you should know that it's been done already-- (take lst 3)
Also, you don't need your if statement at all-- your check for (= x 0) would return '() right away, and you pass in (iter lst '() n) as it is. So the (if (= n 0) ... ) is doing work that (cond [(= x 0)...)' would already do for you.
Here is my code:
(define (squares 1st)
(let loop([1st 1st] [acc 0])
(if (null? 1st)
acc
(loop (rest 1st) (* (first 1st) (first 1st) acc)))))
My test is:
(test (sum-squares '(1 2 3)) => 14 )
and it's failed.
The function input is a list of number [1 2 3] for example, and I need to square each number and sum them all together, output - number.
The test will return #t, if the correct answer was typed in.
This is rather similar to your previous question, but with a twist: here we add, instead of multiplying. And each element gets squared before adding it:
(define (sum-squares lst)
(if (empty? lst)
0
(+ (* (first lst) (first lst))
(sum-squares (rest lst)))))
As before, the procedure can also be written using tail recursion:
(define (sum-squares lst)
(let loop ([lst lst] [acc 0])
(if (empty? lst)
acc
(loop (rest lst) (+ (* (first lst) (first lst)) acc)))))
You must realize that both solutions share the same structure, what changes is:
We use + to combine the answers, instead of *
We square the current element (first lst) before adding it
The base case for adding a list is 0 (it was 1 for multiplication)
As a final comment, in a real application you shouldn't use explicit recursion, instead we would use higher-order procedures for composing our solution:
(define (square x)
(* x x))
(define (sum-squares lst)
(apply + (map square lst)))
Or even shorter, as a one-liner (but it's useful to have a square procedure around, so I prefer the previous solution):
(define (sum-squares lst)
(apply + (map (lambda (x) (* x x)) lst)))
Of course, any of the above solutions works as expected:
(sum-squares '())
=> 0
(sum-squares '(1 2 3))
=> 14
A more functional way would be to combine simple functions (sum and square) with high-order functions (map):
(define (square x) (* x x))
(define (sum lst) (foldl + 0 lst))
(define (sum-squares lst)
(sum (map square lst)))
I like Benesh's answer, just modifying it slightly so you don't have to traverse the list twice. (One fold vs a map and fold)
(define (square x) (* x x))
(define (square-y-and-addto-x x y) (+ x (square y)))
(define (sum-squares lst) (foldl square-y-and-addto-x 0 lst))
Or you can just define map-reduce
(define (map-reduce map-f reduce-f nil-value lst)
(if (null? lst)
nil-value
(map-reduce map-f reduce-f (reduce-f nil-value (map-f (car lst))))))
(define (sum-squares lst) (map-reduce square + 0 lst))
racket#> (define (f xs) (foldl (lambda (x b) (+ (* x x) b)) 0 xs))
racket#> (f '(1 2 3))
14
Without the use of loops or lamdas, cond can be used to solve this problem as follows ( printf is added just to make my exercises distinct. This is an exercise from SICP : exercise 1.3):
;; Takes three numbers and returns the sum of squares of two larger number
;; a,b,c -> int
;; returns -> int
(define (sum_sqr_two_large a b c)
(cond
((and (< a b) (< a c)) (sum-of-squares b c))
((and (< b c) (< b a)) (sum-of-squares a c))
((and (< c a) (< c b)) (sum-of-squares a b))
)
)
;; Sum of squares of numbers given
;; a,b -> int
;; returns -> int
(define (sum-of-squares a b)
(printf "ex. 1.3: ~a \n" (+ (square a)(square b)))
)
;; square of any integer
;; a -> int
;; returns -> int
(define (square a)
(* a a)
)
;; Sample invocation
(sum_sqr_two_large 1 2 6)
I'm having a little trouble with an assignment. I have to create a procedure that requests a list of lists and an element and proceeds to add the element to the first position in every sublist. I managed to do that and it looks like this:
(define (add-element lst elem)
(foldr cons lst (list elem)))
(define (insert-first lst1 x)
(cond
[(empty? lst1) empty]
[else (local [(define insert (add-element(first lst1) x))]
(cons insert (insert-first (rest lst1) x)))]))
So if you were to type (insert-first '((a b) (c d)) you'd end up with (list (list 'x 'a 'b) (list 'x 'c 'd))
Only problem is that I'm required to code the procedure using map and local. The latter one I think I accomplished but I can't for the life of me figure out a way to use map.
(define (insert-first elt lst)
(map (lambda (x)
(cons elt x))
lst))
then
(insert-first 'x '((a b) (c d)))
=> '((x a b) (x c d))
(define (insert-first lst elem)
(foldr (lambda (x y) (cons (cons elem x) y)) '() lst))
Close to your solution, but map is more naturally suited to the problem than a fold, since you want to want to do something to each element of a list. Use fold when you want to accumulate a value by successively applying a function to elements of that list.
foldr embodies a certain recursion pattern,
(foldr g init [a,b,c,...,z])
= (g a (foldr g init [b,c,...,z]))
....
= (g a (g b (g c ... (g z init) ...)))
if we manually expand the foldr call in your add-element function definition, we get
(add-element lst elem)
= (foldr cons lst (list elem))
= (cons elem (foldr cons lst '()))
= (cons elem lst)
then, looking at your insert-first function, we see it is too following the foldr recursion pattern,
(insert-first lst1 x)
= (foldr (lambda(a r)(cons (add-element a x) r)) empty lst1)
= (foldr (lambda(a r)(cons (cons x a) r)) empty lst1)
But (foldr (lambda(a r) (cons (g a) r)) empty lst) === (map g lst), because to combine sub-terms with cons is to build a list, which is what map does; and so we get
(insert-first lst1 x) = (map (lambda(a)(cons x a)) lst1)
and so we can write
(define (insert-first lst1 x)
(local [(define (prepend-x a) (cons ... ...))]
(map ... ...)))
A little help, guys.
How do you sort a list according to a certain pattern
An example would be sorting a list of R,W,B where R comes first then W then B.
Something like (sortf '(W R W B R W B B)) to (R R W W W B B B)
Any answer is greatly appreciated.
This is a functional version of the Dutch national flag problem. Here are my two cents - using the sort procedure with O(n log n) complexity:
(define sortf
(let ((map '#hash((R . 0) (W . 1) (B . 2))))
(lambda (lst)
(sort lst
(lambda (x y) (<= (hash-ref map x) (hash-ref map y)))))))
Using filter with O(4n) complexity:
(define (sortf lst)
(append (filter (lambda (x) (eq? x 'R)) lst)
(filter (lambda (x) (eq? x 'W)) lst)
(filter (lambda (x) (eq? x 'B)) lst)))
Using partition with O(3n) complexity::
(define (sortf lst)
(let-values (((reds others)
(partition (lambda (x) (eq? x 'R)) lst)))
(let-values (((whites blues)
(partition (lambda (x) (eq? x 'W)) others)))
(append reds whites blues))))
The above solutions are written in a functional programming style, creating a new list with the answer. An optimal O(n), single-pass imperative solution can be constructed if we represent the input as a vector, which allows referencing elements by index. In fact, this is how the original formulation of the problem was intended to be solved:
(define (swap! vec i j)
(let ((tmp (vector-ref vec i)))
(vector-set! vec i (vector-ref vec j))
(vector-set! vec j tmp)))
(define (sortf vec)
(let loop ([i 0]
[p 0]
[k (sub1 (vector-length vec))])
(cond [(> i k) vec]
[(eq? (vector-ref vec i) 'R)
(swap! vec i p)
(loop (add1 i) (add1 p) k)]
[(eq? (vector-ref vec i) 'B)
(swap! vec i k)
(loop i p (sub1 k))]
[else (loop (add1 i) p k)])))
Be aware that the previous solution mutates the input vector in-place. It's quite elegant, and works as expected:
(sortf (vector 'W 'R 'W 'B 'R 'W 'B 'B 'R))
=> '#(R R R W W W B B B)
This is a solution without using sort or higher order functions. (I.e. no fun at all)
This doesn't really sort but it solves your problem without using sort. named let and case are the most exotic forms in this solution.
I wouldn't have done it like this unless it's required not to use sort. I think lepple's answer is both elegant and easy to understand.
This solution is O(n) so it's probably faster than the others with very large number of balls.
#!r6rs
(import (rnrs base))
(define (sort-flag lst)
;; count iterates over lst and counts Rs, Ws, and Bs
(let count ((lst lst) (rs 0) (ws 0) (bs 0))
(if (null? lst)
;; When counting is done build makes a list of
;; Rs, Ws, and Bs using the frequency of the elements
;; The building is done in reverse making the loop a tail call
(let build ((symbols '(B W R))
(cnts (list bs ws rs))
(tail '()))
(if (null? symbols)
tail ;; result is done
(let ((element (car symbols)))
(let build-element ((cnt (car cnts))
(tail tail))
(if (= cnt 0)
(build (cdr symbols)
(cdr cnts)
tail)
(build-element (- cnt 1)
(cons element tail)))))))
(case (car lst)
((R) (count (cdr lst) (+ 1 rs) ws bs))
((W) (count (cdr lst) rs (+ 1 ws) bs))
((B) (count (cdr lst) rs ws (+ 1 bs)))))))
Make a lookup eg
(define sort-lookup '((R . 1)(W . 2)(B . 3)))
(define (sort-proc a b)
(< (cdr (assq a sort-lookup))
(cdr (assq b sort-lookup))))
(list-sort sort-proc '(W R W B R W B B))
Runnable R6RS (IronScheme) solution here: http://eval.ironscheme.net/?id=110
You just use the built-in sort or the sort you already have and use a custom predicate.
(define (follow-order lst)
(lambda (x y)
(let loop ((inner lst))
(cond ((null? inner) #f)
((equal? x (car inner)) #t)
((equal? y (car inner)) #f)
(else (loop (cdr inner)))))))
(sort '(W R W B R W B) (follow-order '(R W B)))
;Value 50: (r r w w w b b)