Get data out of a tcltk function - r

This is probably so simple I will cringe when the answer comes back but I am totally stumped. I have tried the manuals, tried searching the web, assorted examples and anything else I can think of. I am still stuck.
I am trying to create a simple input for the user to add two values I can then use in the rest of the R script. I need the script to pause and wait for the input from the user and then continue along once it gets the input (like how the choose file function works). AFter reading a bunch of stuff I decided to use library(tcltk). I have a nice little box within a function.
inputs <- function(){
xvar <- tclVar("")
yvar <- tclVar("")
tt <- tktoplevel()
tkwm.title(tt,"Input Numbers")
x.entry <- tkentry(tt, textvariable=xvar)
y.entry <- tkentry(tt, textvariable=yvar)
reset <- function()
{
tclvalue(xvar)<-""
tclvalue(yvar)<-""
}
reset.but <- tkbutton(tt, text="Reset", command=reset)
submit <- function() {
x <- as.numeric(tclvalue(xvar))
y <- as.numeric(tclvalue(yvar))
print(x)
print(y)
tkdestroy(tt)
}
submit.but <- tkbutton(tt, text="submit", command=submit)
tkgrid(tklabel(tt,text="Enter Two Inputs"),columnspan=2)
tkgrid(tklabel(tt,text="Input1"), x.entry, pady = 10, padx =10)
tkgrid(tklabel(tt,text="Input2"), y.entry, pady = 10, padx =10)
tkgrid(submit.but, reset.but)
}
When I type in:
inputs()
The nice little box pops up and I can input my values, say 3 and 4 for this example.
I get back
<Tcl>
[1] 3
[1] 4
I want to use those number in a subsequent part of the R code. How do I get them so I can get the equivalent of this?
input1 <- 3
input2 <- 4
Thanks in advance for helping.

Here is a modification of your function:
inputs <- function(){
xvar <- tclVar("")
yvar <- tclVar("")
tt <- tktoplevel()
tkwm.title(tt,"Input Numbers")
x.entry <- tkentry(tt, textvariable=xvar)
y.entry <- tkentry(tt, textvariable=yvar)
reset <- function()
{
tclvalue(xvar)<-""
tclvalue(yvar)<-""
}
reset.but <- tkbutton(tt, text="Reset", command=reset)
submit <- function() {
x <- as.numeric(tclvalue(xvar))
y <- as.numeric(tclvalue(yvar))
e <- parent.env(environment())
e$x <- x
e$y <- y
tkdestroy(tt)
}
submit.but <- tkbutton(tt, text="submit", command=submit)
tkgrid(tklabel(tt,text="Enter Two Inputs"),columnspan=2)
tkgrid(tklabel(tt,text="Input1"), x.entry, pady = 10, padx =10)
tkgrid(tklabel(tt,text="Input2"), y.entry, pady = 10, padx =10)
tkgrid(submit.but, reset.but)
tkwait.window(tt)
return(c(x,y))
}
Now run the function like:
myvals <- inputs()
Now enter your 2 values and click "Submit", then look at the myvals variable, it contains your 2 values.

You have them in the submit callback -- you just need to put them somewhere. Sometimes global variables are best for this. Just use <<- to assign to them so the bindings happen outside of the scope of the submit callback. You can also use an environment for this purpose or even a reference class.

Related

link group color thanks to mapper to shiny

