Subject: (no subject)
From: Peter Wolf (pwolf@wiwi.uni-bielefeld.de)
Date: Fri 29 Sep 2000 - 05:05:14 EST
Message-id: <200009281905.VAA00548@wiwi5.uni-bielefeld.de>
Prasad wrote:
> I wrote a function in R which uses tcltk package .... essentially I wanted
> to give within that function, a widget with 2 radiobuttons to choose
> between plotting Precip and Temperature plots. After the user has chosen
> one of the radiobuttons there is another widget that asking him to identify
> outliers. However, I am having a lot of problems...what R does is evaluate
> the whole function without pausing...if I introduce a while() loop as I
> have in the example below, R does nothing until I hit cntrl-c upon which it
> shows the widget and comes out of the function......I could use a while
> loop in S-PLUS using the dialog.create() dialog.display() functions, but I
> cannot seem to implement that functionality in R.....what am I doing wrong?
> I enclose below the sample function...Any help will be greatly
> appreciated....
>
> "tcltktst" <-
+ function(x="") {
+ xd <- read.table(x, header=T)
+ library("tcltk")
+
+ tt <- tktoplevel()
+ tktitle(tt) <- "Diagnostics"
+ label.widget <- tklabel(tt, text="Choose!")
+
+ pptlabs <- function() {
+ plot(xd$iv802, xd$PPT)
+ abline(0,1)
+ tt2 <- tktoplevel()
+ tktitle(tt2) <- "Identify Outliers"
+ lab.wid2 <- tklabel(tt2, text="Identify Outliers")
+ but.wid2 <- tkbutton(tt2, text="OK", command=function() tkdestroy(tt2))
+ tkpack(lab.wid2, but.wid2)
+ labp <- identify(xd$iv802, xd$PPT, label=xd$FIPS)
+ dev.print(png, "pptlabs.png", width=600,height=600)
+ }
+
+ templabs <- function() {
+ plot(xd$iv802, xd$AVGT)
+ abline(0,1)
+ tt2 <- tktoplevel()
+ tktitle(tt2) <- "Identify Outliers"
+ lab.wid2 <- tklabel(tt2, text="Identify Outliers")
+ but.wid2 <- tkbutton(tt2, text="OK", command=function() tkdestroy(tt2))
+ tkpack(lab.wid2, but.wid2)
+ labp <- identify(xd$iv802, xd$AVGT, label=xd$FIPS)
+ dev.print(png, "templabs.png", width=600,height=600)
+ }
+
+ tclvar$choice <- 99
+ rbut.wid <- tkradiobutton(tt, text="Precipitation", value=0,
+ variable=tclvar$choice,
+ command=pptlabs)
+ rbut.wid2 <- tkradiobutton(tt, text="Temperature", value=1,
+ variable=tclvar$choice,
+ command=templabs)
+ but.wid <- tkbutton(tt, text="FINISHED", command=function(){ dxcbutt <-
+ "Cancel"; tkdestroy(tt)})
+
+ tkpack(label.widget)
+ tkpack(rbut.wid)
+ tkpack(rbut.wid2)
+ #tkpack.configure(rbut.wid,side="left")
+ tkpack(but.wid)
+
+ dxcbutt <- "OK"
+ while(dxcbutt == "OK") {
+ if(dxcbutt=="Cancel") break
+ }
+
+ plot(xd$AVGT, xd$PPT)
+
+ }
To stop the evaluation of a function until a specific tcltk action is done
you have to use the tk-function tkwait.variable().
The following function -- a simple modification of Prasad's
tcltktst function -- shows an example:
tcltk.test <- function(x1=1:10, x2=10:1) {
library("tcltk")
# define first toplevel-widget
tt <- tktoplevel()
tktitle(tt) <- "Diagnostics"
label.widget <- tklabel(tt, text="Choose data for plot!")
rbut.wid1 <- tkradiobutton(tt, text="x1", value="0", variable="choice")
rbut.wid2 <- tkradiobutton(tt, text="x2", value="1", variable="choice")
but.done <- tkbutton(tt, text="FINISHED", command=function(){
tclvar$done <- "T"
tkdestroy(tt)
} )
tkpack(label.widget, rbut.wid1, rbut.wid2, but.done)
# wait until FINISHED is pressed
tclvar$choice <- "0"
tkwait.variable("done")
# plot x1 or x2
if(tclvar$choice == "0") x <- x1
if(tclvar$choice == "1") x <- x2
if(is.null(names(x))) names(x) <- x
plot(x)
# define second toplevel widget
tt2 <- tktoplevel()
tktitle(tt2) <- "Action"
but.wid21 <- tkbutton(tt2, text="print summary",
command=function()print(summary(x)))
but.wid22 <- tkbutton(tt2, text="identify outlier",
command=function()identify(x))
but.wid23 <- tkbutton(tt2, text="exit", command=function(){
tclvar$done<-"T"
tkdestroy(tt2)
} )
tkpack(but.wid21, but.wid22, but.wid23)
# wait until exit is pressed
tclvar$done <- "F"
tkwait.variable("done")
}
Peter Wolf
-------------------------------------------------------------------------
Hans Peter Wolf pwolf@wiwi.uni-bielefeld.de
Fak. f. Wiwi.
Uni Bielefeld
33615 Bielefeld
Germany
-------------------------------------------------------------------------
-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-help mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !) To: r-help-request@stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._
This archive was generated by hypermail 2b25 : Thu 01 Feb 2001 - 16:14:25 EST