I have been trying to define multiple combo boxes in R using the tcltk package but to no avail. I am using the below code. My inspiration was here, however I can't seem to just label them comboBox1, comboBox2, etc... so I decided to try and set their output values into a vector... but their output values don't make any sense to me... any ideas out there?
many thanks
require(tcltk)
tclRequire("BWidget")
tt <- tktoplevel()
tkgrid(tklabel(tt,text="What's your favorite fruits?"))
fruit <- c("Apple","Orange","Banana","Pear")
num <- c(0:3)
num.fruit <- cbind(num, fruit)
#####1st box
comboBox <- tkwidget(tt,"ComboBox",editable=FALSE,values=num.fruit[,2])
tkgrid(comboBox)
Cbox1<- comboBox
tkfocus(tt)
######2nd box
comboBox <- tkwidget(tt,"ComboBox",editable=FALSE,values=num.fruit[,2])
tkgrid(comboBox)
Cbox2 <- comboBox
###
##preliminary wrap-ip to pass to OnOK function
pref1 <- tcl(Cbox1,"getvalue")
pref2 <- tcl(Cbox2,"getvalue")
Prefs <- c(pref1,pref2)
######action on OK button
OnOK <- function()
{
fruitChoice <- fruits[as.numeric(tclvalue(tcl(Prefs,"getvalue")))+1]
tkdestroy(tt)
msg <- paste("Good choice! ",fruitChoice,"s are delicious!",sep="")
tkmessageBox(title="Fruit Choice",message=msg)
}
OK.but <-tkbutton(tt,text=" OK ",command=OnOK)
tkgrid(OK.but)
tkfocus(tt)
Why don't you just use ttkcombobox?
require(tcltk)
tt <- tktoplevel()
tkwm.title(tt, "Fruits!")
tkwm.geometry(tt, "200x150+300+300")
onOK <- function()
{
fav <- tclvalue(favFruit)
worst <- tclvalue(worstFruit)
if (fav != "Choose one")
tkmessageBox(title="Favorite fruit", message = paste("Your favorite fruit is", fav))
if (worst != "Choose one")
tkmessageBox(title="Worst fruit", message = paste("The fruit you like the least is", worst))
if (fav == "Choose one" & worst == "Choose one")
tkmessageBox(title="Well...", message = "Select a fruit!")
}
label1 <- tklabel(tt, text="What's your favorite fruit?")
label2 <- tklabel(tt, text="What fruit you like the least?")
fruits <- c("Choose one", "Apple", "Orange", "Banana", "Pear")
# Default selections for the two combo boxes
favFruit <- tclVar("Choose one")
worstFruit <- tclVar("Choose one")
# 1st box
combo.1 <- ttkcombobox(tt, values=fruits, textvariable=favFruit, state="readonly")
# 2nd box
combo.2 <- ttkcombobox(tt, values=fruits, textvariable=worstFruit, state="readonly")
# If you need to do something when the user changes selection just use
# tkbind(combo.1, "<<ComboboxSelected>>", functionname)
OK.but <- tkbutton(tt,text=" OK ", command = onOK)
tkpack(label1, combo.1)
tkpack(label2, combo.2)
tkpack(OK.but)
tkfocus(tt)
PS: personally, I abandoned tcltk in favour of RGtk2, much more flexible in my opinion and you can design interfaces visually using Glade Interface Designer
If you don't want to get too involved with tcltk, you might find gWidgets easier to work with.
library(gWidgets)
options(guiToolkit="tcltk") ## or RGtk2 or Qt
w <- gwindow("Multiple comboboxes")
tbl <- glayout(cont=w, horizontal=FALSE)
fruit <- c("Apple","Orange","Banana","Pear")
tbl[1,1] <- "Favorite fuits"
tbl[1,2] <- (cb1 <- gcombobox(fruit, cont=tbl))
tbl[2,1] <- "Other fruit?"
tbl[2,2] <- (cb2 <- gcombobox(fruit, cont=tbl))
tbl[3,2] <- (b <- gbutton("Ok", cont=tbl))
addHandlerClicked(b, handler=function(h,...) {
cat(sprintf("You picked %s and %s\n", svalue(cb1), svalue(cb2)))
})
Related
I am using Shiny and have three goals:
a) user is able to select variables from a drop down menu
b) Cramer's V is calculated and the result is displayed on the screen
c) Depending on the result, a particular text output is displayed eg "this is a strong association"
I have successfully been able to complete goal a and b. I have tried various attempts at goal three but to no avail.
This one block of code below show an attempt that do not work:
library(shinydashboard)
library(shiny)
library(dplyr)
library(DT)
library(rcompanion)
df <- data.frame(ACCIDENT_MASTER_single)
Cat1.Variables <- c("SEVERITY", "ATMOSPH_COND", "DAY_OF_WEEK", "CAT")
Cat2.Variables <- c("SEVERITY", "ATMOSPH_COND", "DAY_OF_WEEK", "CAT")
ui <- fluidPage(
titlePanel("Calculate the strength of the relationship between categorical variables"),
sidebarLayout(
sidebarPanel(
selectInput("cat1", choices = Cat1.Variables, label = "Select a Categorical Variable:"),
selectInput("cat2", choices = Cat2.Variables, label = "Select a Categorical Variable:")
),
mainPanel(
textOutput("text1"),
h3(tableOutput("results")),
textOutput("text2")
)
)
)
server <- shinyServer(function(input, output) {
cramerdata <- reactive({
req(input$cat1, input$cat2)
df3 <- data.matrix(ACCIDENT_MASTER_single[c(input$cat1, input$cat2)])
df3
})
results <- reactive({
cramerV(cramerdata())
})
output$text1 <- renderText({
paste("You have selected variables:", input$cat1, input$cat2)
})
output$results <- renderPrint({
cat(sprintf("\nThe results equal: \n"))
x <- cramerV(cramerdata())
print(x)
if (x >.5) {
return(paste("<span style=\"color:red\">There is a strong association between the selected variables </span>"))
} else if
(x > 0.3 && x <= 0.5) {
"There is a medium association between the selected variables"
} else if
(x > 0.1 && x <= 0.3) {
"There is a weak association between the selected variables"
} else
"There is a very weak association between the selected variables"
})
})
shinyApp(ui, server)
The output I get under output$results are as follows:
The results equal: Cramer V 0.605 [1] "There is a strong association between the selected variables "
I understand the output looks like this with the [1] and the "" because I am using renderPrint. However, when I use renderText I get the text output producing the correct output but the result of Cramer's V is not displayed at all (goal b).
Can anyone please help solve this problem?
Thanks
Your second attempt is not working because variable 'x' is not global, it's defined under output$results and you can't access it in output$text2. I cannot run your whole code since you didn't provide the necessary data but I guess this would do the job for you:
# in the ui change your tableOutput() to textOutput() for 'results':
h3(textOutput("results"))
# in the server change your output$results to this:
output$results <- renderText({
x <- cramerV(cramerdata())
print(paste("The results equal:", x, ifelse(x > 0.5, "There is a strong association between the selected variables",
ifelse(x > 0.3 && x <= 0.5, "There is a medium association between the selected variables",
ifelse(x > 0.1 && x <= 0.3, "There is a weak association between the selected variables", "There is a very weak association between the selected variables")))))
})
P.S. You had already put cramerV(cramerdata()) in the results() reactive element, so why are you rewriting that in the output$results.
P.S.S: try not to use the same name for variables and functions (like results here both as reactive element and output)
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
the code below produces a table of inputs with 2 rows and 2 columns (to simplify the situation - see picture below). Based on these inputs, I'd like to produce four histograms, and they should be aligned with the input boxes. It's not the case at the moment. Ideally, there should be a blank space below the rownames of the table, then the first(second) column of histograms should be right below the first(second) column of the table.
One option I've thought about is to add the plots directly in the table in the form of "matrix_input[i,j] <- hist(rnorm(n),breaks=10)", where "n <- input[[paste0("C", j,"_A",i)]]". This way, they would definitely be aligned. But I didn't manage it because I didn't succeed in making the table accept plots as elements. A second option is to code the current framework with a table and the plots underneath, but making sure that they are properly aligned.
I've tried many things without success. Can anyone help please ? Any inputs would be greatly appreciated. Many thanks.
library(shiny)
library(grid)
library(gridBase)
u <- shinyUI(navbarPage(
"My Application",
tabPanel("Component 1",
fluidPage(fluidRow(column(6,tableOutput('decision_Matrix'),plotOutput('decision_Matrix_plots')),column(6))
)),
tabPanel("Component 2")
))
s <- shinyServer(
function(input,output) {
output$decision_Matrix <- renderTable({
matrix_input <- matrix(data = NA,nrow = 2,ncol = 2)
for (j in 1:2) {
for (i in 1:2) {
matrix_input[i,j] <- paste0("<input id='C",j,"_A",i,"' type='number' class='form-control shiny-bound-input' value='",input[[paste0("C",j,"_A",i)]],"'>")
}
}
rownames(matrix_input) <- c("alternative1","alternative2")
colnames(matrix_input) <- c("crit1","crit2")
matrix_input
},include.rownames = TRUE,sanitize.text.function = function(x) x)
output$decision_Matrix_plots <- renderPlot({
layout(matrix(c(1,2,3,4),nrow = 2,ncol = 2))
for (j in 1:2) {
for (i in 1:2) {
set.seed(123)
n <- input[[paste0("C",j,"_A",i)]]
if (is.null(n) || is.na(n) || n < 1) n <- 1
hist(rnorm(n),breaks = 10,main=sprintf("histogram of rnorm( %d )",n))
}
}
recordPlot()
})
})
shinyApp(ui = u,server = s)
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)
}
})
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)))
})