module Data.Histogram.Generic (
Histogram
, module Data.Histogram.Bin
, histogram
, histogramUO
, readHistogram
, readFileHistogram
, bins
, histData
, underflows
, overflows
, outOfRange
, asList
, asVector
, sliceByIx
, sliceByVal
, sliceX
, sliceY
, histMap
, histMapBin
, histZip
, histZipSafe
) where
import Control.Applicative ((<$>),(<*>))
import Control.Arrow ((***))
import Control.Monad (ap)
import qualified Data.Vector.Generic as G
import Data.Typeable (Typeable1(..), Typeable2(..), mkTyConApp, mkTyCon)
import Data.Vector.Generic (Vector,(!))
import Text.Read
import Data.Histogram.Bin
import Data.Histogram.Parse
data Histogram v bin a = Histogram bin (Maybe (a,a)) (v a)
deriving (Eq)
histogram :: (Vector v a, Bin bin) => bin -> v a -> Histogram v bin a
histogram b v | nBins b == G.length v = Histogram b Nothing v
| otherwise = error "histogram: number of bins and vector size doesn't match"
histogramUO :: (Vector v a, Bin bin) => bin -> Maybe (a,a) -> v a -> Histogram v bin a
histogramUO b uo v | nBins b == G.length v = Histogram b uo v
| otherwise = error "histogram: number of bins and vector size doesn't match"
instance (Show a, Show (BinValue bin), Show bin, Bin bin, Vector v a) => Show (Histogram v bin a) where
show h@(Histogram bin uo _) = "# Histogram\n" ++ showUO uo ++ show bin ++
unlines (map showT $ asList h)
where
showT (x,y) = show x ++ "\t" ++ show y
showUO (Just (u,o)) = "# Underflows = " ++ show u ++ "\n" ++
"# Overflows = " ++ show o ++ "\n"
showUO Nothing = "# Underflows = \n" ++
"# Overflows = \n"
instance Typeable1 v => Typeable2 (Histogram v) where
typeOf2 h = mkTyConApp (mkTyCon "Data.Histogram.Generic.Histogram") [typeOf1 (histData h)]
histHeader :: (Read bin, Read a, Bin bin, Vector v a) => ReadPrec (v a -> Histogram v bin a)
histHeader = do
keyword "Histogram"
u <- maybeValue "Underflows"
o <- maybeValue "Overflows"
bin <- readPrec
return $ Histogram bin ((,) `fmap` u `ap` o)
readHistogram :: (Read bin, Read a, Bin bin, Vector v a) => String -> Histogram v bin a
readHistogram str =
let (h,rest) = case readPrec_to_S histHeader 0 str of
[x] -> x
_ -> error "Cannot parse histogram header"
xs = map (unwords . tail) . filter (not . null) . map words . lines $ rest
in h (G.fromList $ map read xs)
readFileHistogram :: (Read bin, Read a, Bin bin, Vector v a) => FilePath -> IO (Histogram v bin a)
readFileHistogram fname = readHistogram `fmap` readFile fname
bins :: Histogram v bin a -> bin
bins (Histogram bin _ _) = bin
histData :: Histogram v bin a -> v a
histData (Histogram _ _ a) = a
underflows :: Histogram v bin a -> Maybe a
underflows (Histogram _ uo _) = fst <$> uo
overflows :: Histogram v bin a -> Maybe a
overflows (Histogram _ uo _) = snd <$> uo
outOfRange :: Histogram v bin a -> Maybe (a,a)
outOfRange (Histogram _ uo _) = uo
asList :: (Vector v a, Bin bin) => Histogram v bin a -> [(BinValue bin, a)]
asList (Histogram bin _ arr) = map (fromIndex bin) [0..] `zip` G.toList arr
asVector :: (Bin bin, Vector v a, Vector v (BinValue bin), Vector v (BinValue bin,a))
=> Histogram v bin a -> v (BinValue bin, a)
asVector (Histogram bin _ arr) = G.zip (G.generate (nBins bin) (fromIndex bin) ) arr
histMap :: (Vector v a, Vector v b) => (a -> b) -> Histogram v bin a -> Histogram v bin b
histMap f (Histogram bin uo a) = Histogram bin (fmap (f *** f) uo) (G.map f a)
histMapBin :: (Bin bin, Bin bin') => (bin -> bin') -> Histogram v bin a -> Histogram v bin' a
histMapBin f (Histogram bin uo a)
| nBins bin == nBins bin' = Histogram (f bin) uo a
| otherwise = error "Number of bins doesn't match"
where
bin' = bin
histZip :: (Bin bin, Eq bin, Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> Histogram v bin a -> Histogram v bin b -> Histogram v bin c
histZip f (Histogram bin uo v) (Histogram bin' uo' v')
| bin /= bin' = error "histZip: bins are different"
| otherwise = Histogram bin (f2 <$> uo <*> uo') (G.zipWith f v v')
where
f2 (x,x') (y,y') = (f x y, f x' y')
histZipSafe :: (Bin bin, Eq bin, Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> Histogram v bin a -> Histogram v bin b -> Maybe (Histogram v bin c)
histZipSafe f (Histogram bin uo v) (Histogram bin' uo' v')
| bin /= bin' = Nothing
| otherwise = Just $ Histogram bin (f2 <$> uo <*> uo') (G.zipWith f v v')
where
f2 (x,x') (y,y') = (f x y, f x' y')
sliceByIx :: (Bin1D bin, Vector v a) => Int -> Int -> Histogram v bin a -> Histogram v bin a
sliceByIx i j (Histogram b _ v) =
Histogram (sliceBin i j b) Nothing (G.slice i (j i + 1) v)
sliceByVal :: (Bin1D bin, Vector v a) => BinValue bin -> BinValue bin -> Histogram v bin a -> Histogram v bin a
sliceByVal x y h
| inRange b x && inRange b y = sliceByIx (toIndex b x) (toIndex b y) h
| otherwise = error "sliceByVal: Values are out of range"
where
b = bins h
sliceY :: (Vector v a, Bin bX, Bin bY) => Histogram v (Bin2D bX bY) a -> [(BinValue bY, Histogram v bX a)]
sliceY (Histogram b _ a) = map mkSlice [0 .. ny1]
where
(nx, ny) = nBins2D b
mkSlice i = ( fromIndex (binY b) i
, Histogram (binX b) Nothing (G.slice (nx*i) nx a) )
sliceX :: (Vector v a, Bin bX, Bin bY) => Histogram v (Bin2D bX bY) a -> [(BinValue bX, Histogram v bY a)]
sliceX (Histogram b _ a) = map mkSlice [0 .. nx1]
where
(nx, ny) = nBins2D b
mkSlice i = ( fromIndex (binX b) i
, Histogram (binY b) Nothing (mkArray i))
mkArray x = G.generate ny (\y -> a ! (y*nx + x))