opencv-0.0.2.1: Haskell binding to OpenCV-3.x

Safe HaskellNone
LanguageHaskell2010

OpenCV.Core.ArrayOps

Contents

Description

Operations on arrays

Synopsis

Per element operations

The following functions work on the individual elements of matrices.

Examples are based on the following two images:

matScalarAdd Source #

Arguments

:: ToScalar scalar 
=> Mat shape channels depth 
-> scalar 
-> Mat shape channels depth 

matScalarMult Source #

Arguments

:: Mat shape channels depth 
-> Double 
-> Mat shape channels depth 

matAbs Source #

Arguments

:: Mat shape channels depth 
-> Mat shape channels depth 

Calculates an absolute value of each matrix element.

OpenCV Sphinx doc

matAbsDiff Source #

Arguments

:: Mat shape channels depth 
-> Mat shape channels depth 
-> Mat shape channels depth 

Calculates the per-element absolute difference between two arrays.

Example:

matAbsDiffImg :: Mat (ShapeT [341, 512]) ('S 3) ('S Word8)
matAbsDiffImg = matAbsDiff flower_512x341 sailboat_512x341

OpenCV Sphinx doc

matAdd Source #

Arguments

:: Mat shape channels depth 
-> Mat shape channels depth 
-> Mat shape channels depth 

Calculates the per-element sum of two arrays.

Example:

matAddImg :: Mat (ShapeT [341, 512]) ('S 3) ('S Word8)
matAddImg = matAdd flower_512x341 sailboat_512x341

OpenCV Sphinx doc

matSubtract Source #

Arguments

:: Mat shape channels depth 
-> Mat shape channels depth 
-> Mat shape channels depth 

Calculates the per-element difference between two arrays

Example:

matSubtractImg :: Mat (ShapeT [341, 512]) ('S 3) ('S Word8)
matSubtractImg = matSubtract flower_512x341 sailboat_512x341

OpenCV Sphinx doc

matAddWeighted Source #

Arguments

:: ToDepthDS (Proxy dstDepth) 
=> Mat shape channels srcDepth

src1

-> Double

alpha

-> Mat shape channels srcDepth

src2

-> Double

beta

-> Double

gamma

-> CvExcept (Mat shape channels dstDepth) 

Calculates the weighted sum of two arrays

Example:

matAddWeightedImg :: Mat (ShapeT [341, 512]) ('S 3) ('S Word8)
matAddWeightedImg = exceptError $
    matAddWeighted flower_512x341 0.5 sailboat_512x341 0.5 0.0

OpenCV Sphinx doc

matScaleAdd Source #

Arguments

:: Mat shape channels depth

First input array.

-> Double

Scale factor for the first array.

-> Mat shape channels depth

Second input array.

-> CvExcept (Mat shape channels depth) 

Calculates the sum of a scaled array and another array.

The function scaleAdd is one of the classical primitive linear algebra operations, known as DAXPY or SAXPY in BLAS. It calculates the sum of a scaled array and another array.

OpenCV Sphinx doc

matMax Source #

Arguments

:: Mat shape channels depth 
-> Mat shape channels depth 
-> CvExcept (Mat shape channels depth) 

data CmpType Source #

Comparison type

Constructors

Cmp_Eq 
Cmp_Gt 
Cmp_Ge 
Cmp_Lt 
Cmp_Le 
Cmp_Ne 

matScalarCompare Source #

Arguments

:: Mat shape channels depth 
-> Double 
-> CmpType 
-> CvExcept (Mat shape channels depth) 

Bitwise operations

The examples for the bitwise operations make use of the following images:

Example:

type VennShape = [200, 320]

vennCircleAImg :: Mat (ShapeT VennShape) ('S 1) ('S Word8)
vennCircleAImg = exceptError $
    withMatM
      (Proxy :: Proxy VennShape)
      (Proxy :: Proxy 1)
      (Proxy :: Proxy Word8)
      black $ \imgM -> lift $ vennCircleA imgM white (-1)

vennCircleBImg :: Mat (ShapeT VennShape) ('S 1) ('S Word8)
vennCircleBImg = exceptError $
    withMatM
      (Proxy :: Proxy VennShape)
      (Proxy :: Proxy 1)
      (Proxy :: Proxy Word8)
      black $ \imgM -> lift $ vennCircleB imgM white (-1)

bitwiseNot Source #

Arguments

:: Mat shape channels depth 
-> CvExcept (Mat shape channels depth) 

Example:

bitwiseNotImg :: Mat (ShapeT VennShape) ('S 3) ('S Word8)
bitwiseNotImg = exceptError $ do
    img <- bitwiseNot vennCircleAImg
    imgBgr <- cvtColor gray bgr img
    createMat $ do
      imgM <- lift $ thaw imgBgr
      lift $ vennCircleA imgM blue 2
      pure imgM

OpenCV Sphinx doc

bitwiseAnd Source #

Arguments

:: Mat shape channels depth 
-> Mat shape channels depth 
-> CvExcept (Mat shape channels depth) 

Example:

