September Morn Update

Task/Image-convolution/Common-Lisp/image-convolution.lisp

@@ -0,0 +1,68 @@
+(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)))

Task/Image-convolution/MATLAB/image-convolution.m

@@ -9,7 +9,7 @@ function testConvImage
            1 2 1 ];         % Gaussian smoothing (without normalizing)
     fprintf('Original image:\n')
     disp(Im)
-    fprintf('Original kernal:\n')
+    fprintf('Original kernel:\n')
     disp(Ker)
     fprintf('Padding with zeroes:\n')
     disp(convImage(Im, Ker, 'zeros'))
@@ -17,7 +17,7 @@ function testConvImage
     disp(convImage(Im, Ker, 'value', 5))
     fprintf('Duplicating border pixels to pad image:\n')
     disp(convImage(Im, Ker, 'extend'))
-    fprintf('Renormalizing kernal and using only values within image:\n')
+    fprintf('Renormalizing kernel and using only values within image:\n')
     disp(convImage(Im, Ker, 'partial'))
     fprintf('Only processing inner (non-border) pixels:\n')
     disp(convImage(Im, Ker, 'none'))
@@ -39,7 +39,7 @@ function testConvImage
 %     title('Duplicating border pixels to pad image')
 %     figure
 %     imshow(imresize(convImage(Im, Ker, 'partial'), 10))
-%     title('Renormalizing kernal and using only values within image')
+%     title('Renormalizing kernel and using only values within image')
 %     figure
 %     imshow(imresize(convImage(Im, Ker, 'none'), 10))
 %     title('Only processing inner (non-border) pixels')
@@ -47,7 +47,7 @@ end
 
 function ImOut = convImage(Im, Ker, varargin)
 % ImOut = convImage(Im, Ker)
-%   Filters an image using sliding-window kernal convolution.
+%   Filters an image using sliding-window kernel convolution.
 %   Convolution is done layer-by-layer. Use rgb2gray if single-layer needed.
 %   Zero-padding convolution will be used if no border handling is specified.
 %   Im - Array containing image data (output from imread)
@@ -60,7 +60,7 @@ function ImOut = convImage(Im, Ker, varargin)
 %
 % ImOut = convImage(Im, Ker, 'value', padVal)
 %   Image will be padded with padVal when calculating convolution
-%   (possibly useful for emphasizing certain data with unusual kernal)
+%   (possibly useful for emphasizing certain data with unusual kernel)
 %
 % ImOut = convImage(Im, Ker, 'extend')
 %   Image will be padded with the value of the closest image pixel

Task/Image-convolution/Perl-6/image-convolution.pl6

@@ -0,0 +1,31 @@
+#!/usr/bin/env perl6
+
+# Reference:
+# https://github.com/azawawi/perl6-magickwand
+# http://www.imagemagick.org/Usage/convolve/
+
+use v6;
+
+use MagickWand;
+
+# A new magic wand
+my $original = MagickWand.new;
+
+# Read an image
+$original.read("./Lenna100.jpg") or die;
+
+my $o = $original.clone;
+
+# using coefficients from kernel "Sobel"
+# http://www.imagemagick.org/Usage/convolve/#sobel
+$o.convolve( [ 1, 0, -1,
+               2, 0, -2,
+               1, 0, -1] );
+
+$o.write("Lenna100-convoluted.jpg") or die;
+
+# And cleanup on exit
+LEAVE {
+  $original.cleanup   if $original.defined;
+  $o.cleanup if $o.defined;
+}

Task/Image-convolution/Phix/image-convolution.phix

