I want to write a procedure that rearranges the items in one stream (the data stream) into the order specified by another stream (the order stream), which consists of item numbers specifying the desired order.
For example, if the data stream starts with 4, 13, 2, 8 and the order stream starts with 3, 1, 4, 2 then the result stream will start with 2, 4, 8, 13. (The first item of the result is the third item of the data, the second item of the result is the first item of the data, and so on.)
I have got so far...
(define (reorder order-stream data-stream)
(cond ((stream-null? order-stream) the-empty-stream)
((stream-null? data-stream) the-empty-stream)
(else (cons-stream (stream-ref order-stream data-stream))))
(define (stream-ref s n)
(if (= n 0)
(stream-car s)
(stream-ref (stream-cdr s) (- n 1))))
However, the output is not as expected.
Using Racket streams.
Notice that
(stream-ref data-stream (stream-first order-stream))
will use the first element of the order stream to pick out an element of the data stream.
Note also that unless the data stream support random access, this will be we slow.
#lang racket
(require racket/stream)
(define (reorder order-stream data-stream)
(cond ((stream-empty? order-stream) empty-stream)
(else (stream-cons (stream-ref data-stream (stream-first order-stream))
(reorder (stream-rest order-stream) data-stream)))))
(define ones (stream-cons 1 ones))
(define (stream-add s1 s2)
(stream-cons (+ (stream-first s1) (stream-first s2))
(stream-add (stream-rest s1) (stream-rest s2))))
(define fibonacci (stream-cons 1 (stream-cons 1 (stream-add fibonacci (stream-rest fibonacci)))))
(for/list ([x fibonacci] [n 10]) x) ; '(1 1 2 3 5 8 13 21 34 55)
(for/list ([x (reorder '(3 1 4 2 10) fibonacci)]) x) ; '(3 1 5 2 89)
Related
A recent Q&A entry showcased the following primes generating code from SICP, using lazy streams:
(define (sieve stream)
(cons-stream
(stream-car stream)
(sieve (stream-filter
(lambda (x)
(not (divisible? x (stream-car stream))))
(stream-cdr stream)))))
(define primes (sieve (integers-starting-from 2)))
An answer there showed primes to be equivalent, among other possibilities, to the following:
(cons-stream 2
(cons-stream 3
(cons-stream 5
(cons-stream 7
(sieve
(stream-filter (lambda (x) (not (divisible? x 7)))
(stream-filter (lambda (x) (not (divisible? x 5)))
(stream-filter (lambda (x) (not (divisible? x 3)))
(stream-filter (lambda (x) (not (divisible? x 2)))
(integers-starting-from 9))))))))))
It seems there are too many filter streams here -- for instance 7 was produced by filtering the input numbers by 2, 3 and 5, whereas it only really had to be tested by 2 alone -- only the numbers above 9 need really be test divided by 3, let alone by 5 etc.
This problem becomes more and more pronounced as we go along producing this stream of primes. Overall, producing first n primes takes O(n^2) with this code.
Can we do better?
Indeed, we need to only start filtering out multiples of a prime after its square is encountered in the input.
For that, we shall use the primes and their squares. And we'll use the same code to produce the primes we need to produce our primes:
(define (pprimes)
(cons-stream 2
(psieve (stream-map (lambda (x) (cons x (* x x)))
(pprimes)) ;; here
(integers-starting-from 3))))
(define (psieve pr-sqrs numbers) ;; prime+square pairs
(if (< (stream-car numbers)
(cdr (stream-car pr-sqrs))) ;; prime's square
(cons-stream
(stream-car numbers)
(psieve pr-sqrs ;; same prime+square pair
(stream-cdr numbers))) ;; for the next number
(psieve
(stream-cdr pr-sqrs) ;; advance prime+square's stream
(stream-filter ;; and start filtering
(let ((p (car (stream-car pr-sqrs)))) ;; by this prime now
(lambda (x)
(not (divisible? x p))))
(stream-cdr numbers)))))
Now this leads to
(pprimes)
=
....
=
(cons-stream 2
(cons-stream 3
(cons-stream 5
(cons-stream 7
(cons-stream 11
(cons-stream 13
(cons-stream 17
(cons-stream 19
(psieve (cons-stream 5 ... )
(cons-stream 25 ... )
(stream-filter (lambda (x) (not (divisible? x 3)))
(stream-filter (lambda (x) (not (divisible? x 2)))
(integers-starting-from 20))))))))))))
=
....
which, undoubtedly, is much better. No number below 25 will be tested by 5, etc.
This is still trial division, and runs in about n^1.5. True sieve of Eratosthenes should run at n log n log log n which is empirically usually close to n^1.1..1.2 or thereabouts. But this n^1.5 is a great improvement over the quadratic algorithm too, and in practice will run much faster than it in absolute terms as well.
I'm trying to implement an accumulator for an infinite stream. I've written the following code but it's running into an infinite loop and failing to terminate
(define (stream-first stream) (car stream))
(define (stream-second stream) (car ((cdr stream))))
(define (stream-third stream) (car ((cdr ((cdr stream))))))
(define (stream-next stream) ((cdr stream)))
(define (stream-foldl func accum stream)
(cond
[(empty? stream) accum]
[else (stream-foldl func (func (stream-first stream) accum) (stream-next stream))] ))
I've written up a few tests to demonstrate what I'm trying to implement
(define (natural-nums)
(define (natural-nums-iter n)
(thunk
(cons n (natural-nums-iter (+ n 1)))))
((natural-nums-iter 0)))
(define x (stream-foldl cons empty (natural-nums)))
(check-equal? (stream-first x) empty)
(check-equal? (stream-second x) (list 0))
(check-equal? (stream-third x) (list 1 0))
(define y (stream-foldl (curry + 1) 10 (naturals)))
(check-equal? (stream-first y) 10)
(check-equal? (stream-second y) 11)
(check-equal? (stream-third y) 13)
Here's a trace of my stream-foldl function
>(stream-foldl
#<procedure:cons>
'()
'(0 . #<procedure:...9/saccum.rkt:25:0>))
()>(stream-foldl
#<procedure:cons>
'(0)
'(1 . #<procedure:...9/saccum.rkt:25:0>))
(0)>(stream-foldl
#<procedure:cons>
'(1 0)
'(2 . #<procedure:...9/saccum.rkt:25:0>))
(1 0)>....
I believe I'm failing to properly set a base case, thus never terminating from the recursion call
Fold is supposed to look at every element in the stream, then produce a result based on those elements. With an infinite stream, it is no surprise that the fold does not terminate (how would you be able to look at every single element in an infinite stream?).
What you can do:
Produce a finite stream out of the infinite stream. stream-take can be used for that. Example implementation of stream-take:
;; Returns a stream containing the first n elements of stream s.
(define (stream-take n s)
(cond ((zero? n) empty-stream)
((empty? s) (error "Stream is shorter than n")
(else
(delay (stream-first s)
(stream-take (- n 1) (stream-rest s)))))))
; Note: 'delay' is the same as the 'thunk' in your code.
Then, fold the finite stream either using your implementation of fold, or stream-fold.
Say there is any given list in Scheme. This list is ‘(2 3 4)
I want to find all possible partitions of this list. This means a partition where a list is separated into two subsets such that every element of the list must be in one or the other subsets but not both, and no element can be left out of a split.
So, given the list ‘(2 3 4), I want to find all such possible partitions. These partitions would be the following: {2, 3} and {4}, {2, 4} and {3}, and the final possible partition being {3, 4} and {2}.
I want to be able to recursively find all partitions given a list in Scheme, but I have no ideas on how to do so. Code or psuedocode will help me if anyone can provide it for me!
I do believe I will have to use lambda for my recursive function.
I discuss several different types of partitions at my blog, though not this specific one. As an example, consider that an integer partition is the set of all sets of positive integers that sum to the given integer. For instance, the partitions of 4 is the set of sets ((1 1 1 1) (1 1 2) (1 3) (2 2) (4)).
The process is building the partitions is recursive. There is a single partition of 0, the empty set (). There is a single partition of 1, the set (1). There are two partitions of 2, the sets (1 1) and (2). There are three partitions of 3, the sets (1 1 1), (1 2) and (3). There are five partitions of 4, the sets (1 1 1 1), (1 1 2), (1 3), (2 2), and (4). There are seven partitions of 5, the sets (1 1 1 1 1), (1 1 1 2), (1 2 2), (1 1 3), (1 4), (2 3) and (5). And so on. In each case, the next-larger set of partitions is determined by adding each integer x less than or equal to the desired integer n to all the sets formed by the partition of n − x, eliminating any duplicates. Here's how I implement that:
Petite Chez Scheme Version 8.4
Copyright (c) 1985-2011 Cadence Research Systems
> (define (set-cons x xs)
(if (member x xs) xs
(cons x xs)))
> (define (parts n)
(if (zero? n) (list (list))
(let x-loop ((x 1) (xs (list)))
(if (= x n) (cons (list n) xs)
(let y-loop ((yss (parts (- n x))) (xs xs))
(if (null? yss) (x-loop (+ x 1) xs)
(y-loop (cdr yss)
(set-cons (sort < (cons x (car yss)))
xs))))))))
> (parts 6)
((6) (3 3) (2 2 2) (2 4) (1 1 4) (1 1 2 2) (1 1 1 1 2)
(1 1 1 1 1 1) (1 1 1 3) (1 2 3) (1 5))
I'm not going to solve your homework for you, but your solution will be similar to the one given above. You need to state your algorithm in recursive fashion, then write code to implement that algorithm. Your recursion is going to be something like this: For each item in the set, add the item to each partition of the remaining items of the set, eliminating duplicates.
That will get you started. If you have specific questions, come back here for additional help.
EDIT: Here is my solution. I'll let you figure out how it works.
(define range (case-lambda ; start, start+step, ..., start+step<stop
((stop) (range 0 stop (if (negative? stop) -1 1)))
((start stop) (range start stop (if (< start stop) 1 -1)))
((start stop step) (let ((le? (if (negative? step) >= <=)))
(let loop ((x start) (xs (list)))
(if (le? stop x) (reverse xs) (loop (+ x step) (cons x xs))))))
(else (error 'range "unrecognized arguments"))))
(define (sum xs) (apply + xs)) ; sum of elements of xs
(define digits (case-lambda ; list of base-b digits of n
((n) (digits n 10))
((n b) (do ((n n (quotient n b))
(ds (list) (cons (modulo n b) ds)))
((zero? n) ds)))))
(define (part k xs) ; k'th lexicographical left-partition of xs
(let loop ((ds (reverse (digits k 2))) (xs xs) (ys (list)))
(if (null? ds) (reverse ys)
(if (zero? (car ds))
(loop (cdr ds) (cdr xs) ys)
(loop (cdr ds) (cdr xs) (cons (car xs) ys))))))
(define (max-lcm xs) ; max lcm of part-sums of 2-partitions of xs
(let ((len (length xs)) (tot (sum xs)))
(apply max (map (lambda (s) (lcm s (- tot s)))
(map sum (map (lambda (k) (part k xs))
(range (expt 2 (- len 1)))))))))
(display (max-lcm '(2 3 4))) (newline) ; 20
(display (max-lcm '(2 3 4 6))) (newline) ; 56
You can find all 2-partitions of a list using the built-in combinations procedure. The idea is, for every element of a (len-k)-combination, there will be an element in the k-combination that complements it, producing a pair of lists whose union is the original list and intersection is the empty list.
For example:
(define (2-partitions lst)
(define (combine left right)
(map (lambda (x y) (list x y)) left right))
(let loop ((m (sub1 (length lst)))
(n 1))
(cond
((< m n) '())
((= m n)
(let* ((l (combinations lst m))
(half (/ (length l) 2)))
(combine (take l half)
(reverse (drop l half)))))
(else
(append
(combine (combinations lst m)
(reverse (combinations lst n)))
(loop (sub1 m) (add1 n)))))))
then you can build the partitions as:
(2-partitions '(2 3 4))
=> '(((2 3) (4))
((2 4) (3))
((3 4) (2)))
(2-partitions '(4 6 7 9))
=> '(((4 6 7) (9))
((4 6 9) (7))
((4 7 9) (6))
((6 7 9) (4))
((4 6) (7 9))
((4 7) (6 9))
((6 7) (4 9)))
Furthermore, you can find the max lcm of the partitions:
(define (max-lcm lst)
(define (local-lcm arg)
(lcm (apply + (car arg))
(apply + (cadr arg))))
(apply max (map local-lcm (2-partitions lst))))
For example:
(max-lcm '(2 3 4))
=> 20
(max-lcm '(4 6 7 9))
=> 165
To partition a list is straightforward recursive non-deterministic programming.
Given an element, we put it either into one bag, or the other.
The very first element will go into the first bag, without loss of generality.
The very last element must go into an empty bag only, if such is present at that time. Since we start by putting the first element into the first bag, it can only be the second:
(define (two-parts xs)
(if (or (null? xs) (null? (cdr xs)))
(list xs '())
(let go ((acc (list (list (car xs)) '())) ; the two bags
(xs (cdr xs)) ; the rest of list
(i (- (length xs) 1)) ; and its length
(z '()))
(if (= i 1) ; the last element in the list is reached:
(if (null? (cadr acc)) ; the 2nd bag is empty:
(cons (list (car acc) (list (car xs))) ; add only to the empty 2nd
z) ; otherwise,
(cons (list (cons (car xs) (car acc)) (cadr acc)) ; two solutions,
(cons (list (car acc) (cons (car xs) (cadr acc))) ; adding to
z))) ; either of the two bags;
(go (list (cons (car xs) (car acc)) (cadr acc)) ; all solutions after
(cdr xs) ; adding to the 1st bag
(- i 1) ; and then,
(go (list (car acc) (cons (car xs) (cadr acc))) ; all solutions
(cdr xs) ; after adding
(- i 1) ; to the 2nd instead
z))))))
And that's that!
In writing this I was helped by following this earlier related answer of mine.
Testing:
(two-parts (list 1 2 3))
; => '(((2 1) (3)) ((3 1) (2)) ((1) (3 2)))
(two-parts (list 1 2 3 4))
; => '(((3 2 1) (4))
; ((4 2 1) (3))
; ((2 1) (4 3))
; ((4 3 1) (2))
; ((3 1) (4 2))
; ((4 1) (3 2))
; ((1) (4 3 2)))
It is possible to reverse the parts before returning, or course; I wanted to keep the code short and clean, without the extraneous details.
edit: The code makes use of a technique by Richard Bird, of replacing (append (g A) (g B)) with (g' A (g' B z)) where (append (g A) y) = (g' A y) and the initial value for z is an empty list.
Another possibility is for the nested call to go to be put behind lambda (as the OP indeed suspected) and activated when the outer call to go finishes its job, making the whole function tail recursive, essentially in CPS style.
How to define a procedure return all pairs of elements in an infinite stream s?
s = {1,2,3,4,5,6,...}
=> {(2,1), (3,2), (3,1), (4,3), (4,2), (4,1), ......}
Here is my code, however it didn't work like a stream, it keep running infinitely and ran out of memory.
(define (stream-pairs s)
(define (iter s save)
(stream-append (stream-map (lambda (x) (stream-cons (stream-first s) x))
save)
(iter (stream-rest s) (stream-cons save (stream-first s)))))
(iter s empty-stream))
(define A (stream-cons 1 (scale-stream 2 A)))
(define C (stream-pairs A))
A = {1,2,4,8,16,......}
Turns out, Racket's stream-append does not delay its last (at least) argument, so iter calls stream-append which calls iter ... thus the loop.
One way is to reimplement the stream-append fused with the stream-map as used here, as a simple recursive function. That way the tail will be properly under the guard of the delaying stream-cons.
Another is to take a stream-rest1 of a fake stream-cons:
(require racket/stream)
(define (stream-pairs s)
(define (iter s save)
(stream-append (stream-map (lambda (x) (list (stream-first s) x))
save) ;^^^^
(stream-rest
(stream-cons 'fake ;<<-----------------
(iter (stream-rest s)
(stream-cons (stream-first s) save))))))
(iter s empty-stream))
(define A (stream-cons 1 (stream-map add1 A))) ; easier to follow
(define C (stream-pairs A))
Also, there was another error in your code where stream-cons was used instead of plain list, to pair up the elements of save with a current element of the input stream. Now we have
> (for ((i (in-range 0 12))) (display (stream-ref C i)))
(2 1)(3 2)(3 1)(4 3)(4 2)(4 1)(5 4)(5 3)(5 2)(5 1)(6 5)(6 4)
1 cf.,
> (stream-rest (stream-cons 1 (/ 1 0)))
#<stream>
Since the question specified that the given stream is infinite:
(define (stream-pairs strm)
(stream-cons (cons (stream-first strm)
(stream-first (stream-rest strm)))
(stream-pairs (stream-rest (stream-rest strm)))))
(If the stream is not infinite, you need to add an emptiness guard to the front of the function.)
Note: If you're using SRFI 41 streams instead of Racket streams, change define to define-stream.
I'm unclear as what you mean by 'pairs of a stream', but assuming you want something like this:
> (stream-subset-pairs (in-naturals) 5)
'((0 . 1) (1 . 2) (2 . 3) (3 . 4))
With that as the expected output, here is a solution:
(define (stream-subset-pairs stream i)
(define subset ; collect all elements up to i by iterating over the list and all #'s in sequence
(for/list ([element stream]
[position (in-naturals)]
#:break (= position i)) ; break when we have reached the # of elements we want to collect
element))
(let-values ([(ignore result) ; wrapper because we want for/fold to produce one result (last-element is just a state variable)
(for/fold ([last-element null]
[result empty])
([element subset]) ; iterate through the subset
(values element (if (null? last-element) ; if we are on the first loop
result ; ignore it
(cons (last-element element) result))))]) ; else add a pair of the last result and this result
result))
I have got these functions
(define force!
(lambda (thunk)
(thunk)))
(define stream-head
(lambda (s n)
(if (zero? n)
'()
(cons (car s)
(stream-head (force! (cdr s))
(1- n))))))
(define make-stream
(lambda (seed next)
(letrec ([produce (lambda (current)
(cons current
(lambda ()
(produce (next current)))))])
(produce seed))))
(define make-traced-stream
(lambda (seed next)
(letrec ([produce (trace-lambda produce (current)
(cons current
(lambda ()
(produce (next current)))))])
(produce seed))))
(define stream-of-even-natural-numbers
(make-traced-stream 0
(lambda (n)
(+ n 2))))
(define stream-of-odd-natural-numbers
(make-traced-stream 1
(lambda (n)
(+ n 2))))
And I need to make a function that appends the last two streams, so that if I run
(stream-head (append-stream stream-of-even-natural-numbers stream-of-odd-natural-numbers) 4)
I get the output (0 2 1 3)
Problem is, that the streams are infinite, and I dunno how to make a function that knows when to stop taking input from the first stream and then continue taking input from the last.
Earlier I made the Merge of the two lists, which looks like this;
> (define (merge-streams s1 s2) (cons (car s1) (delay (merge-streams
> s2 (force!(cdr s1))))))
(stream-head (merge-stream stream-of-even-natural-numbers stream-of-odd-natural-numbers) 10)
= (0 1 2 3 4 5 6 7 8 9)
Here I can delay, and alternate which element from each list that I take.
How can I make a smart procedure to append the lists?
(define (append-streams s1 s2)
(cond
[(empty-stream? s1) s2]
[(empty-stream? s2) s1]
[else
(cons (stream-car s1)
(delay (append-streams (stream-cdr s1) s2)))]))
From what you show, the streams can only be infinite. Appending two infinite streams is simple:
(define append-infinite-streams
(lambda (s1 s2)
s1))
If you wanted to have an adaptable appending, reporting back different things depending on how it is called through stream-head, then it is impossible with this set of functions and how they are defining the concept of streams.
And even if you manage to achieve that with some other scheme, this is ill-advised. Shouldn't the shorter prefix of a stream always be part of a longer prefix of the same stream? But you seem to want
(define s3 (stream-append s1 s2))
(stream-head s3 6)
=> (0 2 4 1 3 5)
(stream-head s3 8)
=> (0 2 4 6 1 3 5 7)