[aricb] A poster on comp.lang.tcl [http://groups.google.com/group/comp.lang.tcl/browse_frm/thread/7166a0264934ef9b#] was looking for code to convert a rectangular set of floating point values into a color image, similarly to MATLAB's ''imagesc''.  I used to do some data visualization in a previous life, so I thought I'd bite.  Critiques welcome.


  # Aric Bills 2008
  # no rights reserved

  package require math::statistics
  
  proc generateDefaultColormap {} {
    for {set i 0} {$i < 256} {incr i} {
      lappend colormap [format #%02x%02x%02x $i $i $i]
    }
    return $colormap
  }
  
  proc valuesToImg {data args} {
    # Required argument:
    #   data: a list of lists containing the values to plot;
    #       outer lists are rows; inner lists are columns
    # Optional arguments:
    #   -photo <handle>
    #       use <handle> instead of creating a new photo object
    #   -colormap <colormaplist>
    #       use <colormaplist> instead of the default 256-level
    #       grayscale map.  <colormaplist> should be a list of
    #       valid Tk colors (see man page for Tk_GetColor); the
    #       lowest value in the data maps to the first item in
    #       <colormaplist>
    #   -min <value>
    #       scale data so that all values <value> and lower map
    #       to the first value in the colormap
    #   -max <value>
    #       scale data so that all values <value> and higher map
    #       to the last value in the colormap
  
    # get width and height of data
    set height [llength $data]
    set width [llength [lindex $data 0]]
  
    # ensure that data is numerical and rectangular
    foreach row $data {
      if {[llength $row] != $width} {
	error "data is not rectangular"
      }
      foreach item $row {
	if {![string is double -strict $item]} {
	  error "data contains non-numerical item \"$item\""
	}
      }
    }
      
    # set default values for options
    set options(-max) [math::statistics::max [join $data]]
    set options(-min) [math::statistics::min [join $data]]
    set options(-photo) ""
    set options(-colormap) [list]
    
    # validate optional arguments
    foreach {key value} $args {
      switch -- $key {
	"-max" {
	  if {![string is double -strict $value]} {
	    error "invalid maximum value $value"
	  }
	}
	"-min" {
	  if {![string is double -strict $value]} {
	    error "invalid minimum value $value"
	  }
	}
	"-photo" { #take this one on faith for now }
	"-colormap" { #take ths one on faith for now }
	default {
	  error [concat "unknown option \"$key\"; valid options are:" \
	    "[lsort -dictionary [array names $options]]"]
	}
      }
      set options($key) $value
    }
    
    if {[llength $options(-colormap)] == 0} {
      set options(-colormap) [generateDefaultColormap]
    }
    
    if {$options(-photo) eq ""} {
      set options(-photo) [image create photo \
	-width $width \
	-height $height]
    } else {
      $options(-photo) configure \
	-width $width \
	-height $height
    }
    
    # populate the image
    set scaleFactor [expr {([llength $options(-colormap)] - 1) / 
      double($options(-max) - $options(-min))}]
    set y -1
    foreach row $data {
      incr y
      set x -1
      foreach value $row {
	incr x
	set colormapindex \
	  [expr {int(($value - $options(-min)) * $scaleFactor)}]
	# make sure $colormapindex is within
	# 0 to ([llength $options(-colormap)]-1) inclusive
	set colormapindex [expr {
	  $colormapindex < 0
	    ? 0
	    : $colormapindex >= [llength $options(-colormap)]
	      ? [llength $options(-colormap)] - 1
	      : $colormapindex
	}]
	$options(-photo) put \
	  [lindex $options(-colormap) $colormapindex] \
	  -to $x $y [expr {$x + 1}] [expr {$y + 1}]
      }
    }
    return $options(-photo)
  }


----
!!!!!!
%| enter categories here |%
!!!!!!