module CV.Textures (rotationInvariant,lbp,lbp5,weightedLBP) where
import Foreign.C.Types
import Foreign.C.String
import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Marshal.Array
import System.IO.Unsafe
import CV.Image
import CV.ImageOp
import Data.List
import qualified Data.Vector as V
import Data.Vector (Vector)
import Data.Maybe (fromMaybe)
import Data.Word
import Data.Bits (rotateL)
import CV.Image
normalize :: Word8 -> Word8
normalize x = minimum [rotateL x i | i<-[0..8] ]
rotationInvariantE :: Word8 -> Word8
rotationInvariantE a = fromIntegral
. fromMaybe (error "Unthinkable happened(RI)")
. V.findIndex (==normalize a) $ keywords
keywords = V.fromList . nub . sort . map normalize $ allWords
allWords = [minBound .. maxBound]
rotationInvariant :: [Double] -> Vector Double
rotationInvariant es = V.accum (+) (V.replicate 36 0)
[(fromIntegral . rotationInvariantE $ i, e)
| i <- [minBound .. maxBound]
| e <- es]
lbp :: Image GrayScale D32 -> [Double]
lbp = broilerPlate256 (localBinaryPattern)
lbp5 :: Image GrayScale D32 -> [Double]
lbp5 = broilerPlate256 (localBinaryPattern5)
lbpHorizontal :: Image GrayScale D32 -> [Double]
lbpHorizontal = broilerPlate256
(localHorizontalBinaryPattern)
lbpVertical :: Image GrayScale D32 -> [Double]
lbpVertical = broilerPlate256
(localVerticalBinaryPattern)
weightedLBP :: (Integral a, Integral a1) =>
a
-> a1
-> CV.Image.Image GrayScale D32
-> CV.Image.Image GrayScale D32
-> [Double]
weightedLBP offsetX offsetXY weights image = unsafePerformIO $ do
withGenImage image $ \img ->
withGenImage weights $ \ws ->
withArray (replicate 256 0) $ \ptrn -> do
weighted_localBinaryPattern img
(fromIntegral offsetX)
(fromIntegral offsetXY) ws ptrn
p <- peekArray 256 ptrn
return $map realToFrac p
broilerPlate256 = broilerPlate' 256
broilerPlate' l op image = unsafePerformIO $ do
withGenImage image $ \img ->
withArray (replicate l 0 :: [CInt]) $ \ptrn -> do
(op img ptrn )
p <- peekArray l ptrn
let !maximum = fromIntegral $ sum p
return $ map (\x -> fromIntegral x / maximum) p
foreign import ccall safe "CV/Textures.chs.h localBinaryPattern"
localBinaryPattern :: ((Ptr (BareImage)) -> ((Ptr CInt) -> (IO ())))
foreign import ccall safe "CV/Textures.chs.h localBinaryPattern5"
localBinaryPattern5 :: ((Ptr (BareImage)) -> ((Ptr CInt) -> (IO ())))
foreign import ccall safe "CV/Textures.chs.h localHorizontalBinaryPattern"
localHorizontalBinaryPattern :: ((Ptr (BareImage)) -> ((Ptr CInt) -> (IO ())))
foreign import ccall safe "CV/Textures.chs.h localVerticalBinaryPattern"
localVerticalBinaryPattern :: ((Ptr (BareImage)) -> ((Ptr CInt) -> (IO ())))
foreign import ccall safe "CV/Textures.chs.h weighted_localBinaryPattern"
weighted_localBinaryPattern :: ((Ptr (BareImage)) -> (CInt -> (CInt -> ((Ptr (BareImage)) -> ((Ptr CDouble) -> (IO ()))))))