A couple of weeks ago I posted a trick in R-help on improving Quartz
behaviour in the command line version of R:
http://tolstoy.newcastle.edu.au/R/e6/help/09/04/12948.html .
Works with Aqua Tcl/Tk 8.5 too, but I discovered one annoying
side-effect. After having a Tk dialog open (and using it) for a while,
the R process starts eating more than 50% cpu on my PPC G4, using
either the 8.4 or the 8.5 Tcl/Tk libraries. (I'm currently running R
2.8.1 .)
This does NOT happen when running the exact same code in the same
commandline R version with the 8.4 X11 Tcl/Tk libraries, nor when I
run the Quartz version in R-GUI.
For completeness, here's the Tcl/Tk function:
dialog.test <- function(wait=FALSE)
{
with3 <- function( data1, data2=.GlobalEnv, expr )
{
attach(data1)
attach(data2)
on.exit( detach(data1), add= FALSE )
on.exit( detach(data2), add= TRUE )
try( eval( substitute(expr), parent.frame() ) )
}
require(tcltk) || stop("tcltk support is absent")
tt <- tktoplevel()
tkwm.title(tt,"VG1 tests")
tt.done <- tclVar("0")
name <- paste('dialog.test',as.character(tt$ID), sep='')
assign( name, tt, env=tdialog.env )
dialogVals<-get("dialogVals", env=RJVB.env)
data<-tclVar(dialogVals[1])
crit<-tclVar(dialogVals[2])
eval1st<-tclVar(dialogVals[9])
func<-tclVar(dialogVals[3])
args<-tclVar(dialogVals[4])
args2<-tclVar(dialogVals[5])
acomm<-tclVar(dialogVals[8])
sumvar <- tclVar(dialogVals[7])
done <- tclVar(0)
savecmd<-tclVar(dialogVals[6]);
devvar <- tclVar( dev.cur() )
theData <- ""
reset <- function()
{
tclvalue(data)<-""
tclvalue(crit)<-""
tclvalue(eval1st)<-""
tclvalue(func)<-""
tclvalue(args)<-""
tclvalue(args2)<-""
tclvalue(acomm)<-""
tclvalue(sumvar)<-"0"
}
doSource <- function()
{
fileN <- tclvalue( tkgetOpenFile() )
if( fileN != "" ){
try( source(fileN) )
}
}
dfInfo <- function(fnc)
{
## notice that tclvalue() is correct here, since it is the
## string representation of xvar and yvar that is being
## displayed in the entry fields
dataf <- tclvalue(data)
crit <- tclvalue(crit)
eval1st <- tclvalue(eval1st)
if( is.null(crit) | !strlen(crit) ){
theData <- paste( dataf )
assign( "Selected.Cases", "", env=RJVB.env )
}
else{
theData <- paste( "SelectCases(", dataf, ",\"", crit,
"\")" )
}
cmd<-paste( fnc, "( ", theData, " )" )
try(
cmd<-parse( text=cmd )
);
print( paste( "###", cmd ) )
print( try( eval(cmd, envir=.GlobalEnv) ) )
cmd
}
build <- function()
{
## notice that tclvalue() is correct here, since it is the
## string representation of xvar and yvar that is being
## displayed in the entry fields
dataf <- tclvalue(data)
crit <- tclvalue(crit)
eval1st <- tclvalue(eval1st)
func <- tclvalue(func)
args <- tclvalue(args)
args2 <- tclvalue(args2)
acomm <- tclvalue(acomm)
summ <- as.logical(tclObj(sumvar))
assign( "dialogVals",
c(dataf,crit,func,args,args2,dialogVals[6],tclvalue(sumvar), acomm,
eval1st ), env=RJVB.env )
if( is.null(crit) | !strlen(crit) ){
theData <- paste( dataf )
assign( "Selected.Cases", "", env=RJVB.env )
}
else{
theData <- paste( "SelectCases(", dataf, ",\"", crit,
"\")" )
}
if( is.null(acomm) | is.na(acomm) | !strlen(acomm) ){
acomm <- ""
}
else{
acomm <- paste( ", add.comment=\"", acomm, "\"" )
}
if( summ ){
cmd<-paste( "with3( ", theData, ", tkdial.env, summary(
last.dialog.result<-", func, "(", args, ",", args2, acomm, ") ) )" )
# cmd<-paste( "with2( ", theData, ", summary(
last.dialog.result<-", func, "(", args, ",", args2, acomm, ") ) )" )
}
else{
cmd<-paste( "with3( ", theData, ", tkdial.env,
last.dialog.result<-", func, "(", args, ",", args2, acomm, ") )" )
# cmd<-paste( "with2( ", theData, ",
last.dialog.result<-", func,
"(", args, ",", args2, acomm, ") )" )
}
assign( "Selected.Data", theData, env=RJVB.env )
try(
cmd<-parse( text=cmd )
);
cmd
}
saveIt <- function()
{
cmd<-savecmd <- tclvalue(savecmd)
assign( "dialogVals",
c(dialogVals[1],dialogVals[2],dialogVals[3],dialogVals[4],dialogVals[5],cmd,dialogVals[7],
dialogVals[9]), env=RJVB.env )
try(
cmd<-parse( text=savecmd )
);
cmd
}
doIt <- function(cmd="")
{
orgDev <- dev.cur()
try( dev.set( tclvalue(devvar) ) )
func <- tclvalue(func)
eval1st <- tclvalue(eval1st)
eval( parse( text="tkdial.env <- new.env()"), env=.GlobalEnv )
if( !is.null(eval1st) & strlen(eval1st) ){
try(
eval1st <- parse( text=eval1st )
);
cat(deparse(eval1st,width=500),sep="\n")
print(
try( eval(eval1st, env=tkdial.env) )
);
ls( env=tkdial.env )
}
cat("### Command executed via Tk ###\n")
cat(deparse(cmd,width=500),sep="\n")
cat("### Output:\n")
dialogVals<-get("dialogVals", env=RJVB.env)
print( system.time( print( try( res<-eval(cmd,
envir=.GlobalEnv) ) ) ) )
if( func == 'aov' | func == 'aov.VG1' ){
cat('\n')
try( print( TukeyHSD(res, ordered=TRUE) ), silent=TRUE)
}
cat( paste( "### ----------- (",
deparse(tclvalue(data),width=132),
") ----------- ###\n", sep="" ) )
try( dev.set(orgDev) )
eval( parse( text="rm(tkdial.env)" ), env=.GlobalEnv )
}
doQuit <- function()
{
dQ <- function()
{
tclvalue(done)<-"cancel"
tkdestroy(tt)
tt.done<-"1"
}
# if the window is referenced in the windowlist environment,
remove
the reference and then close
if( exists(name, env=tdialog.env) ){
w <- get(name, env=tdialog.env)
if( !is.null(w) && class(w) == "tkwin" ){
try( assign( name, NULL, env=tdialog.env ) )
try( rm( list=name, envir=tdialog.env ) )
dQ()
}
}
else{
# if not, close too. Probably means that dQ() can sstill be
called
recursively...
dQ()
}
return(0)
}
data.entry <- tkentry(tt, textvariable=data, width=100)
crit.entry <- tkentry(tt, textvariable=crit, width=100)
eval1st.entry <- tkentry(tt, textvariable=eval1st, width=100)
func.entry <- tkentry(tt, textvariable=func, width=100)
args.entry <- tkentry(tt, textvariable=args, width=100)
args2.entry <- tkentry(tt, textvariable=args2, width=100)
acomm.entry <- tkentry(tt, textvariable=acomm, width=100)
dev.entry <- tkentry(tt, textvariable=devvar, width=2)
summ.cbut <- tkcheckbutton(tt,text="Print summary()", variable=sumvar)
submit.but <- tkbutton(tt, text="submit",
command=function()doIt(build()) )
savecmd.entry <- tkentry(tt, textvariable=savecmd, width=100)
save.but <- tkbutton(tt, text="save",
command=function()doIt(saveIt()) )
reset.but <- tkbutton(tt, text="Reset", command=reset)
source.but <- tkbutton(tt, text="Source", command=function()doSource() )
cancel.but <- tkbutton(tt, text="Cancel", command=doQuit )
names.but <- tkbutton(tt, text="names",
command=function()dfInfo("names") )
summary.but <- tkbutton(tt, text="summary",
command=function()dfInfo("summary") )
tkgrid(tklabel(tt,text="Dataframe"), data.entry, names.but,
columnspan=3 )
tkgrid(tklabel(tt,text="Sel.Crit"), crit.entry, summary.but,
columnspan=3 )
tkgrid(tklabel(tt,text="Eval.1st"), eval1st.entry, columnspan=3 )
tkgrid(tklabel(tt,text="Analysis"), func.entry, columnspan=3 )
tkgrid(tklabel(tt,text="Variables"), args.entry, columnspan=3 )
tkgrid(tklabel(tt,text="Options"), args2.entry, columnspan=3 )
tkgrid(tklabel(tt,text="Comment"), acomm.entry, columnspan=3 )
tkgrid(summ.cbut, tklabel(tt,text="Device"), dev.entry, sticky="e" ,
columnspan=3 )
tkgrid(tklabel(tt,text="Save cmd"), savecmd.entry, columnspan=3 )
tkgrid(submit.but, save.but, reset.but, source.but, cancel.but,
columnspan=2, sticky="w")
## capture destroy (e.g. from window controls
## otherwise the tkwait hangs with nowhere to go)
# tkbind(tt, "<Destroy>", function()tclvalue(done)<-"quit")
tkbind(tt, "<Destroy>", function()doQuit())
tkbind(tt, "<Return>", function()doIt(build()) )
tkbind(tt, "<Control-s>", function()doIt(saveIt()) )
tkbind(tt, "<Control-S>", function()doSource() )
.Tcl("update idletasks")
if( wait ){
while( tclvalue(done) != "cancel" ){
tkwait.variable(done)
doQuit()
}
}
# else{
# return(tt)
# }
## not necessary: button handlers do all the work, until tkdestroy().
# tkwait.variable(done)
#
# while( tclvalue(done)!= "cancel" ){
# if(tclvalue(done)=="quit") stop("aborted")
#
# if( tclvalue(done)=="save"){
# cmd <- saveIt()
# }
# else{
# cmd <- build()
# }
# cat("### Command executed via Tk ###\n")
# cat(deparse(cmd,width=132),sep="\n")
# cat("### Output:\n")
# dialogVals<-get("dialogVals", env=RJVB.env)
# print( try( eval.parent(cmd) ) )
# cat("### ----------------------- ###\n")
#
# tkwait.variable(done)
# }
# return(NULL)
}
On 2009-04-28, René J.V. Bertin <rjvber...@gmail.com> wrote:
> mkApp /Library/Frameworks/R.framework/Resources/bin/exec/R
<snip>
> improves the behaviour of Quartz graphics windows, and of dialogs made
> with TclTk (Aqua version 8.4), which for me now behave like under X11.
> (i.e. as if controlled by a separate thread while the prompt remains
> usable.)
______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
