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.
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'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)
I am using this script from The little schemer, to get intersection of two sets. But I am getting unbound identifier error at 'member?', can anyone please tell what's wrong with it:
(define intersect
(lambda (set1 set2)
(cond ((null? set1) (quote ()))
((member? (car set1) set2)
(cons (car setl)
(intersect (cdr set1) set2)))
(else (intersect (cdr setl) set2)))))
I was missing this function above:
(define member?
(lambda (a lat)
(cond ((null? lat) #f)
(else (or (eq? (car lat) a)
(member? a (cdr lat)))))))
Also, I want to intersect two lists like: '((1 2)(2 7)) '((1 3)(4 5)) = '((1 5)), any suggestions on how to go about it? I am looking up the answers from this post: How to write a scheme function that takes two lists and returns four lists
You have a typo in intersect where you have switched 1 with as lower case L. If you fix that your intersect seems fine by me if you are comparing symbols. Eg.
(define intersect
(lambda (set1 set2)
(cond
((null? set1)(quote ()))
((member? (car set1) set2)
(cons (car set1)
(intersect (cdr set1) set2)))
(else (intersect (cdr set1) set2)))))
(intersect '(a b c d) '(c d e f)) ; ==> (c d)
To make it compare other things than symbols, you need to change your member? so that it uses equal? instead of eq?. It will be like this:
(define member?
(lambda (a lat)
(cond
((null? lat) #f)
(else (or (equal? (car lat) a) ; changed eq? to equal?
(member? a (cdr lat)))))))
(intersect '((1 2)(3 4)(5 6)) '((9 10) (7 8) (5 6))) ; ==> ((5 6))
Even after this. The symbol version above still works.
In any LISP (Common Lisp and Scheme at least) you have member. It uses equal and evaluate to false (whatever is false in the implementation) when it's not found and if it's found it evaluates to the rest of the argument list starting from where the element was found (which is considered true):
(member 'a '(x y a c)) ; ==> (a c)
Using standard member instead of your own predicate:
(define intersect
(lambda (set1 set2)
(cond
((null? set1)(quote ()))
((member (car set1) set2)
(cons (car set1)
(intersect (cdr set1) set2)))
(else (intersect (cdr set1) set2)))))
(intersect '((1 2)(3 4)(5 6)) '((9 10) (7 8) (5 6))) ; ==> ((5 6))
(intersect '(a b c d) '(c d e f)) ; ==> (c d)
EDIT 1
It seems you are not searching for intersection but a special alist merge:
#!r6rs
(import (rnrs base)
(rnrs lists))
;; if you dont have r6rs remove the above and
;; uncomment this rnrs/lists-6 memp
#;(define (memp predicate? lst)
(cond ((null? lst) #f)
((predicate? lst) lst)
(else (memp predicate? (cdr lst)))))
(define (alist-merge merge-proc alist-1 alist-2)
(if (null? alist-1)
'()
(let* ((name (caar alist-1))
(found (memp (lambda (x) (equal? (car x) name)) alist-2)))
(if found
(cons (merge-proc (car alist-1) (car found))
(alist-merge merge-proc
(cdr alist-1)
alist-2))
(alist-merge merge-proc
(cdr alist-1)
alist-2)))))
(define (alist-merge-add alist-1 alist-2)
(alist-merge (lambda (x y)
(list (car x)
(+ (cadr x) (cadr y))))
alist-1
alist-2))
(alist-merge-add '((1 2)(2 7)) '((1 3)(4 5))) ; ==> ((1 5))
My intersection solution:
#lang racket
(define (intersect set1 set2)
(cond [(empty? set1) '()]
[(empty? set2) '()]
[(= (caar set1) (caar set2)) (cons (list (caar set1)
(+ (cadar set1)
(cadar set2)))
(intersect (cdr set1) (cdr set2)))]
[(< (caar set1) (caar set2)) (intersect (cdr set1) set2)]
[else (intersect set1 (cdr set2))]))
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 wrote this code to create a list from en number of arguments given
(define (create-list . e)
e)
But I need it to remove any duplicated numbers from the list within this block itself.
I have tried and searched for hours and can't find a solution without placing dozens of lines of code on other blocks.
For example let's say my input is
(create-list . 2 2 3 5 5 )
I need the list created to be '(2 3 5) and not '(2 2 3 5 5 )...
The order of the numbers doesn't matter.
Basically, you need to do something like:
(define (create-list . e) (dedupe e))
I can think of a really simple but probably inefficient way to do this:
(define (dedupe e)
(if (null? e) '()
(cons (car e) (dedupe (filter (lambda (x) (not (equal? x (car e))))
(cdr e))))))
If you can't use existing functions like filter, you can make one yourself:
(define (my-filter pred ls)
(cond ((null? ls) '())
((pred (car ls)) (cons (car ls) (my-filter pred (cdr ls))))
(else (my-filter pred (cdr ls)))))
This one is faster:
(define (remove-duplicates l)
(cond ((null? l)
'())
((member (car l) (cdr l))
(remove-duplicates (cdr l)))
(else
(cons (car l) (remove-duplicates (cdr l))))))
But even better,
mit-scheme provides delete-duplicates, which does exactly what you want.
The most efficient (traversing the list once) way to do this is to define a function which goes through the list element-by-element. The function stores a list of which elements are already in the de-duped list.
An advantage of this solution over #Tikhon Jelvis's, is that the list elements don't need to be in order, to be deduplicated.
Given a function elem, which says if a is an element of l:
(define (elem? a l)
(cond ((null? l) #f)
((equal? a (car l)) #t)
(else (elem? a (cdr l)))))
We can traverse the list, storing each element we haven't seen before:
(define (de_dupe l_remaining already_contains)
(cond ((null? l_remaining) already_contains)
((elem? (car l_remaining) already_contains) (de_dupe (cdr l_remaining) already_contains))
(else (de_dupe (cdr l_remaining) (cons (car l_remaining) already_contains)))))
Note: for efficiency, this returns the elements in reverse order
(define (delete x)
(cond
((null? x) x)
((= (length x) 1) x) | ((null? (cdr x)) x)
((= (car x) (cadr x)) (delete (cdr x)))
(#t (cons (car x) (delete (cdr x))))
)
)