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 ... ...)))
Related
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
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.
Suppose we have a function f. This function takes as an argument a list l and returns a function of one argument g.Function g takes as an argument x and looking for the x in the list l. If it finds it returns true, else false.
I'm interested in a solution without using the built-in functions.
My start code:
(define (f l)
(lamda (x)
..........
)))
You could go for this:
(define (f l)
(lambda (x)
(and (member x l) #t)))
(define g (f '(a b c e)))
(g 'a)
=> #t
(g 'd)
=> #f
If you need to avoid the built-in member procedure, you can roll your own member?:
(define (member? e l)
(and (not (null? l))
(or (eq? (car l) e) (member? e (cdr l)))))
(define (f l)
(lambda (x)
(member? x l)))
or have member? as an internal procedure, if you prefer:
(define (f l)
(define (member? e l)
(and (not (null? l))
(or (eq? (car l) e) (member? e (cdr l)))))
(lambda (x)
(member? x l)))
How would I loop this list in scheme?
(define test-document '(
((h e l l o))
((t h i s)(i s)(t e s t))
))
What I tried it only showed the first column.
car and cdr family of functions are your friends to navigate lists. Here are some examples.
(define test-document '(
((h e l l o))
((t h i s)(i s)(t e s t))
))
(car test-document) ;; `((h e l l o))
(caar test-document) ;; `(h e l l o)
(cadr test-document) ;; `((t h i s) (i s) (t e s t))
(car (cadr test-document) ;; `(t h i s)
(cadr (cadr test-document) ;; `(i s)
(caddr (cadr test-document) ;; `(test )
Define a function that will walk the list and call a function for each item that is not a list.
(define (walk-list lst fun)
(if (not (list? lst))
(fun lst)
(if (not (null? lst))
(begin
(walk-list (car lst) fun)
(walk-list (cdr lst) fun)))))
Call it to print each item.
(walk-list test-document print)
What you have is a list of lists of lists:
(define test-document '(((h e l l o)) ((t h i s) (i s) (t e s t))))
To loop over its elements you must create a loop of a loop of a loop. To do so we can use map and curry as follows:
(map (curry map (curry map
(compose string->symbol string-upcase symbol->string)))
test-document)
This produces the following output:
(((H E L L O)) ((T H I S) (I S) (T E S T)))
If your Scheme interpreter doesn't have a built-in curry function then you can define one as follows:
(define (curry func . args)
(lambda x (apply func (append args x))))
Hope this helped.
Were you thinking of something like this?
(define (walk-list lst)
(define (sub-walk lst)
(if (null? lst)
'()
(let ((x (car lst)))
(if (list? x)
(cons (sub-walk x) (sub-walk (cdr lst)))
(apply string-append (map symbol->string lst))))))
(flatten (sub-walk lst)))
then
(walk-list test-document)
=> '("hello" "this" "is" "test")
which you can process using the usual suspects (map, filter, ...).
If your Scheme has no flatten procedure, you can use this one:
(define (flatten lst)
(reverse
(let loop ((lst lst) (res null))
(if (null? lst)
res
(let ((c (car lst)))
(loop (cdr lst) (if (pair? c) (loop c res) (cons c res))))))))
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)