@@ -0,0 +1,107 @@
+-- demo\rosetta\Image_convolution.exw
+include pGUI.e
+
+constant filters = {-- Emboss
+                    {{-2.0, -1.0, 0.0},
+                     {-1.0,  1.0, 1.0},
+                     { 0.0,  1.0, 2.0}},
+                    -- Sharpen
+                    {{-1.0, -1.0, -1.0},
+                     {-1.0,  9.0, -1.0},
+                     {-1.0, -1.0, -1.0}},
+                    -- Sobel_emboss
+                    {{-1.0, -2.0, -1.0},
+                     { 0.0,  0.0,  0.0},
+                     { 1.0,  2.0,  1.0}},
+                    -- Box_blur
+                    {{ 1.0, 1.0, 1.0},
+                     { 1.0, 1.0, 1.0},
+                     { 1.0, 1.0, 1.0}},
+                    -- Gaussian_blur
+                    {{1,  4,  7,  4, 1},
+                     {4, 16, 26, 16, 4},
+                     {7, 26, 41, 26, 7},
+                     {4, 16, 26, 16, 4},
+                     {1,  4,  7,  4, 1}}}
+
+function convolute(imImage img, integer fdx)
+integer width = im_width(img),
+        height = im_height(img)
+sequence original = repeat(repeat(0,width),height),
+         new_image,
+         filter = filters[fdx]
+integer fh = length(filter), hh=(fh-1)/2,
+        fw = length(filter[1]), hw=(fw-1)/2,
+        divisor = max(sum(filter),1)
+
+    for y=height-1 to 0 by -1 do
+        for x=0 to width-1 do
+            original[height-y,x+1] = im_pixel(img, x, y)
+        end for
+    end for
+    new_image = original
+
+    for y=hh+1 to height-hh-1 do
+        for x=hw+1 to width-hw-1 do
+            sequence newrgb = {0,0,0}
+            for i=-hh to +hh do
+                for j=-hw to +hw do
+                    newrgb = sq_add(newrgb,sq_mul(filter[i+hh+1,j+hw+1],original[y+i,x+j]))
+                end for
+            end for
+            new_image[y,x] = sq_max(sq_min(sq_floor_div(newrgb,divisor),255),0)
+        end for
+    end for
+
+    new_image = flatten(new_image) -- (as needed by IupImageRGB)
+    Ihandle new_img = IupImageRGB(width, height, new_image)
+    return new_img
+end function
+
+IupOpen()
+
+constant w = machine_word(),
+         TITLE = "Image convolution"
+atom pError = allocate(w)
+imImage im1 = imFileImageLoadBitmap("Quantum_frog.512.png",0,pError)
+
+if im1=NULL then
+    ?{"error opening image",peekNS(pError,w,1)}
+    {} = wait_key()
+    abort(0)
+end if
+
+Ihandle dlg,
+        filter = IupList("DROPDOWN=YES, VALUE=1")
+
+Ihandln image1 = IupImageFromImImage(im1),
+        image2 = convolute(im1,1),
+        label1 = IupLabel(),
+        label2 = IupLabel()
+IupSetAttributeHandle(label1, "IMAGE", image1)
+IupSetAttributeHandle(label2, "IMAGE", image2)
+
+function valuechanged_cb(Ihandle /*filter*/)
+    IupSetAttribute(dlg,"TITLE","Working...")
+    IupSetAttributeHandle(label2, "IMAGE", NULL)
+    IupDestroy(image2)
+    image2 = convolute(im1,IupGetInt(filter,"VALUE"))
+    IupSetAttributeHandle(label2, "IMAGE", image2)
+    IupSetAttribute(dlg,"TITLE",TITLE)
+    IupRefresh(dlg)
+    return IUP_DEFAULT
+end function
+IupSetCallback(filter,"VALUECHANGED_CB",Icallback("valuechanged_cb"))
+
+IupSetAttributes(filter,"1=Emboss, 2=Sharpen, 3=\"Sobel emboss\", 4=\"Box_blur\", 5=Gaussian_blur")
+IupSetAttributes(filter,"VISIBLEITEMS=6") -- (still dunno why this trick works)
+dlg = IupDialog(IupVbox({filter,
+                         IupFill(),
+                         IupHbox({IupFill(),label1, label2,IupFill()}),
+                         IupFill()}))
+IupSetAttribute(dlg, "TITLE", TITLE)
+IupCloseOnEscape(dlg)
+IupShow(dlg)
+
+IupMainLoop()
+IupClose()