never executed always true always false
    1 {-# language CPP #-}
    2 {-# language QuasiQuotes #-}
    3 {-# language TemplateHaskell #-}
    4 
    5 #if __GLASGOW_HASKELL__ >= 800
    6 {-# options_ghc -Wno-redundant-constraints #-}
    7 #endif
    8 
    9 module OpenCV.ImgProc.ObjectDetection
   10     ( MatchTemplateMethod(..)
   11     , MatchTemplateNormalisation(..)
   12     , matchTemplate
   13     ) where
   14 
   15 import "base" Data.Int
   16 import "base" Data.Word
   17 import qualified "inline-c" Language.C.Inline as C
   18 import qualified "inline-c-cpp" Language.C.Inline.Cpp as C
   19 import "this" OpenCV.Core.Types
   20 import "this" OpenCV.Internal.C.Inline ( openCvCtx )
   21 import "this" OpenCV.Internal.C.Types
   22 import "this" OpenCV.Internal.Core.Types.Mat
   23 import "this" OpenCV.Internal.Exception
   24 import "this" OpenCV.TypeLevel
   25 
   26 --------------------------------------------------------------------------------
   27 
   28 C.context openCvCtx
   29 
   30 C.include "opencv2/core.hpp"
   31 C.include "opencv2/imgproc.hpp"
   32 C.include "opencv2/objdetect.hpp"
   33 C.using "namespace cv"
   34 
   35 #include <bindings.dsl.h>
   36 #include "opencv2/core.hpp"
   37 #include "opencv2/imgproc.hpp"
   38 
   39 #include "namespace.hpp"
   40 #include "hsc_macros.hpp"
   41 
   42 --------------------------------------------------------------------------------
   43 
   44 -- | Type of the template matching operation
   45 --
   46 -- In the formulae for the comparison methods \(\bf{I}\) denotes image,
   47 -- \(\bf{T}\) template and \(\bf{R}\) result. Each method supports
   48 -- normalization. See 'MatchTemplateNormalisation'.
   49 data MatchTemplateMethod
   50    = MatchTemplateSqDiff
   51        {- ^
   52        * not normed:
   53            \[
   54            R(x,y) = \sum _{x',y'} (T(x',y')-I(x+x',y+y'))^2
   55            \]
   56 
   57        * normed:
   58            \[
   59            R(x,y) = \frac{\sum_{x',y'} (T(x',y')-I(x+x',y+y'))^2}
   60                          {\sqrt{\sum_{x',y'}T(x',y')^2 \cdot \sum_{x',y'} I(x+x',y+y')^2}}
   61            \]
   62        -}
   63    | MatchTemplateCCorr
   64        {- ^
   65        * not normed:
   66            \[
   67            R(x,y) = \sum _{x',y'} (T(x',y')  \cdot I(x+x',y+y'))
   68            \]
   69 
   70        * normed:
   71            \[
   72            R(x,y) = \frac{\sum_{x',y'} (T(x',y') \cdot I(x+x',y+y'))}
   73                          {\sqrt{\sum_{x',y'}T(x',y')^2 \cdot \sum_{x',y'} I(x+x',y+y')^2}}
   74            \]
   75        -}
   76    | MatchTemplateCCoeff
   77        {- ^
   78        * not normed:
   79            \[
   80            R(x,y) = \sum _{x',y'} (T'(x',y') \cdot I'(x+x',y+y'))
   81            \]
   82 
   83        * where
   84            \[ \begin{array}{l}
   85            T'(x',y') = T(x',y') - 1/(w \cdot h) \cdot \sum _{x'',y''} T(x'',y'')
   86            \\ I'(x+x',y+y') = I(x+x',y+y') - 1/(w \cdot h) \cdot \sum _{x'',y''} I(x+x'',y+y'')
   87            \end{array} \]
   88 
   89        * normed:
   90            \[
   91            R(x,y) = \frac{ \sum_{x',y'} (T'(x',y') \cdot I'(x+x',y+y')) }
   92                          { \sqrt{\sum_{x',y'}T'(x',y')^2 \cdot \sum_{x',y'} I'(x+x',y+y')^2} }
   93            \]
   94        -}
   95      deriving Show
   96 
   97 -- | Whether to use normalisation. See 'MatchTemplateMethod'.
   98 data MatchTemplateNormalisation
   99    = MatchTemplateNotNormed -- ^ Do not use normalization.
  100    | MatchTemplateNormed    -- ^ Use normalization.
  101    deriving (Show, Eq)
  102 
  103 #num CV_TM_SQDIFF
  104 #num CV_TM_SQDIFF_NORMED
  105 #num CV_TM_CCORR
  106 #num CV_TM_CCORR_NORMED
  107 #num CV_TM_CCOEFF
  108 #num CV_TM_CCOEFF_NORMED
  109 
  110 marshalMatchTemplateMethod :: MatchTemplateMethod -> Bool -> Int32
  111 marshalMatchTemplateMethod m n =
  112     case (m, n) of
  113       (MatchTemplateSqDiff, False) -> c'CV_TM_SQDIFF
  114       (MatchTemplateSqDiff, True ) -> c'CV_TM_SQDIFF_NORMED
  115       (MatchTemplateCCorr , False) -> c'CV_TM_CCORR
  116       (MatchTemplateCCorr , True ) -> c'CV_TM_CCORR_NORMED
  117       (MatchTemplateCCoeff, False) -> c'CV_TM_CCOEFF
  118       (MatchTemplateCCoeff, True ) -> c'CV_TM_CCOEFF_NORMED
  119 
  120 {- | Compares a template against overlapped image regions.
  121 
  122 The function slides through image, compares the overlapped patches of size
  123   \( w \times h \)
  124 against templ using the specified method and stores the comparison
  125 results in result. The summation is done over template and/or the image patch:
  126   \( x' = 0...w-1, y' = 0...h-1 \)
  127 
  128 After the function finishes the comparison, the best matches can be found as
  129 global minimums (when 'MatchTemplateSqDiff' was used) or maximums (when
  130 'MatchTemplateCCorr' or 'MatchTemplateCCoeff' was used) using the 'minMaxLoc'
  131 function. In case of a color image, template summation in the numerator and each
  132 sum in the denominator is done over all of the channels and separate mean values
  133 are used for each channel.  That is, the function can take a color template and
  134 a color image. The result will still be a single-channel image, which is easier
  135 to analyze.
  136 
  137 Example:
  138 
  139 @
  140 matchTemplateImg
  141     :: forall (width :: Nat) (height :: Nat) (width2 :: Nat)
  142      . ( Mat (ShapeT [height, width]) ('S 3) ('S Word8) ~ Kodak_512x341
  143        , width2 ~ (width + width)
  144        )
  145     => Mat (ShapeT [height, width2]) ('S 3) ('S Word8)
  146 matchTemplateImg = exceptError $
  147     withMatM (Proxy :: Proxy [height, width2])
  148              (Proxy :: Proxy 3)
  149              (Proxy :: Proxy Word8)
  150              transparent $ \\imgM -> do
  151       matCopyToM imgM (V2 0 0) barn_512x341 Nothing
  152       rectangle imgM templateRect blue 1 LineType_8 0
  153       matCopyToM imgM (V2 width 0) resultImg Nothing
  154       rectangle imgM matchRect blue 1 LineType_8 0
  155   where
  156     -- Recovered location of 'template', translated for rendering.
  157     matchRect :: Rect2i
  158     matchRect = toRect $ HRect (fromPoint maxLoc ^+^ V2 width 0)
  159                                (V2 20 20)
  160 
  161     -- Find location of best match in 'result'.
  162     _minVal, _maxVal :: Double
  163     _minLoc, maxLoc :: Point2i
  164     (_minVal, _maxVal, _minLoc, maxLoc) = exceptError $ minMaxLoc result
  165 
  166     -- Result matrix converted to color image for rendering.
  167     resultImg :: Mat ('S ['D, 'D]) ('S 3) ('S Word8)
  168     resultImg = exceptError $ do
  169         resultGray
  170             :: Mat ('S ['D, 'D]) ('S 1) ('S Word8)
  171             <- matConvertTo (Just 255) Nothing result
  172         cvtColor gray bgr resultGray
  173 
  174     -- Result of looking for 'template' in 'barn_512x341'.
  175     result :: Mat ('S ['D, 'D]) ('S 1) ('S Float)
  176     result = exceptError $
  177         matchTemplate barn_512x341 template MatchTemplateCCoeff MatchTemplateNormed
  178 
  179     -- Small part of the barn image which we want to find again.
  180     template :: Mat ('S ['D, 'D]) ('S 3) ('S Word8)
  181     template = exceptError $ matSubRect barn_512x341 templateRect
  182 
  183     -- Rectangle that defines a small part of the barn image.
  184     templateRect :: Rect2i
  185     templateRect = toRect $ HRect (V2 183 24) (V2 20 20)
  186 
  187     width :: Int32
  188     width = fromInteger $ natVal (Proxy :: Proxy width)
  189 @
  190 
  191 <<doc/generated/examples/matchTemplateImg.png matchTemplateImg>>
  192 -}
  193 matchTemplate
  194     :: (depth `In` [Word8, Float])
  195     => Mat ('S [sh, sw]) ('S channels) ('S depth)
  196        -- ^ Image where the search is running. It must be 8-bit or 32-bit floating-point.
  197     -> Mat ('S [th, tw]) ('S channels) ('S depth)
  198        -- ^ Searched template. It must be not greater than the source image and have the same data type.
  199     -> MatchTemplateMethod -- ^ Comparison method.
  200     -> MatchTemplateNormalisation -- ^ Normalization.
  201     -> CvExcept (Mat ('S [rh, rw]) ('S 1) ('S Float))
  202        -- ^ Map of comparison results. It must be single-channel 32-bit
  203        -- floating-point. If image is \(W \times H\) and templ is
  204        -- \(w \times h\), then result is \((W-w+1) \times (H-h+1)\).
  205 matchTemplate image templ method normalisation = unsafeWrapException $ do
  206     result <- newEmptyMat
  207     handleCvException (pure $ unsafeCoerceMat result) $
  208       withPtr result $ \resultPtr ->
  209       withPtr image $ \imagePtr ->
  210       withPtr templ $ \templPtr ->
  211         [cvExcept|
  212           cv::matchTemplate( *$(Mat * imagePtr)
  213                            , *$(Mat * templPtr)
  214                            , *$(Mat * resultPtr)
  215                            , $(int32_t c'method)
  216                            );
  217         |]
  218   where
  219     normed =
  220       case normalisation of
  221         MatchTemplateNotNormed -> False
  222         MatchTemplateNormed -> True
  223     c'method = marshalMatchTemplateMethod method normed