module CV.Thresholding(
ThresholdType(..)
, threshold
, thresholdOtsu
, AdaptiveType(..)
, adaptiveThreshold
, bernsen
, nibbly
, nibblyr
, kittler
, kittlerMeasure
, betweenClassVariance
) where
import CV.Image
import CV.Filters
import qualified CV.ImageMath as IM
import CV.ImageMathOp
import CV.Morphology
import System.IO.Unsafe
import CV.Sampling
import Utils.List
import Data.List
import CV.Histogram
import CV.Bindings.ImgProc
import Foreign.Ptr (nullPtr,castPtr)
class MaxVal a where
maxval :: (Image GrayScale a) -> Double
instance MaxVal D32 where
maxval _ = 1
instance MaxVal D8 where
maxval _ = 255
data ThresholdType
= MaxAndZero
| ZeroAndMax
| ThreshAndValue
| ValueAndZero
| ZeroAndValue
cThresholdType t =
case t of
MaxAndZero -> c'CV_THRESH_BINARY
ZeroAndMax -> c'CV_THRESH_BINARY_INV
ThreshAndValue -> c'CV_THRESH_TRUNC
ValueAndZero -> c'CV_THRESH_TOZERO
ZeroAndValue -> c'CV_THRESH_TOZERO_INV
cOtsuThresholdType t =
case t of
MaxAndZero -> c'CV_THRESH_OTSU_BINARY
ZeroAndMax -> c'CV_THRESH_OTSU_BINARY_INV
ThreshAndValue -> c'CV_THRESH_OTSU_TRUNC
ValueAndZero -> c'CV_THRESH_OTSU_TOZERO
ZeroAndValue -> c'CV_THRESH_OTSU_TOZERO_INV
data AdaptiveType
= ByMean
| ByGaussian
cAdaptiveType t =
case t of
ByMean -> c'CV_ADAPTIVE_THRESH_MEAN_C
ByGaussian -> c'CV_ADAPTIVE_THRESH_GAUSSIAN_C
threshold :: (MaxVal d) => ThresholdType -> Double -> Image GrayScale d -> Image GrayScale d
threshold ttype tval image =
unsafePerformIO $
withCloneValue image $ \result ->
withImage image $ \pimage ->
withImage result $ \presult -> do
c'cvThreshold (castPtr pimage) (castPtr presult) (realToFrac tval)
(realToFrac (maxval image)) (cThresholdType ttype)
return result
thresholdOtsu :: ThresholdType -> Image GrayScale D8 -> Image GrayScale D8
thresholdOtsu ttype image =
unsafePerformIO $
withCloneValue image $ \result ->
withImage image $ \pimage ->
withImage result $ \presult -> do
c'cvThreshold (castPtr pimage) (castPtr presult) 0
(realToFrac 255) (cOtsuThresholdType ttype)
return result
adaptiveThreshold :: (MaxVal d) => AdaptiveType -> ThresholdType -> Int -> Double
-> Image GrayScale d -> Image GrayScale d
adaptiveThreshold a t neighborhood bias image =
unsafePerformIO $
withCloneValue image $ \result ->
withImage image $ \pimage ->
withImage result $ \presult -> do
c'cvAdaptiveThreshold (castPtr pimage) (castPtr presult) (realToFrac (maxval image))
(cAdaptiveType a) (cThresholdType t) (fromIntegral neighborhood) (realToFrac bias)
return result
bernsen (w,h) c i = goodContrast #* (i #< surface)
where
low = erode se 1 i
high = dilate se 1 i
goodContrast = IM.moreThan c (high #- low)
surface = 0.5 |* (high #+ low)
se = structuringElement (w,h) (w`div`2,h`div`2) EllipseShape
nibbly k c i = let dev = IM.stdDeviation i
mean = IM.average i
in IM.moreThan (mean+k*dev+c) i
nibblyr (w,h) k i = IM.lessThan t flat
where
t = IM.average flat + k * IM.stdDeviation flat
flat = i #- gaussian (w,h) i
kittler precision image = IM.moreThan t image
where t = maximumBy (comparing (kittlerMeasure image))
[0,0+precision..1]
kittlerMeasure image t = unNaN $
p_t*log fgDev
+ (1p_t)*log bgDev
p_t*log p_t
(1p_t)*log(1p_t)
where
unNaN x | isNaN x = 10000000
| otherwise = x
thresholded = unsafeImageTo32F (IM.lessThan t image)
p_t = IM.sum ( thresholded) / fromIntegral (getArea image)
bgDev = realToFrac $ IM.stdDeviationMask image thresholded
fgDev = realToFrac $ IM.stdDeviationMask image (IM.invert thresholded)
betweenClassVariance as bs = sum as * sum bs
* (average bs average as)^2