Linear regression toy

Richard Suchenwirth 2007-05-12 - Here's another little weekend project, an educational toy to experiment with linear regression.

On the canvas, you can put data points with left mouse button. (Cursor position is displayed in the title bar). The "C" button clears all. The "Reg" button computes the linear regression for the points, and display it as a green line. That's all, but it may be fun for some...

package require Tk

proc main argv {
    pack [frame .f] -fill x
    button .f.c -text " C " -command {.c delete all}
    button .f.r -text Reg -command {drawReg .c}
    eval pack [winfo children .f] -side left
    pack [canvas .c -bg white] -fill both -expand 1
    bind .c <Motion> {wm title . [%W canvasx %x]|[%W canvasy %y]}
    bind .c <1> {drawPoint %W %x %y}
    bind .c <2> {%W delete current}
}
proc drawPoint {w x y} {
    set x [$w canvasx $x]
    set y [$w canvasy $y]
    $w create rect $x $y [expr $x+2] [expr $y+2] -fill red -tag point
}
proc drawReg w {
    set xys {}
    foreach point [$w find withtag point] {
        lappend xys [center [$w bbox $point]]
    }
    foreach {a b} [linear'regression $xys] break
    set x1 [winfo width $w]
    set y1 [expr {$a + $b*$x1}]
    $w delete line
    $w create line 0 $a $x1 $y1 -fill green -tag line
}
proc center bbox {
    foreach {x0 y0 x1 y1} $bbox break
    list [expr {($x0+$x1)/2.}] [expr {($y0+$y1)/2.}]
}
proc linear'regression xys {
    set xsum 0.0; set ysum 0.0
    foreach xy $xys {
        foreach {x y} $xy break
        set xsum [expr {$xsum + $x}]
        set ysum [expr {$ysum + $y}]
    }
    set xm [expr {$xsum/[llength $xys]}]
    set ym [expr {$ysum/[llength $xys]}]
    set xsum 0.0; set ysum 0.0
    foreach xy $xys {
        foreach {x y} $xy break
        set dx [expr {$x - $xm}]
        set dy [expr {$y - $ym}]
        set xsum [expr {$xsum + $dx * $dy}]
        set ysum [expr {$ysum + $dx * $dx}]
    }
    set b [expr {$xsum / $ysum}]
    set a [expr {$ym - $b * $xm}]
    list $a $b
}
main $argv
#-- Useful little helper: quick restart
bind . <Escape> {exec wish $argv0 &; exit}