module CV.Histogram where
import CV.Image
import CV.Image
import Data.List
import Data.Array
import Data.Array.ST
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Marshal.Array
import Foreign.Marshal.Alloc
import Foreign.Ptr
import CV.Bindings.Types
import qualified CV.Bindings.ImgProc as I
import System.IO.Unsafe
import Utils.Pointer
newtype HistogramData a = HGD [(a,a)]
backProjectHistogram :: [Image GrayScale D8] -> I.Histogram -> Image GrayScale D8
backProjectHistogram images@(img:_) (I.Histogram hist) = unsafePerformIO $ do
r <- cloneImage img
withImage r $ \c_r ->
withPtrList (map imageFPTR images) $ \ptrs ->
withForeignPtr hist $ \c_hist ->
I.c'cvCalcArrBackProject (castPtr ptrs) (castPtr c_r) c_hist
return r
backProjectHistogram _ _ = error "Empty list of images"
histogram :: [(Image GrayScale D8, Int)] -> Bool -> Maybe (Image GrayScale D8)
-> I.Histogram
histogram imageBins accumulate mask = unsafePerformIO $
I.creatingHistogram $ do
hist <- I.emptyUniformHistogramND ds
withPtrList (map imageFPTR images) $ \ptrs ->
case mask of
Just m -> do
withImage m $ \c_mask -> do
I.c'cvCalcArrHist (castPtr ptrs) hist c_accumulate (castPtr c_mask)
return hist
Nothing -> do
I.c'cvCalcArrHist (castPtr ptrs) hist c_accumulate (nullPtr)
return hist
where
(images,ds) = unzip imageBins
c_accumulate = 0
values (HGD a) = snd.unzip $ a
cmpUnion a b = sum $ zipWith (max) a b
cmpIntersect a b = sum $ zipWith min a b
cmpEuclidian a b = sum $ (zipWith (\x y -> (xy)^2) a b)
cmpAbs a b = sum $ (zipWith (\x y -> abs (xy)) a b)
chiSqrHG a b = chiSqr (values a) (values b)
chiSqr a b = sum $ zipWith (calc) a b
where
calc a b = (ab)*(ab) `divide` (a+b)
divide a b | abs(b) > 0.000001 = a/b
| otherwise = 0
liftBins op (HGD a) = zip (op bins) values
where (bins,values) = unzip a
liftValues op (HGD a) = zip bins (op values)
where (bins,values) = unzip a
sub (HGD a) (HGD b) | bins a == bins b
= HGD $ zip (bins a) values
where
bins a = map fst a
msnd = map snd
values = zipWith () (msnd a) (msnd b)
noBins (HGD a) = length a
getPositivePart (HGD a) = HGD $ dropWhile ((<0).fst) a
tcumulate [] = []
tcumulate values = tail $ scanl (+) 0 values
weightedHistogram img weights start end binCount = unsafePerformIO $
withImage img $ \i ->
withImage weights $ \w -> do
bins <- mallocArray (fromIntegral binCount)
get_weighted_histogram i w (realToFrac start)
(realToFrac end)
(fromIntegral binCount) bins
r <- peekArray binCount bins >>= return.map realToFrac
free bins
return r
simpleGetHistogram :: Image GrayScale D32 -> Maybe (Image GrayScale D8)
-> D32 -> D32 -> Int -> Bool -> [D32]
simpleGetHistogram img mask start end binCount cumulative = unsafePerformIO $
withImage img $ \i -> do
bins <- mallocArray binCount
let isCum | cumulative == True = 1
| cumulative == False = 0
case mask of
(Just msk) -> do
withImage msk $ \m -> do
get_histogram i m (realToFrac start) (realToFrac end)
isCum (fromIntegral binCount) bins
Nothing -> get_histogram i (nullPtr)
(realToFrac start) (realToFrac end)
isCum (fromIntegral binCount) bins
r <- peekArray binCount bins >>= return.map realToFrac
free bins
return r
foreign import ccall safe "CV/Histogram.chs.h get_weighted_histogram"
get_weighted_histogram :: ((Ptr (BareImage)) -> ((Ptr (BareImage)) -> (CDouble -> (CDouble -> (CInt -> ((Ptr CDouble) -> (IO ())))))))
foreign import ccall safe "CV/Histogram.chs.h get_histogram"
get_histogram :: ((Ptr (BareImage)) -> ((Ptr (BareImage)) -> (CFloat -> (CFloat -> (CInt -> (CInt -> ((Ptr CDouble) -> (IO ()))))))))