I have created a function that takes a list as input and returns either a list or a atom. I want to apply this function to a deep list, starting with the inner lists, then finish once the function has been run on the outer list.
Can somebody give me some direction on this?
A sample input would be (a b (c (d e))) z) the function should compute on (d e) first with a result of say f. then the function should compute on (c f) with a result of say g then similarly on (a b g z) to produce an output of h.
An example function could be:
(define sum
(lambda (l)
(if (not (pair? l))
0
(+ (car l) (sum (cdr l))))))
Where input would be (1 2 (3 4) 5) > 15
Assuming your example transformation, expressed as a Scheme procedure:
(define (transform lst)
(case lst
(((d e)) 'f)
(((c f)) 'g)
(((a b g z)) 'h)
(else (error (~a "wot? " lst)))))
then what you are looking for seems to be
(define (f lst)
(transform
(map (lambda (e)
(if (list? e) (f e) e))
lst)))
Testing:
> (f '(a b (c (d e)) z))
'h
Here is an example:
(define product
(lambda (l)
(cond
[(number? l) l]
[(pair? l) (* (product (car l)) (product (cdr l)))]
[else 1])))
> (product '(1 2 (3 4) 5))
120
Related
I am trying to reverse a general list using Scheme. How can I reverse a complex list?
I can make a single list like (A B C D) works using my function, but for some complex list inside another list like (F ((E D) C B) A), the result is just (A ((E D) C B) F). How can I improve it?
(define (reverse lst)
(if (null? lst)
lst
(append (reverse (cdr lst)) (list (car lst)))))
Any comments will be much appreciated!
Here is another way that uses a default parameter (r null) instead of the expensive append operation -
(define (reverse-rec a (r null))
(if (null? a)
r
(reverse-rec (cdr a)
(cons (if (list? (car a))
(reverse-rec (car a))
(car a))
r))))
(reverse-rec '(F ((E D) C B) A))
; '(A (B C (D E)) F)
Using a higher-order procedure foldl allows us to encode the same thing without the extra parameter -
(define (reverse-rec a)
(foldl (lambda (x r)
(cons (if (list? x) (reverse-rec x) x)
r))
null
a))
(reverse-rec '(F ((E D) C B) A))
; '(A (B C (D E)) F)
There are several ways of obtaining the expected result. One is to call reverse recursively also on the car of the list that we are reversing, of course taking care of the cases in which we must terminate the recursion:
(define (reverse x)
(cond ((null? x) '())
((not (list? x)) x)
(else (append (reverse (cdr x)) (list (reverse (car x)))))))
(reverse '(F ((E D) C B) A))
'(A (B C (D E)) F)
(A ((E D) C B) F) is the correct result, if your goal is to reverse the input list. There were three elements in the input list, and now the same three elements are present, in reverse order. Since it is correct, I don't suggest you improve its behavior!
If you have some other goal in mind, some sort of deep reversal, you would do well to specify more clearly what result you want, and perhaps a solution will be easier to find then.
I'm trying to write function for insertion sort with and without primitive functions.
My code with primitive functions is below.
(define (insert n d)
(cond ((null? n) d)
((null? d) n)
(else (< (car n) (car d)) (cons (car n) (insert (cdr n) d)) (cons (car d) (insert (cdr d) n)))))
(define (sort n)
(cond ((null? n) '())
(else (insert (list (car n)) (sort (cdr n))))))
How should I revise insert and sort to not use car, cdr, and cons?
Edit: I tried to write the insert function. This is what I have so far.
(define (insert n d)
(let ((rest-digit (truncate (/ n 10))))
(if (null? n) 0
(+ rest-digit (insert (- n 1) d)))))
(insert '(3 2 1) '5)
Edit #2: I think I can use the built-in function expt.
Ultimately you will be using primitive functions. To illustrate let me show you a trick that actually uses cons, car, and cdr under the hood:
(define (my-car lst)
(apply (lambda (a . d) a) lst))
(define (my-cdr lst)
(apply (lambda (a . d) d) lst))
(define (my-cons a d)
(apply (lambda l l) a d))
(define test (my-cons 1 '(2 3)))
test ; ==> (1 2 3)
(my-car test) ; ==> 1
(my-cdr test) ; ==> (2 3)
This abuses the fact that apply takes a list as the final arguments and that rest arguments are cons-ed onto a list in order. cons doesn't work for all pairs:
(my-cons 1 2) ; ERROR: expected list?, got 1
You can make cons, car, and cdr such that they adher to the same rules as primitive cons, but that they are not made of pairs at all. Barmar suggested closures:
(define (ccons a d)
(lambda (f) (f a d))
(define (ccar cc)
(cc (lambda (a d) a)))
(define (ccdr cc)
(cc (lambda (a d) d)))
(define test2 (ccons 1 2))
test2 ; ==> #<function...>
(ccar test2) ; ==> 1
(ccdr test2) ; ==> 2
This works since a and d gets closed over in the returned function and that function passes those values and thus the function acts as an object with two attributes. The challenge with this is that you cannot just pass a list since only "lists" made with ccons will work with ccar and ccdr.
A less classical way is to use vectors:
(define vtag (make-vector 0))
(define (vcons a d)
(let ((v (make-vector 3)))
(vector-set! v 0 vtag)
(vector-set! v 1 a)
(vector-set! v 2 d)
v))
(define (vcar vl)
(vector-ref vl 1))
(define (vcdr vl)
(vector-ref vl 2))
(define (vpair? vl)
(eq? vtag (vector-ref vl 0)))
Or you can use records:
(define-record-type :rpair
(rcons a d)
rpair?
(a rcar)
(d rcdr))
(define test (rcons 1 2))
(rpair? test) ; ==> #t
(rcar test) ; ==> 1
(rcdr test) ; ==> 2
Now I think records just syntax sugar and abstractions and that under the hood you are doing exactly the same as the vector version with less code, but that isn't a bad thing.
EDIT
So from the comments if the only restriction is to avoid car, cdr, and cons, but no restrictions on their sisters we might as well implement with them:
(define (sort lst)
(define (insert e lst)
(if (null? lst)
(list e)
(let ((a (first lst)))
(if (>= a e)
(list* e lst)
(list* a (insert e (rest lst)))))))
(foldl insert
'()
lst))
(sort '(1 5 3 8 5 0 2))
; ==> (0 1 2 3 5 5 8)
And of course my first suggestion works in its place:
(define (sort lst)
(define (my-car lst)
(apply (lambda (a . d) a) lst))
(define (my-cdr lst)
(apply (lambda (a . d) d) lst))
(define (my-cons a d)
(apply (lambda l l) a d))
(define (insert e lst)
(if (null? lst)
(my-cons e '())
(let ((a (my-car lst)))
(if (>= a e)
(my-cons e lst)
(my-cons a (insert e (my-cdr lst)))))))
(foldl insert
'()
lst))
And of course, using substitution rules you can make it utterly ridiculous:
(define (sort lst)
;; insert element e into lst in order
(define (insert e lst)
(if (null? lst)
((lambda l l) e)
(let ((a (apply (lambda (a . d) a) lst)))
(if (>= a e)
(apply (lambda l l) e lst)
(apply (lambda l l)
a
(insert e (apply (lambda (a . d) d) lst)))))))
;; main loop of sort
;; insert every element into acc
(let loop ((lst lst) (acc '()))
(if (null? lst)
acc
(loop (apply (lambda (a . d) d) lst)
(insert (apply (lambda (a . d) a) lst)
acc)))))
In response to the following exercise from the 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.
I wrote the following (correct) function:
(define (square-sum-larger a b c)
(cond ((or (and (> a b) (> b c)) (and (> b a) (> a c))) (+ (* a a) (* b b)))
((or (and (> a c) (> c b)) (and (> c a) (> a b))) (+ (* a a) (* c c)))
((or (and (> b c) (> c a)) (and (> c b) (> b a))) (+ (* b b) (* c c)))))
Unfortunately, that is one of the ugliest functions I've written in my life. How do I
(a) Make it elegant, and
(b) Make it work for an arbitrary number of inputs?
I found an elegant solution (though it only works for 3 inputs):
(define (square-sum-larger a b c)
(+
(square (max a b))
(square (max (min a b) c))))
If you're willing to use your library's sort function, this becomes easy and elegant.
(define (square-sum-larger . nums)
(define sorted (sort nums >))
(let ((a (car sorted))
(b (cadr sorted)))
(+ (* a a) (* b b))))
In the above function, nums is a "rest" argument, containing a list of all arguments passed to the function. We just sort that list in descending order using >, then square the first two elements of the result.
I don't know if it's elegant enough but for a 3 argument version you can use procedure abstraction to reduce repetition:
(define (square-sum-larger a b c)
(define (square x)
(* x x))
(define (max x y)
(if (< x y) y x))
(if (< a b)
(+ (square b) (square (max a c)))
(+ (square a) (square (max b c)))))
Make it work for an arbitrary number of inputs.
(define (square-sum-larger a b . rest)
(let loop ((a (if (> a b) a b)) ;; a becomes largest of a and b
(b (if (> a b) b a)) ;; b becomes smallest of a and b
(rest rest))
(cond ((null? rest) (+ (* a a) (* b b)))
((> (car rest) a) (loop (car rest) a (cdr rest)))
((> (car rest) b) (loop a (car rest) (cdr rest)))
(else (loop a b (cdr rest))))))
A R6RS-version using sort and take:
#!r6rs
(import (rnrs)
(only (srfi :1) take))
(define (square-sum-larger . rest)
(apply +
(map (lambda (x) (* x x))
(take (list-sort > rest) 2))))
You don't need to bother sorting you just need the find the greatest two.
(define (max-fold L)
(if (null? L)
#f
(reduce (lambda (x y)
(if (> x y) x y))
(car L)
L)))
(define (remove-num-once x L)
(cond ((null? L) #f)
((= x (car L)) (cdr L))
(else (cons (car L) (remove-once x (cdr L))))))
(define (square-sum-larger . nums)
(let ((max (max-fold nums)))
(+ (square max)
(square (max-fold (remove-num-once max nums))))))
(square-sum-larger 1 8 7 4 5 6 9 2)
;Value: 145
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)
I know how to get the first n elements in a list,
(define (countup n ls)
(cond
[(zero? n) '()]
[else (cons (first ls) (countup (sub1 n) (rest ls)))]))
but how can I do something like this for the last n elements in a list (without using list-ref)?
If I call (countup 3 '(a b c d e)), I get (list a b c). I need to be able to enter (counter 3 '(a b c d e)) and get (list c d e).
I need error messages in case the number n given is bigger than the list's length.
Just use the built-in take-right procedure, it does exactly what you need:
(take-right '(a b c d e) 3)
=> '(c d e)
Or you can implement it from scratch, using primitive procedures:
(define (counter n lst)
(define (move n lst)
(if (zero? n)
lst
(move (sub1 n) (rest lst))))
(define (trim-left lst rst)
(if (empty? rst)
lst
(trim-left (rest lst) (rest rst))))
(trim-left lst (move n lst)))
It also works as expected:
(counter 3 '(a b c d e))
=> '(c d e)
I guess I would use a local fn to chop of items from the left and then return the remaining items. The following also returns '() if asked to return a Negative number of items. You may want to treat this as an error as well. #f signals an error in your input ie trying to take more items than the list contains
(define (counter n loN)
(define (acc loN c)
(cond [(null? loN) '()]
[(> c 0) (acc (cdr loN) (sub1 c))]
[else loN]))
;in
(let ((c (- (length loN) n)))
(cond ; [(>= 0 n) #f]
[(positive? c) (acc loN c)]
[else #f])))
(check-equal? (counter 3 '(a b c d e)) '(c d e))
(check-equal? (counter 6 '(a b c d e)) #f)
(check-equal? (counter -3 '(a b c d e)) '())
(check-equal? (counter 0 '(a b c d e)) '())