<commit_before>{-#LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, UnicodeSyntax, ViewPatterns#-}
#include "cvWrapLEO.h"
module CV.Morphology (StructuringElement
                  ,structuringElement
                  ,customSE
                  ,basicSE,bigSE
                  ,geodesic
                  ,openOp,closeOp
                  ,open,close
                  ,erode,dilate
                  ,blackTopHat,whiteTopHat
                  ,dilateOp,erodeOp,KernelShape(EllipseShape,CrossShape,RectShape) 
                  , ConvKernel
                  )
where

import Foreign.C.Types
import Foreign.C.String
import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Marshal.Array

import CV.Image 

import CV.ImageOp
import qualified CV.ImageMath as IM

import System.IO.Unsafe

-- Morphological opening
openOp :: StructuringElement -> ImageOperation GrayScale d
openOp se = erodeOp se 1 #> dilateOp se 1                    
open se = unsafeOperate (openOp se) 
a ○ b = open b a
-- a ○ b = (a ⊖ b) ⊕ b 


-- Morphological closing
closeOp :: StructuringElement -> ImageOperation GrayScale d
closeOp se = dilateOp se 1 #> erodeOp se 1                    
close se = unsafeOperate (closeOp se) 
a ● b = close b a

geodesic :: Image GrayScale D32 -> ImageOperation GrayScale d -> ImageOperation GrayScale d
geodesic mask op = op #> IM.limitToOp mask

-- | Perform a black tophat filtering of size
blackTopHat size i =
                  let se = structuringElement 
                        (size,size) (size `div` 2, size `div` 2) RectShape
                      x  = unsafeOperate (closeOp se) i
                  in x `IM.sub` i

-- | Perform a white tophat filtering of size
whiteTopHat size i =
                  let se = structuringElement 
                        (size,size) (size `div` 2, size `div` 2) RectShape
                      x  = unsafeOperate (openOp se) i
                  in i `IM.sub` x

basicSE = structuringElement (3,3) (1,1) RectShape
bigSE = structuringElement (9,9) (4,4) RectShape

---------- Low level wrapper
#c
enum KernelShape {
    RectShape    = CV_SHAPE_RECT
    ,CrossShape   = CV_SHAPE_CROSS
    ,EllipseShape = CV_SHAPE_ELLIPSE
    ,CustomShape  = CV_SHAPE_CUSTOM
    };
#endc
{#enum KernelShape {} #}

{#pointer *IplConvKernel as ConvKernel foreign newtype#}

type StructuringElement = ConvKernel

foreign import ccall "& wrapReleaseStructuringElement" 
    releaseSE :: FinalizerPtr ConvKernel


-- Check morphology element
isGoodSE s@(w,h) d@(x,y) | x>=0 && y>=0 
                         && w>=0 && h>=0
                         && x<w  && y<h 
                         = True

                         | otherwise = False 


-- |Create a structuring element for morphological operations
-- The first pair is @(width,height)@ while the second is the origin @(x,y)@
structuringElement :: (Int, Int) -> (Int, Int) -> KernelShape -> StructuringElement
structuringElement s d | isGoodSE s d = createSE s d 
                       | otherwise = error "Bad values in structuring element"

-- Create SE with custom shape that is taken from flat list shape.
createSE :: (Int, Int) -> (Int, Int) -> KernelShape -> StructuringElement
createSE (fromIntegral -> w,fromIntegral -> h) (fromIntegral -> x,fromIntegral -> y) shape = unsafePerformIO $ do
    iptr <- {#call cvCreateStructuringElementEx#}
             w h x y (fromIntegral . fromEnum $ shape) nullPtr
    fptr <- newForeignPtr releaseSE iptr
    return (ConvKernel fptr)

customSE :: (CInt, CInt) -> (CInt, CInt) -> [CInt] -> ConvKernel
customSE s@(w,h) o shape | isGoodSE s o 
                         && length shape == fromIntegral (w*h)
                            = createCustomSE s o shape

createCustomSE (w,h) (x,y) shape = unsafePerformIO $ do
            iptr <- withArray shape $ \arr ->
                    {#call cvCreateStructuringElementEx#}
                      w h x y (fromIntegral . fromEnum $ CustomShape) arr
            fptr <- newForeignPtr releaseSE iptr
            return (ConvKernel fptr)

{#fun cvErode as erosion 
    {withGenBareImage* `BareImage'
    ,withGenBareImage* `BareImage'
    ,withConvKernel* `ConvKernel'
    ,`Int'} -> `()' #}
{#fun cvDilate as dilation 
    {withGenBareImage* `BareImage'
    ,withGenBareImage* `BareImage'
    ,withConvKernel* `ConvKernel'
    ,`Int'} -> `()' #}


erodeOp se count = ImgOp $ \(unS -> img)  -> erosion img img se count
dilateOp se count = ImgOp $ \(unS -> img) -> dilation img img se count

erode se count  i = unsafeOperate (erodeOp se count)  i
dilate se count i = unsafeOperate (dilateOp se count) i

a ⊕ b = dilate b 1 a
a ⊖ b = erode b 1 a
                       
erode' se count img = withImage img $ \image ->
               withConvKernel se $ \ck ->
             {#call cvErode#} (castPtr image) 
                              (castPtr image) 
                              ck count
                              
dilate' se count img = withImage img $ \image ->
               withConvKernel se $ \ck ->
             {#call cvDilate#} (castPtr image) 
                              (castPtr image) 
                              ck count<commit_msg>Added skeletonization to Morphology<commit_after>{-#LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, UnicodeSyntax, ViewPatterns#-}
#include "cvWrapLEO.h"
module CV.Morphology (StructuringElement
                  ,structuringElement
                  ,customSE
                  ,basicSE,bigSE
                  ,geodesic
                  ,openOp,closeOp
                  ,open,close
                  ,erode,dilate
                  ,blackTopHat,whiteTopHat
                  ,skeletonize
                  ,dilateOp,erodeOp,KernelShape(EllipseShape,CrossShape,RectShape) 
                  , ConvKernel
                  )
where

import Foreign.C.Types
import Foreign.C.String
import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Marshal.Array

import CV.Image 

import CV.ImageOp
import qualified CV.ImageMath as IM

import System.IO.Unsafe

-- Morphological opening
openOp :: StructuringElement -> ImageOperation GrayScale d
openOp se = erodeOp se 1 #> dilateOp se 1                    
open se = unsafeOperate (openOp se) 
a ○ b = open b a
-- a ○ b = (a ⊖ b) ⊕ b 


-- Morphological closing
closeOp :: StructuringElement -> ImageOperation GrayScale d
closeOp se = dilateOp se 1 #> erodeOp se 1                    
close se = unsafeOperate (closeOp se) 
a ● b = close b a

geodesic :: Image GrayScale D32 -> ImageOperation GrayScale d -> ImageOperation GrayScale d
geodesic mask op = op #> IM.limitToOp mask

-- | Perform a black tophat filtering of size
blackTopHat size i =
                  let se = structuringElement 
                        (size,size) (size `div` 2, size `div` 2) RectShape
                      x  = unsafeOperate (closeOp se) i
                  in x `IM.sub` i

-- | Perform a white tophat filtering of size
whiteTopHat size i =
                  let se = structuringElement 
                        (size,size) (size `div` 2, size `div` 2) RectShape
                      x  = unsafeOperate (openOp se) i
                  in i `IM.sub` x

basicSE = structuringElement (3,3) (1,1) RectShape
bigSE = structuringElement (9,9) (4,4) RectShape

---------- Low level wrapper
#c
enum KernelShape {
    RectShape    = CV_SHAPE_RECT
    ,CrossShape   = CV_SHAPE_CROSS
    ,EllipseShape = CV_SHAPE_ELLIPSE
    ,CustomShape  = CV_SHAPE_CUSTOM
    };
#endc
{#enum KernelShape {} #}

{#pointer *IplConvKernel as ConvKernel foreign newtype#}

type StructuringElement = ConvKernel

foreign import ccall "& wrapReleaseStructuringElement" 
    releaseSE :: FinalizerPtr ConvKernel


-- Check morphology element
isGoodSE s@(w,h) d@(x,y) | x>=0 && y>=0 
                         && w>=0 && h>=0
                         && x<w  && y<h 
                         = True

                         | otherwise = False 


-- |Create a structuring element for morphological operations
-- The first pair is @(width,height)@ while the second is the origin @(x,y)@
structuringElement :: (Int, Int) -> (Int, Int) -> KernelShape -> StructuringElement
structuringElement s d | isGoodSE s d = createSE s d 
                       | otherwise = error "Bad values in structuring element"

-- Create SE with custom shape that is taken from flat list shape.
createSE :: (Int, Int) -> (Int, Int) -> KernelShape -> StructuringElement
createSE (fromIntegral -> w,fromIntegral -> h) (fromIntegral -> x,fromIntegral -> y) shape = unsafePerformIO $ do
    iptr <- {#call cvCreateStructuringElementEx#}
             w h x y (fromIntegral . fromEnum $ shape) nullPtr
    fptr <- newForeignPtr releaseSE iptr
    return (ConvKernel fptr)

customSE :: (CInt, CInt) -> (CInt, CInt) -> [CInt] -> ConvKernel
customSE s@(w,h) o shape | isGoodSE s o 
                         && length shape == fromIntegral (w*h)
                            = createCustomSE s o shape

createCustomSE (w,h) (x,y) shape = unsafePerformIO $ do
            iptr <- withArray shape $ \arr ->
                    {#call cvCreateStructuringElementEx#}
                      w h x y (fromIntegral . fromEnum $ CustomShape) arr
            fptr <- newForeignPtr releaseSE iptr
            return (ConvKernel fptr)

{#fun cvErode as erosion 
    {withGenBareImage* `BareImage'
    ,withGenBareImage* `BareImage'
    ,withConvKernel* `ConvKernel'
    ,`Int'} -> `()' #}
{#fun cvDilate as dilation 
    {withGenBareImage* `BareImage'
    ,withGenBareImage* `BareImage'
    ,withConvKernel* `ConvKernel'
    ,`Int'} -> `()' #}


erodeOp se count = ImgOp $ \(unS -> img)  -> erosion img img se count
dilateOp se count = ImgOp $ \(unS -> img) -> dilation img img se count

erode se count  i = unsafeOperate (erodeOp se count)  i
dilate se count i = unsafeOperate (dilateOp se count) i

a ⊕ b = dilate b 1 a
a ⊖ b = erode b 1 a
                       
erode' se count img = withImage img $ \image ->
               withConvKernel se $ \ck ->
             {#call cvErode#} (castPtr image) 
                              (castPtr image) 
                              ck count
                              
dilate' se count img = withImage img $ \image ->
               withConvKernel se $ \ck ->
             {#call cvDilate#} (castPtr image) 
                              (castPtr image) 
                              ck count

skeletonize :: Image GrayScale D8 -> Image GrayScale D8
skeletonize i = fst . snd . head . dropWhile (\x -> fst x > 0) . iterate (skeletonize'.snd)
                $ (1,(CV.Image.empty (getSize i),i))
skeletonize' :: (Image GrayScale D8, Image GrayScale D8) -> (Int, (Image GrayScale D8, Image GrayScale D8))
skeletonize' (skel,img) = (countNonZero tmp, (tmp, erode se 1 img))
    where 
       tmp = unsafeOperateOn img $ openOp se #> IM.notOp #> IM.andOp img Nothing #> IM.orOp skel Nothing
       se = structuringElement (3,3) (1,1) CrossShape 

{'fraction_non_alphanumeric': 0.09510694941705683, 'fraction_numerical': 0.0055999265583402185, 'mean_word_length': 2.015222806531968, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 80, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 6, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '62555', 'n_tokens_mistral': 3432, 'n_tokens_neox': 3222, 'n_words': 1038}