Implement stable merging of Streams
This commit is contained in:
parent
a34e1e8806
commit
06ec115c88
1 changed files with 12 additions and 0 deletions
|
@ -18,6 +18,18 @@ fromList (pair:pairs) = Stream [(pair, fromList pairs)]
|
||||||
infinite :: a -> Stream a
|
infinite :: a -> Stream a
|
||||||
infinite a = Stream [(a, infinite a)]
|
infinite a = Stream [(a, infinite a)]
|
||||||
|
|
||||||
|
merge :: Eq a => Stream a -> Stream a -> Stream a
|
||||||
|
merge (Stream aPairs) (Stream bPairs) = Stream $ foldl mergeOrAdd aPairs bPairs
|
||||||
|
where
|
||||||
|
openAt _ l [] = (l, [])
|
||||||
|
openAt p up l@(x:xs) = if p x then (up, l) else openAt p (x:up) xs
|
||||||
|
zipUp ([], l) = l
|
||||||
|
zipUp (x:xs, l) = zipUp (xs, x:l)
|
||||||
|
mergeOrAdd accumulator (b, bStream) = zipUp $
|
||||||
|
case openAt ((== b) . fst) [] accumulator of
|
||||||
|
(up, []) -> (up, [(b, bStream)])
|
||||||
|
(up, (x, xStream):down) -> (up, (x, merge xStream bStream):down)
|
||||||
|
|
||||||
showTree :: Show a => Stream a -> String
|
showTree :: Show a => Stream a -> String
|
||||||
showTree = intercalate "\n" . getLines
|
showTree = intercalate "\n" . getLines
|
||||||
where
|
where
|
||||||
|
|
Loading…
Reference in a new issue