From 408bd51b585c02561f7d01fab4f6a9ff6b0c807f Mon Sep 17 00:00:00 2001 From: Vasily Postnicov Date: Mon, 18 Mar 2024 10:36:42 +0300 Subject: [PATCH] Fix ERODE with non-square structuring elements --- src/morphology.lisp | 52 +++++++++++++++++++++++++++++++-------------- 1 file changed, 36 insertions(+), 16 deletions(-) diff --git a/src/morphology.lisp b/src/morphology.lisp index 4917921..a96f450 100644 --- a/src/morphology.lisp +++ b/src/morphology.lisp @@ -127,7 +127,30 @@ components of an image. COMPONENTS is an array returned by LABEL-COMPONENTS" ;; ==================== ;; Erode & Dilate ;; ==================== -(macrolet ((def-morphological-op (name operation documentation) +(sera:-> kernel-some + ((simple-array bit (* *)) + (simple-array bit (* *)) + alex:non-negative-fixnum alex:non-negative-fixnum + alex:non-negative-fixnum alex:non-negative-fixnum + alex:non-negative-fixnum alex:non-negative-fixnum + (sera:-> (bit bit) (values boolean &optional))) + (values boolean &optional)) +(declaim (inline kernel-some)) +(defun kernel-some (kernel array i j kh kw h w fn) + (declare (optimize (speed 3))) + (let ((kh/2 (floor kh 2)) + (kw/2 (floor kw 2))) + (loop for k fixnum below kh do + (loop for l fixnum below kw do + (when (funcall fn + (aref kernel k l) + (aref array + (mod (+ i kh/2 (- k)) h) + (mod (+ j kw/2 (- l)) w))) + (return-from kernel-some t))))) + nil) + +(macrolet ((def-morphological-op (name op succ documentation) `(progn (sera:-> ,name (binary-image &optional (simple-array bit (* *))) (values binary-image &optional)) @@ -139,25 +162,22 @@ components of an image. COMPONENTS is an array returned by LABEL-COMPONENTS" (result (make-binary-image width height)) (image-pixels (image-pixels image)) (result-pixels (image-pixels result))) - (declare (type alex:positive-fixnum width height) - (type (simple-array bit (* *)) image-pixels result-pixels)) - (destructuring-bind (se-height/2 se-width/2) - (mapcar (the function (alex:rcurry #'floor 2)) - (array-dimensions structuring-element)) - (declare (type alex:positive-fixnum se-height/2 se-width/2)) - (aops:each-index! result-pixels - (i j) - (aops:reduce-index #',operation (k l) - (* (aref structuring-element k l) - (aref image-pixels - (mod (+ i se-height/2 (- k)) height) - (mod (+ j se-width/2 (- l)) width)))))) + (destructuring-bind (se-height se-width) + (array-dimensions structuring-element) + (aops:each-index! result-pixels (i j) + (if (kernel-some structuring-element image-pixels + i j se-height se-width height width + (lambda (kernel pixel) + (declare (type bit kernel pixel)) + (and (not (zerop kernel)) + (,op (zerop pixel))))) + ,succ (- (1- ,succ))))) result))))) - (def-morphological-op erode min + (def-morphological-op erode identity 0 "Erode binary image. STRUCTURING-ELEMENT is an optional 2D simple array of bits which serves as a structuring element and defaults to *STRUCTURING-ELEMENT*.") - (def-morphological-op dilate max + (def-morphological-op dilate not 1 "Dilate binary image. STRUCTURING-ELEMENT is an optional 2D simple array of bits which serves as a structuring element and defaults to *STRUCTURING-ELEMENT*."))