tcltk.R

### Interactive density plots. Based on TCL version by Guido Masarotto
###
###  Intending to use this for a surface viewer, MDSumner 21 April 2004
###
### Well, that was OK for a first go, now I want it for the chain.

### Function:

##  default is Grid size 10
##             Overlay "Lines"
##             Window - first twilight
##             Type - "image"
##             Twilights to smooth - 1
##
##  actions    Change grid size - replot with new n
##             Change overlay   - replot with new option
##             Change window    - regen with different subset
##             Change display   - replot with new option
##             Change ## twi    - regen with different subset


library(tcltk)
library(MASS)
#source("C:/Documents and Settings/mdsumner/My Documents/CODE/R/src/sMat.r")
#mat <- increMat(sMat(),c(-50,100))
d <- read.csv("track.csv")
lons <- d[,2]
lats <- d[,1]
load("Chain.Rdata")
npars <- 3
npts <- dim(ps)[2]/npars
xx <- NULL
yy <- NULL
for(i in 1:npts) {
  yy <- c(yy,ps[,(i-1)*npars+1])
  xx <- c(xx,ps[,(i-1)*npars+2])	
}


require(tcltk) || stop("tcltk support is absent")
require(MASS) || stop("MASS support is absent")

y <- NULL
x <- NULL
size  <- tclVar(10)
disp <- tclVar(1)
overlay<- tclVar(1)
twi <- tclVar(1)
twi.sav <- 1
wind <- tclVar(1)
wind.sav <- 1
h <- NULL
xlim <<- range(lons) + c(-2,2)
ylim <<- range(lats) + c(-2,2)

replot <- function(...)
{
  sz <- as.numeric(tclObj(size))
  
  if (is.null((h)))
    h <- c(bandwidth.nrd(x), bandwidth.nrd(y))
  h <- h/6

  plot(lons,lats,type="n")
  if (tclvalue(disp)=="1"){
    #eval(substitute(image(kde2d(x,y,n=sz),xlim=xlim,ylim=ylim)))
    image(kde2d(x,y,h=h,n=sz),add=T)
  }else {
    #eval(substitute(contour(kde2d(x,y,n=sz),xlim=xlim,ylim=y)))
     contour(kde2d(x,y,h=h,n=sz),add=T)
  }
  if (tclvalue(overlay)=="1"){
    eval(substitute(lines(lons,lats)))
  }
  if (tclvalue(overlay)=="2"){
    eval(substitute(points(lons,lats)))
  }
}

## replot.maybe
## <- function(...)
 # {
  #  if (as.numeric(tclvalue(twi.n)) != twi.n.sav)
   #   {
    #    regen()
     # }
  #}
regen <- function(...) {
  wind.sav <<- wind.n <- as.numeric(tclObj(wind))
  twi.sav <<- twi.n <- as.numeric(tclObj(twi))
  rngST <- (wind.n-1)*1000 + 1
  rng <- rngST:(min(npts*1000,rngST+twi.n*1000))
  h <- NULL
  x <<- xx[rng]
  y <<- yy[rng]
  replot()
}
regen.maybe <- function(...)
  {
    if((as.numeric(tclvalue(wind)) != wind.sav) | (as.numeric(tclvalue(twi)) != twi.sav))
      {
        regen()
      }
  }
base <- tktoplevel()
tkwm.title(base, "mcmc plot")
spec.frm <- tkframe(base,borderwidth=2)
left.frm <- tkframe(spec.frm)
right.frm <- tkframe(spec.frm)


## frame 1  - set the grid size
frame1 <- tkframe(left.frm, relief="groove", borderwidth=2)
tkpack(tklabel(frame1, text="Grid size n"))
for ( i in c(10,20,50,100) ) {
  tmp <- tkradiobutton(frame1, command=replot,
     text=i,value=i,variable=size)
     tkpack(tmp, anchor="w")
      }


## frame 2 - set the window position (which twilight are we centred on)
frame2 <-tkframe(left.frm, relief="groove", borderwidth=2)
tkpack(tklabel (frame2, text="Window"))
tkpack(tkscale(frame2,command=regen.maybe, from=1, to=npts,
                   showvalue=F, variable=wind,
                   resolution=1, orient="horiz"))


## frame 3 - set the display "image" or "contour"
frame3 <-tkframe(left.frm, relief="groove", borderwidth=2)
tkpack(tklabel(frame3, text="Type of Display"))
tkpack(tkradiobutton(frame3, command=replot, text="Image",
               value=1, variable=disp), anchor="w")
tkpack(tkradiobutton(frame3, command=replot, text="Contour",
                         value=2, variable=disp), anchor="w")


## frame 4 - set the overlays
frame4 <-tkframe(right.frm, relief="groove", borderwidth=2)
tkpack(tklabel(frame4, text="Overlay Track"))
tkpack(tkradiobutton(frame4, command=replot, text="Lines",
                         value=1, variable=overlay), anchor="w")
tkpack(tkradiobutton(frame4, command=replot, text="Points",
                         value=2, variable=overlay), anchor="w")
tkpack(tkradiobutton(frame4, command=replot, text="Off",
                         value=3, variable=overlay), anchor="w")


## frame 5 - set the number of twilights to include
frame5 <- tkframe(left.frm, relief="groove", borderwidth=2)
tkpack(tklabel(frame5, text="Twilights to smooth"))
tkpack(tkentry(frame5,textvariable=twi))

## pack the frames together
tkpack(frame1, frame2, fill="x")
tkpack(frame3,frame4, fill="x")
tkpack(frame5,fill="x")
tkpack(left.frm, right.frm,side="left", anchor="n")
          

## `Bottom frame' (on base):
q.but <- tkbutton(base,text="Quit",
                      command=function(){tkdestroy(base);dev.off()})
tkpack(spec.frm, q.but)

    #regen()
## })  ## end local comment out