toggling a group of icons in gWidgets - r

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.

Related

Toggle a gbutton in gWidgets2

I am creating a gbutton in gWidgets2 which will toggle between "go" and "stop" when it will be clicked.
I am following this example: toggling a group of icons in gWidgets
My Code:
library(gWidgets2)
library(gWidgets2RGtk2)
options(guiToolkit="RGtk2")
w= gwindow()
g1 <- ggroup(horizontal=TRUE, cont=w)
icon <- gbutton('go', container = g1)
state <- FALSE # a global
changeState <- function(h,...) {
if(state) {
svalue(icon) <- "go"
} else {
svalue(icon) <- "stop"
}
state <<- !state
}
addHandlerClicked(icon, handler=changeState)
It creates a button and toggle between "go" and "stop" when it is clicked. But the problem is I have to click two times to toggle. I want it should toggle between "go" and "stop" on one click.
You can use blockHandlers() and unblockHandlers() functions to avoid this issue.
w= gwindow()
g1 <- ggroup(horizontal=FALSE, cont=w)
icon <- gbutton("go", container = g1)
#icon <- gimage(reject,cont=g1)
state <- FALSE # a global
addHandlerClicked(icon, function(h,...) {
#
if(!state) {
blockHandlers(icon)
svalue(icon) <- "stop"
unblockHandlers(icon)
} else {
blockHandlers(icon)
svalue(icon) <- "go"
unblockHandlers(icon)
}
state <<- !state
})
I tried this and it works for me.

R Shiny not randomizing

I am trying to write a Shiny app for a class I'm teaching that draws a random sample from a dataset and computes summary statistics. Whenever I press the reset button on the UI, a new subset should be sampled. Here is my code so far:
shinyServer(function(input, output) {
# Output for Ch. 1 Problems: Central Tendency
# Prepare data
observeEvent(input$Ch1.Prob.CT.reset, {
Ch1.Prob.CT.n <- sample(8:12, 1)
Ch1.Prob.CT.obs <- sample(1:nrow(cars), Ch1.Prob.CT.n)
})
data <- eventReactive(input$Ch1.Prob.CT.reset, {
cars[Ch1.Prob.CT.obs, 'dist', drop=F]
})
# Outputs
output$Ch1.Prob.CT.Data <- renderDataTable({
data()
})
output$Ch1.Prob.CT.Mean.out <- renderUI({
if (is.na(input$Ch1.Prob.CT.Mean.in)) { # Error checking
p("No answer provided")
} else if (round(input$Ch1.Prob.CT.Mean.in, digits = 4) == round(mean(Ch1.Prob.CT.data[,1]), digits = 4)) {
p("Correct", style = "color:green")
} else {
p("Incorrect", style = "color:red")
}
})
})
The problem is that the sample is not random; it is always the same, every time. Even when I press the reset button, the sample is exactly the same as the one before.
Why is Shiny not randomizing? And how can I make it randomize again?
Add a line such as
set.seed(as.integer(Sys.time()))
before you need random numbers
Such code:
observeEvent(input$xxx, {
x <- ...
})
f <- eventReactive(input$xxx, {
[do something with x]
})
does not work.
You can simply remove the observer and do:
f <- eventReactive(input$xxx, {
x <- ...
[do something with x]
})
If you want to use a variable subject to modifications inside an observer, you have to use a reactive list, like this :
values <- reactiveValues()
values$x <- [initial value of x]
observeEvent(input$xxx, {
values$x <- ...
})
(In addition, don't use some dots (.) in the names of the shiny elements.)

R / Shiny -- how do I prevent too many expensive operations from getting queued up

I have an R/Shiny app that responds to a selectInput() by doing an expensive operation (fetch data from a DB, compute, produce chart etc).
I would like R to 'cancel' any operations in progress if I choose another element and simply react to the latest choice.
Instead what I see is that it queues up all choices I made and forces me to wait until it executes thru -- for example if i up-arrow thru the combo box.
Here's some sample code -- `
baseStockData <- reactive({
# Parse out the first part of the ticker descriptor to get the tick
print(input$toolDetrendBase)
print(">>>> in baseStockData")
if (input$stockDetrend)
{
ticker.firstpart <- strsplit(input$toolDetrendBase, " ")[[1]][1]
ticker <- str_replace_all(ticker.firstpart, "[^[:alnum:]]", "")
# parse ticker till first space
print(paste('loading base stock data for', ticker))
db.con <- xdbOpen()
cur.proc.time <- system.time(
stock <- xdbReadStockEvents(db.con,ticker)
)
print(paste('load stock perf :'))
print(cur.proc.time)
xdbClose(db.con)
stock
}
else
{
NA
}
}
)
output$stockViewPanelAdj <-
renderPlot({
print(">>> in stockViewPanelAdj")
stock <- currentStockData()
daterange <- paste(input$stockViewDateStart, '::', input$stockViewDateEnd, sep='')
print(paste('updating view panel for stock data', daterange))
if (input$stockDetrend)
{
print('calculating detrended stock series view')
baseStock <- baseStockData()
calcDetrendStockSeries(stock, baseStock, daterange)
}
else
{
if (input$stockNormalize)
{
baseval <- 100.0 / as.numeric(stock$adj[daterange][1,4])
if (!is.numeric(baseval)) {
baseval <- 1.0
}
print(baseval)
stockvals <- stock$adj[daterange] * baseval
yrange <- c(80,120)
theme <- chartTheme('white')
}
else
{
stockvals <- stock$adj[daterange]
baseval <- 1.0
yrange <- NULL
theme <- chartTheme('black')
}
render.time <- system.time(
chartSeries(stockvals,
name = stock$stock.metadata$Name,
minor.ticks = T,
major.ticks =T,
theme = theme,
yrange = yrange,
TA=c(addBBands())))
print("Render perf")
print(render.time)
if(input$stockNormalize) {
abline(h=100, lwd=2, col='green')
}
}
}

R combo box for selecting numbe of clusterring

How to fill a combo box with numbers like 2,3,4,5 ,when the user select the number , after that a button coded with clustering will take the value from the combo box to do the selected number of clustering.
Need help .
In case someone wants an answer, here is a sketch using gWidgets2:
w <- gwindow()
g <- gvbox(cont=w)
e <- gedit("5", cont=g, coerce=as.integer)
cb <- gcombobox(1:5, cont=g)
b <- gbutton("do clustering", cont=g)
addHandlerChanged(e, handler=function(h,...) {
## check svalue(e) is non-NA
cb[] <- seq_len(svalue(e))
})
addHandlerClicked(b, handler=function(h,...) {
print(sprintf("Do clustering with %s", svalue(cb)))
})

Get data out of a tcltk function

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.

Resources