Blurring an image

ulis, 2003-12-07. A proc to blur an image.

David Easton, 2003-12-08. Speeded up 25%

(this page replace the Blurring one)

(Original photo: to fill)

How it works

It works by adding some neighbor pixels:

     0  1  2  3  4
    .--.--.--.--.--.
  0 |//|  |  |  |//|
    .--.--.--.--.--.
  1 |  |  |//|  |  |
    .--.--.--.--.--.
  2 |  |//|XX|//|  |
    .--.--.--.--.--.
  3 |  |  |//|  |  |
    .--.--.--.--.--.
  4 |//|  |  |  |//|
    .--.--.--.--.--.

The color of the central pixel is computed from all marked pixels:

  p22 = (1 - coef) * p22 
        + coef/8 * (p00 + p04 + p12 + p21 + p23 + p32 + p40 + p44)

The proc

  namespace eval ::blur \
  {
    namespace export blur

    package require Tk

    proc blur {image coef} \
    {
      # check coef
      if {$coef < 0.0 || $coef > 1.0} \
      { error "bad coef \"$coef\": should be in the range 0.0, 1.0" }
      if {$coef < 1.e-5} { return $image }
      set coef2 [expr {$coef / 8.0}]
      # get the old image content
      set width [image width $image]
      set height [image height $image]
      if {$width * $height == 0} { error "bad image" }
      # create corresponding planes
      for {set y 0} {$y < $height} {incr y} \
      {
        set r:row {}
        set g:row {}
        set b:row {}
        for {set x 0} {$x < $width} {incr x} \
        {
          foreach {r g b} [$image get $x $y] break
          foreach c {r g b} { lappend $c:row [set $c] }
        }
        foreach c {r g b} { lappend $c:data [set $c:row] }
      }
      # blurring
      for {set y 0} {$y < $height} {incr y} \
      {
        set row2 {}
        for {set x 0} {$x < $width} {incr x} \
        {
          foreach c {r g b} \
          { 
            set c00 [lindex [set $c:data] [expr {$y - 2}] [expr {$x - 2}]]
            set c01 [lindex [set $c:data] [expr {$y - 1}] [expr {$x - 0}]]
            set c02 [lindex [set $c:data] [expr {$y - 2}] [expr {$x + 2}]]
            set c10 [lindex [set $c:data] [expr {$y + 0}] [expr {$x - 1}]]
            set c11 [lindex [set $c:data] [expr {$y + 0}] [expr {$x - 0}]]
            set c12 [lindex [set $c:data] [expr {$y + 0}] [expr {$x + 1}]]
            set c20 [lindex [set $c:data] [expr {$y + 2}] [expr {$x - 2}]]
            set c21 [lindex [set $c:data] [expr {$y + 1}] [expr {$x - 0}]]
            set c22 [lindex [set $c:data] [expr {$y + 2}] [expr {$x + 2}]]
            foreach v {c00 c01 c02 c10 c12 c20 c21 c22} { if {[set $v] == ""} { set $v 0.0 } }
            set cc [expr {int((1.0 - $coef) * $c11 + $coef2 * ($c00 + $c01 + $c02 + $c10 + $c12 + $c20 + $c21 + $c22))}]
            if {$cc < 0} { set cc 0 }
            if {$cc > 255} { set cc 255 }
            set $c $cc
          }
          lappend row2 [format #%02x%02x%02x $r $g $b]
        }
        lappend data2 $row2
      }
      # create the new image
      set image2 [image create photo]
      # fill the new image
      $image2 put $data2
      # return the new image
      return $image2
    }

  }

The demo

  # to download the image:
  # http://perso.wanadoo.fr/maurice.ulis/tcl/image3.png

  package require Img
  image create photo Photo -file image3.png
  namespace import ::blur::blur
  wm withdraw .
  set n 0
  foreach coef {0.0 0.5 1.0} \
  {
    set image [blur Photo $coef]
    toplevel .$n
    wm title .$n "blur $coef"
    canvas .$n.c -bd 0 -highlightt 0
    .$n.c create image 0 0 -anchor nw -image $image
    foreach {- - width height} [.$n.c bbox all] break
    .$n.c config -width $width -height $height
    pack .$n.c
    bind .$n.c <Destroy> exit 
    update
    incr n
  }

Minor alterations

The code above...

     foreach v {c00 c01 c02 c10 c12 c20 c21 c22} { if {[set $v] == ""} { set $v 0.0 } }

checks to see if any of the pixels are blank, and sets them to black. This has an overall darkening effect on the image. Corrected it is:

     foreach v {c00 c01 c02 c10 c12 c20 c21 c22} {
          if {[set $v] == ""} { set $v [lindex [set $c:data] $y $x] }
     }

I also speed this process up significantly (approximately 40% speed increase)

        proc Blur { data coef } {
            if {$coef < 0.0 || $coef > 1.0} { error "bad coef \"$coef\": should be in the range 0.0, 1.0" }
            if {$coef < 1.e-5} { return $image }
            set coef2 [expr {$coef / 8.0}]
            if {[catch {set width [image width $data]} blah ]} {return 0;}
            set height [image height $data]
            for {set y 0} {$y < $height} {incr y} {
                set r:row {}; set g:row {}; set b:row {};
                for {set x 0} {$x < $width} {incr x} {
                    foreach {r g b} [$data get $x $y] break
                    foreach c {r g b} {lappend $c:row [set $c];}
                }
                foreach c {r g b} {lappend $c:data [set $c:row];}
                set row {}
                for {set x 0} {$x < $width} {incr x} {
                    foreach c {r g b} {
                        set c00 [lindex [set $c:data] [expr {$y - 2}] [expr {$x - 2}]]
                        set c01 [lindex [set $c:data] [expr {$y - 1}] [expr {$x - 0}]]
                        set c02 [lindex [set $c:data] [expr {$y - 2}] [expr {$x + 2}]]
                        set c10 [lindex [set $c:data] [expr {$y + 0}] [expr {$x - 1}]]
                        set c11 [lindex [set $c:data] [expr {$y + 0}] [expr {$x - 0}]]
                        set c12 [lindex [set $c:data] [expr {$y + 0}] [expr {$x + 1}]]
                        set c20 [lindex [set $c:data] [expr {$y + 2}] [expr {$x - 2}]]
                        set c21 [lindex [set $c:data] [expr {$y + 1}] [expr {$x - 0}]]
                        set c22 [lindex [set $c:data] [expr {$y + 2}] [expr {$x + 2}]]
                        foreach v {c00 c01 c02 c10 c12 c20 c21 c22} {
                            if {[set $v] == ""} { set $v [lindex [set $c:data] $y $x] }
                        }
                        set cc [expr {int((1.0 - $coef) * $c11 + $coef2 * ($c00 + $c01 + $c02 + $c10 + $c12 + $c20 + $c21 + $c22))}]
                        if {$cc < 0} { set cc 0 }
                        if {$cc > 255} { set cc 255 }
                        set $c $cc
                    }
                    lappend row [format #%02x%02x%02x $r $g $b]
                }
                lappend data2 $row
            }
            set blurred [image create photo]
            $blurred put $data2
            return $blurred
        }

* modified by: Barry Skidmore

More performance

DKF: After playing around and knowing what's really expensive and what isn't, I get much better performance with this:

proc Blur { image coef } {
    if {$coef < 0.0 || $coef > 1.0} {
        error "bad coef \"$coef\": should be in the range 0.0, 1.0"
    }
    if {$coef < 1.e-5} {
        return $image
    }
    set coef2 [expr {$coef / 8.0}]
    set coef1 [expr {1.0 - $coef}]
    if {[catch {
        set width [image width $image]
        set height [image height $image]
    }]} {
        return 0
    }
    set data {}
    for {set y 0} {$y < $height} {incr y} {
        set row {}
        for {set x 0} {$x < $width} {incr x} {
            set pixel [$image get $x $y]
            if {![llength $row]} {
                lappend row $pixel $pixel
            }
            lappend row $pixel
        }
        lappend row $pixel $pixel
        if {![llength $data]} {
            lappend data $row $row
        }
        lappend data $row
    }
    lappend data $row $row
    # blurring
    for {set y0 0;set y1 1;set y2 2;set y3 3;set y4 4} {$y0 < $height} {incr y0;incr y1;incr y2;incr y3;incr y4} {
        set row2 {}
        for {set x0 0;set x1 1;set x2 2;set x3 3;set x4 4} {$x0 < $width} {incr x0;incr x1;incr x2;incr x3;incr x4} {
            set cc [expr {
                int($coef1 * ([lindex $data $y2 $x2 0]) +
                    $coef2 * ([lindex $data $y0 $x0 0] +
                              [lindex $data $y1 $x2 0] +
                              [lindex $data $y0 $x4 0] +
                              [lindex $data $y2 $x1 0] +
                              [lindex $data $y2 $x3 0] +
                              [lindex $data $y4 $x0 0] +
                              [lindex $data $y3 $x2 0] +
                              [lindex $data $y4 $x4 0]))
            }]
            set r [expr {$cc<0?0:$cc>255?255:$cc}]
            set cc [expr {
                int($coef1 * ([lindex $data $y2 $x2 1]) +
                    $coef2 * ([lindex $data $y0 $x0 1] +
                              [lindex $data $y1 $x2 1] +
                              [lindex $data $y0 $x4 1] +
                              [lindex $data $y2 $x1 1] +
                              [lindex $data $y2 $x3 1] +
                              [lindex $data $y4 $x0 1] +
                              [lindex $data $y3 $x2 1] +
                              [lindex $data $y4 $x4 1]))
            }]
            set g [expr {$cc<0?0:$cc>255?255:$cc}]
            set cc [expr {
                int($coef1 * ([lindex $data $y2 $x2 2]) +
                    $coef2 * ([lindex $data $y0 $x0 2] +
                              [lindex $data $y1 $x2 2] +
                              [lindex $data $y0 $x4 2] +
                              [lindex $data $y2 $x1 2] +
                              [lindex $data $y2 $x3 2] +
                              [lindex $data $y4 $x0 2] +
                              [lindex $data $y3 $x2 2] +
                              [lindex $data $y4 $x4 2]))
            }]
            set b [expr {$cc<0?0:$cc>255?255:$cc}]
            lappend row2 [format #%02x%02x%02x $r $g $b]
        }
        lappend data2 $row2
    }
    set blurred [image create photo]
    $blurred put $data2
    return $blurred
}

This goes at least twice as fast as the other versions.