I am developing a topological data analysis app on R thanks to shiny and I have some trouble with one of my functions.
I would like to put those lines into the server as reactive elements:
l = length(V(aspargus.graph))
cc.maj.vertex <- c()
filter.vertex <- c()
for (i in 1:l){
points.in.vertex <- aspargus.mapper$points_in_vertex[[i]]
Mode.in.vertex <- Mode(normaspargus$`DataAspargus$Treatment`[points.in.vertex])
cc.maj.vertex <- c(cc.maj.vertex,as.character(Mode.in.vertex))
filter.vertex <- c(filter.vertex,mean(filter_list[points.in.vertex]))
}
vertex.size <- rep(0,l)
for (i in 1:l){
points.in.vertex <- aspargus.mapper$points_in_vertex[[i]]
vertex.size[i] <- length((aspargus.mapper$points_in_vertex[[i]]))
}
MapperNodes <- mapperVertices(aspargus.mapper, labels_pts )
MapperNodes$cc.maj.vertex <- as.factor(cc.maj.vertex)
MapperNodes$filter_list <- filter.vertex
MapperNodes$Nodesize <- vertex.size
MapperLinks <- mapperEdges(aspargus.mapper)
My main problems are for the for loop (lines 5 and 14), and the column change as:
MapperNodes$filter_list <- filter.vertex
At the moment my code looks like that:
server <- function (input, output){
l = reactive({length(V(data.mapper.graph()))})
reactive({for (i in 1:l()){
points.in.vertex <- reactive({data.mapper()$points_in_vertex[[i]]})
Mode.in.vertex <- reactive({Mode(X1()$`DataAspargus$Treatment`[points.in.vertex()])})
cc.maj.vertex <- reactive({c(cc.maj.vertex(),as.character(Mode.in.vertex()))})
filter.vertex <- reactive({c(filter.vertex(),mean(f()[points.in.vertex()]))})
}
})
vertex.size <- reactive({rep(0,l)})
reactive({for (i in 1:l){
points.in.vertex <- reactive({data.mapper()$points_in_vertex[[i]]})
vertex.size()[i] <- reactive({length((data.mapper()$points_in_vertex[[i]]))})
}
})
MapperNodes <- reactive({mapperVertices(data.mapper(), labels_pts )})
MapperNodes$cc.maj.vertex <- reactive({as.factor(cc.maj.vertex())})
MapperNodes$f <- reactive({filter.vertex()})
MapperNodes$Nodesize <- reactive({vertex.size()})
MapperLinks <- reactive({mapperEdges(data.mapper())})
As you can imagine, it is not working:
Error in MapperNodes$cc.maj.vertex <- reactive({ :
object of type 'closure' is not subsettable
I have tried to put bracket before MapperNodes, after etc...and I don't find any solution...
I hope someone will get an idea!
If you need any more details, feel free to ask :D
The way to resolve this problem is to put all the code inside the output function.

Prompt to put input string to variable - R

I am running an R script daily that I would like to prompt me to enter data when selecting all the whole script.
I have already tried readline(prompt = ), which prompts in the rstudio console, but it does not prompt me if I select all code to run. I also did not like the prompt being in the console because it was easy to overlook.
I have also looked into library(tcltk), in hopes that a message box could help, but nothing I tried seemed to work.
Here's a method using library(tcltk)
EntryBox <- function(label = 'Enter', title = 'Entry Box') {
tt <- tktoplevel()
tkwm.title(tt, title)
done <- tclVar(0)
tkbind(tt,"<Destroy>", function() tclvalue(done) <- 2)
result <- tclVar("")
cancel.but <- tkbutton(tt, text='Cancel', command=function() tclvalue(done) <- 2)
submit.but <- tkbutton(tt, text="Submit", command=function() tclvalue(done) <- 1)
tkgrid(tklabel(tt, text=label), tkentry(tt, textvariable=result), pady=3, padx=3)
tkgrid(submit.but, cancel.but, pady=3, padx=3)
tkfocus(tt)
tkwait.variable(done)
if(tclvalue(done) != 1) result <- "" else result <- tclvalue(result)
tkdestroy(tt)
return(result)
}
x <- EntryBox(label = 'Enter a string'); x

Display message and rerun the code using gWidgets in R

x <- gconfirm("Run Program?",title="gConfirm")
if (x){
w <- gwindow(title="List of Programs",visible=TRUE)
g = ggroup(horizontal = FALSE, cont=w)
glabel("Please select the Program", cont=g)
ptype <- c("A","B")
temp <- gcombobox(ptype , cont=g)
addHandlerChanged(temp , handler=function(...){})
gbutton("Run", cont=g,handler = function(...){
print(svalue(temp)
dispose(g)
runagain <- gconfirm("Run again?",title="gConfirm")
if(runagain){
## If user clicks okay, I want to start running again from the third line of the code, w <- gwindow......)**
}
}
Can anyone hint a work around that? Also how do I display the svalue(temp) in to similar UI box instead of printing it on the console. Any help is much appreciated.
SOmething like this might get you what you want:
library(gWidgets2)
programs = list("Program A"="a.R",
"Program B" = "b.R")
w <- gwindow("run programs")
g <- ggroup(cont=w, horizontal=FALSE)
fl <- gformlayout(cont=g)
cb <- gcombobox(names(programs), cont=fl, label="Select a program to run")
b <- gbutton("Run selected program", cont=fl, label="", handler=function(h,...) {
prog <- svalue(cb)
val <- gconfirm(sprintf("Run program %s?", prog), parent=w)
if (val) {
source(programs[[val]])
gmessage("All done", parent=w)
}
})

toggling a group of icons in gWidgets

Adapting an example I can toggle the display of an icon like this:
reject <- "D:/Pictures/web/close32.png"
accept <- "D:/Pictures/web/open32.png"
w= gwindow()
g1 <- ggroup(horizontal=TRUE, cont=w)
icon <- gimage(reject,cont=g1)
state <- FALSE # a global
changeState <- function(h,...) {
if(state) {
svalue(icon) <- reject
} else {
svalue(icon) <- accept
}
state <<- !state
}
addHandlerClicked(icon, handler=changeState)
However, I would like to get this to work with a group of icons
example 3x3 icon grouping http://cran.r-project.org/web/packages/gWidgets/vignettes/gWidgets.pdf
so that each icon can be toggled and I can retrieve the state of the icons as a vector. The purpose is to create a graphical selector for picking pairs of observations to perform analysis on. Here is my attempt. It displays correctly, but does not respond to clicks to change the state. I recognize that I am confusing how the handler and action parameters act together and would appreciate any clarifications and fixes for this code.
reject <- "D:/Pictures/web/close32.png"
accept <- "D:/Pictures/web/open32.png"
w= gwindow()
g1 <- ggroup(horizontal=TRUE, cont=w)
lyt <- glayout(cont=g1, spacing=10)
icon <- rep(reject,times=9)
state <- rep(FALSE, times=9)
changeState <- function(h,...) {
if(state[index]) {
svalue(icon[index]) <- reject
} else {
svalue(icon[index]) <- accept
}
state[index] <<- !state[index]
}
for(i in 1:3){
for(j in 1:3){
ind <- (i-1) * 3 +j
lyt[i,j] <- gimage(icon[ind], cont=lyt)
addHandlerClicked(lyt[i,j], handler=changeState, action= index <-ind)
}
}
1c: http://i.stack.imgur.com/4kbwK.png
The index value must be retrieved from h$action in your handler (index <- h$action). As well, this bit action=index <- ind need only be action=ind.

How to disable OK button in `gbasicdialog()` instance of gWidgets2?

Consider:
fix_df <- function(DF, ...) {
dfname <- deparse(substitute(DF))
w <- gbasicdialog(..., handler=function(h,...) {
assign(dfname, df[,], .GlobalEnv)
})
g <- ggroup(cont=w, horizontal=FALSE)
glabel("Edit a data frame", cont=g)
df <- gdf(DF, cont=g, expand=TRUE)
size(w) <- c(400, 400)
out <- visible(w)
}
m <- mtcars[1:3, 1:4]
fix_df(m)
How can I programmatically disable the OK button in w?
There is a do.buttons argument to not show the buttons. To access the button requires digging into the internals. You can see how that is hacked in where do.buttons is implemented in gWidgets2RGtk2.

Resources