module Data.Histogram.Fill (
HBuilderCl(..)
, HBuilder
, builderList
, builderListWrap
, createHistograms
, module Data.Histogram.Bin
, mkHist
, mkHist1
, mkHistWgh
, mkHistWgh1
, mkHistMonoid
, mkHistMonoid1
, forceInt
, forceDouble
, forceFloat
, HistBuilder
) where
import Control.Monad.ST (ST)
import Data.Monoid (Monoid, mempty)
import Data.Array.Vector
import Data.Histogram
import Data.Histogram.Bin
import Data.Histogram.ST
createHistograms :: Monoid b =>
HBuilder a b
-> [a]
-> b
createHistograms h xs = fillHistograms (runBuilder h) xs
class HBuilderCl h where
modifyIn :: (a' -> a) -> h a b -> h a' b
modifyOut :: (b -> b') -> h a b -> h a b'
runBuilder :: h a b -> ST s (Accum s a b)
data HBuilder a b where
MkHBuilder :: HBuilderCl h => h a b -> HBuilder a b
instance HBuilderCl HBuilder where
modifyIn f (MkHBuilder h) = MkHBuilder $ modifyIn f h
modifyOut g (MkHBuilder h) = MkHBuilder $ modifyOut g h
runBuilder (MkHBuilder h) = runBuilder h
newtype HBuilderList a b = HBuilderList [HBuilder a b]
builderList :: [HBuilder a b] -> HBuilder a [b]
builderList = MkHBuilder . modifyOut (:[]) . HBuilderList
builderListWrap :: [HBuilder a b] -> HBuilder a b
builderListWrap = MkHBuilder . HBuilderList
instance HBuilderCl HBuilderList where
modifyIn f (HBuilderList l) = HBuilderList $ map (modifyIn f) l
modifyOut g (HBuilderList l) = HBuilderList $ map (modifyOut g) l
runBuilder (HBuilderList l) = accumList $ map runBuilder l
data HistBuilder a b where
HistBuilder :: (Bin bin, UA val) =>
bin
-> val
-> (forall s . a -> HistogramST s bin val -> ST s ())
-> (Histogram bin val -> b)
-> HistBuilder a b
instance HBuilderCl HistBuilder where
modifyIn f (HistBuilder bin z inp out) = HistBuilder bin z (inp . f) out
modifyOut g (HistBuilder bin z inp out) = HistBuilder bin z inp (g . out)
runBuilder (HistBuilder bin z inp out) = accumHist inp out =<< newHistogramST z bin
forceInt :: Histogram bin Int -> Histogram bin Int
forceInt = id
forceDouble :: Histogram bin Double -> Histogram bin Double
forceDouble = id
forceFloat :: Histogram bin Float -> Histogram bin Float
forceFloat = id
mkHist1 :: (Bin bin, UA val, Num val) =>
bin
-> (Histogram bin val -> b)
-> (a -> BinValue bin)
-> HBuilder a b
mkHist1 bin out inp = MkHBuilder $ HistBuilder bin 0 (flip fillOne . inp) out
mkHist :: (Bin bin, UA val, Num val) =>
bin
-> (Histogram bin val -> b)
-> (a -> [BinValue bin])
-> HBuilder a b
mkHist bin out inp = MkHBuilder $ HistBuilder bin 0 fill out
where
fill a h = mapM_ (fillOne h) $ inp a
mkHistWgh1 :: (Bin bin, UA val, Num val) =>
bin
-> (Histogram bin val -> b)
-> (a -> (BinValue bin, val))
-> HBuilder a b
mkHistWgh1 bin out inp = MkHBuilder $ HistBuilder bin 0 (flip fillOneW . inp) out
mkHistWgh :: (Bin bin, UA val, Num val) =>
bin
-> (Histogram bin val -> b)
-> (a -> [(BinValue bin, val)])
-> HBuilder a b
mkHistWgh bin out inp = MkHBuilder $ HistBuilder bin 0 fill out
where
fill a h = mapM_ (fillOneW h) $ inp a
mkHistMonoid1 :: (Bin bin, UA val, Monoid val) =>
bin
-> (Histogram bin val -> b)
-> (a -> (BinValue bin, val))
-> HBuilder a b
mkHistMonoid1 bin out inp = MkHBuilder $ HistBuilder bin mempty (flip fillMonoid . inp) out
mkHistMonoid :: (Bin bin, UA val, Monoid val) =>
bin
-> (Histogram bin val -> b)
-> (a -> [(BinValue bin, val)])
-> HBuilder a b
mkHistMonoid bin out inp = MkHBuilder $ HistBuilder bin mempty fill out
where
fill a h = mapM_ (fillMonoid h) $ inp a