(define (element-of-set x lst1)
(cond ((null? lst1) '())
((equal? x (car lst1)) (cons (car lst1) (element-of-set x (cdr lst1))))
(else
(element-of-set x (cdr lst1)))))
(define (helper set1 set2) (append set1 set2))
(define (union-set set1 set2)
(cond ((null? set1) '())
((> (length (element-of-set (car set1) (helper set1 set2))) 1) (cons (car set1) (union-set (cdr set1) (cdr set2))))
((> (length (element-of-set (car set2) (helper set1 set2))) 1) (cons (car set2) (union-set (cdr set1) (cdr set2))))
(else
(append (helper set1 set2) (union-set (cdr set1) (cdr set2))))))
This code is suppose to find the union of 2 sets. I tried to put the two sets together and then take out any repeats but it didn't work.
How about this:
#lang racket
(require racket/set)
(define (union-set set1 set2)
(set-union set1 set2))
(union-set '(1 2 3) '(4 3 2))
=> '(4 1 2 3)
FYI, set is a built-in data type in Racket, so it's easy to write a set union - just call the existing procedure! Anyway, if you want to roll your own version it's also easy, and simpler than your current implementation:
(define (element-of-set x lst1)
(cond ((null? lst1) #f)
((equal? x (car lst1)) #t)
(else (element-of-set x (cdr lst1)))))
(define (union-set set1 set2)
(cond ((null? set1) set2)
((element-of-set (car set1) set2)
(union-set (cdr set1) set2))
(else
(cons (car set1) (union-set (cdr set1) set2)))))
Here's how I'd do it in Common Lisp if it didn't include functions for set operations.
(defun set-union (set1 set2)
(remove-duplicates (append set1 set2)))
I'll write one in Scheme.
Related
I am stuck with this particular problem I was doing for fun:
Why does it cause a contract violation everytime car comes around? And are there any possible fixes?
(define (fv expr)
(cond ((eq? (car expr) 'lambda) (fv (cadr (cdr expr))))
((pair? (car expr)) (union (fv (car expr)) (fv (cdr expr))))
((symbol? (car expr)) (remove (car expr) (fv (cdr expr))))
(else '())))
(define (union set1 set2)
(cond ((null? set1) set2)
((member (car set1) set2) (union (cdr set1) set2))
(else (cons (car set1) (union (cdr set1) set2)))))
(define (remove item set)
(cond ((null? set) '())
((equal? item (car set)) (cdr set))
(else (cons (car set) (remove item (cdr set))))))
Input = (fv '(λ f (λ x (f ((t g) g)))))
Output =
car: contract violation expected: pair? given: '()
Output Should Be: (t g)
The error message:
car: contract violation expected: pair? given: '()
means that the function car was called with the argument '() (the empty list) and this gives an error.
Now you know that the problem is related to a call to car.
Since car is called multiple times in your program it is hard
to spot which car is the culprit. Presumably your Scheme implementation
displays a source locations that points to the offending expression.
But let's say you are not so lucky. In that case, you'll need to figure out which function has the problem. Inserting a few calls to display helps:
(define (fv expr)
(display (list 'fv: 'expr expr) (newline)
(cond ((eq? (car expr) 'lambda) (fv (cadr (cdr expr))))
((pair? (car expr)) (union (fv (car expr)) (fv (cdr expr))))
((symbol? (car expr)) (remove (car expr) (fv (cdr expr))))
(else '())))
(define (union set1 set2)
(display (list 'union: 'set1 set1 'set2 set2) (newline)
(cond ((null? set1) set2)
((member (car set1) set2) (union (cdr set1) set2))
(else (cons (car set1) (union (cdr set1) set2)))))
(define (remove item set)
(display (list 'remove: 'item item 'set set) (newline)
(cond ((null? set) '())
((equal? item (car set)) (cdr set))
(else (cons (car set) (remove item (cdr set))))))
If you try your example now, you'll see which function is called before the error occurs. In this case, I bet the problem is fv. Here car is called without a check that the argument is a non-empty list first.
if this is rotating a list to the left:
(define (rotate-left l)
(if (null? l)
'()
(append (cdr l) (cons(car l) '()))))
How would I rotate a list to the right?
If you're ok with writing a helper function to find the last element, it's pretty easy to do a recursive implementation:
(define rotate-right
(lambda (lis full)
(if (null? (cdr lis))
(cons (car lis) (get-all-but-last full))
(rotate-right (cdr lis) full))))
(define get-all-but-last
(lambda (lis)
(if (null? (cdr lis))
'()
(cons (car lis) (get-all-but-last (cdr lis))))))
Here is a short non-recursive solution:
(define (rotate-right l)
(let ((rev (reverse l)))
(cons (car rev) (reverse (cdr rev)))))
And here is a iterative solution:
(define (rotate-right l)
(let iter ((remain l)
(output '()))
(if (null? (cdr remain))
(cons (car remain) (reverse output))
(iter (cdr remain) (cons (car remain) output)))))
(rotate-right '(1 2 3 4 5)) ;==> (5 1 2 3 4)
(define (merge-sorted lst1 lst2)
(cond ((null? lst1) lst2)
((null? lst2) lst1)
((>= (car lst1) (car lst2))
(cons (car lst2) (merge-sorted lst1 (cdr lst2))))
(else
(cons (car lst1) (merge-sorted (cdr lst1) lst2)))))
Output:
(merge-sorted '(1 3 4) '(2 4 5))
=> '(1 2 3 4 4 5)
I have to write function on lists in Scheme.
How can I fix the duplication?
Instead of having >= as one condition, you can test equality separately, whereby whenever (car lst1) is equal to (car lst2), you would keep one of them, but remove both on your recursive call by doing:
(cons (car lst1)
(merge-sorted (cdr lst1) (cdr lst2)))
For example:
(define (merge-sorted lst1 lst2)
(cond
((null? lst1) lst2)
((null? lst2) lst1)
((> (car lst1)
(car lst2))
(cons (car lst2)
(merge-sorted lst1 (cdr lst2))))
((< (car lst1)
(car lst2))
(cons (car lst1)
(merge-sorted (cdr lst1) lst2)))
(else
(cons (car lst1)
(merge-sorted (cdr lst1) (cdr lst2))))))
then you would have:
(merge-sorted '(1 3 4) '(2 4 5))
=> '(1 2 3 4 5)
My task is to get first atom in structure, that's why I'm used flatten and func "first-atom-lst". But there is one big problem - I need to handle pairs in structure and do NOT broke pairs. Can you please help me to handle this?
(define (check-improper? lst)
(cond
((null? lst) #f)
((number? lst) #f)
((atom? lst) #f)
((list? lst) #f)
((pair? (cdr lst)) #t)
(#t #f)
))
(define (improper-to-proper lst)
(cond
((null? lst) '())
((not (pair? (cdr lst))) (cons lst '()))
(else (cons (car lst) (improper-to-proper (cdr lst))))
)
)
(define (first-atom-from-pair lst)
(cond ((check-improper? lst))
((null? lst) #f)
((atom? (car (flatten lst)))
(car (flatten lst)))
(else
(first-atom (cdr (flatten lst))))))
(define (first-atom lst)
(cond ((check-improper? lst))
((null? lst) #f)
((atom? lst) lst)
((pair? (cdr lst)) (first-atom-from-pair lst))
((pair? lst) #f)
((atom? (car (flatten (not pair? lst))))
(car (flatten (not pair? lst))))
(else
(first-atom (cdr (flatten lst))))))
You cannot flatten improper lists, but it's actually overkill in your case anyway. You could do something like this:
(define (first-atom tree)
(if (null? tree)
#f
(if (pair? tree)
(first-atom (car tree))
tree)))
then
> (first-atom '((2 . 0) 2))
2
> (first-atom '((1 . 0) (2 . 3) 2))
1
> (first-atom '((2 . 1) (2 3) 1))
2
> (first-atom '(((((((1 . 2) 3) 4))))))
1
Note that my second result differs from yours, but I believe mine is correct since the first element of a flattened list would also yield 1.
Solve problem, but need improvement.
(define (atom? a)
(and (not (pair? a))
(not (null? a))))
(define (true-pair? p)
(cond
((list? p) #f)
((pair? (cdr p)) #f)
(else #t)))
(define (flatten-atom x)
(cond ((null? x) '())
((atom? x) (list x))
((true-pair? x) (list x))
(else (append (flatten-atom (car x))
(flatten-atom (cdr x))))))
(flatten-atom '((a b . c)))
(flatten-atom '((a b c) d e () ((f)) (1 . 2)))
(flatten-atom '((a b . c) (((4 5))) () 6 (7 . 8)))
> (a (b . c))
> (a b c d e f (1 . 2))
> (a (b . c) 4 5 6 (7 . 8))
I have been working on the following function flatten and so far have it working for just lists. I was wondering if someone could provide me with some insight on how to get it work with pairs? For example (flatten '(a .a)) would return (a a). Thanks.
(define (flatten list)
(cond ((null? list) null)
((list? (car list)) (append (flatten (car list)) (flatten (cdr list))))
(else
(cons (car list) (flatten (cdr list))))))
Here's one option:
(define (flatten x)
(cond ((null? x) '())
((pair? x) (append (flatten (car x)) (flatten (cdr x))))
(else (list x))))
This does what you want, without requiring append, making it o(n). I walks the list as a tree. Some schemes might throw a stack overflow error if the list is too deeply nested. In guile this is not the case.
I claim no copyright for this code.
(define (flatten lst)
(let loop ((lst lst) (acc '()))
(cond
((null? lst) acc)
((pair? lst) (loop (car lst) (loop (cdr lst) acc)))
(else (cons lst acc)))))
(define (flatten l)
(cond
[(empty? l) empty]
[(list? l)
(append (flatten (first l))
(flatten (rest l)))]
[else (list l)]))