No subject

[Peter Wolf]

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 at 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 at stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._