Scheme -- how to find the intersection of two streams - stream

Is there a way to define a stream as the intersection of two streams? i.e., if a and b are streams, c is the stream containing the elements that are in both a and b.

Two streams can be intersected as long as they're sorted (even if they're infinite!). Granted, if they're infinite and not sorted there's no way to know if an element is in a stream. But if they're sorted we can advance over either stream (depending on the element's order) until we find an element in common, which is then added to the output.
Here's a proof of concept using Racket's stream primitives, and assuming two streams of numbers as input:
(define (stream-intersection s1 s2)
(if (or (stream-empty? s1) (stream-empty? s2))
(stream)
(let ((x1 (stream-first s1))
(x2 (stream-first s2)))
(cond ((> x1 x2)
(stream-intersection s1 (stream-rest s2)))
((< x1 x2)
(stream-intersection (stream-rest s1) s2))
(else
(stream-cons x1
(stream-intersection (stream-rest s1)
(stream-rest s2))))))))

Related

Racket: How can I fix my code so that it will return all the flipped pairs that is missing?

This function should return the symmetric closure of L.
Examples:
(Symmetric-Closure'((a a) (a b) (b a) (b c) (c b))) ---> '((a a) (a b) (b a) (b c) (c b))
(Symmetric-Closure'((a a) (a b) (a c))) ---> '((a a) (a b) (a c) (b a)(c a))
(Symmetric-Closure'((a a) (b b))) ---> '((a a) (b b))
(Symmetric-Closure'())---> '()
Here is what I have in Racket
(define (Symmetric-Closure L)
;Iterate over each pair in L
(andmap (lambda (x)
;If the flipped pair does not exist in L, it will
;return L and the flipped pair that is missing. Otherwise, return L.
(if(not(member (list (cadr x)(car x)) L))
(cons (list (cadr x)(car x)) L)
(append L)))
L))
How can I fix my code so that it will return all the flipped pairs that is missing
For example, my code only return L and the last missing flipped pair (c a) instead of (b a) and (c a)
;this is wrong, it should return '((c a)(b a)(a a)(a b)(a c))
(Symmetric-Closure '((a a)(a b)(a c))-----> '((c a)(a a)(a b)(a c))
;this is correct
(Symmetric-Closure '((a a)(a b)(b a)(b c)(c b)))-----> '((a a)(a b)(b a)(b c)(c b))
andmap means "map the list using this function and then and together the results." In Racket, whenever you and together any values, the result is going to be either the last value provided to it, or false. For example, (and value1 value2) results in value2 if neither value1 nor value2 is false (and if one of them is false, the result is false as well). Since the value produced by your lambda is never false, the result of your andmap is going to be the value of the lambda expression the final time it is called, which in this case, could be the list (cons (list (cadr x)(car x)) L) for the last value of x that it sees in the original list L. This means that all preceding values that were consed don't factor into the result at all.
You could modify this to use a simple map instead. But this produces a list of lists of pairs, not a list of pairs which is what you want. So at the end you need to flatten this to arrive at the result.
(define (symmetric-closure L)
;Iterate over each pair in L
(apply append
(map (lambda (x)
;If the flipped pair does not exist in L, it will
;return L and the flipped pair that is missing. Otherwise, return L.
(if (not (member (list (cadr x) (car x)) L))
(list (list (cadr x) (car x)) x)
(list x)))
L)))
One thing to be aware of, though, is that this algorithm calls member for every element in the original list. Checking for membership in a list is O(N) and you are doing this N times, meaning that the complexity of this algorithm is O(N²). You should be able to do this more efficiently, for instance by using a hash set.

delete! function for R5RS

I'm trying to write a delete! function that mutates a list and removes from it a specified value. This is the code I have so far.
(define (extend! l . xs)
(if (null? (cdr l))
(set-cdr! l xs)
(apply extend! (cdr l) xs)))
(define (delete! lis y)
(define returnLis '())
(for-each (lambda(x) (if(not(eq? x y))
(extend! returnLis x))) lis)
returnLis)
The problem I am having is that I am trying to add to an empty list which can't be done in Scheme.
Desired outcome:
(delete! '(1 2 3 4 5) 3)
=> (1 2 4 5)
Your extend function use actually would make a copy of each element in a fresh pair, but since the initial value is '() it cannot be set-cdr!. The whole point of mutating something is that old variables will continue point to the changed data and making a copy won't do that.
You need to see the pairs. You want to remove 3
[1,-]->[2,-]->[3,-]->[4,-]->[5,-]->()
So When you have found 3, you need to change the cdr of the pair that holds 2 and pint it the pair that holds 3s cdr like this:
[1,-]->[2,-]->[4,-]->[5,-]->()
Something like this then:
(define (delete lst e)
(if (and (not (null? lst)) (not (null? (cdr lst))))
(if (equal? (cadr lst) e)
(set-cdr! lst (cddr lst))
(delete (cdr lst) e))
'undefined))
(define test (list 1 2 3 4 5))
(delete lst 3)
lst ; ==> (1 2 4 5)
Notice I'm using list since a quoted literal cannot be used here since you are not allowed to change constant data like '(1 2 3 4 5). The result will be undefined or it will signal an error.
It won't work if the element in question is the first. It's because the variable points to the first pair and this only changes the pointers in pairs, not bindings. One could just switch the two first and delete the second, but in the event you have a one element list you are still stuck. Scheme implementations of mutable queues usually have a head consisting of a dummy element not considered part of the list to delete the first element.
All you need is a head-sentinel technique:
(define (delete! lis y)
(define returnLis (list 1))
(for-each (lambda(x) (if(not(eq? x y))
(extend! returnLis x))) lis)
(cdr returnLis))
Well, not all... because as it is, this is a quadratic algorithm. It re-searches the returnLis from top anew while adding each new element with extend!. Better just maintain the last cdr cell and update it:
(define (delete! lis y)
(define returnLis (list 1))
(define last-cell returnLis)
(for-each (lambda(x) (cond ((not(eq? x y))
; (extend! last-cell x)
(set-cdr! last-cell (list x))
(set! last-cell (cdr last-cell)))))
lis)
(cdr returnLis))
But, as #Sylwester points out, with this approach you shouldn't use an exclamation mark in the name, as this will return a freshly built list instead of mutating the argument's structure.

Comparing two lists of symbols in lisp

Let's say I have two lisp lists that are the same but in different sequence: '(A B C) and '(C B A).
How can I check if they are the same (in the sense that the elements are the same)?
CL-USER> (equal '(a b c) '(c b a))
NIL
Like this:
(not (set-exclusive-or '(a b c) '(c b a)))
which returns T if the two sets are equal, NIL otherwise.
[Edit] If they are not truly sets then you could use this:
(not (set-exclusive-or
(remove-duplicates '(a b c))
(remove-duplicates '(c b a))))
If the lists are not sets and repeated items are important, one could use a function like this:
(defun same-elements-p (a b)
(loop (when (and (null a) (null b))
(return t))
(when (or (null a) (null b))
(return nil))
(setf b (remove (pop a) b :count 1))))
If both lists are empty, they are the same. We remove all items of one list from the other and see what happens. Note the :count 1 argument to REMOVE. It makes sure than only one item is removed.
We can define the functions perm-equal and perm-equalp which are similar to EQUAL and EQUALP except that if the arguments are lists, then their permutation doesn't matter. The list (1 1 2 3) is perm-equal to (2 1 3 1), but not to (2 3 1).
The implementation works by normalizing values into a canonical permutation by sorting. This brings up the ugly spectre of requiring an inequality comparison. However, we can hide that by providing a predefined one which works for numbers, symbols and strings. (Why doesn't the sort function do something like this, the way eql is defaulted as the :key parameter?)
(defun less (a b)
(if (realp a)
(< a b)
(string< a b)))
(defun lessp (a b)
(if (realp a)
(< a b)
(string-lessp a b)))
(defun perm-equal (a b &optional (pred #'less))
(if (or (atom a) (atom b))
(equal a b)
(let ((as (sort (copy-list a) pred))
(bs (sort (copy-list b) pred)))
(equal as bs))))
(defun perm-equalp (a b &optional (pred #'lessp))
(if (or (atom a) (atom b))
(equalp a b)
(let ((as (sort (copy-list a) pred))
(bs (sort (copy-list b) pred)))
(equalp as bs))))
Notes:
Doesn't handle improper lists: it just tries to sort them and it's game over.
Even though equalp compares vectors, perm-equalp doesn't extend its permutation-squashing logic over vectors.
realp is used to test for numbers because complex numbers satisfy numberp, yet cannot be compared with <.
The trivial answer for non-sets is to sort both lists. CL's default sort is destructive, so you'll need copies if you want to keep them afterwards.
(defun sorted (a-list predicate)
(sort (copy-list a-list) predicate))
(defun same-list-p (list-a list-b predicate)
(equalp (sorted list-a predicate) (sorted list-b predicate)))
It doesn't have the best performance, but is simple and functional.
This looks to me like an O(n) variant:
(defun equal-elementwise (a b &key (test #'eq))
(loop with hash = (make-hash-table :test test)
for i on a for j on b do
(let ((i (car i)) (j (car j)))
(unless (funcall test i j)
(setf (gethash i hash) (1+ (gethash i hash 0))
(gethash j hash) (1- (gethash j hash 0)))))
finally (return
(unless (or (cdr i) (cdr j))
(loop for value being the hash-value of hash do
(unless (zerop value) (return))
finally (return t))))))
However, this won't be efficient on short lists.

Infinite ascending sequence in Racket

Is there an analog of Python's itertools.count in Racket? I want to create an infinite stream of evenly spaced numbers. in-naturals is similar to what i want, but does not provide step. I'd want not to reinvent the wheel, but if there's no equivalent function, how to write one? (i presume, generators should be used)
You can get the same functionality of Python's count using in-range with an infinite end value:
(define (count start step)
(in-range start +inf.0 step))
For example:
(define s (count 2.5 0.5))
(stream-ref s 0)
=> 2.5
(stream-ref s 1)
=> 3.0
(stream-ref s 2)
=> 3.5
(stream-ref s 3)
=> 4.0
Making the function yourself can be done in a single line:
(define (stream-from n s) (stream-cons n (stream-from (+ n s) s)))
To test it, you here is an example that prints 100000 numbers:
#lang racket
(require racket/stream)
(define (stream-from n s) (stream-cons n (stream-from (+ n s) s)))
(define (stream-while s p)
(let ([fst (stream-first s)])
(if (p fst) (stream-cons fst (stream-while (stream-rest s) p)) empty-stream)))
(define test (stream-while (stream-from 0 1) (λ (x) (< x 100000))))
(stream-for-each println test)

Scheme streams with Taylor series

I've been doing some homework, wrote some code and can't actually find the reason why it doesn't work. The main idea of this part of the work is to make a stream that will give me elements of Taylor series of cosine function for a given X (angle i guess). anyways here is my code, I'd be happy if some one could point me to the reasons it doesn't work :)
(define (force exp) exp)
(define (s-car s) (car s))
(define (s-cdr s) (force (cdr s)))
; returns n elements of stream s as a list
(define (stream->list s n)
(if (= n 0)
'()
(cons (s-car s) (stream->list (s-cdr s) (- n 1)))))
; returns the n-th element of stream s
(define stream-ref (lambda (s n)
(if (= n 1)
(s-car s)
(stream-ref (s-cdr s) (- n 1)))))
; well, the name kinda gives it away :) make factorial n!
(define (factorial x)
(cond ((= x 0) 1)
((= x 1) 1)
(else (* x (factorial (- x 1))))))
; this function is actually the equation for the
; n-th element of Taylor series of cosine
(define (tylorElementCosine x)
(lambda (n)
(* (/ (expt -1 n) (factorial (* 2 n))) (expt x (* 2 n)))))
; here i try to make a stream of those Taylor series elements of cosine
(define (cosineStream x)
(define (iter n)
(cons ((tylorElementCosine x) n)
(lambda() ((tylorElementCosine x) (+ n 1)))))
(iter 0))
; this definition should bind cosine
; to the stream of taylor series for cosine 10
(define cosine (cosineStream 10))
(stream->list cosine 10)
; this should printi on screen the list of first 10 elements of the series
However, this doesn't work, and I don't know why.
I'm using Dr.Scheme 4.2.5 with the language set to "Essentials of Programming Languages 3rd ed".
Since I was feeling nice (and nostalgic about scheme) I actually waded through your code to finde the mistakes. From what I can see there are 2 problems which keeps the code from running as it should:
If I understand your code correctly (force exp) should evaluate exp, however you directly return it (unevaluated). So it probably should be defined as (define (force exp) (exp))
The second problem is in your lambda: (lambda() ((tylorElementCosine x) (+ n 1)) ) will evaluate to the next element of the taylor series, while it should evaluate to a stream. You probably want something like this: (lambda() (iter (+ n 1)) )
I haven't checked if the output is correct, but with those modifications it does at least run. So if there are any more problems with the code the should be in the formula used.
However I'd suggest that next time you want help with your homework you at least tell us where exactly the problem manifests and what you tried already (the community does frown on "here is some code, please fix it for me" kind of questions).

Resources