{-# LANGUAGE PatternGuards #-}
module Numeric.Histogram ( Range
, binBounds
, histValues
, histWeightedValues
, histWithBins
) where
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
import Control.Monad.ST
type Range a = (a,a)
binBounds :: RealFrac a => a -> a -> Int -> [Range a]
binBounds :: forall a. RealFrac a => a -> a -> Int -> [Range a]
binBounds a
a a
b Int
n = forall a b. (a -> b) -> [a] -> [b]
map (\Int
i->(forall {a}. Real a => a -> a
lbound Int
i, forall {a}. Real a => a -> a
lbound (Int
iforall a. Num a => a -> a -> a
+Int
1))) [Int
0..Int
nforall a. Num a => a -> a -> a
-Int
1]
where lbound :: a -> a
lbound a
i = a
a forall a. Num a => a -> a -> a
+ (a
bforall a. Num a => a -> a -> a
-a
a) forall a. Num a => a -> a -> a
* forall a b. (Real a, Fractional b) => a -> b
realToFrac a
i forall a. Fractional a => a -> a -> a
/ forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
n
histValues :: RealFrac a => a -> a -> Int -> [a] -> V.Vector (Range a, Int)
histValues :: forall a.
RealFrac a =>
a -> a -> Int -> [a] -> Vector (Range a, Int)
histValues a
a a
b Int
n = forall w a.
(Num w, RealFrac a) =>
Vector (Range a) -> [(w, a)] -> Vector (Range a, w)
histWithBins (forall a. [a] -> Vector a
V.fromList forall a b. (a -> b) -> a -> b
$ forall a. RealFrac a => a -> a -> Int -> [Range a]
binBounds a
a a
b Int
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. a -> [a]
repeat Int
1)
histWeightedValues :: RealFrac a => a -> a -> Int -> [(Double,a)] -> V.Vector (Range a, Double)
histWeightedValues :: forall a.
RealFrac a =>
a -> a -> Int -> [(Double, a)] -> Vector (Range a, Double)
histWeightedValues a
a a
b Int
n = forall w a.
(Num w, RealFrac a) =>
Vector (Range a) -> [(w, a)] -> Vector (Range a, w)
histWithBins (forall a. [a] -> Vector a
V.fromList forall a b. (a -> b) -> a -> b
$ forall a. RealFrac a => a -> a -> Int -> [Range a]
binBounds a
a a
b Int
n)
histWithBins :: (Num w, RealFrac a) => V.Vector (Range a) -> [(w, a)] -> V.Vector (Range a, w)
histWithBins :: forall w a.
(Num w, RealFrac a) =>
Vector (Range a) -> [(w, a)] -> Vector (Range a, w)
histWithBins Vector (Range a)
bins [(w, a)]
xs =
let n :: Int
n = forall a. Vector a -> Int
V.length Vector (Range a)
bins
testBin :: RealFrac a => a -> (Int, Range a) -> Bool
testBin :: forall a. RealFrac a => a -> (Int, Range a) -> Bool
testBin a
x (Int
i, (a
a,a
b)) =
if Int
i forall a. Eq a => a -> a -> Bool
== Int
n forall a. Num a => a -> a -> a
- Int
1
then a
x forall a. Ord a => a -> a -> Bool
>= a
a Bool -> Bool -> Bool
&& a
x forall a. Ord a => a -> a -> Bool
<= a
b
else a
x forall a. Ord a => a -> a -> Bool
>= a
a Bool -> Bool -> Bool
&& a
x forall a. Ord a => a -> a -> Bool
< a
b
f :: (RealFrac a, Num w)
=> V.Vector (Range a) -> MV.STVector s w -> (w, a)
-> ST s ()
f :: forall a w s.
(RealFrac a, Num w) =>
Vector (Range a) -> STVector s w -> (w, a) -> ST s ()
f Vector (Range a)
bins1 STVector s w
bs (w
w,a
x) =
case forall a. (a -> Bool) -> Vector a -> Vector a
V.dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RealFrac a => a -> (Int, Range a) -> Bool
testBin a
x) forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> Vector (Int, a)
V.indexed Vector (Range a)
bins1 of
Vector (Int, Range a)
v | forall a. Vector a -> Bool
V.null Vector (Int, Range a)
v -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Vector (Int, Range a)
v | (Int
idx,Range a
_) <- forall a. Vector a -> a
V.head Vector (Int, Range a)
v -> do
w
m <- forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.read STVector s w
bs Int
idx
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write STVector s w
bs Int
idx forall a b. (a -> b) -> a -> b
$! w
mforall a. Num a => a -> a -> a
+w
w
counts :: Vector w
counts = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do STVector s w
b <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MVector (PrimState m) a)
MV.replicate Int
n w
0
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a w s.
(RealFrac a, Num w) =>
Vector (Range a) -> STVector s w -> (w, a) -> ST s ()
f Vector (Range a)
bins STVector s w
b) [(w, a)]
xs
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.freeze STVector s w
b
in forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip Vector (Range a)
bins Vector w
counts