bitwiseAndImg :: Mat (ShapeT VennShape) ('S 3) ('S Word8)
bitwiseAndImg = exceptError $ do
    img <- bitwiseAnd vennCircleAImg vennCircleBImg
    imgBgr <- cvtColor gray bgr img
    createMat $ do
      imgM <- lift $ thaw imgBgr
      lift $ vennCircleA imgM blue 2
      lift $ vennCircleB imgM red  2
      pure imgM

OpenCV Sphinx doc

bitwiseOr Source #

Arguments

:: Mat shape channels depth 
-> Mat shape channels depth 
-> CvExcept (Mat shape channels depth) 

Example:

bitwiseOrImg :: Mat (ShapeT VennShape) ('S 3) ('S Word8)
bitwiseOrImg = exceptError $ do
    img <- bitwiseOr vennCircleAImg vennCircleBImg
    imgBgr <- cvtColor gray bgr img
    createMat $ do
      imgM <- lift $ thaw imgBgr
      lift $ vennCircleA imgM blue 2
      lift $ vennCircleB imgM red  2
      pure imgM

OpenCV Sphinx doc

bitwiseXor Source #

Arguments

:: Mat shape channels depth 
-> Mat shape channels depth 
-> CvExcept (Mat shape channels depth) 

Example:

bitwiseXorImg :: Mat (ShapeT VennShape) ('S 3) ('S Word8)
bitwiseXorImg = exceptError $ do
    img <- bitwiseXor vennCircleAImg vennCircleBImg
    imgBgr <- cvtColor gray bgr img
    createMat $ do
      imgM <- lift $ thaw imgBgr
      lift $ vennCircleA imgM blue 2
      lift $ vennCircleB imgM red  2
      pure imgM

OpenCV Sphinx doc

Channel operations

matMerge Source #

Arguments

:: Vector (Mat shape (S 1) depth) 
-> Mat shape D depth 

Creates one multichannel array out of several single-channel ones.

OpenCV Sphinx doc

matSplit Source #

Arguments

:: Mat shape channels depth 
-> Vector (Mat shape (S 1) depth) 

Divides a multi-channel array into several single-channel arrays.

Example:

matSplitImg
    :: forall (width    :: Nat)
              (width3   :: Nat)
              (height   :: Nat)
              (channels :: Nat)
              (depth    :: *)
     . ( Mat (ShapeT [height, width]) ('S channels) ('S depth) ~ Birds_512x341
       , width3 ~ ((*) width 3)
       )
    => Mat (ShapeT [height, width3]) ('S channels) ('S depth)
matSplitImg = exceptError $ do
    zeroImg <- mkMat (Proxy :: Proxy [height, width])
                     (Proxy :: Proxy 1)
                     (Proxy :: Proxy depth)
                     black
    let blueImg  = matMerge $ V.fromList [channelImgs V.! 0, zeroImg, zeroImg]
        greenImg = matMerge $ V.fromList [zeroImg, channelImgs V.! 1, zeroImg]
        redImg   = matMerge $ V.fromList [zeroImg, zeroImg, channelImgs V.! 2]

    withMatM (Proxy :: Proxy [height, width3])
             (Proxy :: Proxy channels)
             (Proxy :: Proxy depth)
             white $ \imgM -> do
      matCopyToM imgM (V2 (w*0) 0) (unsafeCoerceMat blueImg)  Nothing
      matCopyToM imgM (V2 (w*1) 0) (unsafeCoerceMat greenImg) Nothing
      matCopyToM imgM (V2 (w*2) 0) (unsafeCoerceMat redImg)   Nothing
  where
    channelImgs = matSplit birds_512x341

    w :: Int32
    w = fromInteger $ natVal (Proxy :: Proxy width)

OpenCV Sphinx doc

matChannelMapM :: Monad m => (Mat shape (S 1) depth -> m (Mat shape (S 1) depth)) -> Mat shape channelsOut depth -> m (Mat shape channelsOut depth) Source #

Apply the same 1 dimensional action to every channel

Other

minMaxLoc Source #

Arguments

:: Mat (S [height, width]) channels depth 
-> CvExcept (Double, Double, Point2i, Point2i) 

Finds the global minimum and maximum in an array

OpenCV Sphinx doc

norm Source #

Arguments

:: NormType 
-> Maybe (Mat shape (S 1) (S Word8))

Optional operation mask; it must have the same size as the input array, depth Depth_8U and 1 channel.

-> Mat shape channels depth

Input array.

-> CvExcept Double

Calculated norm.

Calculates an absolute array norm

OpenCV Sphinx doc

normDiff Source #

Arguments

:: NormAbsRel

Absolute or relative norm.

-> NormType 
-> Maybe (Mat shape (S 1) (S Word8))

Optional operation mask; it must have the same size as the input array, depth Depth_8U and 1 channel.

-> Mat shape channels depth

First input array.

-> Mat shape channels depth

Second input array of the same size and type as the first.

-> CvExcept Double

Calculated norm.

Calculates an absolute difference norm, or a relative difference norm

OpenCV Sphinx doc

normalize Source #

Arguments

:: ToDepthDS (Proxy dstDepth) 
=> Double

Norm value to normalize to or the lower range boundary in case of the range normalization.

