I'm new with making gui's and I need some help.
I have a gcombobox, and i want to know users choice after clicking on button Calculate
library(gWidgets)
city <- c("NY", "Tokyo", "Rome")
#main window
window <- gwindow(title = "stackoverflow",
visible=TRUE)
group <- ggroup(cont = window)
lay <- glayout(cont=group)
lay[1,1] <- "City:"
lay[1,2] <- gcombobox(city,
selected=0L,
cont=lay)
lay[2,2] <- gbutton(text = "Calculate",
border = TRUE,
cont = lay,
handler = function(h,...){
#here i want to know the users choice(NY, Tokyo, Rome).
#for example: if(combobox == "Rome") a = 5
})
Tnx in advance
Try to get value of lay[1,2]using svalue
for example
lay[2,2] <- gbutton(text = "Calculate",
border = TRUE,
cont = lay,
handler = function(h,...){
combobox=svalue(lay[1,2])
if(combobox == "Rome") {
a = 5} else {
a=0
}
print(paste(combobox , a))
})
Related
Thanks in advance for any help you can offer. I am trying to create a GUI that allows the user to choose choose which directory the files are located then input some other information. I then want to be able to calculate information like how many files are in the folder, and some other information that is gained from the files. I need the values that the user inputs to do any of the analysis. However, when I use svalue() I get an error. I also want to summarize the information on a second tab of the notebook. Here's my code so far:
library(gWidgets)
library(gWidgets2)
library(gWidgets2RGtk2)
library(gWidgetsRGtk2)
library(gWidgetstcltk)
library(gWidgets2tcltk)
library(pdftools)
require(gWidgets2RGtk2)
fileChoose <- function(action="print", text = "Select a file...",
type="open", ...) {
gfile(text=text, type=type, ..., action = action, handler =
function(h,...) {
do.call(h$action, list(h$file))
})
}
path <- fileChoose(action="setwd", type="selectdir", text="Select a
directory...")
files <- list.files(path, full.names = TRUE)
files_ex <- file_ext(files)
win <- gwindow("DataMate Project")
grp <- ggroup(horizontal = FALSE, container=win)
nb <- gnotebook(container = grp, expand=TRUE)
group1 <- ggroup(horizontal = FALSE, container=nb, label = "Input")
x <- c("SELECT CUSTOMER", "Eaton", "NG", "Spectris", "Other")
n <- length(files_ex)
lyt <- glayout(cont = frame)
glabel("File Path to Docs", container = group1)
p <- gedit(path, container=group1)
glabel("To your knowledge is this an ITAR quote?", container = group1)
itar <- gradio(c("Non-ITAR","ITAR"), container=group1)
glabel("Who is the customer? (Parent company)", container = group1)
cust <- gcombobox(x, container=group1)
glabel("How many RFQs / Assemblies?", container = group1)
val <- gspinbutton(from=1, to = 100, by =1, value=1,container=group1)
run <- gbutton("Run", container = group1, gmessage(svalue(val))
Maybe this will get you a start:
show_gui <- function(parent, path) {
files <- list.files(path, full.names = TRUE)
files_ex <- tools::file_ext(files)
nb <- gnotebook(container = parent, expand=TRUE)
group1 <- gframe(horizontal = FALSE, container=nb, label = "Input", expand=TRUE)
x <- c("SELECT CUSTOMER", "Eaton", "NG", "Spectris", "Other")
n <- length(files_ex)
glabel("File Path to Docs", container = group1)
p <- gedit(path, container=group1)
glabel("To your knowledge is this an ITAR quote?", container = group1)
itar <- gradio(c("Non-ITAR","ITAR"), container=group1)
glabel("Who is the customer? (Parent company)", container = group1)
cust <- gcombobox(x, container=group1)
glabel("How many RFQs / Assemblies?", container = group1)
val <- gspinbutton(from=1, to = 100, by =1, value=1,container=group1)
run <- gbutton("Run", container = group1, handler = function(h, ...) {
gmessage(svalue(val))
})
}
w <- gwindow("GUI")
parentgroup <- ggroup(cont=w)
g = ggroup(cont=parentgroup, horizontal=FALSE)
glabel("Choose a file to proceed", cont=g)
gfilebrowse(cont=g, type="selectdir", handler=function(h, ...) {
dname = svalue(h$obj)
if (dir.exists(dname)) {
delete(parentgroup, g)
show_gui(parentgroup, dname)
} else {
gmessage("That file does not exists")
}
})
You had several mistakes. I didn't do the rest for you, but in the button handler you would create the widgets in a new tab, and use svalue(nb) <- 2 to switch to that tab.
I have a handsontable with dynamic data and I am uploading it to the MSSQL DB with the sqlSave code with the Submit button in shiny.
However, I could bot find any function that will going to disable the actionbutton for lets say 10 seconds. I tried shinyjs::disable and withProgress, incProgress things but none of them worked.
Thank you,
dbhandle <- odbcDriverConnect('driver={SQL Server};server=....;database=...;trusted_connection=true')
withProgress(
sqlSave(dbhandle, dat = some data),
tablename = "Budget_Tool",
rownames = F, append = T, verbose = T, fast = F, colnames = F, safer =
T), value = 1,
style = "notification", message = "Submitting, please wait..")
--------------------
actionButton("submit", "Submit", class = "btn-primary",
style="color: #fff; background-color: #337ab7; border-
color: #2e6da4; font-size: 20px;"),
It's more or less straight forward when you integrate the disabling and enabling before and after the action function.
Here is a sample snippet:
library(shiny)
library(shinyjs)
ui <- shinyUI({
shiny::fluidPage(
useShinyjs(), # Set up shinyjs
actionButton(inputId = "start", label = "start")
)
})
server <- shinyServer(function(input, output){
actionFunction = function(){
shinyjs::disable("start")
# Replace actual code instead
withProgress(message = 'Calculation in progress',
detail = 'This may take a while...', value = 0, {
for (i in 1:15) {
incProgress(1/15)
Sys.sleep(0.25)
}
})
shinyjs::enable("start")
}
# Run action function on button click
onclick("start", actionFunction())
})
shinyApp(ui,server)
I fixed it by using hide and show;
observeEvent(input$submit, {
hide('submit', animType = "fade", time = 5)
asd <- as.data.frame(cbind(Department = rv$data[,2], Cost_Summary_Key =
rv$data[,1], Calculated_Budget = rowSums(rv$data[,3:14]))) %>%
left_join(CSK_Budget, c("Department", "Cost_Summary_Key"))
asd <- asd %>% mutate(Deviation = (as.numeric(Budget_2017) - rowSums(rv$data[,3:14])))
x <- c()
for (i in 1:nrow(asd)) {
if(asd[i,5] >= -0.05)
{x[i] <- TRUE} else {x[i] <- FALSE}
}
moment <- substr(Sys.time(), 1, 10)
moment2 <- substr(Sys.time(), 12, 19)
personel <- input$userName
if( all(x))
{
dbhandle <- odbcDriverConnect('driver={SQL Server};server=...;database=...._SQL;trusted_connection=true')
withProgress(
sqlSave(dbhandle, dat = (cbind(melt(rv$data, na.rm = F, varnames = c(Department, Cost_Summary_Key), as.is = F), Year = "2017",
Time_Stamp1 = moment, Time_Stamp2 = moment2, User = personel)),
tablename = ".....",
rownames = F, append = T, verbose = T, fast = F, colnames = F, safer = T), value = 1,
style = "notification", message = "Submitting, please wait..")
js_string <- 'alert("Succes!!");'
session$sendCustomMessage(type='jsCode', list(value = js_string))
showNotification("Thanks, your response was submitted successfully!", duration = 5, type = "warning")
}
else {showNotification("Check Your Budget Items !!", duration = 3, type = "warning")}
odbcCloseAll()
show('submit', animType = "slide", time = 1)
})
Using tcltk to create a GUI in R, I want to make a non-editable text box that displays the name of the save file that was selected by the user. I am able to create the button and the box, but I cannot figure out how to display the name of the selected file. I think I need to use tkinsert()
This is what I have so far:
library(tcltk)
library(tcltk2)
library(readxl)
test1 <- tktoplevel()
tkwm.title(test1, "Test 1")
tkgrid.rowconfigure(test1, 4)
tkgrid.columnconfigure(test1, 3)
getXlsx <- function() {
xlsheet <- tclvalue(tkgetOpenFile(
filetypes = "{ {Excel Files} {.xlsx} } { {All Files} * }"))
a <- read_excel(xlsheet)
assign("a", a, envir = .GlobalEnv)
}
test1$env$butSelect1 <- tk2button(test1, text = " Select File ", command
= getXlsx)
tkgrid(test1$env$butSelect1, padx = c(10,0), pady = 10, column = 0, row =
0)
test1$env$txt1 <- tk2text(test1, width = 40, height = 1)
tkgrid(test1$env$txt1, padx = c(10,10), pady = 10, column = 1, row = 0,
columnspan = 2)
tkconfigure(test1$env$txt1, state = "disabled")
### tkinsert(test1$env$txt1, ???) ###
Any help would be greatly appreciated, thank you.
I got it now, I had to add 4 lines to the function itself:
getXlsx <- function() {
xlsheet <- tclvalue(tkgetOpenFile(
filetypes = "{ {Excel Files} {.xlsx} } { {All Files} * }"))
a <- read_excel(xlsheet)
assign("a", a, envir = .GlobalEnv)
assign("z", xlsheet, envir = .GlobalEnv)
tkconfigure(test1$env$txt1, state = "normal")
tkinsert(test1$env$txt1, "end", z)
tkconfigure(test1$env$txt1, state = "disabled")
}
This creates a new "z" value in the global environment with the path name, then allows the text box to be editable, then adds the path name, then makes the text box non-editable again.
1) I used the package gWidget to make a GUI in R. I have had some problems. I want to add a "save" button in the window, but I don't know how to store the pic already drawn in ggraphics.
library("memoise")
library("gWidgets2RGtk2")
library("RGtk2")
library("digest")
library("gWidgets2")
library("stats")
options(guiToolkit="RGtk2")
d<-0
#the main window to make and some parts of it to make
win <- gwindow("Load curve analysis", visible=TRUE,expand = TRUE)
biggroup <- ggroup(horizontal = FALSE, container=win, expand = TRUE)
topgroup<-ggroup(horizontal = TRUE, container=biggroup,expand = TRUE)
bottomgroup<-ggroup(horizontal = TRUE, container=biggroup, expand = TRUE)
leftgroup<-ggroup(horizontal = FALSE, container=bottomgroup,expand= TRUE)
rightgroup<-ggroup(horizontal = FALSE, container=bottomgroup,expand=TRUE)
add(rightgroup, ggraphics(), expand=TRUE)
#draw a pic
updatePlot <- function(h,...) {
if(d==1){
if(svalue(Analyse1)=="Month duration curve")
plot(1:100,1:100,main="1")
if(svalue(Analyse1)=="Month load curve")
plot(1:100,1:100,main="2")
}
if(d==2){
if(svalue(Analyse2)=="Jahresdauerlinie"){
plot(1:100,1:100,main="3")
}
}
}
#the "save" button to make, this button will bring another window,
#but after setting up the road of the saving place, this smaller window will be closed
Store<-gbutton("Save as pdf",container=topgroup, handler = function(h,...){
win1 <- gwindow("set up road", visible=TRUE,expand = TRUE)
group <- ggroup(horizontal = FALSE, container=win1, expand = TRUE)
tmp <- gframe("Pls type the place you want to save in", container=group)
obj0<-gedit("",cont=tmp,expand = TRUE)
tmp <- gframe("Pls name the new diagram, and end it with .pdf", container=group)
obj1<-gedit("Lastganganalyse.pdf",cont=tmp,expand = TRUE)
#here the function recordPlot will be used,but it doesnt work,the document cant be opened
ok<-gbutton("Ok",container=group, handler = function(h,...){
p<-recordPlot()
# I dont know why this record Plot doesnt work
setwd(svalue(obj0))
pdf(svalue(obj1))
p
dev.off()
dispose(win1)
})
})
#the other parts of the main window
tmp <- gframe("Year(after input a year pls press Enter)", container=leftgroup)
#Jahren <- gradio(c(2012,2013,2014), horizontal=FALSE, cont=tmp, handler=updatePlot)
Jahren<-gedit("2012",cont=tmp, handler=updatePlot)
tmp <- gframe("Month", container=leftgroup)
Monat <- gslider(from=1,to=12,by=1, value=1, cont=tmp, handler=updatePlot)
tmp <- gframe("Analysis' way of a month", container=leftgroup)
Analyse1 <- gcombobox(c(" ","Month duration curve","Month load curve"), cont=tmp, handler=function(h,...){
d<<-1
updatePlot(h,...)
},expand = TRUE)
tmp <- gframe("Analysis' way of a year", container=leftgroup)
Analyse2 <- gcombobox(c(" ","Jahresdauerlinie"),cont=tmp,handler=function(h,...){
d<<-2
updatePlot(h,...)},expand = TRUE)
2) Besides, I don't know how to set up the size of the ggroup. Or how can I control all parts of the window's size to look better. I dont know that kind of function.
3) The line which is drawn in ggraphics is hard to be seen. And how can I change this situation?
Suppose we had the following plot in the graphics:
ggplot(dat = data.frame("x" = 1:100, "y" = rnorm(100)), aes(x = x, y = y)) + geom_point()
Within the handler for the button, you can try the following:
setwd(svalue(obj0))
dev.copy2pdf(file = svalue(obj1))
I am writing a GUI with the gwidgets package in R. I am implementing a tool that will allow the user to select a number of variables from one list, and drag them to an empty list for collection. The inspiration is the gui from SPSS, see link:
spss drag and drop
I was planning do this with two gtables, i.e. first create one gtable with the list of variables, and an empty gtable to collect the selected variables. Below is my sample code:
portfolioBuilder <- function(h,...){
## globals
widgets <- list()
varNames <- c("var1","var2","var3","var4" )#with(.GlobalEnv, names(data))
#window
win <- gwindow("Test")
#groups
g <- ggroup(horizontal = FALSE, container = win, expand = TRUE)
gg <- ggroup(horizontal = FALSE, container = win, expand = TRUE)
#graphics container
ggraphics(container = gg)
#paned group
pg <- gpanedgroup(container = g, expand = TRUE)
nb <- gnotebook(container = pg)
## main group
qpg <- ggroup(horizontal = FALSE, container = nb, label = "portfolio")
parg <- ggroup(horizontal = FALSE, container = nb, label = "portfolio args")
## qplot group
tbl <- glayout(container = qpg)
#variable list
tbl[1,1,anchor = c(1,0)] <- "Variables"
tbl[2:10,2] <- (widgets[["table"]] <- gtable(varNames, multiple = TRUE, container = tbl, expand = TRUE))
tbl[3,3, anchor = c(1,0)] <- "y"
tbl[3,4] <- (widgets[["y"]] <- gedit("", container = tbl))
tbl[4,3, anchor = c(1,0)] <- "x"
tbl[4,4] <- (widgets[["x"]] <- gtable(c(""),container = tbl))
## make table visible and set tab
visible(tbl) <- TRUE
svalue(nb) <- 1
##################################end layout#################################
}
However my sample code spits out an error because of the empty gtable widget. Does anyone know how to accomplish this with gwidgets?
You'll want to work on the layout, but the key to this is addDropSource and addDropTarget:
options(guiToolkit="RGtk2")
library(gWidgets)
w <- gwindow(visible=FALSE)
g <- gpanedgroup(cont=w)
tbl <- gtable(names(mtcars), cont=g)
fl <- gframe("variables", horizontal=FALSE, cont=g)
dep <- gedit(initial.msg="Dependent variable", label="Dependent", cont=fl)
ind <- gedit(initial.msg="Independent variable(s)", label="Independent", cont=fl)
addDropSource(tbl, handler=function(h,...) svalue(h$obj))
addDropTarget(dep, handler=function(h,...) svalue(h$obj) <- h$dropdata)
addDropTarget(ind, handler=function(h,...) {
cur <- svalue(h$obj)
new <- ifelse(nchar(cur) > 0, paste(cur, h$dropdata, sep=", "), h$dropdata)
svalue(h$obj) <- new
})
visible(w) <- TRUE
Drag and drop support in gWidgets is really variable. Of the 6 possibilities for this to work in: gWidgetsRGtk2, gWidgets2RGtk2, gWidgetstcltk, gWidgets2tcltk, gWidgetsQt and gWidgets2Qt this code only worked in gWidgetsRGtk2.