Output Elements in List That Are Not Incommon - scheme

I've created a function that should return the elements that the two lists do not have in common. Currently, they are outputting exactly what is passed into it. Any suggestions on how to fix this?
(define (findDifference lst1 lst2)
(if (null? lst1) lst2
(cons (car lst1) (findDifference (cdr lst1) lst2))))
(findDifference '(2 3 4 (2 3) 2 (4 5)) '(2 4 (4 5))
Current Output: (2 3 4 (2 3) 2 (4 5) 2 4 (4 5))
Desired Output: (3 (2 3))

You're asking for the symmetric difference of two lists. Try this:
(define (diff list1 list2)
(union (complement list1 list2)
(complement list2 list1)))
Using the following helper procedures:
(define (union list1 list2)
(cond ((null? list1) list2)
((member (car list1) list2) (union (cdr list1) list2))
(else (cons (car list1) (union (cdr list1) list2)))))
(define (complement list1 list2)
(cond ((null? list1) '())
((member (car list1) list2) (complement (cdr list1) list2))
(else (cons (car list1) (complement (cdr list1) list2)))))
Also notice that if you're using Racket you can simply use the built-in set-symmetric-difference procedure for the same effect. For example:
(diff '(2 3 4 (2 3) 2 (4 5)) '(2 4 (4 5)))
=> '(3 (2 3))

Since it seems like homework and I do not want to spoil the fun, here is the brute force algorithm, with some bits left out. If you are really stuck I will give you the full source.
(define (sym-diff xs ys)
;; Since we have the helper function we can determine all the elements that are in the first list,
;; but not in the second list.
;; Then we can pass this intermediate result to the second call to sym-diff-helper.
;;This will return us all the elements that are in the second list but not the first.
(let ((in-first-not-second ...))
(sym-diff-helper ys xs in-first-not-second)))
;; This function will return all the elements from the first list that are not in the second list!
(define (sym-diff-helper xs ys acc)
(cond
;; If the first list is empty we have checked it.
(...
acc)
;; If the first list is not empty yet, check if the first element
;; is in the second list.
;; If so, discard it and continue with the rest of the list.
((member ... ...)
(sym-diff-helper ... ... ...)
;; If the first element of the first list is not in the second list,
;; add it to the accumulator and continue with the rest of the list.
(else
(sym-diff-helper ... ... ...)))
(sym-diff-helper '(1 2 3) '(2 3 4) '())
;; == (1)
(sym-diff-helper '(1 2 (3 4) 5) '(2 3 4) '())
;; == (5 (3 4) 1)
(sym-diff '(2 3 4 (2 3) 2 (4 5)) '(2 4 (4 5)))
;; == ((2 3) 3)
Note that I have chosen to use member. There are a few other search functions but they were not well suited in this case. Hence, I left it there. More info on the search functions can be found here: http://docs.racket-lang.org/reference/pairs.html#%28part..List.Searching%29

Related

Pair combinations in scheme

I'm trying to find the various combinations that can be made with a list of N pairs in scheme. Here is where I'm at thus far:
(define (pair-combinations list-of-pairs)
(if (null? list-of-pairs)
nil
(let ((first (caar list-of-pairs))
(second (cadar list-of-pairs))
(rest (pair-combinations (cdr list-of-pairs))))
(append
(list (cons first rest))
(list (cons second rest))
))))
Now, I'm not sure if the logic is correct, but what I notice immediately is the telescoping of parentheticals. For example:
(define p1 '( (1 2) (3 4) (5 6) ))
(pair-combinations p1)
((1 (3 (5) (6)) (4 (5) (6))) (2 (3 (5) (6)) (4 (5) (6))))
Obviously this is from the repetition of the list (... within the append calls, so the result looks something like (list 1 (list 2 (list 3 .... Is there a way to do something like the above in a single function? If so, where am I going wrong, and how would it be properly done?
The answer that I'm looking to get would be:
((1 3 5) (1 3 6) (1 4 5) (1 4 6) (2 3 5) (2 3 6) (2 4 5) (2 4 6))
That is, the possible ways to choose one element from N pairs.
Here is one way to think about this problem. If the input is the empty list, then the result is (). If the input is a list containing a single list, then the result is just the result of mapping list over that list, i.e., (combinations '((1 2 3))) --> ((1) (2) (3)).
Otherwise the result can be formed by taking the first list in the input, and prepending each item from that list to all of the combinations found for the rest of the lists in the input. That is, (combinations '((1 2) (3 4))) can be found by prepending each element of (1 2) to each of the combinations in (combinations '((3 4))), which are ((3) (4)).
It seems natural to express this in two procedures. First, a combinations procedure:
(define (combinations xss)
(cond ((null? xss) '())
((null? (cdr xss))
(map list (car xss)))
(else
(prepend-each (car xss)
(combinations (cdr xss))))))
Now a prepend-each procedure is needed:
(define (prepend-each xs yss)
(apply append
(map (lambda (x)
(map (lambda (ys)
(cons x ys))
yss))
xs)))
Here the procedure prepend-each takes a list xs and a list of lists yss and returns the result of prepending each x in xs to the lists in yss. The inner map takes each list ys in yss and conses an x from xs onto it. Since the inner mapping produces a list of lists, and the outer mapping then produces a list of lists of lists, append is used to join the results before returning.
combinations.rkt> (combinations '((1 2) (3 4) (5 6)))
'((1 3 5) (1 3 6) (1 4 5) (1 4 6) (2 3 5) (2 3 6) (2 4 5) (2 4 6))
Now that a working approach has been found, this could be converted into a single procedure:
(define (combinations-2 xss)
(cond ((null? xss) '())
((null? (cdr xss))
(map list (car xss)))
(else
(apply append
(map (lambda (x)
(map (lambda (ys)
(cons x ys))
(combinations-2 (cdr xss))))
(car xss))))))
But, I would not do that since the first version in two procedures seems more clear.
It might be helpful to look just at the results of prepend-each with and without using append:
combinations.rkt> (prepend-each '(1 2) '((3 4) (5 6)))
'((1 3 4) (1 5 6) (2 3 4) (2 5 6))
Without using append:
(define (prepend-each-no-append xs yss)
(map (lambda (x)
(map (lambda (ys)
(cons x ys))
yss))
xs))
combinations.rkt> (prepend-each-no-append '(1 2) '((3 4) (5 6)))
'(((1 3 4) (1 5 6)) ((2 3 4) (2 5 6)))
It can be seen that 1 is prepended to each list in ((3 4) (5 6)) to create a list of lists, and then 2 is prepended to each list in ((3 4) (5 6)) to create a list of lists. These results are contained in another list, since the 1 and 2 come from the outer mapping over (1 2). This is why append is used to join the results.
Some Final Refinements
Note that prepend-each returns an empty list when yss is empty, but that a list containing the elements of xs distributed among as many lists is returned when yss contains a single empty list:
combinations.rkt> (prepend-each '(1 2 3) '(()))
'((1) (2) (3))
This is the same result that we want when the input to combinations contains a single list. We can modify combinations to have a single base case: when the input is '(), then the result is (()). This will allow prepend-each to do the work previously done by (map list (car xss)), making combinations a bit more concise; the prepend-each procedure is unchanged, but I include it below for completeness anyway:
(define (combinations xss)
(if (null? xss) '(())
(prepend-each (car xss)
(combinations (cdr xss)))))
(define (prepend-each xs yss)
(apply append
(map (lambda (x)
(map (lambda (ys)
(cons x ys))
yss))
xs)))
Having made combinations more concise, I might be tempted to go ahead and write this as one procedure, after all:
(define (combinations xss)
(if (null? xss) '(())
(apply append
(map (lambda (x)
(map (lambda (ys)
(cons x ys))
(combinations (cdr xss))))
(car xss)))))

Scheme function that returns shortest of its list arguments

I am trying to create a scheme function that will return the shortest of its list of arguments.
(shortest '(1 2) '(2 3 4) '(4) '(5 6 7 8)) should compile (4).
This is what I have so far...
(define (shortest lst) (foldl (lambda (e r) (if (or (not r) (< e r)) e r))
#f
lst))
It gives error arity mismatch.
Your answer is close to be correct, but you need to actually compare the lengths of the sublists, and make sure that your procedure accepts a variable number of arguments. This should work, with minimum changes:
; the . is for accepting multiple args
(define (shortest . lst)
(foldl (lambda (e r)
; notice how we compare the lengths
(if (or (not r) (< (length e) (length r))) e r))
#f
lst))
It works as expected:
(shortest '(1 2) '(2 3 4) '(4) '(5 6 7 8))
=> '(4)
(shortest '())
=> '()
(shortest)
=> #f
Your function has only one argument named lst, but you call it on variable number of lists. So, you should decide which input do you expect:
List of lists
(define (shortest lst)
(if (null? lst) lst
(car (sort lst
(lambda (l1 l2)
(< (length l1) (length l2)))))))
(shortest '((1 2) (2 3 4) (4) (5 6 7 8)))
(shortest '())
Variable number of lists
(define (shortest . args)
(if (null? args) args
(car (sort args
(lambda (l1 l2)
(< (length l1) (length l2)))))))
(shortest '(1 2) '(2 3 4) '(4) '(5 6 7 8))
(shortest '())
One interesting thing to ask is: can you solve this problem without taking the length of all the lists? If you have a list with a million elements and one with four, do you really need to compute the length of the huge list to know the answer?
Well, the answer is no, you don't. Here's one approach to doing this:
(define (shortest . args)
(define (step tail-pairs new-tail-pairs)
;; step has a list of pairs of tail & original-list pairs it is looking at,
;; and another list of pairs of (cdr tail) & original-list which it will
;; look at on the next cycle.
(if (null? tail-pairs)
;; Run out of things to look at, start on the next cycle
(step new-tail-pairs '())
(let ((this-tail-pair (first tail-pairs))
(more-tail-pairs (rest tail-pairs)))
(if (null? (car this-tail-pair))
;; found it: nothing left in this list so return the original
;; list
(cdr this-tail-pair)
;; Not empty: add this tail pair with its first element removed to
;; the next cycle list, and loop on the remains of this cycle
(step more-tail-pairs (cons (cons (cdr (car this-tail-pair))
(cdr this-tail-pair))
new-tail-pairs))))))
;; build the initial list of tail pairs and start stepping down it.
(step (map cons args args) '()))

Invert a list without the last element in Racket

I am trying to write a Racket function with tail recursion, it should return the inverted list but the last element should remain in the last position.
That is, I need to get from the example:
(reversar-lista '(1 2 3 4))
>(3 2 1 4)
Here is what I have so far:
(define (reversar-lista lista)
(define (reversa-aux lista aux)
(if (null? lista) aux
(reversa-aux (cdr lista) (reverse (cons (car lista) aux)))
)
)
(reversa-aux lista '())
)
I get the following output:
(3 1 2 4)
It's possible to solve this question using only built-in procedures, there's no need to implement explicit looping logic:
(define (reversar-lista lista)
(if (null? lista)
'()
(append (reverse (drop-right lista 1))
(take-right lista 1))))
Of course, it's also possible to write a solution by hand - but you have to be careful with the edge cases, in particular watch out for the empty list case.
The main problems with your solution are that you must stop the recursion before the last element, and that you must not reverse the result at every iteration, the list is being built in reverse anyway. This is what I mean:
(define (reversar-lista lista)
(define (reversa-aux lista aux)
(if (null? (cdr lista))
(append aux (list (car lista)))
(reversa-aux (cdr lista) (cons (car lista) aux))))
(if (null? lista)
'()
(reversa-aux lista '())))
Either way, it works as expected:
(reversar-lista '())
=> '()
(reversar-lista '(1))
=> '(1)
(reversar-lista '(1 2))
=> '(1 2)
(reversar-lista '(1 2 3))
=> '(2 1 3)
(reversar-lista '(1 2 3 4))
=> '(3 2 1 4)

Scheme recursive

Deos anyone know, how I can make this funktion recursive by inserting the function somewhere? I am not allowed to use implemented functions for lists except append, make-pair(list) and reverse.
(: split-list ((list-of %a) -> (tuple-of (list-of %a) (list-of %a))))
(check-expect (split-list (list 1 2)) (make-tuple (list 1) (list 2)))
(check-expect (split-list (list 1 2 3 4)) (make-tuple (list 1 3) (list 2 4)))
(check-expect (split-list (list 1 2 3)) (make-tuple (list 1 3) (list 2)))
(check-expect (split-list (list 1 2 3 4 5)) (make-tuple (list 1 3 5) (list 2 4)))
(check-expect (split-list (list 1 2 3 4 5 6)) (make-tuple (list 1 3 5) (list 2 4 6)))
(define split-list
(lambda (x)
(match x
(empty empty)
((make-pair a empty) (make-tuple a empty))
((make-pair a (make-pair b empty)) (make-tuple (list a) (list b)))
((make-pair a (make-pair b c)) (make-tuple (list a (first c)) (list b (first(rest c))))))))
Code for make-tuple:
(define-record-procedures-parametric tuple tuple-of
make-tuple
tuple?
(first-tuple
rest-tuple))
Here's a way you can fix it using match and a named let, seen below as loop.
(define (split xs)
(let loop ((xs xs) ;; the list, initialized with our input
(l empty) ;; "left" accumulator, initialized with an empty list
(r empty)) ;; "right" accumulator, initialized with an empty list
(match xs
((list a b rest ...) ;; at least two elements
(loop rest
(cons a l)
(cons b r)))
((cons a empty) ;; one element
(loop empty
(cons a l)
r))
(else ;; zero elements
(list (reverse l)
(reverse r))))))
Above we use a loop to build up left and right lists then we use reverse to return the final answer. We can avoid having to reverse the answer if we build the answer in reverse order! The technique used here is called continuation passing style.
(define (split xs (then list))
(match xs
((list a b rest ...) ;; at least two elements
(split rest
(λ (l r)
(then (cons a l)
(cons b r)))))
((cons a empty) ;; only one element
(then (list a) empty))
(else ;; zero elements
(then empty empty))))
Both implementations perform to specification.
(split '())
;; => '(() ())
(split '(1))
;; => '((1) ())
(split '(1 2 3 4 5 6 7))
;; => '((1 3 5 7) (2 4 6))
Grouping the result in a list is an intuitive default, but it's probable that you plan to do something with the separate parts anyway
(define my-list '(1 2 3 4 5 6 7))
(let* ((result (split my-list)) ;; split the list into parts
(l (car result)) ;; get the "left" part
(r (cadr result))) ;; get the "right" part
(printf "odds: ~a, evens: ~a~n" l r))
;; odds: (1 3 5 7), evens: (2 4 6)
Above, continuation passing style gives us unique control over the returned result. The continuation is configurable at the call site, using a second parameter.
(split '(1 2 3 4 5 6 7) list) ;; same as default
;; '((1 3 5 7) (2 4 6))
(split '(1 2 3 4 5 6 7) cons)
;; '((1 3 5 7) 2 4 6)
(split '(1 2 3 4 5 6 7)
(λ (l r)
(printf "odds: ~a, evens: ~a~n" l r)))
;; odds: (1 3 5 7), evens: (2 4 6)
(split '(1 2 3 4 5 6 7)
(curry printf "odds: ~a, evens: ~a~n"))
;; odds: (1 3 5 7), evens: (2 4 6)
Oscar's answer using an auxiliary helper function or the first implementation in this post using loop are practical and idiomatic programs. Continuation passing style is a nice academic exercise, but I only demonstrated it here because it shows how to step around two complex tasks:
building up an output list without having to reverse it
returning multiple values
I don't have access to the definitions of make-pair and make-tuple that you're using. I can think of a recursive algorithm in terms of Scheme lists, it should be easy to adapt this to your requirements, just use make-tuple in place of list, make-pair in place of cons and make the necessary adjustments:
(define (split lst l1 l2)
(cond ((empty? lst) ; end of list with even number of elements
(list (reverse l1) (reverse l2))) ; return solution
((empty? (rest lst)) ; end of list with odd number of elements
(list (reverse (cons (first lst) l1)) (reverse l2))) ; return solution
(else ; advance two elements at a time, build two separate lists
(split (rest (rest lst)) (cons (first lst) l1) (cons (second lst) l2)))))
(define (split-list lst)
; call helper procedure with initial values
(split lst '() '()))
For example:
(split-list '(1 2))
=> '((1) (2))
(split-list '(1 2 3 4))
=> '((1 3) (2 4))
(split-list '(1 2 3))
=> '((1 3) (2))
(split-list '(1 2 3 4 5))
=> '((1 3 5) (2 4))
(split-list '(1 2 3 4 5 6))
=> '((1 3 5) (2 4 6))
split is kind of a de-interleave function. In many other languages, split names functions which create sublists/subsequences of a list/sequence which preserve the actual order. That is why I don't like to name this function split, because it changes the order of elements in some way.
Tail-call-rescursive solution
(define de-interleave (l (acc '(() ())))
(cond ((null? l) (map reverse acc)) ; reverse each inner list
((= (length l) 1)
(de-interleave '() (list (cons (first l) (first acc))
(second acc))))
(else
(de-interleave (cddr l) (list (cons (first l) (first acc))
(cons (second l) (second acc)))))))
You seem to be using the module deinprogramm/DMdA-vanilla.
The simplest way is to match the current state of the list and call it again with the rest:
(define split-list
(lambda (x)
(match x
;the result should always be a tuple
(empty (make-tuple empty empty))
((list a) (make-tuple (list a) empty))
((list a b) (make-tuple (list a) (list b)))
;call split-list with the remaining elements, then insert the first two elements to each list in the tuple
((make-pair a (make-pair b c))
((lambda (t)
(make-tuple (make-pair a (first-tuple t))
(make-pair b (rest-tuple t))))
(split-list c))))))

List of lists to normal list in scheme

I'm trying to make a scheme function that returns a 'normal' list from a pair made by lists of lists.
I'm trying to change something like this:
((((((() 1) 2) 3) 4) (12 13 14)) ((((() 8) 9) 10) 11) (5 6 7))
into something like this:
(1 2 3 4 12 13 14 8 9 10 11 5 6 7)
I've tried using tail recursion, but my code just returns the same initial pair.
Then I did this, but it also doesn't work and kind of shuffles the list:
(define (tolist l1 lista)
(if (empty? (cdr lista))
null
(if (empty? (car lista))
(append l1 (cdr lista))
(tolist (append l1 (car lista)) (list (cdr lista)) ))))
What can I do?
Oscar Lopez has given you a good answer, although I would test l1 with list? rather than pair?, as with his code (flatten '(1 . 2)) would produce (1 2), which is probably not your desired result.
With that correction his code can be turned into a fold:
(define (flatten seq)
(letrec ((flatten-with-append
(lambda (elt acc) ;; args as for SRFI-1 fold
(if (list? elt)
(fold flatten-with-append acc elt)
(append acc (list elt))))))
(flatten-with-append seq '())))
One problem with this way of doing it is that it appends, which is not very efficient. It is usually better to cons into the accumulator and then reverse. This would be likely to be more optimal:
(define (flatten seq)
(letrec ((flatten-with-cons
(lambda (elt acc) ;; args as for SRFI-1 fold
(if (list? elt)
(fold flatten-with-cons acc elt)
(cons elt acc)))))
(reverse (flatten-with-cons seq '()))))

Resources