# NOT RUN {
# }
# NOT RUN {
##################################################
## *** EXAMPLE 1 *** ##
## Basic example of available graphical objects ##
## our function to base the GUI on
demofunc <- function( opt, lst, slide, cmd, ed, txt, flname ) {
## Returns a string of output, this will be displayed
return( paste( "opt:", opt,
"lst:", paste(lst,collapse=","),
"slide:", slide,
"ed:", ed,
"txt:", txt,
"flname:", flname,
sep="\n" ) )
}
## Simple callback example
cmdCallback <- function() {
tkmessageBox( message="Hello World :)", title="A Classic" )
}
## start the gui
res <- gui( demofunc,
argOption=list(opt=c("TRUE","FALSE")), ## names in list are that of args in func
argList=list(lst=c(as.character(1:10))),
argSlider=list(slide=c(0,100,2.5)), ## start,stop,stepsize
argCommand=list(cmd=cmdCallback),
argEdit=list(ed=NULL), ## otherwise (width,height) to tweak, default
argFilter=list(flname="{{Text files} {.txt}}") ) ## note space inbetween the braces!
## prints out the arguments the user chose
print( res )
# }
# NOT RUN {
# }
# NOT RUN {
########################
## ** EXAMPLE 2 *** ##
## Auto-loading help! ##
## This is extremely useful if you write your own R package
## and want to include help with the GUI with no fuss.
## This is what this looks like
help("rnorm")
## Now build a gui
gui( rnorm )
## Now, suppose we wanted to customize it,
## but we really want to keep all that help...
rnorm2 <- function( n=10, mean=1, sd=2 ) {
res <- rnorm( n=n, mean=mean, sd=sd )
return( paste( res, collapse=", " ) )
}
gui( rnorm2, helpsFunc="rnorm" )
# }
# NOT RUN {
# }
# NOT RUN {
######################
## ** EXAMPLE 3 *** ##
## Power interface ##
ss <- function( alpha=0.05, beta=0.8, sigma=2, effect_size=0.5 ) {
n <- ceiling( (qnorm(1-alpha/2) + qnorm(1-beta))^2 * sigma^2 / effect_size^2 )
print(n)
return(n)
}
## Create the gui
## Note 1: the use of output in the slider
## Note 2: callback set to the 'guiExec' (fixed) routine,
## so 'ss' is run with the proper arguments
## whenever a slider value is changed
gui( ss,
argSlider=list(alpha=c(0,0.1,0.001),
beta=c(0,1,0.01),
sigma=c(0,10),
effect_size=c(0,10),
output=c(0,10000,1)), ## Note the use of output here
exec=NULL, ## don't draw an execute button
callback=guiExec
)
# }
# NOT RUN {
# }
# NOT RUN {
#################################
## *** Example 4 *** ##
## Sliders setting each other. ##
## You can envision this for more complicated power interfaces
## that do both calculating power and solving for sample
## sizes...
## Also includes non-auto help, a waste to bother with
## if you are planning on creating a package
## Change a default for fun, see `guiSet' function
## for more details/options
guiSet( "SLIDER_LENGTH", 400 )
sli <- function( alpha=0.5, beta=0.5 ) {
## Nothing to do...
}
sliCallback <- function( lastTouched ) {
if( lastTouched=="alpha" )
guiSetValue("beta",guiGetValue("alpha")) ## setting beta to be alpha
if( lastTouched=="beta" )
guiSetValue("alpha",guiGetValue("beta")) ## setting alpha to be beta
}
gui( sli,
argSlider=list(alpha=c(0,1), beta=c(0,1)),
output=NULL, exec=NULL, callback=sliCallback,
helps=list(alpha="type I error", beta="power") )
# }
# NOT RUN {
# }
# NOT RUN {
###############################
## *** EXAMPLE 5 *** ##
## Parsing R objects example ##
## Suppose you want a user to be able to enter a vector of data,
## then you can use the following as an example for that.
summaryStats <- function( data ) {
return( paste( "Mean = ", mean(data), ", Variance = ", var(data), sep="" ) )
}
gui(summaryStats, helps=list(
data="Enter vector, e.g. 'c(13,66,44,27)' or 'rivers' for builtin dataset (without quotes)."))
# }
# NOT RUN {
# }
# NOT RUN {
###############################
## *** EXAMPLE 6 *** ##
## Advanced nesting example. ##
## Suppose we have a function 'f', which has too many
## arguments to comfortably fit on one screen.
f <- function( a=1, b=2, c=3, d=4, e=5, f=6 ) {
print( "Running f" )
return( paste( "a =", a, "\n",
"b =", b, "\n",
"c =", c, "\n",
"d =", d, "\n",
"e =", e, "\n",
"f =", f, "\n", sep="" ) )
}
## Say we split into two functions/forms
f1 <- function( a=1, b=2, c=3 ) {
print( "Running f1" )
return( list(a=a,b=b,c=c) )
}
f2 <- function( d=4, e=5, f=6 ) {
print( "Running f2" )
return( list(d=d,e=e,f=f) )
}
## Then our main gui function could be
guif <- function( abc, def ) {
print( "guif" )
print( "guif: abc" )
print( abc )
print( "guif: def" )
print( def )
f <- guiFormals( f, c(abc,def) )
f()
}
gui( guif, argCommand=list(abc=guiNestedF(f1,"abc"), def=guiNestedF(f2,"def")) )
# }
# NOT RUN {
###############################
## *** EXAMPLE 7 *** ##
## The menuing interface. ##
## Call just as you would gui, same options, same everything,
## EXCEPT title is now a vector indicating the menu path.
## If you want it modal though, do not do so until the last mgui call,
## or it will be modal inbetween additions to the menu!
# }
# NOT RUN {
fguiWindowPrint( "Goes to the console because no window has been created." )
mgui( rgeom, title=c("Random","Geometric") )
mgui( rbinom, title=c("Random","Binomial") )
fguiNewMenu( c("Random","SEPARATOR") ) ## Puts a separator in the menu
mgui( rnorm, title=c("Random","Normal") )
mgui( runif, title=c("Random","Uniform") )
fguiWindowPrint( "Goes to the main window, now that it has been created." )
# }
# NOT RUN {
###############################
## *** EXAMPLE 8 *** ##
## Basic lm() interface. ##
# }
# NOT RUN {
lmgui <- function( csvFilename, response, explanatory ) {
## Construct a formula for the 'lm' routine
modelStr <- paste( response, "~", paste( explanatory, collapse="+" ) )
## Load in the data
data <- read.csv( csvFilename )
## perform the regression, give the summary
return <- summary( lm( formula=modelStr, data=data ) )
}
lmguiCallback <- function( arg ) {
if( arg=="csvFilename" ) {
## A dataset was chosen
## - The filename corresponds to the value at that argument
## - So pull of the names of that dataset
datanames <- names( read.csv( guiGetValue("csvFilename") ) )
print( datanames )
## - Store the datanames for future use, think of this as a global variable
guiSet( "datanames", datanames )
## - Set the possible values for the response
setListElements( "response", datanames )
setListElements( "explanatory", datanames )
}
}
guiv(lmgui, argFilename=list(csvFilename=NULL),
argList=list(response=NULL,explanatory=NULL), callback=lmguiCallback)
# }
# NOT RUN {
###############################
## *** EXAMPLE 9 *** ##
## Advanced lm() interface. ##
# }
# NOT RUN {
## The function we will pass to guiv is somewhat of a shell here, that is it would not
## make sense to use it from the command line. It's specification
## is only to create a GUI using fgui.
lmgui2 <- function( csvFilename, ## Create file dialogue, special callback
simData, ## Only for a command button
response, ## Required input
explanatory, ## Required input
scatter, ## Only for a command button
summary ) { ## Only for a command button
## Data has been loaded in callback routine,
## into what can be thought of as a global variable
data <- guiGetSafe("PERSONAL_dataset")
if( class(data)[1] != "data.frame" )
stop("Data must be loaded.") ## Gives error message box
## Error check: response and explanatory should have been set
if( length(response)==0 ) stop( "Must specify a response." )
if( length(explanatory)==0 ) stop( "Explanatory variable expected." )
## Run and return the fit from 'lm' linear model
modelStr <- paste( response, "~", paste( explanatory, collapse="+" ) )
return( lm( formula=modelStr, data=data ) )
}
lmgui2Callback <- function( arg ) {
if( arg=="csvFilename" ) {
## Dataset chosen from file dialogue,
## so we should load it in.
data <- read.csv( guiGetValue("csvFilename") )
guiSet( "PERSONAL_dataset", data ) ## think of as a global variable
## Also set possible values for response and explanatory variables
setListElements( "response", names(data) )
setListElements( "explanatory", names(data) )
}else if( arg=="simData" ) {
## Generate a random set of data, and write to disk
set.seed(13); library(MASS);
data <- data.frame( mvrnorm( n=100, mu=c(0,0,0),
Sigma=matrix(c(1,0.3,0, 0.3,1,0.3, 0,0.3,1),nrow=3) ) )
names( data ) <- c("Response","Covariate1","Covariate2")
write.csv( data, "lmgui2_generated.csv", row.names=FALSE )
## Now set it as if it was loaded in, and run that callback
guiSetValue( "csvFilename", "lmgui2_generated.csv" )
lmgui2Callback( "csvFilename" )
}else if( arg=="scatter" ) {
## Create a scatterplot of everything in the dataset
data <- guiGetSafe("PERSONAL_dataset")
response <- guiGetValue("response")
wh.response <- which(names(data)==response)
if( length(wh.response) != 1 )
stop( "One and only one response must be chosen." )
if( class(data)[1] != "data.frame" )
stop( "Data must be loaded." )
par( mfrow=rep( ceiling(sqrt(ncol(data)-1)), 2 ) )
for( i in setdiff(1:ncol(data),wh.response) )
plot( data[[i]], data[[wh.response]],
xlab=names(data)[i], ylab=names(data)[wh.response] )
}else if( arg=="summary" ) {
print( summary( guiExec() ) ) ## when no output, guiExec returns value
}
}
fit <- guiv( lmgui2,
argFilename=list(csvFilename=NULL),
argList=list(response=NULL,explanatory=NULL),
argCommand=list(simData=NULL, scatter=NULL, summary=NULL),
callback=lmgui2Callback,
argGridOrder=c(1,1,2,2,3,3), ## Multi-column ordering
argText=c(csvFilename="Load data (csv)",
simData="Simulate data",
response="Choose response variable",
explanatory="Choose explanatory variable",
scatter="Generate scatterplot to response variable",
summary="Print summary")
)
# }
# NOT RUN {
# }
Run the code above in your browser using DataLab