One class of image digital filters is described by a rectangular matrix of real coefficients called kernel convoluted in a sliding window of image pixels. Usually the kernel is square 




K

k
l




{\displaystyle K_{kl}}

, where k, l are in the range -R,-R+1,..,R-1,R. W=2R+1 is the kernel width. The filter determines the new value of a monochromatic image pixel Pij as a convolution of the image pixels in the window centered in i, j and the kernel values:







P

i
j


=


∑

k
=
−
R


R



∑

l
=
−
R


R



P

i
+
k
 
j
+
l



K

k
l





{\displaystyle P_{ij}=\displaystyle \sum _{k=-R}^{R}\sum _{l=-R}^{R}P_{i+k\ j+l}K_{kl}}




Color images are usually split into the channels which are filtered independently. A color model can be changed as well, i.e. filtration is performed not necessarily in RGB. Common kernels sizes are 3x3 and 5x5. The complexity of filtrating grows quadratically (O(n2)) with the kernel width.

Task: Write a generic convolution 3x3 kernel filter. Optionally show some end user filters that use this generic one.

(You can use, to test the functions below, these input and output solutions.)

(load "rgb-pixel-buffer")
(load "ppm-file-io")
 
(defpackage #:convolve
  (:use #:common-lisp #:rgb-pixel-buffer #:ppm-file-io))
 
(in-package #:convolve)
(defconstant +row-offsets+ '(-1 -1 -1 0 0 0 1 1 1))
(defconstant +col-offsets+ '(-1 0 1 -1 0 1 -1 0 1))
(defstruct cnv-record descr width kernel divisor offset)
(defparameter *cnv-lib* (make-hash-table))
(setf (gethash 'emboss *cnv-lib*)
      (make-cnv-record :descr "emboss-filter" :width 3 
                       :kernel '(-2.0 -1.0 0.0 -1.0 1.0 1.0 0.0 1.0 2.0) :divisor 1.0))
(setf (gethash 'sharpen *cnv-lib*)
      (make-cnv-record :descr "sharpen-filter" :width 3 
                       :kernel '(-1.0 -1.0 -1.0 -1.0 9.0 -1.0 -1.0 -1.0 -1.0) :divisor 1.0))
(setf (gethash 'sobel-emboss *cnv-lib*)
      (make-cnv-record :descr "sobel-emboss-filter" :width 3 
                       :kernel '(-1.0 -2.0 -1.0 0.0 0.0 0.0 1.0 2.0 1.0 :divisor 1.0 :offset 0.5)))
(setf (gethash 'box-blur *cnv-lib*)
      (make-cnv-record :descr "box-blur-filter" :width 3 
                       :kernel '(1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0) :divisor 9.0))
 
(defun convolve (filename params)
  (let* ((buf (read-ppm-file-to-rgb-pixel-buffer filename))
         (width (first (array-dimensions buf)))
         (height (second (array-dimensions buf)))
         (obuf (make-rgb-pixel-buffer width height)))
 
    ;;; constrain a value to some range
    ;;; (int,int,int)->int
    (defun constrain (val minv maxv)
      (declare (type integer val minv maxv))
      (min maxv (max minv val)))
 
    ;;; convolve a single channel
    ;;; list ubyte8->ubyte8
    (defun convolve-channel (band)
      (constrain (round (apply #'+ (mapcar #'* band (cnv-record-kernel params)))) 0 255))  
 
    ;;; return the rgb convolution of a list of pixels 
    ;;; list uint24->uint24
    (defun convolve-pixels (pixels)
      (let ((reds (list)) (greens (list)) (blues (list)))
        (dolist (pel (reverse pixels)) 
          (push (rgb-pixel-red pel) reds)
          (push (rgb-pixel-green pel) greens)
          (push (rgb-pixel-blue pel) blues))
        (make-rgb-pixel (convolve-channel reds) (convolve-channel greens) (convolve-channel blues))))
 
    ;;; return the list of pixels to which the kernel will be applied
    ;;; (int,int)->list uint24
    (defun kernel-pixels (c r)
      (mapcar (lambda (coff roff) (rgb-pixel buf (constrain (+ c coff) 0 (1- width)) (constrain (+ r roff) 0 (1- height))))
              +col-offsets+ +row-offsets+))
 
    ;;; body of function
    (dotimes (r height)
      (dotimes (c width)
        (setf (rgb-pixel obuf c r) (convolve-pixels (kernel-pixels c r)))))
 
    (write-rgb-pixel-buffer-to-ppm-file (concatenate 'string (format nil "convolve-~A-" (cnv-record-descr params)) filename) obuf)))
 
(in-package #:cl-user)
(defun main ()
  (loop for pars being the hash-values of convolve::*cnv-lib* 
    do (princ (convolve::convolve "lena_color.ppm" pars)) (terpri)))
 