I am looking at the code from the gWidgets vignette for the gfunction method.
## A constructor to automagically make a GUI for a function
gfunction <- function(f, window = gwindow(title=fName), ...) {
## Get the function and its name
if(is.character(f)) {
fName <- f
f <- get(f)
} else if(is.function(f)) {
fName <- deparse(substitute(f))
}
## Use formals() to define the widget
lst <- formals(f)
## Hack to figure out variable type
type <- NULL
if(names(lst)[1] == "x" && names(lst)[2] == "y") {
type <- "bivariate"
} else if(names(lst)[1] == "x") {
type <- "univariate"
} else if(names(lst)[1] == "formula") {
type <- "model"
} else {
type + NULL
}
## Layout
w <- gwindow("create dialog")
g <- ggroup(horizontal = TRUE, cont=w)
## Arrange widgets with an output area
## Put widgets into a layout container
tbl <- glayout(container=g)
gseparator(horizontal=FALSE, container=g)
outputArea <- gtext(container=g, expand=TRUE)
## Make widgets for arguments from formals()
widgets <- sapply(lst, getWidget, cont=tbl)
## Layout widgets
for( i in 1:length(widgets)) {
tbl[i,1] <- names(lst)[i]
tbl[i,2] <- widgets[[i]]
}
## Add update handler to each widget when changed
sapply(widgets, function(obj) {
try(addHandlerChanged(obj, function(h,...) update()), silent=TRUE)
})
## Add drop target to each widget
sapply(widgets, function(obj)
try(adddroptarget(obj,
handler=function(h,...) {
svalue(h$obj) <- h$dropdata
update()
}),
silent=TRUE))
## In case this doesn't get exported
svalue.default <- function(obj, ...) obj
## Function used to weed out 'NULL' values to widgets
isNULL <- function(x)
ifelse(class(x) == "character" && length(x) ==1 && x == "NULL",
TRUE, FALSE)
## Function called when a widget is changed
## 2nd and 3rd lines trim out non-entries
update <- function(...) {
is.empty <- function(x) return(is.na(x) || is.null(x) || x == "" )
outList <- lapply(widgets,svalue)
cat(paste("Outlist 1:\n",str(outList)))
outList <- outList[!sapply(outList,is.empty)]
outList <- outList[!sapply(outList,isNULL)]
outList[[1]] <- svalue(outList[[1]])
if(type == "bivariate")
outList[[2]] <- svalue(outList[[2]])
cat(paste("Outlist 2:\n",str(outList)))
out <- capture.output(do.call(fName,outList))
dispose(outputArea)
if(length(out)>0)
add(outputArea, out)
}
invisible(NULL)
}
getWidget <- function(x, cont=cont) {
switch(class(x),
"numeric" = gedit(x, coerce.with=as.numeric, cont=cont),
"character" = gcombobox(x, active=1, cont=cont),
"logical" = gcombobox(c(TRUE,FALSE), active = 1 + (x == FALSE), cont=cont),
"name" = gedit("", cont=cont),
"NULL" = gedit("NULL", cont=cont),
"call" = getWidget(eval(x), cont=cont), # recurse
gedit("", cont=cont) # default
)
}
our.t.test = stats:::t.test.default
gfunction('our.t.test')
I am primarily interested in this code because I am trying to develop a driver GUI that takes input values and then pipes them to the appropriate methods in a program I wrote. The problem is that this code does not actually work. As far as I can tell the problem is because the svalue() returns strings from all of the widgets. So instead of getting [1, 2, 3, 4] when c(1,2,3,4) is entered you get a return value of "c(1,2,3,4)" instead. This causes the do.call() to fail because all of the arguments end up getting passed in as strings instead of as the appropriate data type (list, bool, vector, numeric, ect.).
Does anyone know how to fix this behavior? Additionally, unlike in this example, I would ideally like to be able to pass multiple arguments to a function through one widget instead of breaking up each parameter as a separate widget. Ie. "x=5, y=c(1,2,3), z="foo" as the input and then execute a function based on those three input parameters.
Note: I am running this on R 3.0.2 with gWidgets_0.0-54 and gWidgetstcltk_0.0-55
