User Input using tcl/tk
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
I was inspired by Kay Cichini recent post on creating a a tcl/tk dialog box for users to enter variable values. I am going to have a use for this very soon so took some time to make it a bit more generic. What I wanted is a function that takes a vector (of variable names) of arbitrary length, create a dialog box for an input for each, and return the values in a list. While I was at it I also provided an optional separate vector for the labels (defaults to the variable names) that the user will see and a vector of functions used to convert the text input into another data format (e.g. convert characters to numeric values). Obviously using built in functions works great but one could also easily exploit this feature to write custom data validation functions. The function is hosted on Gist and embedded bellow. Here are some very basic examples:
Dialog box with two variables.
> vals <- varEntryDialog(vars=c('Variable1', 'Variable2'))
> str(vals) List of 2 $ Variable1: chr "value 1" $ Variable2: chr "value 2"
Dialog box with two variables, custom labels, and converts one to an integer.
> vals <- varEntryDialog(vars=c('Var1', 'Var2'), labels=c('Enter an integer:', 'Enter a string:'), fun=c(as.integer, as.character))
> str(vals) List of 2 $ Var1: int 5 $ Var2: chr "abc"
Dialog box with validation.
> vals <- varEntryDialog(vars=c('Var1'), labels=c('Enter an integer between 0 and 10:'), fun=c( function(x) { x <- as.integer(x) if(x >= 0 & x <= 10) { return(x) } else { stop("Why didn't you follow instruction!\nPlease enter a number between 0 and 10.") } } ))
> str(vals) List of 1 $ Var1: int 2
User inputs a comma separated list that is split into a character vector.
> vals <- varEntryDialog(vars=c('Var1'), labels=c('Enter a comma separated list of something:'), fun=c(function(x) { return(strsplit(x, split=',')) }))
> vals$Var1 [[1]] [1] "a" "b" "c" > str(vals) List of 1 $ Var1:List of 1 ..$ : chr [1:3] "a" "b" "c"
#' Creates a dialog box using tcl/tk to get input from the user. | |
#' | |
#' This function will create a tcl/tk dialog box to get user input. It has been | |
#' written to be extensible so the R programmer can easily create a dialog with | |
#' any number of varaibles with custom labels and data conversion of the user | |
#' entered data. The function will return a list where the element names are | |
#' \code{vars} and the value is the user input. By default, all entry will be | |
#' converted using the \code{as.character} function. However, this can easily be | |
#' altered using the \code{fun} parameter. For example, if integers are required, | |
#' use \code{fun=c(as.integer, ...)}. It is also possible to write custom | |
#' functions that can serve as a data validation. See the examples. | |
#' | |
#' Adopted from Kay Cichini: | |
#' \url{http://thebiobucket.blogspot.com/2012/08/tcltk-gui-example-with-variable-input.html} | |
#' See also: | |
#' \url{http://bioinf.wehi.edu.au/~wettenhall/RTclTkExamples/OKCancelDialog.html} | |
#' | |
#' @param vars character list of variable names. These will be the element names | |
#' within the returned list. | |
#' @param labels the labels the user will see for each variable entry. | |
#' @param fun list of functions that converts the user input. | |
#' @param title the title of the dialog box. | |
#' @param prompt the prompt the user will see on the dialog box. | |
#' @return a \code{\link{list}} of named values entered by the user. | |
varEntryDialog <- function(vars, | |
labels = vars, | |
fun = rep(list(as.character), length(vars)), | |
title = 'Variable Entry', | |
prompt = NULL) { | |
require(tcltk) | |
stopifnot(length(vars) == length(labels), length(labels) == length(fun)) | |
# Create a variable to keep track of the state of the dialog window: | |
# done = 0; If the window is active | |
# done = 1; If the window has been closed using the OK button | |
# done = 2; If the window has been closed using the Cancel button or destroyed | |
done <- tclVar(0) | |
tt <- tktoplevel() | |
tkwm.title(tt, title) | |
entries <- list() | |
tclvars <- list() | |
# Capture the event "Destroy" (e.g. Alt-F4 in Windows) and when this happens, | |
# assign 2 to done. | |
tkbind(tt,"<Destroy>",function() tclvalue(done)<-2) | |
for(i in seq_along(vars)) { | |
tclvars[[i]] <- tclVar("") | |
entries[[i]] <- tkentry(tt, textvariable=tclvars[[i]]) | |
} | |
doneVal <- as.integer(tclvalue(done)) | |
results <- list() | |
reset <- function() { | |
for(i in seq_along(entries)) { | |
tclvalue(tclvars[[i]]) <<- "" | |
} | |
} | |
reset.but <- tkbutton(tt, text="Reset", command=reset) | |
cancel <- function() { | |
tclvalue(done) <- 2 | |
} | |
cancel.but <- tkbutton(tt, text='Cancel', command=cancel) | |
submit <- function() { | |
for(i in seq_along(vars)) { | |
tryCatch( { | |
results[[vars[[i]]]] <<- fun[[i]](tclvalue(tclvars[[i]])) | |
tclvalue(done) <- 1 | |
}, | |
error = function(e) { tkmessageBox(message=geterrmessage()) }, | |
finally = { } | |
) | |
} | |
} | |
submit.but <- tkbutton(tt, text="Submit", command=submit) | |
if(!is.null(prompt)) { | |
tkgrid(tklabel(tt,text=prompt), columnspan=3, pady=10) | |
} | |
for(i in seq_along(vars)) { | |
tkgrid(tklabel(tt, text=labels[i]), entries[[i]], pady=10, padx=10, columnspan=4) | |
} | |
tkgrid(submit.but, cancel.but, reset.but, pady=10, padx=10, columnspan=3) | |
tkfocus(tt) | |
# Do not proceed with the following code until the variable done is non-zero. | |
# (But other processes can still run, i.e. the system is not frozen.) | |
tkwait.variable(done) | |
if(tclvalue(done) != 1) { | |
results <- NULL | |
} | |
tkdestroy(tt) | |
return(results) | |
} | |
if(FALSE) { #Test the dialog | |
vals <- varEntryDialog(vars=c('Variable1', 'Variable2')) | |
str(vals) | |
vals <- varEntryDialog(vars=c('Var1', 'Var2'), | |
labels=c('Enter an integer:', 'Enter a string:'), | |
fun=c(as.integer, as.character)) | |
str(vals) | |
#Add a custom validation function | |
vals <- varEntryDialog(vars=c('Var1'), | |
labels=c('Enter an integer between 0 and 10:'), | |
fun=c(function(x) { | |
x <- as.integer(x) | |
if(x >= 0 & x <= 10) { | |
return(x) | |
} else { | |
stop("Why didn't you follow instruction!\nPlease enter a number between 0 and 10.") | |
} | |
} )) | |
str(vals) | |
#Return a list | |
vals <- varEntryDialog(vars=c('Var1'), | |
labels=c('Enter a comma separated list of something:'), | |
fun=c(function(x) { | |
return(strsplit(x, split=',')) | |
})) | |
vals$Var1 | |
str(vals) | |
} |
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.