module Data.Histogram.Bin (
Bin(..)
, BinI(..)
, BinF
, binF
, binFn
, Bin2D(..)
, (><)
) where
import Data.Histogram.Parse
import Text.Read (Read(..))
class Bin b where
type BinValue b
toIndex :: b -> BinValue b -> Int
fromIndex :: b -> Int -> BinValue b
nBins :: b -> Int
data BinI = BinI !Int !Int
instance Bin BinI where
type BinValue BinI = Int
toIndex !(BinI base _) !x = x base
fromIndex !(BinI base _) !x = x + base
nBins !(BinI x y) = y x + 1
instance Show BinI where
show (BinI lo hi) = unlines [ "# BinI"
, "# Low = " ++ show lo
, "# High = " ++ show hi
]
instance Read BinI where
readPrec = do
keyword "BinI"
l <- value "Low"
h <- value "High"
return $ BinI l h
data BinF f where
BinF :: RealFrac f => !f -> !f -> !Int -> BinF f
binF :: RealFrac f =>
f
-> Int
-> f
-> BinF f
binF from n to = BinF from ((to from) / fromIntegral n) n
binFn :: RealFrac f =>
f
-> f
-> f
-> BinF f
binFn from step to = BinF from step (round $ (to from) / step)
instance Bin (BinF f) where
type BinValue (BinF f) = f
toIndex !(BinF from step _) !x = floor $ (xfrom) / step
fromIndex !(BinF from step _) !i = (step/2) + (fromIntegral i * step) + from
nBins !(BinF _ _ n) = n
instance Show f => Show (BinF f) where
show (BinF base step n) = unlines [ "# BinF"
, "# Base = " ++ show base
, "# Step = " ++ show step
, "# N = " ++ show n
]
instance (Read f, RealFrac f) => Read (BinF f) where
readPrec = do
keyword "BinF"
base <- value "Base"
step <- value "Step"
n <- value "N"
return $ BinF base step n
data Bin2D bin1 bin2 = Bin2D bin1 bin2
(><) :: bin1 -> bin2 -> Bin2D bin1 bin2
(><) = Bin2D
instance (Bin bin1, Bin bin2) => Bin (Bin2D bin1 bin2) where
type BinValue (Bin2D bin1 bin2) = (BinValue bin1, BinValue bin2)
toIndex (Bin2D bx by) (x,y)
| ix < 0 || ix >= rx || iy < 0 || iy >= ry = maxBound
| otherwise = ix + iy*rx
where
ix = toIndex bx x
iy = toIndex by y
rx = nBins bx
ry = nBins by
fromIndex (Bin2D bx by) i = let (iy,ix) = divMod i (nBins bx)
in (fromIndex bx ix, fromIndex by iy)
nBins (Bin2D b1 b2) = (nBins b1) * (nBins b2)
instance (Show b1, Show b2) => Show (Bin2D b1 b2) where
show (Bin2D b1 b2) = "# Bin2D\n" ++
"# X\n" ++
show b1 ++
"# Y\n" ++
show b2
instance (Read b1, Read b2) => Read (Bin2D b1 b2) where
readPrec = do
keyword "Bin2D"
keyword "X"
b1 <- readPrec
keyword "Y"
b2 <- readPrec
return $ Bin2D b1 b2