source: tol/tolsh/tolsh.vfs/lib/tcllib1.10/math/plotstat.tcl @ 8597867d

# plotstat.tcl --
#
#    Set of very simple drawing routines, belonging to the statistics
#    package
#
# version 0.1: initial implementation, january 2003

namespace eval ::math::statistics {}

# plot-scale
#    Set the scale for a plot in the given canvas
#
# Arguments:
#    canvas   Canvas widget to use
#    xmin     Minimum x value
#    xmax     Maximum x value
#    ymin     Minimum y value
#    ymax     Maximum y value
#
# Result:
#    None
#
# Side effect:
#    Array elements set
#
proc ::math::statistics::plot-scale { canvas xmin xmax ymin ymax } {
    variable plot

    if { $xmin == $xmax } { set xmax [expr {1.1*$xmin+1.0}] }
    if { $ymin == $ymax } { set ymax [expr {1.1*$ymin+1.0}] }

    set plot($canvas,xmin) $xmin
    set plot($canvas,xmax) $xmax
    set plot($canvas,ymin) $ymin
    set plot($canvas,ymax) $ymax

    set cwidth  [$canvas cget -width]
    set cheight [$canvas cget -height]
    set cx      20
    set cy      20
    set cx2     [expr {$cwidth-$cx}]
    set cy2     [expr {$cheight-$cy}]

    set plot($canvas,cx)   $cx
    set plot($canvas,cy)   $cy

    set plot($canvas,dx)   [expr {($cwidth-2*$cx)/double($xmax-$xmin)}]
    set plot($canvas,dy)   [expr {($cheight-2*$cy)/double($ymax-$ymin)}]
    set plot($canvas,cx2)  $cx2
    set plot($canvas,cy2)  $cy2

    $canvas create line $cx $cy $cx $cy2 $cx2 $cy2 -tag axes
}

# plot-xydata
#    Create a simple XY plot in the given canvas (collection of dots)
#
# Arguments:
#    canvas   Canvas widget to use
#    xdata    Series of independent data
#    ydata    Series of dependent data
#    tag      Tag to give to the plotted data (defaults to xyplot)
#
# Result:
#    None
#
# Side effect:
#    Simple xy graph in the canvas
#
# Note:
#    The tag can be used to manipulate the xy graph
#
proc ::math::statistics::plot-xydata { canvas xdata ydata {tag xyplot} } {
    PlotXY $canvas points $tag $xdata $ydata
}

# plot-xyline
#    Create a simple XY plot in the given canvas (continuous line)
#
# Arguments:
#    canvas   Canvas widget to use
#    xdata    Series of independent data
#    ydata    Series of dependent data
#    tag      Tag to give to the plotted data (defaults to xyplot)
#
# Result:
#    None
#
# Side effect:
#    Simple xy graph in the canvas
#
# Note:
#    The tag can be used to manipulate the xy graph
#
proc ::math::statistics::plot-xyline { canvas xdata ydata {tag xyplot} } {
    PlotXY $canvas line $tag $xdata $ydata
}

# plot-tdata
#    Create a simple XY plot in the given canvas (the index in the list
#    is the horizontal coordinate; points)
#
# Arguments:
#    canvas   Canvas widget to use
#    tdata    Series of dependent data
#    tag      Tag to give to the plotted data (defaults to xyplot)
#
# Result:
#    None
#
# Side effect:
#    Simple xy graph in the canvas
#
# Note:
#    The tag can be used to manipulate the xy graph
#
proc ::math::statistics::plot-tdata { canvas tdata {tag xyplot} } {
    PlotXY $canvas points $tag {} $tdata
}

# plot-tline
#    Create a simple XY plot in the given canvas (the index in the list
#    is the horizontal coordinate; line)
#
# Arguments:
#    canvas   Canvas widget to use
#    tdata    Series of dependent data
#    tag      Tag to give to the plotted data (defaults to xyplot)
#
# Result:
#    None
#
# Side effect:
#    Simple xy graph in the canvas
#
# Note:
#    The tag can be used to manipulate the xy graph
#
proc ::math::statistics::plot-tline { canvas tdata {tag xyplot} } {
    PlotXY $canvas line $tag {} $tdata
}

