aricb A poster on comp.lang.tcl [L1 ] 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 |
|---|