Version 4 of Not Functional Imaging - Scripting Imaging

Updated 2004-02-08 21:54:08

Overview 9 Feb 2004

The post Functional imaging looks at implementing a paradigm found in functional programming language in TCL.

While all these contributions are useful in themselves, they also show that TCL does not always map well to these techniques.

The article also touched on a design pattern that is not well exploited in scripting languages. I attempt to elaborate here.

Please refer to the original page before reading further.

In this discussion we assume that the example given in the above reference is a valid image processing technique and that the method of x y transformations are appropriate to real world tasks. We also assume that the function would in real life be called more than once in the life time of the application. For example , face recognition, video editing, or such.

Background

The example implements a combinor function to convert a pipeline of processing tasks, as an example:

   o {gPaint yellow} gChecker {rippleRad 6 0.2} {swirl 26} toPolars  

This creates a proc of the form:

    proc uniquename {x} { gPaint yellow [gChecker [rippleRad 6 0.2 [ swirl 26 [toPolars $x]]]]

We have here the essence of dynamic programming. In the case of TCL, the creation of a proc is due to the need to bytecode for speed. Otherwise the pipeline could have been implmented with eval.

The main processing loop iterates through the x, y coordinates and calls the arbitary function with the xy pair. The result is then appended to the new image data.

Extending dynamic programming

If we instead use specialisation to change the main loop we get a performance increase. Take the following template:

 proc qfim {f {zoom 100} {width 200} {height -}} {
        puts "func {[info args $f]} -> [info body $f]"
    # produce a photo image by applying function f to pixels
    if {$height=="-"} {set height $width}
    set im [image create photo -height $height -width $width]
    set data {}
    set xs {}
    set rgb [rgb yellow]
    set rgbw [rgb white]
    for {set j 0} {$j<$width} {incr j} {
        lappend xs [expr {($j-$width/2.)/$zoom}]
    }
    for {set i 0} {$i<$height} {incr i} {
        set row {}
        set y0 [expr {($i-$height/2.)/$zoom}]
        foreach x $xs {
            #@FUNCTION
            #@RESULT
            lappend row $res
        }
        lappend data $row
    }
    $im put $data
    set im
 }

We can specialise this proc for the following function:

   o {gPaint yellow} gChecker {rippleRad 6 0.2} {swirl 26} toPolars  

We get:

 proc uniquefim {f {zoom 100} {width 200} {height -}} {
        puts "func {[info args $f]} -> [info body $f]"
    # produce a photo image by applying function f to pixels
    if {$height=="-"} {set height $width}
    set im [image create photo -height $height -width $width]
    set data {}
    set xs {}
    set rgb [rgb yellow]
    set rgbw [rgb white]
    for {set j 0} {$j<$width} {incr j} {
        lappend xs [expr {($j-$width/2.)/$zoom}]
    }
    for {set i 0} {$i<$height} {incr i} {
        set row {}
        set y0 [expr {($i-$height/2.)/$zoom}]
        foreach x $xs {
                        #@FUNCTION
                        set y $y0
                        # toPolars
                            set x1 [expr {hypot($x,$y)}]
                                set y [expr {$x||$y? atan2($y,$x): 0}]
                                set x $x1
                        # swirl 26
                            set angle [expr {hypot($x,$y)*6.283185306/26}]
                                #rotate
                            set x1 [expr {$x*cos(-$angle) - $y*sin(-$angle)}]
                            set y [expr {$y*cos(-$angle) + $x*sin(-$angle)}]
                                set x $x1
                        #rippleRad 6 0.2
                                #topolars
                             set r [expr {hypot($x,$y)}]
                                 set a [expr {$x||$y? atan2($y,$x): 0}]
                                #fromPolars [list [expr {$r*(1.+$s*sin($n*$a))}] $a]
                                    set r [expr {$r*(1.+0.2*sin(6*$a))}]
                                 #fromPolars
                                     set x [expr {$r*cos($a)}]
                                  set y [expr {$r*sin($a)}]
                        # gchecker
                            set greylevel [expr {(fmod(abs($x),1.)*fmod(abs($y),1.))}]
                                set hex [format %02X [expr {round($greylevel*255)}]]
                            set pixel #$hex$hex$hex
                        # gpaint yellow
                            set abspixel [lindex [rgb $pixel] 0]
                            foreach var {r g b} in $rgb ref $rgbw {
                                    set $var [expr {round(double($abspixel)*$in/$ref/$ref*255.)}]
                            }
                            #c2c $r $g $b
                            set res [format #%02X%02X%02X $r $g $b]
                        #@RESULT
            lappend row $res
        }
        lappend data $row
    }
    $im put $data
    set im
 }

The passing of the function $f is for debuging only.

Note that the above would have been created by the o proc and not hand crafted. The new proc would be called to create the image. In testing this change gives a 33% reduction in processing time. By moving constant expressions out of the main loop, we get a speedup of 2 times, which is significant. If some optimisation of the use of expr is done (programaticaly) then it would be expected that a boost of 3 times could be gained over the original example.

If we were to apply specialization to the whole procedure we would also specialize the code for processing the width and height. This would include precreation of the lists for I and J and the removal of the if statement for testing if $height is - as we know what the value is.

I have not demonstrated the code to generate the template because the image processing functions were originally coded as procs and in these example they would instead be implemented as lists so that combination would be a trivial process.

The above said, the use of [info body proc] would allow the extraction of the code from existing procedures providing that the code can determine what the return values would be and inline them as assignments to x and y.

Further applications

We find a common task for code libraries is one of initialisation. This takes two forms:

  1. first invokation environment creation.
  2. Application specific environment configuration.

Both of these are candidates for specialisation. Consider this example.

    proc dbOpen {args} {
       variable Data
       if {! info exists Data(Init) } {
          dbInit
          dbConnect
          rename unknown _unknown
          proc unknown {args} {dbUnknown $args}
        }
        ...
   }

To remove the need for an application specific call to initialise the environment for the module, the main API function will do this automatically. The downside of this is that every call to dbOpen has the overhead of checking if this is the first call.

The new approach:

    proc real_dbOpen {args} {
       variable Data
        ...
   }

    proc dbOpen {args} {
        dbInit
        dbConnect
          rename unknown _unknown
          proc unknown {args} {dbUnknown $args}
        rename dbOpen {}
        rename real_dbOpen dbOpen
        uplevel dbOpen $args
   }

Here we incur the overhead once and then no checks are ever made on subsequent calls to dbOpen.

An alternate that removes the need for two proceedures is:

  proc dbOpen {args} {
       #@INIT
        dbInit
        dbConnect
          rename unknown _unknown
          proc unknown {args} {dbUnknown $args}
        set body [info body dbOpen]
        regsub {#@INIT.*#@DONE} $body {} body
        proc dbOpen [info args dbOpen] $body
        #@DONE
       variable Data
        ...
   }

This will work well with autoloading and other packaging systems.

Conclusion'

Scripting languages are always handicapped for speed due to the nature of the language. Any technique that can boose speed can only be good.

The classic example (IMHO) is Stephen Uhler's html_library where data is the program. This should be required reading for all TCL newbies.

Scripting is more than just an interpretered vs compiled paradigm. The ability to change the code during execution is a fundamental concept then needs to be demonstrated more.


Philip Quaife