never executed always true always false
1 {-# LANGUAGE QuasiQuotes #-}
2 {-# LANGUAGE TemplateHaskell #-}
3
4 module OpenCV.ImgProc.StructuralAnalysis
5 ( contourArea
6 , pointPolygonTest
7 , findContours
8 , Contour(..)
9 , ContourAreaOriented(..)
10 , ContourRetrievalMode(..)
11 , ContourApproximationMethod(..)
12 , approxPolyDP
13 , arcLength
14 , minAreaRect
15 ) where
16
17 import "primitive" Control.Monad.Primitive ( PrimMonad, PrimState, unsafePrimToPrim )
18 import "base" Control.Exception ( mask_ )
19 import "base" Control.Monad (guard)
20 import "base" Data.Functor (($>))
21 import "base" Data.Int
22 import "base" Data.Maybe (mapMaybe)
23 import "base" Data.Traversable (for)
24 import qualified "vector" Data.Vector as V
25 import "base" Data.Word
26 import "base" Foreign.C.Types
27 import "base" Foreign.Marshal.Alloc ( alloca )
28 import "base" Foreign.Marshal.Array ( peekArray )
29 import "base" Foreign.Marshal.Utils ( fromBool )
30 import "base" Foreign.Ptr ( Ptr )
31 import "base" Foreign.Storable ( peek )
32 import "base" System.IO.Unsafe ( unsafePerformIO )
33 import qualified "inline-c" Language.C.Inline as C
34 import qualified "inline-c-cpp" Language.C.Inline.Cpp as C
35 import qualified "inline-c" Language.C.Inline.Unsafe as CU
36 import "linear" Linear.V4 ( V4(..) )
37 import "this" OpenCV.Core.Types ( Mut )
38 import "this" OpenCV.Core.Types.Point
39 import "this" OpenCV.Core.Types.Vec ( fromVec )
40 import "this" OpenCV.Internal.C.Inline ( openCvCtx )
41 import "this" OpenCV.Internal.C.Types
42 import "this" OpenCV.Internal.Core.Types
43 import "this" OpenCV.Internal.Core.Types.Mat
44 import "this" OpenCV.Internal.Exception
45 import "this" OpenCV.TypeLevel
46
47 --------------------------------------------------------------------------------
48
49 #include <bindings.dsl.h>
50 #include "opencv2/imgproc.hpp"
51
52 C.context openCvCtx
53
54 C.include "opencv2/core.hpp"
55 C.include "opencv2/imgproc.hpp"
56 C.using "namespace cv"
57
58 --------------------------------------------------------------------------------
59 -- Structural Analysis and Shape Descriptors
60 --------------------------------------------------------------------------------
61
62 {- | Calculates a contour area.
63
64 The function computes a contour area. Similarly to `moments`, the area is
65 computed using the <https://en.wikipedia.org/wiki/Green%27s_theorem Green formula>.
66 Thus, the returned area and the number of non-zero pixels, if you draw the
67 contour using `drawContours` or `fillPoly`, can be different. Also, the function
68 will most certainly give a wrong results for contours with self-intersections.
69
70 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/structural_analysis_and_shape_descriptors.html?highlight=contourarea#cv2.contourArea OpenCV Sphinx doc>
71 -}
72 contourArea
73 :: (IsPoint2 point2 CFloat)
74 => V.Vector (point2 CFloat)
75 -- ^ Input vector of 2D points (contour vertices).
76 -> ContourAreaOriented
77 -- ^ Signed or unsigned area
78 -> CvExcept Double
79 contourArea contour areaOriented = unsafeWrapException $
80 withArrayPtr (V.map toPoint contour) $ \contourPtr ->
81 alloca $ \c'area ->
82 handleCvException (realToFrac <$> peek c'area) $
83 [cvExcept|
84 cv::_InputArray contour =
85 cv::_InputArray( $(Point2f * contourPtr)
86 , $(int32_t c'numPoints)
87 );
88 *$(double * c'area) = cv::contourArea(contour, $(bool c'oriented));
89 |]
90 where
91 oriented =
92 case areaOriented of
93 ContourAreaOriented -> True
94 ContourAreaAbsoluteValue -> False
95 c'numPoints = fromIntegral $ V.length contour
96 c'oriented = fromBool oriented
97
98 -- | Performs a point-in-contour test.
99 --
100 -- The function determines whether the point is inside a contour, outside, or
101 -- lies on an edge (or coincides with a vertex). It returns positive (inside),
102 -- negative (outside), or zero (on an edge) value, correspondingly. When
103 -- measureDist=false , the return value is +1, -1, and 0,
104 -- respectively. Otherwise, the return value is a signed distance between the
105 -- point and the nearest contour edge.
106 --
107 -- <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/structural_analysis_and_shape_descriptors.html#pointpolygontest OpenCV Sphinx doc>
108 pointPolygonTest
109 :: ( IsPoint2 contourPoint2 CFloat
110 , IsPoint2 testPoint2 CFloat
111 )
112 => V.Vector (contourPoint2 CFloat) -- ^ Contour.
113 -> testPoint2 CFloat -- ^ Point tested against the contour.
114 -> Bool
115 -- ^ If true, the function estimates the signed distance from the point
116 -- to the nearest contour edge. Otherwise, the function only checks if
117 -- the point is inside a contour or not.
118 -> CvExcept Double
119 pointPolygonTest contour pt measureDist = unsafeWrapException $
120 withArrayPtr (V.map toPoint contour) $ \contourPtr ->
121 withPtr (toPoint pt) $ \ptPtr ->
122 alloca $ \c'resultPtr ->
123 handleCvException (realToFrac <$> peek c'resultPtr) $
124 [cvExcept|
125 cv::_InputArray contour =
126 cv::_InputArray( $(Point2f * contourPtr)
127 , $(int32_t c'numPoints)
128 );
129 *$(double * c'resultPtr) =
130 cv::pointPolygonTest( contour
131 , *$(Point2f * ptPtr)
132 , $(bool c'measureDist)
133 );
134 |]
135 where
136 c'numPoints = fromIntegral $ V.length contour
137 c'measureDist = fromBool measureDist
138
139 -- | Oriented area flag.
140 data ContourAreaOriented
141 = ContourAreaOriented
142 -- ^ Return a signed area value, depending on the contour orientation (clockwise or
143 -- counter-clockwise). Using this feature you can determine orientation
144 -- of a contour by taking the sign of an area.
145 | ContourAreaAbsoluteValue
146 -- ^ Return the area as an absolute value.
147
148 data ContourRetrievalMode
149 = ContourRetrievalExternal
150 -- ^ Retrieves only the extreme outer contours.
151 | ContourRetrievalList
152 -- ^ Retrieves all of the contours without establishing any hierarchical relationships.
153 | ContourRetrievalCComp
154 -- ^ Retrieves all of the contours and organizes them into a two-level hierarchy. At the top level, there are external boundaries of the components. At the second level, there are boundaries of the holes. If there is another contour inside a hole of a connected component, it is still put at the top level.
155 | ContourRetrievalTree
156 -- ^ Retrieves all of the contours and reconstructs a full hierarchy of nested contours.
157
158 data ContourApproximationMethod
159 = ContourApproximationNone
160 -- ^ Stores absolutely all the contour points. That is, any 2 subsequent points @(x1,y1)@ and @(x2,y2)@ of the contour will be either horizontal, vertical or diagonal neighbors, that is, @max(abs(x1-x2),abs(y2-y1)) == 1@.
161 | ContourApproximationSimple
162 -- ^ Compresses horizontal, vertical, and diagonal segments and leaves only their end points. For example, an up-right rectangular contour is encoded with 4 points.
163 | ContourApproximationTC89L1
164 | ContourApproximationTC89KCOS
165
166 #num CV_RETR_EXTERNAL
167 #num CV_RETR_LIST
168 #num CV_RETR_CCOMP
169 #num CV_RETR_TREE
170 #num CV_CHAIN_APPROX_NONE
171 #num CV_CHAIN_APPROX_SIMPLE
172 #num CV_CHAIN_APPROX_TC89_L1
173 #num CV_CHAIN_APPROX_TC89_KCOS
174
175 marshalContourRetrievalMode
176 :: ContourRetrievalMode -> Int32
177 marshalContourRetrievalMode = \case
178 ContourRetrievalExternal -> c'CV_RETR_EXTERNAL
179 ContourRetrievalList -> c'CV_RETR_LIST
180 ContourRetrievalCComp -> c'CV_RETR_CCOMP
181 ContourRetrievalTree -> c'CV_RETR_TREE
182
183 marshalContourApproximationMethod
184 :: ContourApproximationMethod -> Int32
185 marshalContourApproximationMethod = \case
186 ContourApproximationNone -> c'CV_CHAIN_APPROX_NONE
187 ContourApproximationSimple -> c'CV_CHAIN_APPROX_SIMPLE
188 ContourApproximationTC89L1 -> c'CV_CHAIN_APPROX_TC89_L1
189 ContourApproximationTC89KCOS -> c'CV_CHAIN_APPROX_TC89_KCOS
190
191 data Contour =
192 Contour
193 { contourPoints :: !(V.Vector Point2i)
194 , contourChildren :: !(V.Vector Contour)
195 } deriving Show
196
197 findContours
198 :: (PrimMonad m)
199 => ContourRetrievalMode
200 -> ContourApproximationMethod
201 -> Mut (Mat ('S [h, w]) ('S 1) ('S Word8)) (PrimState m)
202 -> m (V.Vector Contour)
203 findContours mode method src = unsafePrimToPrim $
204 withPtr src $ \srcPtr ->
205 alloca $ \(contourLengthsPtrPtr :: Ptr (Ptr Int32)) ->
206 alloca $ \(contoursPtrPtr :: Ptr (Ptr (Ptr (Ptr C'Point2i)))) ->
207 alloca $ \(hierarchyPtrPtr :: Ptr (Ptr (Ptr C'Vec4i))) ->
208 alloca $ \(numContoursPtr :: Ptr Int32) -> mask_ $ do
209 [C.block| void {
210 std::vector< std::vector<cv::Point> > contours;
211 std::vector<cv::Vec4i> hierarchy;
212 cv::findContours(
213 *$(Mat * srcPtr),
214 contours,
215 hierarchy,
216 $(int32_t c'mode),
217 $(int32_t c'method)
218 );
219
220 *$(int32_t * numContoursPtr) = contours.size();
221
222 cv::Point * * * * contoursPtrPtr = $(Point2i * * * * contoursPtrPtr);
223 cv::Point * * * contoursPtr = new cv::Point * * [contours.size()];
224 *contoursPtrPtr = contoursPtr;
225
226 cv::Vec4i * * * hierarchyPtrPtr = $(Vec4i * * * hierarchyPtrPtr);
227 cv::Vec4i * * hierarchyPtr = new cv::Vec4i * [contours.size()];
228 *hierarchyPtrPtr = hierarchyPtr;
229
230 int32_t * * contourLengthsPtrPtr = $(int32_t * * contourLengthsPtrPtr);
231 int32_t * contourLengthsPtr = new int32_t [contours.size()];
232 *contourLengthsPtrPtr = contourLengthsPtr;
233
234 for (std::vector< std::vector<cv::Point> >::size_type i = 0; i < contours.size(); i++) {
235 std::vector<cv::Point> & contourPoints = contours[i];
236 cv::Vec4i hierarchyInfo = hierarchy[i];
237
238 contourLengthsPtr[i] = contourPoints.size();
239
240 cv::Point * * newContourPoints = new cv::Point * [contourPoints.size()];
241 for (std::vector<cv::Point>::size_type j = 0; j < contourPoints.size(); j++) {
242 cv::Point & orig = contourPoints[j];
243 cv::Point * newPt = new cv::Point(orig.x, orig.y);
244 newContourPoints[j] = newPt;
245 }
246 contoursPtr[i] = newContourPoints;
247
248 hierarchyPtr[i] = new cv::Vec4i(
249 hierarchyInfo[0],
250 hierarchyInfo[1],
251 hierarchyInfo[2],
252 hierarchyInfo[3]
253 );
254 }
255 }|]
256
257 numContours <- fromIntegral <$> peek numContoursPtr
258
259 contourLengthsPtr <- peek contourLengthsPtrPtr
260 contourLengths <- peekArray numContours contourLengthsPtr
261
262 contoursPtr <- peek contoursPtrPtr
263 unmarshalledContours <- peekArray numContours contoursPtr
264
265 allContours <- for (zip unmarshalledContours contourLengths) $ \(contourPointsPtr,n) ->
266 fmap V.fromList
267 (peekArray (fromIntegral n) contourPointsPtr >>= mapM (fromPtr . pure))
268
269 hierarchyPtr <- peek hierarchyPtrPtr
270 (hierarchy :: [V4 Int32]) <-
271 peekArray numContours hierarchyPtr >>=
272 mapM (fmap fromVec . fromPtr . pure)
273
274 let treeHierarchy :: V.Vector ([Contour], Bool)
275 treeHierarchy = V.fromList $
276 zipWith
277 (\(V4 nextSibling previousSibling firstChild parent) points ->
278 ( Contour { contourPoints = points
279 , contourChildren =
280 if firstChild < 0
281 then mempty
282 else V.fromList $ fst $ treeHierarchy V.! fromIntegral firstChild
283 } : if nextSibling < 0
284 then []
285 else fst $ treeHierarchy V.! fromIntegral nextSibling
286 , parent < 0 && previousSibling < 0
287 )
288 )
289 hierarchy
290 allContours
291
292 [CU.block| void {
293 delete [] *$(Point2i * * * * contoursPtrPtr);
294 delete [] *$(Vec4i * * * hierarchyPtrPtr);
295 delete [] *$(int32_t * * contourLengthsPtrPtr);
296 } |]
297
298 return $ V.fromList $ concat
299 $ mapMaybe (\(contours,isRoot) -> guard isRoot $> contours)
300 $ V.toList treeHierarchy
301 where
302 c'mode = marshalContourRetrievalMode mode
303 c'method = marshalContourApproximationMethod method
304
305 {- | Approximates a polygonal curve(s) with the specified precision.
306
307 The functions approxPolyDP approximate a curve or a polygon with another
308 curve/polygon with less vertices so that the distance between them is less or
309 equal to the specified precision. It uses the
310 <http://en.wikipedia.org/wiki/Ramer-Douglas-Peucker_algorithm Douglas-Peucker algorithm>
311
312 <http://docs.opencv.org/3.0-last-rst/modules/imgproc/doc/structural_analysis_and_shape_descriptors.html?highlight=contourarea#approxpolydp>
313 -}
314 approxPolyDP
315 :: (IsPoint2 point2 Int32)
316 => V.Vector (point2 Int32)
317 -> Double -- ^ epsilon
318 -> Bool -- ^ is closed
319 -> V.Vector Point2i -- vector of points
320 approxPolyDP curve epsilon isClosed = unsafePerformIO $
321 withArrayPtr (V.map toPoint curve) $ \curvePtr ->
322 alloca $ \(pointsResPtrPtr ::Ptr (Ptr (Ptr C'Point2i))) ->
323 alloca $ \(numPointsResPtr :: Ptr Int32) -> mask_ $ do
324 [C.block| void {
325 std::vector<cv::Point> points_res;
326 cv::_InputArray curve = cv::_InputArray ($(Point2i * curvePtr), $(int32_t c'numPoints));
327 cv::approxPolyDP
328 ( curve
329 , points_res
330 , $(double c'epsilon)
331 , $(bool c'isClosed)
332 );
333
334 *$(int32_t * numPointsResPtr) = points_res.size();
335
336 cv::Point * * * pointsResPtrPtr = $(Point2i * * * pointsResPtrPtr);
337 cv::Point * * pointsResPtr = new cv::Point * [points_res.size()];
338 *pointsResPtrPtr = pointsResPtr;
339
340 for (std::vector<cv::Point>::size_type i = 0; i < points_res.size(); i++) {
341 cv::Point & ptAddress = points_res[i];
342 cv::Point * newPt = new cv::Point(ptAddress.x, ptAddress.y);
343 pointsResPtr[i] = newPt;
344 }
345 }|]
346
347 numPoints <- fromIntegral <$> peek numPointsResPtr
348
349 pointsResPtr <- peek pointsResPtrPtr
350 (pointsResList :: [Point2i]) <- peekArray numPoints pointsResPtr >>= mapM (fromPtr . pure) --CHECK THIS
351 let pointsRes :: V.Vector (Point2i)
352 pointsRes = V.fromList pointsResList
353
354 [CU.block| void {
355 delete [] *$(Point2i * * * pointsResPtrPtr);
356 } |]
357
358 return pointsRes
359 where
360 c'numPoints = fromIntegral $ V.length curve
361 c'isClosed = fromBool isClosed
362 c'epsilon = realToFrac epsilon
363
364 arcLength
365 :: (IsPoint2 point2 Int32)
366 => V.Vector (point2 Int32)
367 -> Bool -- ^ is closed
368 -> CvExcept Double
369 arcLength curve isClosed = unsafeWrapException $
370 withArrayPtr (V.map toPoint curve) $ \curvePtr ->
371 alloca $ \c'resultPtr ->
372 handleCvException (realToFrac <$> peek c'resultPtr) $
373 [cvExcept|
374 cv::_InputArray curve =
375 cv::_InputArray ( $(Point2i * curvePtr)
376 , $(int32_t c'numPoints)
377 );
378 *$(double * c'resultPtr) =
379 cv::arcLength( curve
380 , $(bool c'isClosed)
381 );
382 |]
383 where
384 c'isClosed = fromBool isClosed
385 c'numPoints = fromIntegral $ V.length curve
386
387 minAreaRect :: (IsPoint2 point2 Int32)
388 => V.Vector (point2 Int32) -> RotatedRect
389 minAreaRect points =
390 unsafePerformIO $ fromPtr $
391 withArrayPtr (V.map toPoint points) $ \pointsPtr ->
392 [CU.exp|
393 RotatedRect * {
394 new RotatedRect(
395 cv::minAreaRect(
396 cv::_InputArray( $(Point2i * pointsPtr)
397 , $(int32_t c'numPoints))))
398 }
399 |]
400 where
401 c'numPoints = fromIntegral $ V.length points