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.
Related
I tried to implement the cons* (https://scheme.com/tspl4/objects.html#./objects:s44).
Examples:
(cons* '()) -> ()
(cons* '(a b)) -> (a b)
(cons* 'a 'b 'c) -> (a b . c)
(cons* 'a 'b '(c d)) -> (a b c d)
this is what I did do far but I don't know how to replace the ?? to make the third example (the dot notion) work
(define cons*
(lambda x
(if
(null? x)
x
(if (list? (car (reverse x)))
(fold-right cons (car (reverse x)) (reverse (cdr (reverse x))))
???
)
)
)
)
Here's a lo-fi way using lambda -
(define cons*
(lambda l
(cond ((null? l) null)
((null? (cdr l)) (car l))
(else (cons (car l) (apply cons* (cdr l)))))))
Here's a way you can do it using match (Racket)
(define (cons* . l)
(match l
((list) null) ; empty list
((list a) a) ; singleton list
((list a b ...) (cons a (apply cons* b))))) ; two or elements
Often times patterns and order can be rearranged and still produce correct programs. It all depends on how you're thinking about the problem -
(define (cons* . l)
(match l
((list a) a) ; one element
((list a b) (cons a b)) ; two elements
((list a b ...) (cons a (apply cons* b))))) ; more
Or sugar it up with define/match -
(define/match (cons* . l)
[((list)) null]
[((list a)) a]
[((list a b ...)) (cons a (apply cons* b))])
All four variants produce the expected output -
(cons* '())
(cons* '(a b))
(cons* 'a 'b 'c)
(cons* 'a 'b '(c d))
'()
'(a b)
'(a b . c)
'(a b c d)
Personally, I'd use a macro instead of a function to transform a cons* into a series of cons calls:
(define-syntax cons*
(syntax-rules ()
((_ arg) arg)
((_ arg1 rest ...) (cons arg1 (cons* rest ...)))))
(define (writeln x)
(write x)
(newline))
(writeln (cons* '())) ;; -> '()
(writeln (cons* '(a b))) ;; -> '(a b)
(writeln (cons* 'a 'b 'c)) ;; -> (cons 'a (cons 'b 'c)) -> '(a b . c)
(writeln (cons* 'a 'b '(c d))) ;; -> (cons 'a (cons 'b '(c d))) -> '(a b c d)
A Simple Procedure
I think that you are making this more complicated than it needs to be. It seems best not to use lambda x here, since that would allow calls like (cons*) with no arguments. Instead, I would use (x . xs), and I would even just use the define syntax:
(define (cons* x . xs)
(if (null? xs)
x
(cons x (apply cons*
(car xs)
(cdr xs)))))
If there is only one argument to cons*, then xs is empty, i.e., (null? xs) is true, and that single argument x should be returned. Otherwise you should cons the first argument to the result of calling cons* again, with the first element of xs as the first argument, followed by the remaining arguments from xs. The trick here is that (cdr xs) returns a list, which will itself be put into a list thanks to the (x . xs) syntax. This is the reason for using apply, which will apply cons* to the arguments in the list.
This works for all of the test cases:
> (cons* '())
()
> (cons* '(a b))
(a b)
> (cons* 'a 'b 'c)
(a b . c)
> (cons* 'a 'b '(c d))
(a b c d)
Using Mutation
Taking a closer look at what a proper list really is suggests another approach to solving the problem. Consider a list like (a b c d). This is really a chain of cons cells that look like this:
(a . (b . (c . (d . ()))))
We would like to transform this list to an improper, or dotted, list:
(a . (b . (c . (d . ())))) --> (a . (b . (c . d)))
This transformed list is equivalent to (abc.d), which is what we would like the call to (cons* 'a 'b 'c 'd) to return.
We could mutate the proper list to an improper list by setting the cdr of the next-to-last pair to the car of the last pair; that is, by setting the cdr of (c . (d .()) to d. We can use the list-tail procedure to get at the next-to-last pair, list-ref to get at the car of the last pair, and set-cdr! to set the cdr of the next-to-last pair to the new value. After this, the list is no longer terminated by an empty list (unless the car of the final pair is itself an empty list!).
Here is a procedure proper->improper! that mutates a proper list to an improper list. Note that the input must be a proper list to avoid an error. If the input list contains only a single element, then that element is simply returned and no mutation takes place.
(define (proper->improper! xs)
(cond ((null? (cdr xs))
(car xs))
(else
(set-cdr! (list-tail xs (- (length xs) 2))
(list-ref xs (- (length xs) 1)))
xs)))
Now cons* can be defined simply in terms of proper->improper!:
(define (cons* . xs)
(proper->improper! xs))
Here, the arguments to cons* are packed up into a fresh list and passed to proper->improper! which effectively removes the terminal empty list from its input, returning a chain of pairs whose last cdr is the last argument to cons*; or if only one argument is provided, that argument is returned. This works just like the other solution:
> (cons* '())
()
> (cons* 'a)
a
> (cons* 'a 'b 'c 'd)
(a b c . d)
> (cons* 'a 'b '(c d))
(a b c d)
Real Life
In real life, at least in Chez Scheme, cons* is not implemented like any of these solutions, or even in Scheme at all. Instead Chez opted to make cons* a primitive procedure, implemented in C (I believe).
I am stuck up in a Scheme program for about 5 hours. The program that I am working on should take two lists as input and then compute the number of times the pattern within the first list appears on the second list.
For example : > (patt '(b c) '(a b c d e b c)) ==> answer = 2
(patt '(a b c) '(a b c a b c d e a b c c c)) ==> answer = 3
(patt '((a b) c) '(a b (a b) c d e b c)) ==> answer = 1
Below is the code that I have till now.
(define (patt lis1 lis2)
(cond
((null? lis1) 0)
((null? lis2) 0)
[(and (> (length lis1) 1) (eq? (car lis1) (car lis2))) (patt (cdr lis1) (cdr lis2))]
((eq? (car lis1) (car lis2)) (+ 1 (patt lis1 (cdr lis2))))
(else (patt lis1 (cdr lis2)))
))
Can someone please help me solve this. Thanks!
Consider the subproblem of testing if a list starts with another list.
Then do this for every suffix of the list. Sum up the count of matches.
If you want non overlapping occurrences, you can have the prefix match, return the suffix of the list so that you can skip over the matching part.
Also use equals? for structural equality, not eq? which is for identity.
You need to divide the problem into parts:
(define (prefix? needle haystack)
...)
(prefix? '() '(a b c)) ; ==> #t
(prefix? '(a) '(a b c)) ; ==> #t
(prefix? '(a b c) '(a b c)) ; ==> #t
(prefix? '(a b c d) '(a b c)) ; ==> #f
(prefix? '(b) '(a b c)) ; ==> #t
(define (count-occurences needle haystack)
...)
So with this you can imagine searching for the pattern (count-occurences '(a a) '(a a a a)). When it is found from the first element you need to search again on the next. Thus so that the result is 3 for the (a a a a) since the matches overlap. Every sublist except when it's the empty list involves using prefix?
Good luck!
(define (patt list1 list2)
(let ([patt_length (length list1)])
(let loop ([loop_list list2]
[sum 0])
(if (>= (length loop_list) patt_length)
(if (equal? list1 (take loop_list patt_length))
(loop (cdr loop_list) (add1 sum))
(loop (cdr loop_list) sum))
sum))))
After giving this homework problem a little time to marinate, I don't see the harm in posting additional answers -
(define (count pat xs)
(cond ((empty? xs)
0)
((match pat xs)
(+ 1 (count pat (cdr xs))))
(else
(count pat (cdr xs)))))
(define (match pat xs)
(cond ((empty? pat)
#t)
((empty? xs)
#f)
((and (list? pat)
(list? xs))
(and (match (car pat) (car xs))
(match (cdr pat) (cdr xs))))
(else
(eq? pat xs))))
(count '(a b c) '(a b c a b c d e a b c c c)) ;; 3
(count '((a b) c) '(a b (a b) c d e b c)) ;; 1
(count '(a a) '(a a a a)) ;; 3
I'm trying to write a procedure: when a pair starts with a, it would return b; when a pair starts with b, it would return c; and when a pair starts with c, it would return a.
(define e '((a b) (b c) (c a)))
(define (make-encoder e)
(cond ((eq? 'a (car (assq 'a e)))
(cadr (assq 'a e)))
((eq? 'b (car (assq 'b e)))
(cadr (assq 'b e)))
((eq? 'c (car (assq 'c e)))
(cadr (assq 'c e)))))
What is returned is only 'b', so I'm wondering where my brackets are wrong in cutting off the remaining code? I have played around for so long and wondering if that's my problem, or if it something else.
I don't think it's an issue of wrong parens; I can't really see a way to tweak your code to get the desired behavior. Here's how I would do it:
(define (make-encoder assoc-list)
(lambda (lst)
(define (-> elem)
(cadr (assq elem assoc-list)))
(map -> lst)))
As you can see, when you call this procedure with an association list such as e, it will return a new function that takes a list and maps -> over it, where -> looks up the element in the association list and returns result. Hence:
> ((make-encoder e) '(a b a c a b))
'(b c b a b c)
You have looking up the value of a key in a association list with (cadr (assq k a)) but what you are missing is how to apply that to every item in a list. That is where map comes in. So:
> (map (lambda (v) (cadr (assq v '((a b) (b c) (c a))))) '(a b a c a b))
'(b c b a b c)
This can be turned into a function by placing it within lambdas or a definition and replacing the values with bound names.
Hi i'm trying to define a function which should make a set from the parts of that set.
Should be defined like: P(A) = P(A-{x}) U { {x} U B} for all B that belongs to P(A-{X}) where X belongs to A.
A test would be:
(parts '(a b c))
=> ((a b c) (a b) (a c) (a) (b c) (b) (c)())
I've been trying with this one:
(define (mapc f x l)
(if (null? l)
l
(cons (f x (car l)) (mapc f x (cdr l)))))
Maybe something like this? (untested)
(define (power-set A)
(cond
[(null? A) '()] ; the power set of an empty set it empty
[else (append (map (lambda (S) (cons x S)) ; sets with x
(power-set (cdr A)))
(power-set (cdr A)) ; sets without x
]))
This is essentially 'combinations' function (https://docs.racket-lang.org/reference/pairs.html?q=combinations#%28def._%28%28lib._racket%2Flist..rkt%29._combinations%29%29).
Following short code in Racket (a Scheme derivative) gets all combinations or parts:
(define (myCombinations L)
(define ol (list L)) ; Define outlist and add full list as one combination;
(let loop ((L L)) ; Recursive loop where elements are removed one by one..
(for ((i L)) ; ..to create progressively smaller combinations;
(define K (remove i L))
(set! ol (cons K ol)) ; Add new combination to outlist;
(loop K)))
(remove-duplicates ol))
Testing:
(myCombinations '(a b c))
Output:
'(() (a) (b) (a b) (c) (a c) (b c) (a b c))
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