incremental-stream.hs

{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE ScopedTypeVariables #-}
module IncrementalStreams where

import Prelude hiding (init)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Map as Map
import Data.Map (Map)

class Change a da where
  (<+>) :: a -> da -> a
  apply :: da -> a -> a
  apply dx x = x <+> dx
  zero :: a -> da

class Integrable t a | t -> a where
  integrate :: t -> [a] -- return partial sums for each timestep
  final :: t -> a       -- integrate over all time
  final = last . integrate

-- A value followed by a stream of updates.
data Updates a da = Up { init :: !a, deltas :: [da] }
                    deriving (Show)

instance Change a da => Integrable (Updates a da) a where
  integrate (Up x []) = [x]
  integrate (Up x (dx:dxs)) = x : integrate (Up (x <+> dx) dxs)

-- Monotone incremental operators on growing sets.
type GrowSet a = Updates (Set a) (Set a)

instance Ord a => Change (Set a) (Set a) where
  (<+>) = Set.union; zero _ = Set.empty

munion :: Ord a => GrowSet a -> GrowSet a -> GrowSet a
munion x y = Up (init x `Set.union` init y)
                (zipWith Set.union (deltas x) (deltas y))

-- we can use a fixed filter function, or...
mfilter :: (a -> Bool) -> GrowSet a -> GrowSet a
mfilter p (Up x dxs) = Up (Set.filter p x) (map (Set.filter p) dxs)

-- we can try to handle monotone growth of the condition.

-- Monotonically growing booleans.
data GrowBool = Now | Never | MaybeLater GrowBool deriving Show
instance Integrable GrowBool Bool where
  integrate Now = [True]
  integrate Never = [False]
  integrate (MaybeLater g) = False : integrate g

growFilter :: forall a. Ord a => (a -> GrowBool) -> GrowSet a -> GrowSet a
growFilter p (Up x dxs) = Up y ys
  where y:ys = loop Map.empty (x : dxs)
        loop :: Map a GrowBool -> [Set a] -> [Set a]
        loop todo (dx:dxs) =
          -- Here we take advantage of monotonicity to not care about timing; we treat
          -- time "relatively" rather than "absolutely" when calling (p a).
          let bools = Map.toList $ Map.union todo $ Map.fromList [(a, p a) | a <- Set.toList dx]
              dones = Set.fromList [a | (a, Now) <- bools]
              todo' = Map.fromList [(a, p) | (a, MaybeLater p) <- bools]
          in dones : loop todo' dxs
        loop todo [] | Map.null todo = []
                     | otherwise = loop todo [Set.empty]

-- Example:

ex1 = growFilter (\x -> if even x then MaybeLater Now else Never)
                 (Up Set.empty [Set.singleton i | i <- [1..10]])

-- try "integrate ex1"