Racket find shared elements between lists - scheme

I'm trying to create a specific response for a given list if it has shared elements with another list. As in if I have a list that is (My name is John) and I have another list of (John Adam Jacob) I would want the first list to be able to see that John is in the second list, and be able to print something along the lines of (this is a known name) or something similiar.
The code I have thought of uses map, and member.
(define (specific-reply user-list)
(cond (member (map (lambda (user-list)) '(John Adam Jacob)))
(write (this is a known name))
(else
(write (this is not a known name)))))
I'm extremely knew to both racket and scheme however and I haven't really gotten it to compile yet so I think I'm largely off.
Any help would be greatly appreciated.

You don't need to complicate the problem if your task is to just find if a is a member of (a b c),
Here's a piece of Scheme code that can tell if a is a member of lat.
It's just a simple recursive function that compares each element of lat with a for a match.
(define member?
(lambda (a lat)
(cond
((null? lat) #f)
((eq? a lat) #t)
(else
(member? a (cdr lat))))))
If you want to take this further and find the intersection of two lists, we can do something like this!
(define intersect
(lambda (set1 set2)
(letrec
((I (lambda (set)
(cond
((null? set) (quote ()))
((member? (car set) set2)
(cons (car set)
(I (cdr set))))
(else (I (cdr set)))))))
(I set1))))
You can use this code as such. Tested from guile compiler
(begin
(display (intersect `(1 2 3) `(1 3 4 5 2)))
(newline))
>> (1 2)
EDIT
I recommend you read The Little Schemer and the The Seasoned Schemer to get more familiar with these kind of concepts

Why not use set in racket:
(define (list-intersect-2 lst1 lst2)
(set->list
(set-intersect (list->set lst1)
(list->set lst2))))
For a solution that takes one or more lists:
(define (list-intersect lst1 . lstn)
(set->list
(foldl set-intersect
(list->set lst1)
(map list->set lstn))))
(list-intersect '(1 2 3) '(2 3 4) '(3 4 8))
; ==> (3)

One can also use built-in functions filter and member to find intersection of 2 lists:
(define (intersection l1 l2)
(remove-duplicates
(filter (λ (x) (member x l1))
l2)))
Above checks each item of l2 to keep it only if it is a member of l1 also.
One can also use for/list to check each element and return a list of common items:
(define (intersect l1 l2)
(remove-duplicates
(for/list ((i l1)
#:when (member i l2))
i)))
Both above function remove duplicates. Just avoiding use of remove-duplicates may result in different result if simply the order of l1 and l2 is interchaged. If one wants that the repeated elements to come repeatedly in outcome list, one can use following function in which common items are removed before proceeding:
(define (intersection2 l1 l2)
(let loop ((l1 l1)
(l2 l2)
(ol '()))
(cond
[(empty? l1) (reverse ol)]
[(member (first l1) l2) ; first item of l1 is common
(loop (rest l1) ; loop with rest of l1
(remove (first l1) l2) ; remove common item from l2
(cons (first l1) ol))] ; add common item to outlist
[else
(loop (rest l1)
l2
ol)])))
Testing:
(intersection2 '(2 4 2 7 2 10) '(10 2 9 2 0 11))
Output:
'(2 2 10)

Related

Reversed output in tail recursion

(define (sqr-tail lst)
(define (helper lst res)
(if (null? lst)
res
(cond ((list? (car lst))
(helper (cdr lst)
(cons (helper (car lst) ())
result)))
(else (helper (cdr lst)
(cons (expt (car lst) 2) res))))))
(helper lst ()))
I have this tail recursion function in scheme which sqr every element in the list, but unfortunately the result is reversed to what I suppose to output.
for input :
> (sqr-tail (list 1 2 4 3 (list 1 2 (list 1)) 3 3))
the output :
< (9 9 ((1) 4 1) 9 16 4 1)
thanks.
This is something that is inherent in the way Lisp/Scheme lists work: because there are only really conses, the way to build up lists is backwards. So the common tail-recursive-loop-with-an-accumulator approach as you've used ends up building the result backwards. The simple answer to this is that you need to reverse the result when you return it, and in your case, since you are recursing (not tail-recursing) into nested lists as well you need to reverse them as well of course.
Here is a somewhat cleaned-up and error-protected version of your original function (note this was written in Racket -- it may not be quite legal Scheme, but it is close):
(define (square-nested-list/reversed l)
(define (snl-loop lt accum)
(cond [(null? lt)
accum]
[(cons? lt)
(let ([head (car lt)]
[tail (cdr lt)])
(cond [(list? head)
(snl-loop tail (cons (snl-loop head '())
accum))]
[(number? head)
(snl-loop tail (cons (* head head) accum))]
[else (error "mutant horror death")]))]
[else (error "mutant death horror")]))
(snl-loop l '()))
So to get the result forwards we need to reverse the accumulator when we return it. This is a very small change to the above function:
(define (square-nested-list/forward l)
(define (snl-loop lt accum)
(cond [(null? lt)
(reverse accum)]
[(cons? lt)
(let ([head (car lt)]
[tail (cdr lt)])
(cond [(list? head)
(snl-loop tail (cons (snl-loop head '())
accum))]
[(number? head)
(snl-loop tail (cons (* head head) accum))]
[else (error "mutant horror death")]))]
[else (error "mutant death horror")]))
(snl-loop l '()))
If you want to be annoyingly clever and purist you can now notice that the tail-recursive-loop-with-accumulator approach produces results in reverse, so the trivial case of it is, in fact, reverse:
(define (square-nested-list/forward/stupidly-purist l)
(define (rev l)
(define (rev-loop lt a)
(if (null? lt) a (rev-loop (cdr lt) (cons (car lt) a))))
(rev-loop l '()))
(define (snl-loop lt accum)
(cond [(null? lt)
(rev accum)]
[(cons? lt)
(let ([head (car lt)]
[tail (cdr lt)])
(cond [(list? head)
(snl-loop tail (cons (snl-loop head '())
accum))]
[(number? head)
(snl-loop tail (cons (* head head) accum))]
[else (error "mutant horror death")]))]
[else (error "mutant death horror")]))
(snl-loop l '()))
People who do this are generally just trying to score points on the internet though (there are even more stupidly pure approaches for which you get more points).
And here are the results of calling those three functions:
> (define test-data '((1 2 3) (4 5) 6))
> (displayln (square-nested-list/reversed test-data))
(36 (25 16) (9 4 1))
> (displayln (square-nested-list/forward test-data))
((1 4 9) (16 25) 36)
> (displayln (square-nested-list/forward/stupidly-purist test-data))
((1 4 9) (16 25) 36)
Some other approaches
One issue with this 'reverse the result' is that it involves walking the result to reverse it, and also making a copy of it. Once upon a time this was something that was a real problem, because machines had only a tiny amount of memory and were very slow. Indeed, if your lists are enormous it still is a problem. More commonly it is a problem which exists in the minds of people who either, like me, remember machines which were very slow and had only tiny memory, or whose minds have been damaged by languages which encourage you to behave as if you were using such machines ('C programmers know the cost of everything but the value of nothing').
One partial answer to this problem offered by older Lisps is a function which is like reverse but works destructively: it reverses a list in place, destroying the original structure. This function is called nreverse in Common Lisp. If it existed in Scheme it would be called reverse! I suppose.
A more complete answer is to build the list forwards in the first place. You do this by trickery involving keeping a reference to the final cons of the list, and repeatedly replacing its cdr with a new final cons whose car is the object you are collecting. If you want to do this without your code looking horrible you need to use a macro: the one I wrote (for Common Lisp, not Scheme) was called collecting as it collected lists forwards. There are many others. Note that this approach requires mutable conses and also is not clearly efficient in the presence of modern garbage collectors.
Macros like collecting still have their place I think: not because they make your code faster, but because they can make it clearer: if you want collect some results into a list, then do that, don't do this weird reversing thing.
You are almost there.
All you need to do is reverse the return value for each sublist:
(defun sqr-tail (lst)
(labels ((helper (lst res)
(cond ((null lst)
(reverse res))
((listp (car lst))
(helper (cdr lst)
(cons (helper (car lst) ())
res)))
(t (helper (cdr lst)
(cons (expt (car lst) 2) res))))))
(helper lst ())))
(sqr-tail (list 1 2 4 3 (list 1 2 (list 1)) 3 3))
==> (1 4 16 9 (1 4 (1)) 9 9)
or, in scheme:
(define (sqr-tail lst)
(define (helper lst res)
(cond ((null? lst)
(reverse res))
((list? (car lst))
(helper (cdr lst)
(cons (helper (car lst) ())
res)))
(else (helper (cdr lst)
(cons (expt (car lst) 2) res)))))
(helper lst ()))

Scheme dot product function of two lists

I'm trying to define a dot-prod function that takes two lists as parameters and applies the dot product version by taking x1*y1+x2*y2 and so on. I got it to work with an empty list but that is it. Thanks.
(define (dot-prod l1 l2)
(cond ((or (null? l1)(null? l2)) '())
(else
(cons (* (car l1) (car l2))
(* (cdr l1) (cdr l2))))))
This is perfect for using built-in procedures. Assuming that the lists have equal length:
(define (dot-prod l1 l2)
(apply + (map * l1 l2)))
But if you want to write a solution from scratch, you must:
Return a value that makes sense for the base case - if it's an addition, we want a zero there, not an empty list, we're not building a new list as output
Call the dot-prod procedure in the recursive step, something that you entirely forgot
Combine the result meaningfully - again, if we're doing an addition, we want to use + not cons
This is what I mean:
(define (dot-prod l1 l2)
(cond ((null? l1) 0)
(else
(+ (* (car l1) (car l2))
(dot-prod (cdr l1) (cdr l2))))))
Either way, it works as expected:
(dot-prod '(1 2 3) '(4 5 6))
=> 32
'for/sum' loop can be used here for a simple understandable function. If l and k are 2 lists:
(define (dotproduct l k)
(for/sum ((i l)(j k))
(* i j)))
Testing:
(dotproduct '(1 2 3) '(4 5 6))
; =>32
This can also be modified if (x y) values occur as a list of lists:
(define (f l)
(for/sum ((i l))
(apply * i)))
(f '((1 4)(2 5)(3 6)))
; => 32
The method is also extendable if x,y,z or even more values are to be evaluated.

Return alternate elements of 3 given lists. Scheme

This procedure is supposed to return a list with alternative values from 3 given lists. So for example (alt ('a b c)'(1 2 3)'(i j k)) should return '(a 1 i b 2 j c 3 k).
This is my logic so far. I would take the first element of each list and recursively call the procedure again with cdr as the new arguments.
(define (alternate lst1 lst2 lst3)
(cons (car lst1)
(cons (car lst2)
(cons (car lst3)
(alternate (cdr lst1)(cdr lst2)(cdr lst3))))))
The error occurs in
(cons (car lst1)
"mcar: contract violation
expected: mpair?
given()"
(cons a d) returns a newly allocated pair whose first element is a and second element is d. But since there are 3 not 2 given lists, is there another way to approach creating lists?
Would this be another approach?
(define (alternate lst1 lst2 lst3)
(list (car lst1)(car lst2)(car lst3))
(alternate (cdr lst1)(cdr lst2)(cdr lst3)))
You need to add empty list check to avoid the error. So your code should look like this:
(define (alternate lst1 lst2 lst3)
(if (or (null? lst1) (null? lst2) (null? lst3))
'()
(cons (car lst1)
(cons (car lst2)
(cons (car lst3)
(alternate (cdr lst1)(cdr lst2)(cdr lst3)))))))
If you can use SRFI-1 (or more precisely append-map), then you can also write like this:
(define (alt l1 l2 l3) (append-map list l1 l2 l3))
You can just use the following standard Scheme:
(define (alternate . lists)
(apply append (apply map list lists)))
Not very optimized, but does the job :)
Eval: http://eval.ironscheme.net/?id=175

Scheme and Merge Sort?

I was assigned to write a merge sort in Scheme but I have some issues with it. I showed it my professor and he said there is one simple mistake. Can someone help me?
Plzz!
(define msort
(lamdba(1st)
(cond
((null?? 1st) 1st)
((null? (cdr 1st)) 1st)
(#t ((letrec ((half (quotient (lenght 1st) 2))
(merge (lamdba (a b result)
(cond ((null? a) (apped (reserve a) result))
((null? b) (append (reserve a) result))
((> (car a) (car b) (merge a (cdr b) (cons (car b) result))
(#t (merge (cdr a) b (cons (car a) result)))))))
(merge (msort (take 1st half)) (msort (drop 1st half)) '()))))))
One simple mistake? He probably referred to #1, but even after fixing that you have some identifiers and parenthesis to fix:
lambda, null?, length, append, and reverse is spelled incorrectly.
letrec result gets applied since you have excess parenthesis around it.
cond in merge where you compare elements are missing parenthesis two places.
It's obvious you need help with parenthesis matching so you should download a decent IDE to write code in. I use DrRacket for Scheme development (#!R5RS, #!R6RS and #!racket) and it idents (just press CTRL+i to get it reidented after pasting in code) and indicate where function names are written wrong when you hit RUN.
Making merge a global function in the beginning and perhaps move it to a letrec later (if you have to) might ease development. Eg. you could find errors by testing stuff like (merge '(3 2 1) '()).
This is no guarantee the program will work since I only address syntax here. You need to debug it! DrRacket has a debugger too!
I think it is useful to implement first a function that allow to merge two ordered lists:
(define (merge l1 l2)
(if (empty? l1)
l2
(if (empty? l2)
l1
(if (< (car l1) (car l2))
(cons (car l1) (merge (cdr l1) l2))
(cons (car l2) (merge l1 (cdr l2)))))))
Now assume we have a function (get ls pos) capable to return the element of ls in position pos:
(define (get ls pos)
(if (= pos 1)
(car ls)
(get (cdr ls) (- pos 1))))
Finally, we can implement mergesort function:
(define (mergesort l p r)
(if (= p r)
(cons (get l p) empty)
(merge (mergesort l p (floor (/ (+ p r) 2))) (mergesort l (+ (floor (/ (+ p r) 2)) 1) r))))

removing last element of a list(scheme)

So I have to remove the last element of a list in scheme.
For example, let's say I have a list (1 2 3 4). I need to return:
(1 2 3)
My idea:
reverse(list)
car(list)
reverse(list)
Is there a reverse function in scheme(racket)?
You wrote: "reverse, car, reverse". I believe you meant to write "reverse, cdr, reverse". There's nothing wrong with this solution; it's linear in the size of the list, just like any solution to this that uses the standard lists.
As code:
;; all-but-last: return the list, not including the last element
;; list? -> list?
(define (all-but-last l) (reverse (cdr (reverse l))))
If the multiple traversal of the list or the needless construction of another list copy bothers you, you can certainly avoid it, by writing the thing directly.
Given your almost-solution, I'm going to assume that this isn't homework.
Here's what it would look like, in racket:
#lang racket
(require rackunit)
;; all-but-last : return the list, except for the last element
;; non-empty-list? -> list?
(define (all-but-last l)
(cond [(empty? l) (error 'all-but-last "empty list")]
[(empty? (rest l)) empty]
[else (cons (first l) (all-but-last (rest l)))]))
(check-equal? (all-but-last '(3 4 5))
'(3 4))
There is a reverse, but using it would not be very efficient. I suggest the following recursive function.
(define (remove-last lst)
(if (null? (cdr lst))
'()
(cons (car lst) (remove-last (cdr lst)))))
(remove-last '(1 2 3 4)) ; returns '(1 2 3)
The if checks whether it is at the last element of the list.
SRFI 1 (activate in Racket using (require srfi/1)) has a drop-right function:
(drop-right '(1 2 3 4) 1) ; => (1 2 3)
I would do a recursive function that goes down the list and attaches the element (using cons) if the element after it is not the last, and appends nothing if it isn't.
I haven't done scheme for years though so that's as far as I can go.
Someone can run with how to implement it (unless it's homework then they probably shouldn't!)
I've done something simpler than: reverse(list), car(list), reverse(list) to get the last element, check out:
(define (last-one liste)
(if(null? (cdr liste))
null
(cons (car liste) (last-one (cdr liste)))
)
)
Those who are looking for another way can check this out:
(define (removing-last xx)
(remove (list-ref xx (- (length xx) 1)) xx))
I would write a simple recursion, altering the typical "empty? mylist" base case to "empty? (rest mylist)," so that I can return empty when the input list is only 1 element.
(define (removelast mylist)
(cond
[(empty? (rest mylist)) empty]
[(cons? mylist) (cons (first mylist) (removelast (rest mylist)))]))
(removelast (list 1 2 3 4 5))
By the way, this code is in Racket/PLT Scheme, a subset of Scheme.

Resources