-> Double

Upper range boundary in case of the range normalization; it is not used for the norm normalization.

-> NormType 
-> Maybe (Mat shape (S 1) (S Word8))

Optional operation mask.

-> Mat shape channels srcDepth

Input array.

-> CvExcept (Mat shape channels dstDepth) 

Normalizes the norm or value range of an array

OpenCV Sphinx doc

matSum Source #

Arguments

:: Mat shape channels depth

Input array that must have from 1 to 4 channels.

-> CvExcept Scalar 

Calculates the sum of array elements

Example:

matSumImg :: Mat (ShapeT [201, 201]) ('S 3) ('S Word8)
matSumImg = exceptError $
    withMatM
      (Proxy :: Proxy [201, 201])
      (Proxy :: Proxy 3)
      (Proxy :: Proxy Word8)
      black $ \imgM -> do
        -- Draw a filled circle. Each pixel has a value of (255,255,255)
        lift $ circle imgM (pure radius :: V2 Int32) radius white (-1) LineType_8 0
        -- Calculate the sum of all pixels.
        scalar <- matSumM imgM
        let V4 area _y _z _w = fromScalar scalar :: V4 Double
        -- Circle area = pi * radius * radius
        let approxPi = area / 255 / (radius * radius)
        lift $ putText imgM
                       (T.pack $ show approxPi)
                       (V2 40 110 :: V2 Int32)
                       (Font FontHersheyDuplex NotSlanted 1)
                       blue
                       1
                       LineType_AA
                       False
  where
    radius :: forall a. Num a => a
    radius = 100

OpenCV Sphinx doc

matSumM Source #

Arguments

:: PrimMonad m 
=> Mut (Mat shape channels depth) (PrimState m)

Input array that must have from 1 to 4 channels.

-> CvExceptT m Scalar 

meanStdDev Source #

Arguments

:: (1 <= channels, channels <= 4) 
=> Mat shape (S channels) depth 
-> Maybe (Mat shape (S 1) (S Word8))

Optional operation mask.

-> CvExcept (Scalar, Scalar) 

Calculates a mean and standard deviation of array elements

OpenCV Sphinx doc

matFlip Source #

Arguments

:: Mat (S '[height, width]) channels depth 
-> FlipDirection

How to flip.

-> Mat (S '[height, width]) channels depth 

Flips a 2D matrix around vertical, horizontal, or both axes.

The example scenarios of using the function are the following: Vertical flipping of the image (FlipVertically) to switch between top-left and bottom-left image origin. This is a typical operation in video processing on Microsoft Windows* OS. Horizontal flipping of the image with the subsequent horizontal shift and absolute difference calculation to check for a vertical-axis symmetry (FlipHorizontally). Simultaneous horizontal and vertical flipping of the image with the subsequent shift and absolute difference calculation to check for a central symmetry (FlipBoth). Reversing the order of point arrays (FlipHorizontally or FlipVertically).

Example:

matFlipImg :: Mat (ShapeT [341, 512]) ('S 3) ('S Word8)
matFlipImg = matFlip sailboat_512x341 FlipBoth

data FlipDirection Source #

Constructors

FlipVertically

Flip around the x-axis.

FlipHorizontally

Flip around the y-axis.

FlipBoth

Flip around both x and y-axis.

matTranspose Source #

Arguments

:: Mat (S '[height, width]) channels depth 
-> Mat (S '[width, height]) channels depth 

Transposes a matrix.

Example:

matTransposeImg :: Mat (ShapeT [512, 341]) ('S 3) ('S Word8)
matTransposeImg = matTranspose sailboat_512x341

hconcat :: Vector (Mat (S '[rows, D]) channels depth) -> CvExcept (Mat (S '[rows, D]) channels depth) Source #

Applies horizontal concatenation to given matrices.

Example:

hconcatImg :: Mat ('S '[ 'D, 'D ]) ('S 3) ('S Word8)
hconcatImg = exceptError $
    hconcat $ V.fromList
      [ halfSize birds_768x512
      , halfSize flower_768x512
      , halfSize sailboat_768x512
      ]
  where
    halfSize = exceptError . resize (ResizeRel 0.5) InterArea

vconcat :: Vector (Mat (S '[D, cols]) channels depth) -> CvExcept (Mat (S '[D, cols]) channels depth) Source #

Applies vertical concatenation to given matrices.

Example:

vconcatImg :: Mat ('S '[ 'D, 'D ]) ('S 3) ('S Word8)
vconcatImg = exceptError $
    vconcat $ V.fromList
      [ halfSize birds_768x512
      , halfSize flower_768x512
      , halfSize sailboat_768x512
      ]
  where
    halfSize = exceptError . resize (ResizeRel 0.5) InterArea

perspectiveTransform :: IsPoint2 point2 CDouble => Vector (point2 CDouble) -> Mat (S '[S 3, S 3]) (S 1) (S Double) -> Vector Point2d Source #

Performs the perspective matrix transformation of vectors.

TODO: Modify this function for accept 3D points TODO: Generalize return type to V.Vector (point2 CDouble)

OpenCV Sphinx doc