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)
Related
I'm trying to do a program in scheme for a school assignment. Given a list, it's supposed to return all given permutations of that list. My issue is that I don't know why it would work for numbers but not characters. Doesn't seem like it would change any of the logic!
Here is my code:
(define (remove1 x lst)
(cond
((null? lst) '())
((= x (car lst)) (remove1 x (cdr lst)))
(else (cons (car lst)
(remove1 x (cdr lst))))))
(define (permute lst)
(cond
((= (length lst) 1) (list lst))
(else (apply append (map (lambda (i)
(map (lambda (j) (cons i j))
(permute (remove1 i lst))))
lst)))))
(permute '(1 2 3))
= is used for comparing numbers; for more general comparisons, use eq?, equal? or (as has been suggested) eqv?.
I've appreciate some helping hand over here. I'm trying to construct a procedure which delete duplicated elements in a list. This part is easy. But then I also want to delete duplicated elements (which may also be lists) and if it is a list the duplicated elements in that list should also be deleted, e.g (make-set (list 1 2 3 2 (list 1 3 2 4 3 4) (list 1 3 2 4 3 4))) should be '(1 3 2 (1 2 3 4)) but in our case it becomes '(1 3 2 2 3 4). Which isn't what we want. What am I doing wrong? Thanks :)
;; Checks if an element x appears in a list (set)
(define (element-of-set? x set)
(cond (( null? set) false)
((equal? x (car set)) true)
(else (element-of-set? x (cdr set)))))
;; Delete duplicated elements of a list (set)
(define make-set
(lambda (lst)
(cond ((null? lst) '())
((if (list? (car lst))
(cond ((null? (car lst))
'()
)
((element-of-set? (caar lst) (car lst)) (make-set (cdar lst))
)
(else (cons (caar lst) (make-set cadr lst))))
(cond ((element-of-set? (car lst) (cdr lst)) (make-set (cdr lst)))
(else (cons (car lst) (make-set (cdr lst))))))))))
Actually, if you want to build a function make-set that manages a generalized, untyped concept of set (that is a set that can contain either numbers or recursively other sets), the definition is quite complex. Here is my try.
;; check if x is contained in set
(define (contained? x set)
(cond ((null? set) false)
((my-equal? x (car set)) true)
(else (contained? x (cdr set)))))
;; check if all the elements of set1 are contained in set2
(define (set-contained? set1 set2)
(cond ((null? set1) true)
((null? set2) false)
(else (and (contained? (car set1) set2)
(set-contained? (cdr set1) set2)))))
;; check if set1 is equal to set2
(define (set-equal? set1 set2)
(and (= (length set1) (length set2))
(set-contained? set1 set2)))
;; check if x1 is equal to x2, when x1 and x2 can be sets or elements
(define (my-equal? x1 x2)
(cond ((list? x1) (and (list? x2) (set-equal? x1 x2)))
((list? x2) false)
(else (eq? x1 x2))))
;; add the element x to set, if not already present
(define (add-to-set x set)
(cond ((null? set) (list x))
((my-equal? x (car set)) set)
(else (cons (car set) (add-to-set x (cdr set))))))
;; make a set from a list lst
(define (make-set lst)
(cond ((null? lst) '())
((list? (car lst)) (add-to-set (make-set (car lst)) (make-set (cdr lst))))
(else (add-to-set (car lst) (make-set (cdr lst))))))
(make-set (list 1 2 3 2 (list 1 3 2 4 3 4) (list 1 3 2 4 3 4))) ; => '(1 3 (1 2 3 4) 2)
The function make-set builds the set by inserting in turn each element of the original list in a new set, so to check if the element is already present (also, if the element is a list, first it is transformed in a set). The other functions should be easy to understand, given the following convention:
If a parameter is called set, the function expects a list which has been already represented as set.
If a parameter is called x, then it is either a number or a set.
The specification of make-set is a little unclear, but maybe this works for you:
(define make-set
(lambda (lst)
(cond ((null? lst) '())
((list? (car lst)) (cons (make-set (car lst)) (make-set (cdr lst))))
((element-of-set? (car lst) (cdr lst)) (make-set (cdr lst)))
(else (cons (car lst) (make-set (cdr lst)))))))
Note that using lst is not in common use.
A nice convention is to use x as an element in a list and use xs as a list of x-elements.
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'd like to create a Scheme function that yields true if it is passed a list that is composed entirely of identical elements. Such a list would be '(1 1 1 1). It would yield false with something like '(1 2 1 1).
This is what I have so far:
(define (list-equal? lst)
(define tmp (car lst))
(for-each (lambda (x)
(equal? x tmp))
lst)
)
Clearly this is incorrect, and I'm new to this. I guess I'm unable to express the step where I'm supposed to return #t or #f.
Thanks in advance!
EDIT:
I fiddled a bit and found a solution that seems to work very well, and with a minimal amount of code:
(define (list-equal? lst)
(andmap (lambda (x)
(equal? x (car lst)))
lst))
Thanks again for the help everyone.
Minimal amount of code, if you don't care that it only works for numbers:
(define (list-equel? lst)
(apply = lst))
Examples:
> (list-equel? '(1 1 2 1))
#f
> (list-equel? '(1 1 1 1))
#t
> (list-equel? '(1))
#t
The andmap solution is nice, but if andmap is not available, you can use this. It uses basic operations (and, or, null check, equality check) and handles empty lists and one element lists. Similar to Sean's implementation, but no helper definition is necessary.
(define (list-equal? args)
(or (or (null? args)
(null? (cdr args)))
(and (eq? (car args) (cadr args))
(list-equal? (cdr args)))))
Try something like this:
(define (list-equal? lst)
(define (helper el lst)
(or (null? lst)
(and (eq? el (car lst))
(helper (car lst) (cdr lst)))))
(or (null? lst)
(helper (car lst) (cdr lst))))
This might not be the cleanest implementation, but I think it will correctly handle the cases of empty lists and one-element lists.
In R6RS there's the for-all function, which takes a predicate and a list, and returns #t if the predicate returns true for all elements in the list and #f otherwise, which is exactly what you need here.
So if you're using R6RS (or any other scheme dialect that has the for-all function), you can just replace for-each with for-all in your code and it will work.
(define (list-equal? lst)
(if (= (cdr lst) null)
true
(and (equal? (car lst) (cadr lst))
(list-equal? (cdr lst)))))
Something like this should work:
(define (list-equal? lst)
(cond ((< (length lst) 2) #t)
(#t (and (equal? (car lst) (cadr lst))
(list-equal? (cdr lst))))))
The other answers in this thread all seem too complicated (I read through them all), so here's my take on it:
(define (all-equal? lst)
(define item (car lst))
(let next ((lst (cdr lst)))
(cond ((null? lst) #t)
((equal? item (car lst)) (next (cdr lst)))
(else #f))))
(It does not work with an empty list, by design. It's easy to add a (if (null? lst) #t ...) if necessary.)
A short, concise solution:
#lang racket
(define (all-equal? lst)
(for/and
([i (in-permutations lst)])
(equal? (first i) (second i))))
; TEST CASES
(require rackunit)
(check-false (all-equal? '(1 2 3)))
(check-true (all-equal? '(1 1 1)))
(check-true (all-equal? '()))
Note that this uses racket, so this may not work with your scheme implementation.
Yet another solution:
(define (all-same ls)
(cond
((or (null? ls)
(null? (cdr ls))) #t)
(else (and (equal? (car ls) (next ls))
(all-same (cdr ls)))))))
(define (next ls)
(cond
((or (null? ls)
(null? (cdr ls))) '())
(else (cadr ls)))))
For is bad in these languages. Try
(define list-equal?
(lambda (lst)
(if (= lst null)
(true)
(foldr = (car lst) (cdr lst))
)))
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)