Understanding 'gslider' function to make interactive plots

Question

I am trying to create an interactive histogram in R whose bin width can be adjusted either by moving a slider or entering a value in the text box. In addition to this, I would also like to provide the user with an option of saving the plot for a particular bin width.

To this end, I found the 'gslider' function of 'aplpack' library to be a good starting point. I tried to modify it to meet my purpose as well as learn more about Tcl/Tk constructs. But I am now stuck and can't proceed, mostly because I haven't completely understood how a slider value is captured and transferred between functions.

Following are the snippets of code that I haven't really understood. These are from the source code of the 'gslider' function.

# What is the rationale behind using the 'assign' function here and at 
# other instances in the code?

  img <- tkrplot::tkrplot(gr.frame, newpl, vscale = 1, hscale = 1)
  tkpack(img, side = "top")
  assign("img", img, envir = slider.env)

# I understand the below lines when considered individually. But collectively,
# I am having a difficult time comprehending them. Most importantly, where 
# exactly is the slider movement captured here?

  sc <- tkscale(fr, from = sl.min, to = sl.max, 
              showvalue = TRUE, resolution = sl.delta, orient = "horiz")
  assign("sc", sc, envir = slider.env)
  eval(parse(text = "tkconfigure(sc, variable=inputbw1)"), envir = slider.env)
  sl.fun <- sl.function
  if (!is.function(sl.fun)) 
    sl.fun <- eval(parse(text = paste("function(...){", 
                                    sl.fun, "}")))
    fname <- 'tkrrsl.fun1'
    eval(parse(text = c(paste(fname, " <-"), " function(...){", 
                    "tkrreplot(get('img',envir=slider.env),fun=function()", 
                    deparse(sl.fun)[-1], ")", "}")))
    eval(parse(text = paste("environment(", fname, ")<-parent.env")))
    if (prompt) 
      tkconfigure(sc, command = get(fname))
    else tkbind(sc, "<ButtonRelease>", get(fname))

  if (exists("tkrrsl.fun1")) {
    get("tkrrsl.fun1")()
  } 
  assign("slider.values.old", sl.default, envir = slider.env)

Thanks to everyone for the varied scope of answers. Juba's and Greg's answers were the ones I could work upon to write the following code:

