never executed always true always false
1 {-# language CPP #-}
2 {-# language DeriveFunctor #-}
3 {-# language DeriveTraversable #-}
4 {-# language MultiParamTypeClasses #-}
5 {-# language NoImplicitPrelude #-}
6 {-# language QuasiQuotes #-}
7 {-# language TemplateHaskell #-}
8 {-# language UndecidableInstances #-}
9
10 #if __GLASGOW_HASKELL__ >= 800
11 {-# options_ghc -Wno-redundant-constraints #-}
12 #endif
13
14 module OpenCV.ImgProc.FeatureDetection
15 ( canny
16 , goodFeaturesToTrack
17 , houghCircles
18 , houghLinesP
19 , GoodFeaturesToTrackDetectionMethod(..)
20 , CannyNorm(..)
21 , Circle(..)
22 , LineSegment(..)
23 ) where
24
25 import "base" Control.Exception ( mask_ )
26 import "base" Data.Int
27 import "base" Data.Maybe
28 import qualified "vector" Data.Vector as V
29 import "base" Data.Word
30 import "base" Foreign.Marshal.Alloc ( alloca )
31 import "base" Foreign.Marshal.Array ( peekArray )
32 import "base" Foreign.Marshal.Utils ( fromBool )
33 import "base" Foreign.Ptr ( Ptr )
34 import "base" Foreign.Storable ( peek )
35 import "base" Prelude hiding ( lines )
36 import "base" System.IO.Unsafe ( unsafePerformIO )
37 import qualified "inline-c" Language.C.Inline as C
38 import qualified "inline-c" Language.C.Inline.Unsafe as CU
39 import qualified "inline-c-cpp" Language.C.Inline.Cpp as C
40 import "linear" Linear ( V2(..), V3(..), V4(..) )
41 import "primitive" Control.Monad.Primitive ( PrimMonad, PrimState, unsafePrimToPrim )
42 import "this" OpenCV.Core.Types
43 import "this" OpenCV.Internal.C.Inline ( openCvCtx )
44 import "this" OpenCV.Internal.C.Types
45 import "this" OpenCV.Internal.Core.Types.Mat
46 import "this" OpenCV.Internal.Exception
47 import "this" OpenCV.TypeLevel
48 #if MIN_VERSION_base(4,9,0)
49 import "base" Data.Foldable ( Foldable )
50 import "base" Data.Traversable ( Traversable )
51 #endif
52
53 --------------------------------------------------------------------------------
54
55 C.context openCvCtx
56
57 C.include "opencv2/core.hpp"
58 C.include "opencv2/imgproc.hpp"
59 C.using "namespace cv"
60
61 --------------------------------------------------------------------------------
62 -- Feature Detection
63 --------------------------------------------------------------------------------
64
65 {- |
66
67 Finds edges in an image using the
68 <http://docs.opencv.org/2.4/modules/imgproc/doc/feature_detection.html#canny86 Canny86>
69 algorithm.
70
71 Example:
72
73 @
74 cannyImg
75 :: forall shape channels depth
76 . (Mat shape channels depth ~ Lambda)
77 => Mat shape ('S 1) depth
78 cannyImg = exceptError $
79 canny 30 200 Nothing CannyNormL1 lambda
80 @
81
82 <<doc/generated/examples/cannyImg.png cannyImg>>
83
84 -}
85 canny
86 :: Double
87 -- ^ First threshold for the hysteresis procedure.
88 -> Double
89 -- ^ Second threshold for the hysteresis procedure.
90 -> Maybe Int32
91 -- ^ Aperture size for the @Sobel()@ operator. If not specified defaults
92 -- to @3@. Must be 3, 5 or 7.
93 -> CannyNorm
94 -- ^ A flag, indicating whether to use the more accurate L2 norm or the default L1 norm.
95 -> Mat ('S [h, w]) channels ('S Word8)
96 -- ^ 8-bit input image.
97 -> CvExcept (Mat ('S [h, w]) ('S 1) ('S Word8))
98 canny threshold1 threshold2 apertureSize norm src = unsafeWrapException $ do
99 dst <- newEmptyMat
100 handleCvException (pure $ unsafeCoerceMat dst) $
101 withPtr src $ \srcPtr ->
102 withPtr dst $ \dstPtr ->
103 [cvExcept|
104 cv::Canny
105 ( *$(Mat * srcPtr)
106 , *$(Mat * dstPtr)
107 , $(double c'threshold1)
108 , $(double c'threshold2)
109 , $(int32_t c'apertureSize)
110 , $(bool c'l2Gradient)
111 );
112 |]
113 where
114 c'threshold1 = realToFrac threshold1
115 c'threshold2 = realToFrac threshold2
116 c'apertureSize = fromMaybe 3 apertureSize
117 c'l2Gradient =
118 fromBool $
119 case norm of
120 CannyNormL1 -> False
121 CannyNormL2 -> True
122
123 -- | A flag, indicating whether to use the more accurate L2 norm or the default L1 norm.
124 data CannyNorm
125 = CannyNormL1
126 | CannyNormL2
127 deriving (Show, Eq)
128
129 data Circle
130 = Circle
131 { circleCenter :: V2 Float
132 , circleRadius :: Float
133 } deriving (Show)
134
135 {- |
136
137 Determines strong corners on an image.
138
139 The function finds the most prominent corners in the image or in the specified image region.
140
141 * Function calculates the corner quality measure at every source image pixel using the cornerMinEigenVal or cornerHarris.
142 * Function performs a non-maximum suppression (the local maximums in 3 x 3 neighborhood are retained).
143 * The corners with the minimal eigenvalue less than @𝚚𝚞𝚊𝚕𝚒𝚝𝚢𝙻𝚎𝚟𝚎𝚕 * max(x,y) qualityMeasureMap(x,y)@ are rejected.
144 * The remaining corners are sorted by the quality measure in the descending order.
145 * Function throws away each corner for which there is a stronger corner at a distance less than maxDistance.
146
147 Example:
148
149 @
150 goodFeaturesToTrackTraces
151 :: forall (width :: Nat)
152 (height :: Nat)
153 (channels :: Nat)
154 (depth :: *)
155 . (Mat (ShapeT [height, width]) ('S channels) ('S depth) ~ Frog)
156 => Mat (ShapeT [height, width]) ('S channels) ('S depth)
157 goodFeaturesToTrackTraces = exceptError $ do
158 imgG <- cvtColor bgr gray frog
159 let features = goodFeaturesToTrack imgG 20 0.01 0.5 Nothing Nothing CornerMinEigenVal
160 withMatM (Proxy :: Proxy [height, width])
161 (Proxy :: Proxy channels)
162 (Proxy :: Proxy depth)
163 white $ \\imgM -> do
164 void $ matCopyToM imgM (V2 0 0) frog Nothing
165 forM_ features $ \\f -> do
166 circle imgM (round \<$> f :: V2 Int32) 2 blue 5 LineType_AA 0
167 @
168
169 <<doc/generated/examples/goodFeaturesToTrackTraces.png goodFeaturesToTrackTraces>>
170 -}
171 goodFeaturesToTrack
172 :: (depth `In` ['S Word8, 'S Float, 'D])
173 => Mat ('S [h, w]) ('S 1) depth
174 -- ^ Input 8-bit or floating-point 32-bit, single-channel image.
175 -> Int32
176 -- ^ Maximum number of corners to return. If there are more corners than are
177 -- found, the strongest of them is returned.
178 -> Double
179 -- ^ Parameter characterizing the minimal accepted quality of image corners.
180 -- The parameter value is multiplied by the best corner quality measure,
181 -- which is the minimal eigenvalue (see cornerMinEigenVal ) or the Harris
182 -- function response (see cornerHarris ). The corners with the quality measure
183 -- less than the product are rejected. For example, if the best corner has the
184 -- quality measure = 1500, and the qualityLevel=0.01 , then all the corners with
185 -- the quality measure less than 15 are rejected.
186 -> Double
187 -- ^ Minimum possible Euclidean distance between the returned corners.
188 -> Maybe (Mat ('S [h, w]) ('S 1) ('S Word8))
189 -- ^ Optional region of interest. If the image is not empty (it needs to have
190 -- the type CV_8UC1 and the same size as image ), it specifies the region in which
191 -- the corners are detected.
192 -> Maybe Int32
193 -- ^ Size of an average block for computing a derivative covariation matrix
194 -- over each pixel neighborhood. See cornerEigenValsAndVecs.
195 -> GoodFeaturesToTrackDetectionMethod
196 -- ^ Parameter indicating whether to use a Harris detector (see cornerHarris)
197 -- or cornerMinEigenVal.
198 -> V.Vector (V2 Float)
199 goodFeaturesToTrack src maxCorners qualityLevel minDistance mbMask blockSize detector = unsafePerformIO $ do
200 withPtr src $ \srcPtr ->
201 withPtr mbMask $ \mskPtr ->
202 alloca $ \(cornersLengthsPtr :: Ptr Int32) ->
203 alloca $ \(cornersPtrPtr :: Ptr (Ptr (Ptr C'Point2f))) -> mask_ $ do
204 [C.block| void {
205 std::vector<cv::Point2f> corners;
206 Mat * mskPtr = $(Mat * mskPtr);
207 cv::goodFeaturesToTrack
208 ( *$(Mat * srcPtr)
209 , corners
210 , $(int32_t maxCorners)
211 , $(double c'qualityLevel)
212 , $(double c'minDistance)
213 , mskPtr ? _InputArray(*mskPtr) : _InputArray(cv::noArray())
214 , $(int32_t c'blockSize)
215 , $(bool c'useHarrisDetector)
216 , $(double c'harrisK)
217 );
218
219 cv::Point2f * * * cornersPtrPtr = $(Point2f * * * cornersPtrPtr);
220 cv::Point2f * * cornersPtr = new cv::Point2f * [corners.size()];
221 *cornersPtrPtr = cornersPtr;
222
223 *$(int32_t * cornersLengthsPtr) = corners.size();
224
225 for (std::vector<cv::Point2f>::size_type i = 0; i != corners.size(); i++) {
226 cornersPtr[i] = new cv::Point2f( corners[i] );
227 }
228 }|]
229 numCorners <- fromIntegral <$> peek cornersLengthsPtr
230 cornersPtr <- peek cornersPtrPtr
231 (corners :: [V2 Float]) <-
232 peekArray numCorners cornersPtr >>=
233 mapM (fmap (fmap fromCFloat . fromPoint) . fromPtr . pure)
234 [CU.block| void {
235 delete [] *$(Point2f * * * cornersPtrPtr);
236 }|]
237 pure (V.fromList corners)
238 where
239 c'qualityLevel = realToFrac qualityLevel
240 c'minDistance = realToFrac minDistance
241 c'blockSize = fromMaybe 3 blockSize
242 c'useHarrisDetector =
243 fromBool $
244 case detector of
245 HarrisDetector _kValue -> True
246 CornerMinEigenVal -> False
247 c'harrisK =
248 realToFrac $
249 case detector of
250 HarrisDetector kValue -> kValue
251 CornerMinEigenVal -> 0.04
252
253 data GoodFeaturesToTrackDetectionMethod
254 = HarrisDetector Double -- ^ Harris detector and it free k parameter
255 | CornerMinEigenVal
256 deriving (Show, Eq)
257
258 {- |
259
260 Finds circles in a grayscale image using a modification of the Hough
261 transformation.
262
263 Example:
264
265 @
266 houghCircleTraces
267 :: forall (width :: Nat)
268 (height :: Nat)
269 (channels :: Nat)
270 (depth :: *)
271 . (Mat (ShapeT [height, width]) ('S channels) ('S depth) ~ Circles_1000x625)
272 => Mat (ShapeT [height, width]) ('S channels) ('S depth)
273 houghCircleTraces = exceptError $ do
274 imgG <- cvtColor bgr gray circles_1000x625
275 let circles = houghCircles 1 10 Nothing Nothing Nothing Nothing imgG
276 withMatM (Proxy :: Proxy [height, width])
277 (Proxy :: Proxy channels)
278 (Proxy :: Proxy depth)
279 white $ \\imgM -> do
280 void $ matCopyToM imgM (V2 0 0) circles_1000x625 Nothing
281 forM_ circles $ \\c -> do
282 circle imgM (round \<$> circleCenter c :: V2 Int32) (round (circleRadius c)) blue 1 LineType_AA 0
283 @
284
285 <<doc/generated/examples/houghCircleTraces.png houghCircleTraces>>
286 -}
287 houghCircles
288 :: Double
289 -- ^ Inverse ratio of the accumulator resolution to the image resolution.
290 -- For example, if @dp=1@, the accumulator has the same resolution as the
291 -- input image. If @dp=2@, the accumulator has half as big width and height.
292 -> Double
293 -- ^ Minimum distance between the centers of the detected circles. If the
294 -- parameter is too small, multiple neighbor circles may be falsely
295 -- detected in addition to a true one. If it is too large, some circles may
296 -- be missed.
297 -> Maybe Double
298 -- ^ The higher threshold of the two passed to the 'canny' edge detector
299 -- (the lower one is twice smaller). Default is 100.
300 -> Maybe Double
301 -- ^ The accumulator threshold for the circle centers at the detection
302 -- stage. The smaller it is, the more false circles may be detected.
303 -- Circles, corresponding to the larger accumulator values, will be returned
304 -- first. Default is 100.
305 -> Maybe Int32
306 -- ^ Minimum circle radius.
307 -> Maybe Int32
308 -- ^ Maximum circle radius.
309 -> Mat ('S [h, w]) ('S 1) ('S Word8)
310 -> V.Vector Circle
311 houghCircles dp minDist param1 param2 minRadius maxRadius src = unsafePerformIO $
312 withPtr src $ \srcPtr ->
313 alloca $ \(circleLengthsPtr :: Ptr Int32) ->
314 alloca $ \(circlesPtrPtr :: Ptr (Ptr (Ptr C'Vec3f))) -> mask_ $ do
315 _ <- [cvExcept|
316 std::vector<cv::Vec3f> circles;
317 cv::HoughCircles(
318 *$(Mat * srcPtr),
319 circles,
320 CV_HOUGH_GRADIENT,
321 $(double c'dp),
322 $(double c'minDist),
323 $(double c'param1),
324 $(double c'param2),
325 $(int32_t c'minRadius),
326 $(int32_t c'maxRadius)
327 );
328
329 cv::Vec3f * * * circlesPtrPtr = $(Vec3f * * * circlesPtrPtr);
330 cv::Vec3f * * circlesPtr = new cv::Vec3f * [circles.size()];
331 *circlesPtrPtr = circlesPtr;
332
333 *$(int32_t * circleLengthsPtr) = circles.size();
334
335 for (std::vector<cv::Vec3f>::size_type i = 0; i != circles.size(); i++) {
336 circlesPtr[i] = new cv::Vec3f( circles[i] );
337 }
338 |]
339 numCircles <- fromIntegral <$> peek circleLengthsPtr
340 circlesPtr <- peek circlesPtrPtr
341 (circles :: [V3 Float]) <-
342 peekArray numCircles circlesPtr >>=
343 mapM (fmap (fmap fromCFloat . fromVec) . fromPtr . pure)
344 [CU.block| void { delete [] *$(Vec3f * * * circlesPtrPtr); }|]
345 pure (V.fromList (map (\(V3 x y r) -> Circle (V2 x y) r) circles))
346 where c'dp = realToFrac dp
347 c'minDist = realToFrac minDist
348 c'param1 = realToFrac (fromMaybe 100 param1)
349 c'param2 = realToFrac (fromMaybe 100 param2)
350 c'minRadius = fromIntegral (fromMaybe 0 minRadius)
351 c'maxRadius = fromIntegral (fromMaybe 0 maxRadius)
352
353 data LineSegment depth
354 = LineSegment
355 { lineSegmentStart :: !(V2 depth)
356 , lineSegmentStop :: !(V2 depth)
357 } deriving (Foldable, Functor, Traversable, Show)
358
359 type instance VecDim LineSegment = 4
360
361 instance (IsVec V4 depth) => IsVec LineSegment depth where
362 toVec (LineSegment (V2 x1 y1) (V2 x2 y2)) =
363 toVec (V4 x1 y1 x2 y2)
364
365 fromVec vec =
366 LineSegment
367 { lineSegmentStart = V2 x1 y1
368 , lineSegmentStop = V2 x2 y2
369 }
370 where
371 V4 x1 y1 x2 y2 = fromVec vec
372
373 {- |
374 Example:
375
376 @
377 houghLinesPTraces
378 :: forall (width :: Nat)
379 (height :: Nat)
380 (channels :: Nat)
381 (depth :: * )
382 . (Mat (ShapeT [height, width]) ('S channels) ('S depth) ~ Building_868x600)
383 => Mat (ShapeT [height, width]) ('S channels) ('S depth)
384 houghLinesPTraces = exceptError $ do
385 edgeImg <- canny 50 200 Nothing CannyNormL1 building_868x600
386 edgeImgBgr <- cvtColor gray bgr edgeImg
387 withMatM (Proxy :: Proxy [height, width])
388 (Proxy :: Proxy channels)
389 (Proxy :: Proxy depth)
390 white $ \\imgM -> do
391 edgeImgM <- thaw edgeImg
392 lineSegments <- houghLinesP 1 (pi / 180) 80 (Just 30) (Just 10) edgeImgM
393 void $ matCopyToM imgM (V2 0 0) edgeImgBgr Nothing
394 forM_ lineSegments $ \\lineSegment -> do
395 line imgM
396 (lineSegmentStart lineSegment)
397 (lineSegmentStop lineSegment)
398 red 2 LineType_8 0
399 @
400
401 <<doc/generated/examples/houghLinesPTraces.png houghLinesPTraces>>
402 -}
403 houghLinesP
404 :: (PrimMonad m)
405 => Double
406 -- ^ Distance resolution of the accumulator in pixels.
407 -> Double
408 -- ^ Angle resolution of the accumulator in radians.
409 -> Int32
410 -- ^ Accumulator threshold parameter. Only those lines are returned that
411 -- get enough votes (> threshold).
412 -> Maybe Double
413 -- ^ Minimum line length. Line segments shorter than that are rejected.
414 -> Maybe Double
415 -- ^ Maximum allowed gap between points on the same line to link them.
416 -> Mut (Mat ('S [h, w]) ('S 1) ('S Word8)) (PrimState m)
417 -- ^ Source image. May be modified by the function.
418 -> m (V.Vector (LineSegment Int32))
419 houghLinesP rho theta threshold minLineLength maxLineGap src = unsafePrimToPrim $
420 withPtr src $ \srcPtr ->
421 -- Pointer to number of lines.
422 alloca $ \(numLinesPtr :: Ptr Int32) ->
423 -- Pointer to array of Vec4i pointers. The array is allocated in
424 -- C++. Each element of the array points to a Vec4i that is also
425 -- allocated in C++.
426 alloca $ \(linesPtrPtr :: Ptr (Ptr (Ptr C'Vec4i))) -> mask_ $ do
427 [C.block| void {
428 std::vector<cv::Vec4i> lines = std::vector<cv::Vec4i>();
429 cv::HoughLinesP
430 ( *$(Mat * srcPtr)
431 , lines
432 , $(double c'rho)
433 , $(double c'theta)
434 , $(int32_t threshold)
435 , $(double c'minLineLength)
436 , $(double c'maxLineGap)
437 );
438
439 *$(int32_t * numLinesPtr) = lines.size();
440
441 cv::Vec4i * * * linesPtrPtr = $(Vec4i * * * linesPtrPtr);
442 cv::Vec4i * * linesPtr = new cv::Vec4i * [lines.size()];
443 *linesPtrPtr = linesPtr;
444
445 for (std::vector<cv::Vec4i>::size_type ix = 0; ix != lines.size(); ix++)
446 {
447 cv::Vec4i & org = lines[ix];
448 cv::Vec4i * newLine = new cv::Vec4i(org[0], org[1], org[2], org[3]);
449 linesPtr[ix] = newLine;
450 }
451 }|]
452
453 numLines <- fromIntegral <$> peek numLinesPtr
454 linesPtr <- peek linesPtrPtr
455 lineSegments <- mapM (fmap fromVec . fromPtr . pure) =<< peekArray numLines linesPtr
456
457 -- Free the array of Vec4i pointers. This does not free the
458 -- Vec4i's pointed to by the elements of the array. That is the
459 -- responsibility of Haskell's Vec4i finalizer.
460 [CU.block| void {
461 delete [] *$(Vec4i * * * linesPtrPtr);
462 }|]
463
464 pure $ V.fromList lineSegments
465 where
466 c'rho = realToFrac rho
467 c'theta = realToFrac theta
468 c'minLineLength = maybe 0 realToFrac minLineLength
469 c'maxLineGap = maybe 0 realToFrac maxLineGap