1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
(define-module (srfi srfi-41 util)
:use-module (srfi srfi-1)
:use-module (srfi srfi-41)
:use-module (srfi srfi-71)
:use-module ((ice-9 sandbox) :select (call-with-time-limit))
:use-module ((hnh util) :select (find-extreme))
:export (stream-car+cdr
eager-stream-cons
interleave-streams
stream-insert
filter-sorted-stream
filter-sorted-stream*
get-stream-interval
stream-find
stream-remove
stream->values
repeating-naturals
stream-partition
stream-split
stream-paginate
stream-timeslice-limit))
(define (stream-car+cdr stream)
(values (stream-car stream)
(stream-cdr stream)))
;; Merges a number of totally ordered streams into a single
;; totally ordered stream.
;; ((≺, stream)) → (≺, stream)
(define (interleave-streams < streams)
;; Drop all empty streams
(let ((streams (remove stream-null? streams)))
;; If all streams where empty, end the output stream
(if (null? streams)
stream-null
(let* ((min other (find-extreme streams < stream-car))
(m ms (stream-car+cdr min)))
(stream-cons m (interleave-streams < (cons ms other)))))))
(define (stream-insert < item s)
(interleave-streams < (list (stream item) s)))
;; Requires that stream is a total order in regards to what we filter
;; on. From there it knows that once it has found the first element
;; that satisfies our predicate all remaining elements satisfying pred
;; will be in direct succession.
;; Does have some drawbacks, concider an event between 2020-01-01 and 2020-12-31.
;; The collection is sorted on start time, and we want all events overlapping the
;; interval 2020-02-01 to 2020-02-29. We would get the long event, but then probably
;; stop because all regular small events in january.
(define (filter-sorted-stream pred stream)
(stream-take-while
pred (stream-drop-while
(negate pred) stream)))
;; Simmilar to the regular @code{filter-sorted-stream}, but once an
;; element satisfies @code{keep-remaning?} then the remaining tail
;; of the stream is all assumed to be good.
(define (filter-sorted-stream* pred? keep-remaining? stream)
(cond [(stream-null? stream) stream-null]
[(keep-remaining? (stream-car stream)) stream]
[(pred? (stream-car stream))
(stream-cons (stream-car stream)
(filter-sorted-stream*
pred? keep-remaining?
(stream-cdr stream)))]
[else (filter-sorted-stream* pred? keep-remaining?
(stream-cdr stream))]))
;; returns all object in stream from the first object satisfying
;; start-pred, until the last object which sattisfies end-pred.
(define (get-stream-interval start-pred end-pred stream)
(stream-take-while
end-pred (stream-drop-while
(negate start-pred)
stream)))
;; Finds the first element in stream satisfying pred.
;; Returns #f if nothing was found
(define (stream-find pred stream)
(cond ((stream-null? stream) #f)
((pred (stream-car stream)) (stream-car stream))
(else (stream-find pred (stream-cdr stream)))))
(define (stream-remove pred stream)
(stream-filter (negate pred) stream))
(define (stream->values stream)
(apply values (stream->list stream)))
;; Natural numbers from 1 and up, each number repeated 7 times.
(define (repeating-naturals from repeats)
(stream-unfold
cdr ; map
(const #t) ; continue?
(lambda (x) ; gen next
(if (= (1- repeats) (car x))
(cons 0 (1+ (cdr x)))
(cons (1+ (car x)) (cdr x))))
(cons 0 from)))
;; Returns two values. A stream of all the elements in stream
;; which satisfiy @var{pred}, and a stream of those elements
;; that don't. @var{pred} is called once per value in the
;; input stream.
(define (stream-partition pred stream)
(let ((strm (stream-zip (stream-map pred stream)
stream)))
(values
(stream-map cadr (stream-filter car strm))
(stream-map cadr (stream-remove car strm)))))
(define (stream-split idx stream)
(stream-cons (stream-take idx stream)
(stream-drop idx stream)))
(define-stream (stream-paginate% stream page-size)
(stream-match (stream-split page-size stream)
((page . rest)
(if (stream-null? page)
stream-null
(stream-cons
page
(stream-paginate rest page-size))))))
(define* (stream-paginate stream optional: (page-size 10))
(stream-paginate% stream page-size))
;; stream cons, but eval arguments beforehand.
(define (eager-stream-cons a b)
(stream-cons a b))
;; Wrap a stream in time limits. Each element has at most @var{timeslice}
;; seconds to produce a value, otherwise the stream ends. Useful for finding the
;; "final" element matching a predicate in an infinite stream.
(define-stream (stream-timeslice-limit strm timeslice)
(call-with-time-limit
timeslice
(lambda () (eager-stream-cons
(stream-car strm)
(stream-timeslice-limit (stream-cdr strm) timeslice)))
(lambda _ stream-null)))
|
