[Haskell-cafe] type class question
Ben
midfield at gmail.com
Tue Sep 29 17:56:14 EDT 2009
dear haskellers --
i'm trying this question again, in haskell-cafe. i got some responses
in haskell-beginners but am looking for more guidance. also, i
understand this functionality is encapsulated in the Workflow module
in hackage, but i'd like to understand this myself. this email is an
(il)literate haskell file.
suppose i have class of computations a -> State s b. for
concreteness, let's say i'm writing a library of on-line statistical
summary functions, like
> {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
>
> module Foo where
>
> import Control.Monad
> import Control.Monad.State
> import Control.Monad.State.Class
>
> data RunningAverageState = S Double Int
>
> runningAverage :: Double -> State RunningAverageState Double
> runningAverage v = do
> S sum count <- get
> let nsum = sum + v
> ncount = count + 1
> put $ S nsum ncount
> return $ nsum / (fromIntegral ncount)
>
> test = take 10 $ evalState (mapM runningAverage [1..]) $ S 0 0
test -> [1.0,1.5,2.0,2.5,3.0,3.5,4.0,4.5,5.0,5.5]
here "on-line" means that we may be taking data from an intermittant
external source, e.g. a data generator IO [Double], say, and want to
be able to feed the summarizer datum one-by-one, and produce
intermediate summaries. also we may want to be able to serialize our
computation state (with Data.Binary, say) so that we can resume data
collection and summarization later.
naturally i want to create some common higher order operations on
these primitives, like applying them to a stream of data, or combining
them in some way. it seems that one would want some kind of type
class to define a common interface to them.
> class (MonadState s m) => Summarizer s m | m -> s where
> initialState :: s
> runOne :: Double -> m Double
>
where initialize puts some intial state into the system, and runOne
collects and summarizes the next piece of data. an instance for
runningAverage would look like
> instance Summarizer RunningAverageState (State RunningAverageState) where
> initialState = S 0 0
> runOne = runningAverage
but how would i use this, e.g.
> --summarizeMany vs = last $ evalState (mapM runOne vs) initialState
is not possible as it has an ambiguous type.
1) what am i doing wrong? what are the right type class and instance
declarations?
2) is there a better way of expressing this kind of "on-line"
calculation, perhaps in pure (non-monadic) functions? i tried
mapAccumL, but was looking for something a little cleaner.
best, ben
More information about the Haskell-Cafe
mailing list