slider_txtbox <- function (x, col=1, sl.delta, title) 
{
  ## Validations
  require(tkrplot)
  pos.of.panel <- 'bottom'
  if(is.numeric(col))
    col <- names(x)[col]
  x <- x[,col, drop=FALSE]
  if (missing(x) || is.null(dim(x))) 
     return("Error: insufficient x values")
  sl.min <- sl.delta # Smarter initialization required
  sl.max <- max(x)
  xrange <- (max(x)-min(x))
  sl.default <- xrange/30
  if (!exists("slider.env")) {
    slider.env <<- new.env(parent = .GlobalEnv)    
  }
  if (missing(title)) 
    title <- "Adjust parameters"

  ## Creating initial dialogs
  require(tcltk)
  nt <- tktoplevel()
  tkwm.title(nt, title)
  if(.Platform$OS.type == 'windows')
    tkwm.geometry(nt, "390x490+0+10")
  else if(.Platform$OS.type == 'unix')
     tkwm.geometry(nt, "480x600+0+10")
  assign("tktop.slider", nt, envir = slider.env)
  "relax"
  nt.bak <- nt
  sl.frame <- tkframe(nt)
  gr.frame <- tkframe(nt)
  tx.frame <- tkframe(nt)
  tkpack(sl.frame, tx.frame, gr.frame, side = pos.of.panel)

  ## Function to create and refresh the plot
  library(ggplot2)
  library(gridExtra)
  makeplot <- function(bwidth, save) {
    if(bwidth <= 0) {
      df <- data.frame('x'=1:10, 'y'=1:10)
       histplot <- ggplot(df, aes(x=x, y=y)) + geom_point(size=0) + xlim(0, 10) +  ylim(0, 100) + 
    geom_text(aes(label='Invalid binwidth...', x=5, y=50), size=9)
    } else {

    histplot <- ggplot(data=x, aes_string(x=col)) +
  geom_histogram(binwidth=bwidth, aes(y = ..density..), fill='skyblue') + 
  theme(axis.title.x=element_text(size=15), axis.title.y=element_text(size=15), 
        axis.text.x=element_text(size=10, colour='black'),
        axis.text.y=element_text(size=10, colour='black'))
    }
    print(histplot)
    if(save){
  filename <- tkgetSaveFile(initialfile=paste('hist_bw_', bwidth, sep=''), 
                            filetypes='{{PNG files} {.png}} {{JPEG files} {.jpg .jpeg}}
                            {{PDF file} {.pdf}} {{Postscript file} {.ps}}')
  filepath <- as.character(filename)
  splitpath <- strsplit(filepath, '/')[[1]]
  flname <- splitpath[length(splitpath)]
  pieces <- strsplit(flname, "\\.")[[1]]
  ext <- tolower(pieces[length(pieces)])
  if(ext != 'png' && ext != 'jpeg' && ext != 'jpg' && ext != 'pdf' && ext != 'ps') {
    ext <- 'png'
    filepath <- paste(filepath, '.png', sep='')
    filename <- tclVar(filepath)
  }
  if(ext == 'ps')
    ext <- 'postscript'
  eval(parse(text=paste(ext, '(file=filepath)', sep='')))
  eval(parse(text='print(histplot)'))
  dev.off()
}
  }
  img <- tkrplot::tkrplot(gr.frame, makeplot(sl.default, FALSE), vscale = 1, hscale = 1)
  tkpack(img, side = "top")
  assign("img", img, envir = slider.env)

  ## Creating slider, textbox and labels
  parent.env <- sys.frame(sys.nframe() - 1)
  tkpack(fr <- tkframe(sl.frame), side = 'top')
  sc <- tkscale(fr, from = sl.min, to = sl.max, 
            showvalue = TRUE, resolution = sl.delta,
            orient = "horiz")
  tb <- tkentry(fr, width=4)
  labspace <- tklabel(fr, text='\t\t\t')
  tkpack(sc, labspace, tb, side = 'left')

  tkpack(textinfo <- tkframe(tx.frame), side = 'top')
  lab <- tklabel(textinfo, text = '                    Move slider', width = "20")
  orlabel <- tklabel(textinfo, text='          OR', width='10')
  txtboxmsg <- tklabel(textinfo, text = 'Enter binwidth', width='20')
  tkpack(txtboxmsg, orlabel, lab, side='right')

  tkpack(f.but <- tkframe(sl.frame))
  tkpack(tklabel(f.but, text=''))
  tkpack(tkbutton(f.but, text = "Exit", command = function() tkdestroy(nt)), 
     side='right')
  tkpack(tkbutton(f.but, text = "Save", command = function(...) {
    bwidth <- as.numeric(tclvalue(get('inputtb', envir=slider.env)))
    tkrreplot(get('img',envir=slider.env),fun=function() { makeplot(bwidth, TRUE); sync_slider()})
  }), side='right')

  ## Creating objects and variables associated with slider and textbox
  assign("sc", sc, envir = slider.env)
  eval(parse(text = "assign('inputsc', tclVar(sl.default), envir=slider.env)"))
  eval(parse(text = "tkconfigure(sc, variable=inputsc)"), envir = slider.env)

  assign("tb", tb, envir = slider.env)
  eval(parse(text = "assign('inputtb', as.character(tclVar(sl.default)),
         envir=slider.env)"))
  eval(parse(text = "tkconfigure(tb, textvariable=inputtb)"), envir = slider.env)

  ## Function to update the textbox value when the slider has changed
  sync_textbox <- function() {
  bwidth_sl <- tclvalue(get('inputsc', envir=slider.env))
  assign('inputtb', tclVar(bwidth_sl), envir=slider.env)
  eval(parse(text = "tkconfigure(tb, textvariable=inputtb)"), envir = slider.env)
}

 ## Function to update the slider value when the textbox has changed
 sync_slider <- function() {
 bwidth_tb <- tclvalue(get('inputtb', envir=slider.env))
 assign('inputsc', tclVar(bwidth_tb), envir=slider.env)
 eval(parse(text = "tkconfigure(sc, variable=inputsc)"), envir = slider.env)
}  

  ## Bindings : association of certain functions to certain events for the slider
  ## and the textbox

  tkbind(sc, "<ButtonRelease>", function(...) {
    bwidth <- as.numeric(tclvalue(get('inputsc', envir=slider.env)))
    tkrreplot(get('img',envir=slider.env),fun=function() { makeplot(bwidth, FALSE); sync_textbox()})
  })

  tkbind(tb, "<Return>", function(...) {
    bwidth <- as.numeric(tclvalue(get('inputtb', envir=slider.env)))
    if(bwidth > sl.max && !is.na(bwidth)) {
      bwidth <- sl.max
      assign('inputtb', tclVar(bwidth), envir=slider.env)
      eval(parse(text = "tkconfigure(tb, textvariable=inputtb)"), envir = slider.env)
     } else
    if(bwidth < sl.min || is.na(bwidth)) {
      bwidth <- sl.min
      assign('inputtb', tclVar(bwidth), envir=slider.env)
      eval(parse(text = "tkconfigure(tb, textvariable=inputtb)"), envir = slider.env)
     }
  tkrreplot(get('img',envir=slider.env),fun=function() { makeplot(bwidth, FALSE);    sync_slider()})
})

}

library(ggplot2)
slider_txtbox(movies, 'rating', 0.1, 'Adjust binwidth') 

Answer 1

Here is a minimal working example with comments, based on the complete code you first submit. As I'm far from an expert in tcl/tk, there may be cleaner or better ways to do it. And it is quite incomplete (for example the textbox values should be checked to be in the range of the slider, etc.) :

library(ggplot2)
library(gridExtra)
title <- "Default title"
data(movies)

## Init dialog
require(tkrplot)
if (!exists("slider.env")) slider.env <<- new.env(parent = .GlobalEnv)
require(tcltk)
nt <- tktoplevel()
tkwm.title(nt, title)
tkwm.geometry(nt, "480x600+0+10")
assign("tktop.slider", nt, envir = slider.env)
"relax"
nt.bak <- nt
sl.frame <- tkframe(nt)
gr.frame <- tkframe(nt)
tx.frame <- tkframe(nt)
tkpack(sl.frame, tx.frame, gr.frame, side = "bottom")
## First default plot
newpl <- function(...) {
  dummydf <- data.frame('x'=1:10, 'y'=1:10)
  dummy <- ggplot(dummydf, aes(x=x, y=y)) + geom_point(size=0) + xlim(0, 10) + ylim(0, 100) + 
    geom_text(aes(label='Generating plot...', x=5, y=50), size=9)
  print(dummy)
  }
img <- tkrplot::tkrplot(gr.frame, newpl, vscale = 1, hscale = 1)
tkpack(img, side = "top")
assign("img", img, envir = slider.env)
tkpack(fr <- tkframe(sl.frame), side = 'top')

## Creating slider, textbox and labels
sc <- tkscale(fr, from = 0, to = 5, showvalue = TRUE, resolution = 0.1, orient = "horiz")
tb <- tkentry(fr, width=4)
lab <- tklabel(fr, text = 'Select binwidth ', width = "16")
orlabel <- tklabel(fr, text=' or ', width='4')
tkpack(lab, sc, orlabel, tb, side = 'left')
tkpack(textinfo <- tkframe(tx.frame), side = 'top')


## Creating objects and variables associated with slider and textbox
assign("sc", sc, envir = slider.env)
assign("tb", tb, envir = slider.env)
assign('inputsc', tclVar(2.5), envir=slider.env)
assign('inputtb', tclVar('2.5'), envir=slider.env)
eval(parse(text = "tkconfigure(sc, variable=inputsc)"), envir = slider.env)
eval(parse(text = "tkconfigure(tb, textvariable=inputtb)"), envir = slider.env)

## Function to update the textbox value when the slider has changed
sync_textbox <- function() {
  bwidth_sl <- tclvalue(get('inputsc', envir=slider.env))
  assign('inputtb', tclVar(bwidth_sl), envir=slider.env)
  eval(parse(text = "tkconfigure(tb, textvariable=inputtb)"), envir = slider.env)
}

## Function to update the slider value when the textbox has changed
sync_slider <- function() {
  bwidth_tb <- tclvalue(get('inputtb', envir=slider.env))
  assign('inputsc', tclVar(bwidth_tb), envir=slider.env)
  eval(parse(text = "tkconfigure(sc, variable=inputsc)"), envir = slider.env)
}

## Function to refresh the plot
refresh <- function(bwidth) {
  histplot <- ggplot(data=movies, aes_string(x="rating")) +
     geom_histogram(binwidth=bwidth, 
                    aes(y = ..density..), fill='skyblue') + 
                      theme(axis.title.x=element_text(size=15), axis.title.y=element_text(size=15), 
                            axis.text.x=element_text(size=10, colour='black'),
                            axis.text.y=element_text(size=10, colour='black'))
  print(histplot)
}

## Bindings : association of certain functions to certain events for the slider
## and the textbox

tkbind(sc, "<ButtonRelease>", function(...) {
  bwidth <- as.numeric(tclvalue(get('inputsc', envir=slider.env)))
  tkrreplot(get('img',envir=slider.env),fun=function() { refresh(bwidth); sync_textbox()})
})

tkbind(tb, "<Return>", function(...) {
  bwidth <- as.numeric(tclvalue(get('inputtb', envir=slider.env)))
  tkrreplot(get('img',envir=slider.env),fun=function() { refresh(bwidth); sync_slider()})
})

Answer 2

If you do not insist on a local solution, you might give rapporter.net a try, which lets you specify such tasks easily with any number of tweakable sliders. Okay, enough of marketing :)

Here goes a quick demo: Interactive histogram on mtcars which looks like:

There you could choose one of the well-know variables of mtcars, but of course you could provide any data frame to be used here or tweak the above form after a free registration.

---

How it's done? I have just created a quick rapport template and let it rapplicate. The body of the template is written in brew-style (please see the above "rapport" URL for more details):

<%=
evalsOptions('width', width)
evalsOptions('height', height)
%>

# Histogram

<%=
set.caption(paste('Histogram of', var.name))
hist(var, breaks=seq(min(var), max(var), diff(range(var))/round(binwidth)), main = paste('Histogram of', var.name), xlab = '')
%>

## Parameters

Provided parameters were:

  * variable: <%=var.name%> (<%=var.label%>)
  * bin-width of histogram: <%=binwidth%>
  * height of generated images: <%=height%>
  * width of generated images: <%=width%>

# Kernel density plot

<%=
set.caption('A kernel density plot')
plot(density(var), main = '', xlab = '')
%>

But a bare-minimal example of the task could be also addressed by a simple one-liner template:

<%=hist(var, breaks=seq(min(var), max(var), diff(range(var))/round(binwidth)))%>

There you would only need to create a new template, add two input types with a click (one numeric variable of any data set and a number input field which would hold the binwidth of the histogram), and you are ready to go.