# PlotXY
#    Create a simple XY plot (points or lines) in the given canvas
#
# Arguments:
#    canvas   Canvas widget to use
#    type     Type: points or line
#    tag      Tag to give to the plotted data
#    xdata    Series of independent data (if empty: index used instead)
#    ydata    Series of dependent data
#
# Result:
#    None
#
# Side effect:
#    Simple xy graph in the canvas
#
# Note:
#    This is the actual routine
#
proc ::math::statistics::PlotXY { canvas type tag xdata ydata } {
    variable plot

    if { ![info exists plot($canvas,xmin)] } {
        return -code error -errorcode "No scaling given for canvas $canvas"
    }

    set xmin $plot($canvas,xmin)
    set xmax $plot($canvas,xmax)
    set ymin $plot($canvas,ymin)
    set ymax $plot($canvas,ymax)
    set dx   $plot($canvas,dx)
    set dy   $plot($canvas,dy)
    set cx   $plot($canvas,cx)
    set cy   $plot($canvas,cy)
    set cx2  $plot($canvas,cx2)
    set cy2  $plot($canvas,cy2)

    set plotpoints [expr {$type == "points"}]
    set xpresent   [expr {[llength $xdata] > 0}]
    set idx        0
    set coords     {}

    foreach y $ydata {
        if { $xpresent } {
            set x [lindex $xdata $idx]
        } else {
            set x $idx
        }
        incr idx

        if { $x == {}    } continue
        if { $y == {}    } continue
        if { $x >  $xmax } continue
        if { $x <  $xmin } continue
        if { $y >  $ymax } continue
        if { $y <  $ymin } continue

        if { $plotpoints } {
            set xc [expr {$cx+$dx*($x-$xmin)-2}]
            set yc [expr {$cy2-$dy*($y-$ymin)-2}]
            set xc2 [expr {$xc+4}]
            set yc2 [expr {$yc+4}]
            $canvas create oval $xc $yc $xc2 $yc2 -tag $tag -fill black
        } else {
            set xc [expr {$cx+$dx*($x-$xmin)}]
            set yc [expr {$cy2-$dy*($y-$ymin)}]
            lappend coords $xc $yc
        }
    }

    if { ! $plotpoints } {
        $canvas create line $coords -tag $tag
    }
}

# plot-histogram
#    Create a simple histogram in the given canvas
#
# Arguments:
#    canvas   Canvas widget to use
#    counts   Series of bucket counts
#    limits   Series of upper limits for the buckets
#    tag      Tag to give to the plotted data (defaults to xyplot)
#
# Result:
#    None
#
# Side effect:
#    Simple histogram in the canvas
#
# Note:
#    The number of limits determines how many bars are drawn,
#    the number of counts that is expected is one larger. The
#    lower and upper limits of the first and last bucket are
#    taken to be equal to the scale's extremes
#
proc ::math::statistics::plot-histogram { canvas counts limits {tag xyplot} } {
    variable plot

    if { ![info exists plot($canvas,xmin)] } {
        return -code error -errorcode DATA "No scaling given for canvas $canvas"
    }

    if { ([llength $counts]-[llength $limits]) != 1 } {
        return -code error -errorcode ARG \
                "Number of counts does not correspond to number of limits"
    }

    set xmin $plot($canvas,xmin)
    set xmax $plot($canvas,xmax)
    set ymin $plot($canvas,ymin)
    set ymax $plot($canvas,ymax)
    set dx   $plot($canvas,dx)
    set dy   $plot($canvas,dy)
    set cx   $plot($canvas,cx)
    set cy   $plot($canvas,cy)
    set cx2  $plot($canvas,cx2)
    set cy2  $plot($canvas,cy2)

    #
    # Construct a sufficiently long list of x-coordinates
    #
    set xdata [concat $xmin $limits $xmax]

    set idx   0
    foreach x $xdata y $counts {
        incr idx

        if { $y == {}    } continue

        set x1 $x
        if { $x <  $xmin } { set x1 $xmin }
        if { $x >  $xmax } { set x1 $xmax }

        if { $y >  $ymax } { set y $ymax }
        if { $y <  $ymin } { set y $ymin }

        set x2  [lindex $xdata $idx]
        if { $x2 <  $xmin } { set x2 $xmin }
        if { $x2 >  $xmax } { set x2 $xmax }

        set xc  [expr {$cx+$dx*($x1-$xmin)}]
        set xc2 [expr {$cx+$dx*($x2-$xmin)}]
        set yc  [expr {$cy2-$dy*($y-$ymin)}]
        set yc2 $cy2

        $canvas create rectangle $xc $yc $xc2 $yc2 -tag $tag -fill blue
    }
}

#
# Simple test code
#
if { [info exists ::argv0] && ([file tail [info script]] == [file tail $::argv0]) } {

    set xdata {1 2 3 4 5 10 20 6 7 8 1 3 4 5 6 7}
    set ydata {2 3 4 5 6 10 20 7 8 1 3 4 5 6 7 1}

    canvas .c
    canvas .c2
    pack   .c .c2 -side top -fill both
    ::math::statistics::plot-scale .c  0 10 0 10
    ::math::statistics::plot-scale .c2 0 20 0 10

    ::math::statistics::plot-xydata .c  $xdata $ydata
    ::math::statistics::plot-xyline .c  $xdata $ydata
    ::math::statistics::plot-histogram .c2 {1 3 2 0.1 4 2} {-1 3 10 11 23}
    ::math::statistics::plot-tdata  .c2 $xdata
    ::math::statistics::plot-tline  .c2 $xdata
}