My implementation of flatten looks like this:
(define flatten
(lambda (lst)
(if (null? lst)
lst
(append
(rtn-lst (car lst))
(flatten (cdr lst))))))
(define rtn-lst
(lambda (lst)
(cond
((null? lst)
empty)
((atom? lst)
(list lst))
(else
(flatten lst)))))
While standard implementation is:
(define (flatten lst)
(cond
((null? list)
empty)
((list? (car lst))
(append (flatten (car lst)) (flatten (cdr lst))))
(else
(cons (car lst) (flatten (cdr lst))))))
Apart from the obvious verboseness, what else is wrong with my code?
I'd try this:
(define rtn-lst
(lambda (lst)
(cond
((list? lst)
(if (null? lst)
empty
(flatten-list lst)))
((atom? lst)
(list lst))
(else
(flatten-list lst)))))
Probably we have different implementations of Scheme.
EDIT:
With modified else branch:
(define rtn-lst
(lambda (lst)
(cond
((list? lst)
(if (null? lst)
empty
(flatten-list lst)))
(else
(list lst)))))
I would consider atom? to be wrong. You want to know if the lst is a list, so use list?. atom? can return false on vector or string for some implementations. But i do not know for sure. The rest is quit good.
How about something like this:
(define foo
(lambda (e)
(cond ((pair? e) `(,#(foo (car e)) ,#(foo (cdr e))))
((null? e) '())
(else (list e)))))
Where for example:
> (foo '(((2 3) (4 . 5) 8)))
(2 3 4 5 8)
Does this do what you want?
How about something like this:
(define (flatten x y)
(if (null? x)
y
(if (list? (car x))
(flatten (append (car x) (cdr x)) y)
(flatten (cdr x) (append y (list (car x)))))))
(define (flat x)
(flatten x '()))
> (flat '(1(2(3(4(5)6)7)8)9))
(1 2 3 4 5 6 7 8 9)
and closure version:
(define (flatten x)
(define (flatten x y)
(if (null? x)
y
(if (list? (car x))
(flatten (append (car x) (cdr x)) y)
(flatten (cdr x) (append y (list (car x)))))))
(flatten x '()))
> (flatten '(1(2(3(4(5)6)7)8)9))
(1 2 3 4 5 6 7 8 9)
Related
I'm attempting to create a function for flattening lists in the R5RS language in scheme and am experiencing the issue where my function simply returns the input list without removing the parenthesis. I figured this was due to the extra cons, but when I remove it the output becomes the list without the elements that were in the parenthesis. Can someone point me in the right direction?
(define (denestify lst)
(cond ((null? lst)'())
((list? (car lst))(cons (denestify (cons (car (car lst))(cdr (car lst))))
(denestify (cdr lst))))
(else (cons (car lst)(denestify (cdr lst))))))
This shows how to convert Óscar López answer into one that doesn't use append and is also tail recursive:
(define (denestify-helper lst acc stk)
(cond ((null? lst)
(if (null? stk) (reverse acc)
(denestify-helper (car stk) acc (cdr stk))))
((pair? (car lst))
(denestify-helper (car lst) acc (cons (cdr lst) stk)))
(else
(denestify-helper (cdr lst) (cons (car lst) acc) stk))))
(define (denestify lst) (denestify-helper lst '() '()))
(denestify '(1 (2 (3 4 (5) (6 (7) (8)) (9))) 10))
Note how it uses the accumulator to build up the list in reverse and also a list as a stack.
Which results in
'(1 2 3 4 5 6 7 8 9 10)
as expected.
After I posted this I thought of this change:
(define (denestify-helper lst acc stk)
(cond ((null? lst)
(if (null? stk) (reverse acc)
(denestify-helper (car stk) acc (cdr stk))))
((pair? (car lst))
(denestify-helper (car lst) acc (if (null? (cdr lst))
stk
(cons (cdr lst) stk))))
(else
(denestify-helper (cdr lst) (cons (car lst) acc) stk))))
Which eliminates some useless consing by effectively doing tail-call optimization on our stack. One could go further and optimize handling of one element lists.
If you want to flatten a list of lists, then you have to use append to combine each sublist. Besides, your implementation is overly complicated, try this instead:
(define (denestify lst)
(cond ((null? lst) '())
((pair? (car lst))
(append (denestify (car lst))
(denestify (cdr lst))))
(else (cons (car lst) (denestify (cdr lst))))))
For example:
(denestify '(1 (2 (3 4 (5) (6 (7) (8)) (9))) 10))
=> '(1 2 3 4 5 6 7 8 9 10)
(define (associate lst)
(if (or (null? lst) (= (length lst) 1))
'()
(cons (cons (car lst) (cadr lst)) (associate (cddr lst)))))
(define (disassociate lst)
;(display (caar lst))
(if (null? lst)
'()
(cons (cons (caar lst) (cdar lst)) (disassociate (cdr lst)))))
(display (disassociate '((a . 1) (b . 2) (c . 3))))
(newline)
(display (associate '(a 1 b 2 c)))
(newline)
OUTPUT:
;; with list
((a 1) ((b 2) ((c 3) ())))
((a . 1) (b . 2))
;; with cons
((a . 1) (b . 2) (c . 3))
((a . 1) (b . 2))
I'm trying to flatten an association list in Scheme but the brackets
keep turning up even when I change the list to cons. Am I doing something wrong?
There's an error in the way you're creating the list in disassociate. Try this:
(define (disassociate lst)
(if (null? lst)
'()
(cons (caar lst)
(cons (cdar lst)
(disassociate (cdr lst))))))
Or alternatively, using list*:
(define (disassociate lst)
(if (null? lst)
'()
(list* (caar lst)
(cdar lst)
(disassociate (cdr lst)))))
The above assumes that the association list is using cons to stick together the values, notice how the output list is created by consing the first element, then the second and then calling the recursion. On the other hand, if the association list was created using list to stick together the values, then this is the way to disassociate it:
(define (disassociate lst)
(if (null? lst)
'()
(cons (caar lst)
(cons (cadar lst) ; here's the change
(disassociate (cdr lst))))))
Or alternatively:
(define (disassociate lst)
(if (null? lst)
'()
(list* (caar lst)
(cadar lst) ; here's the change
(disassociate (cdr lst)))))
A more idiomatic solution would be to use higher-order procedures to process the input list. Here's how, using foldr for the two association list variants described in the question:
; associations created with cons
(define (disassociate lst)
(foldr (lambda (pr ac) (list* (car pr) (cdr pr) ac))
'()
lst))
; associations created with list
(define (disassociate lst)
(foldr (lambda (pr ac) (list* (car pr) (cadr pr) ac))
'()
lst))
Your disassociate line needs to read:
(cons (caar lst) (cons (cdar lst) (disassociate (cdr lst)))))
quasi-quotation! Sometimes these are more clearly implemented using quasi-quotation because quasi-quotation lets you see the resulting list structure.
(define (associate lst)
(if (or (null? lst) (null? (cdr lst)))
'()
`(,(cons (car lst) (cadr lst)) ,#(associate (cddr lst)))))
(define (disassociate lst)
(if (null? lst)
'()
`(,(caar lst) ,(cdar lst) ,#(disassociate (cdr lst)))))
> (associate (disassociate '((a . 1) (b . 2))))
((a . 1) (b . 2))
Note that you could also write the associate quasi-quotation as:
`((,(car lst) . ,(cadr lst)) ,#(associate (cddr list)))))
but that starts getting harder to read for me even though it makes the association pair explicit.
I have a list '(1 2 1 1 4 5) and want output list as '((1 3)(2 1)(4 1)(5 1)). I have written a small code but I am stuck with how to calculate the cardinality for each number and then put it as pair in list. Can anyone please look at my code and give some ideas?
(define set2bags
(lambda (randlist)
(cond ((null? randlist) '())
(else
(sort randlist)
(makepairs randlist)))))
(define makepairs
(lambda (inlist)
(let ((x 0)) ((newlist '()))
(cond ((zero? (car inlist)) '())
(else
(eq? (car inlist)(car (cdr inlist)))
(+ x 1)
(makepairs (cdr inlist))
(append newlist (cons (car inlist) x)))))))
Your current solution is incorrect - it doesn't even compile. Let's start again from scratch, using a named let for traversing the input list:
(define set2bags
(lambda (randlist)
(cond ((null? randlist) '())
(else (makepairs (sort randlist >))))))
(define makepairs
(lambda (inlist)
(let loop ((lst inlist)
(prv (car inlist))
(num 0)
(acc '()))
(cond ((null? lst)
(cons (list prv num) acc))
((= (car lst) prv)
(loop (cdr lst) prv (add1 num) acc))
(else
(loop (cdr lst) (car lst) 1 (cons (list prv num) acc)))))))
Now it works as expected:
(set2bags '(1 2 1 1 4 5))
=> '((1 3) (2 1) (4 1) (5 1))
The trick is keeping a counter for the cardinality (I called it num), and incrementing it as long as the same previous element (I named it prv) equals the current element. Whenever we find a different element, we add a new pair to the output list (called acc) and reset the previous element and the counter.
Your code is fairly hard to read without proper formating.
I notice a two branch cond, which is easier to read as an if.
In your else clause of set2bags, you call (sort randlist) but leave it as is. You actually want to use this in the next s-expression (makepairs (sort randlist))
So far a pretty good idea.
Now in makepairs you should have better abstraction, say let variables like-first and unlike-first. If the inlist is null, then the function should be the null list, else it's the pair with the car being the list of the car of like-first and the length of like-first and the cdr being the result of calling makepairs on the unlike-first list
(define (makepairs inlist)
(let ((like-first (filter (lambda (x) (equal? x (car inlist)) inlist))
(unlike-first (filter (lambda (x) (not (equal? x (car inlist))) inlist)))
(if (null? inlist)
'()
(cons (list (car inlist) (length like-first)) (makepairs unlike-first)))))
more effecient version
(define (makepairs inlist)
(if (null? inlist)
'()
(let loop ((firsts (list (car inlist)))
(but-firsts (cdr inlist)))
(if (or (null? but-firsts)
(not (equal? (car firsts) (car but-firsts))))
(cons (list (car firsts) (length firsts))
(makepairs but-firsts))
(loop (cons (car but-firsts) firsts) (cdr but-firsts))))))
]=> (makepairs (list 1 1 1 2 4 5))
;Value 17: ((1 3) (2 1) (4 1) (5 1))
If you have your own implementation of sort, say a mergesort you could write this right into the merge part for the best effeciency.
(define (set2bags lst)
(mergesort2bags lst <))
(define (mergesort2bags lst pred)
(let* ((halves (divide-evenly lst))
(first-half (car halves))
(other-half (cadr halves)))
(cond ((null? lst) '())
((null? (cdr lst)) (list (list (car lst) 1)))
(else
(merge-bags
(mergesort2bags first-half pred)
(mergesort2bags other-half pred)
pred)))))
(define (divide-evenly lst)
(let loop
((to-go lst)
(L1 '())
(l2 '()))
(if (null? to-go)
(list L1 L2)
(loop (cdr to-go) (cons (car to-go) L2) L1))))
(define (merge-bags L1 L2 pred)
(cond ((null? L1) L2)
((null? L2) L1)
((pred (caar L1) (caar L2))
(cons (car L1) (merge-bags (cdr L1) L2 pred)))
((equal? (caar L1) (caar L2))
(cons (list (caar L1) (+ (cadar L1) (cadar L2)))
(merge-bags (cdr L1) (cdr L2) pred)))
(else (cons (car L2) (merge-bags L1 (cdr L2) pred)))))
(mergesort2bags (list 1 2 1 1 4 5) <)
;Value 46: ((1 3) (2 1) (4 1) (5 1))
I'm thinking for very large datasets with a lot of repetition this method would pay off.
I have this scheme procedure that makes a list of all the things in a (nested) list for which the predicate is true.
(define (deep-filter f lst)
(cond
((null? lst) '())
((and (atom? lst) (f lst)) lst)
((atom? lst) '() )
(else (cons (deep-filter f (car lst))
(deep-filter f (cdr lst))))))
An example:
(deep-filter number? '(2 (a ((c)) (1)) 6)) => (2 (() ((())) (1)) 6)
Is it possible to fix this procedure so that it doesn't print empty lists?
Thanks in advance
Try this:
(define (deep-filter f lst)
(cond
((null? lst) '())
((and (atom? lst) (f lst)) (list lst))
((atom? lst) '())
(else (append (deep-filter f (car lst))
(deep-filter f (cdr lst))))))
It's called flattening a list, the trick is using append instead of cons and packing single elements (second case in the cond) inside a list. Notice that this will eliminate all sublists, returning only the elements that satisfy the predicate.
If you need to preserve list structure after removing empty lists, then do this instead:
(define (deep-filter f lst)
(cond ((null? lst)
'())
((atom? (car lst))
(if (f (car lst))
(cons (car lst) (deep-filter f (cdr lst)))
(deep-filter f (cdr lst))))
(else
(filter (compose not null?)
(cons (deep-filter f (car lst))
(deep-filter f (cdr lst)))))))
Now it will work as expected:
(deep-filter number? '(2 (a ((c)) (b)) 6))
=> '(2 6)
(deep-filter number? '(2 (a ((c)) (1)) 6))
=>'(2 ((1)) 6)
(deep-filter number? '(2 (a ((4)) (1)) 6))
=> '(2 (((4)) (1)) 6)
(deep-filter number? '(2 (a ((4)) (1)) 6 ((((((b))))))))
=> '(2 (((4)) (1)) 6)
This is my first experience with Scheme. I have a list with integers and I wanna get the sum of all even number in list.
; sum_even
(define (sum_even l)
(if (null? l) l
(cond ((even? (car l)) 0)
((not(even? (car l))) (car l)))
(+ (sum_even (car l) (sum_even(cdr l))))))
(sum_even '(2 3 4))
(define (sum_even l)
(cond ((null? l) 0)
((even? (car l)) (+ (car l) (sum_even (cdr l))))
(else (sum_even (cdr l)))))
Not tested
You're not exactly asking a question. Are you checking if your solution is correct or looking for an alternate solution?
You can also implement it as follows via
(apply + (filter even? lst))
edit: If, as you mentioned, you can't use filter, this solution will work and is tail-recursive:
(define (sum-even lst)
(let loop ((only-evens lst) (sum 0))
(cond
((null? only-evens) sum)
((even? (car only-evens))
(loop (cdr only-evens) (+ (car only-evens) sum)))
(else (loop (cdr only-evens) sum)))))
(define (sum-even xs)
(foldl (lambda (e acc)
(if (even? e)
(+ e acc)
acc))
0
xs))
Example:
> (sum-even (list 1 2 3 4 5 6 6))
18
Here is another one with higher order functions and no explicit recursion:
(use srfi-1)
(define (sum-even ls) (fold + 0 (filter even? ls)))
Consider using the built-in filter function. For example:
(filter even? l)
will return a list of even numbers in the list l. There are lots of ways to sum numbers in a list (example taken from http://groups.engin.umd.umich.edu/CIS/course.des/cis400/scheme/listsum.htm):
;
; List Sum
; By Jerry Smith
;
(define (list-sum lst)
(cond
((null? lst)
0)
((pair? (car lst))
(+(list-sum (car lst)) (list-sum (cdr lst))))
(else
(+ (car lst) (list-sum (cdr lst))))))