Reputation: 2609
I have 15 select (input type) fields. And I need to pass it to the Server function do prediction and show resultant output. I don't want to auto-update, when user sets value for one input field, but instead I want user to set values for all (15 input fields) and then press some type of a button to get the output.
how to achieve that? this is my first shiny UI application.
library(shiny)
dataset <- diamonds
marks <- 0:100
grades <- c("A","B","C","D","E","F")
ui <- fluidPage(
tags$head(tags$style(HTML("
h2 {
text-align: center;
}
h3 {
text-align: center;
}
h6 {
text-align: center;
color:red;
}
#goButton
{
width: 100%;
}
")
)
),
verticalLayout
(
wellPanel
(
titlePanel("Get Recommendation for Year 4 or 5 Courses"),
h6("* Set the value of input field as 'NA', if you received a remark of Absent (ABS), Medical Circumstances (MC), Exemption (EX), Synoptic Course in absence (NC), Discretionary credits (DC), or any other reason")
)
),
fluidRow
(
column(2,
wellPanel(
radioButtons("type", label = h3("Select Type"),
choices = list("Grades" = 'grades', "Marks" = 'marks'),
selected = 'grades')
)
),
conditionalPanel
(
condition = "input.type == 'grades'",
column
(2,
wellPanel
(
h3("Year 1"),
selectInput('a', 'A',c('NA', grades)),
selectInput('b', 'B',c('NA', grades)),
selectInput('c', 'C',c('NA', grades)),
selectInput('d', 'D',c('NA', grades)),
selectInput('e', 'E',c('NA', grades))
)
),
column
(2,
wellPanel
(
h3("Year 2"),
selectInput('f', 'F',c('NA', grades)),
selectInput('g', 'G',c('NA', grades)),
selectInput('h', 'H',c('NA', grades)),
selectInput('i', 'I',c('NA', grades)),
selectInput('j', 'J',c('NA', grades))
)
),
column
(2,
wellPanel
(
h3("Year 3"),
selectInput('k', 'K',c('NA', grades)),
selectInput('l', 'L',c('NA', grades)),
selectInput('m', 'M',c('NA', grades)),
selectInput('n', 'N',c('NA', grades)),
selectInput('o', 'O',c('NA', grades))
)
)
),
conditionalPanel
(
condition = "input.type == 'marks'",
column
(2,
wellPanel
(
h3("Year 1"),
selectInput('a', 'A',c('NA', marks)),
selectInput('b', 'B',c('NA', marks)),
selectInput('c', 'C',c('NA', marks)),
selectInput('d', 'D',c('NA', marks)),
selectInput('e', 'E',c('NA', marks))
)
),
column
(2,
wellPanel
(
h3("Year 2"),
selectInput('f', 'F',c('NA', marks)),
selectInput('g', 'G',c('NA', marks)),
selectInput('h', 'H',c('NA', marks)),
selectInput('i', 'I',c('NA', marks)),
selectInput('j', 'J',c('NA', marks))
)
),
column
(2,
wellPanel
(
h3("Year 3"),
selectInput('k', 'K',c('NA', marks)),
selectInput('l', 'L',c('NA', marks)),
selectInput('m', 'M',c('NA', marks)),
selectInput('n', 'N',c('NA', marks)),
selectInput('o', 'O',c('NA', marks))
)
)
),
column
(4,
actionButton("goButton", "Submit"),
wellPanel
(
h3("Results"),
verbatimTextOutput("value")
)
)
)
)
server <- function(input, output)
{
#Do Prediction
#Get Results
new_vector = c()
if (input.type == 'marks'){
new_vector <- append(new_vector, input$f27sa, 1)
new_vector <- append(new_vector, input$f27sb, 2)
new_vector <- append(new_vector, input$f27cs, 3)
new_vector <- append(new_vector, input$f27is, 4)
new_vector <- append(new_vector, input$f27px, 5)
new_vector <- append(new_vector, input$f28in, 6)
new_vector <- append(new_vector, input$f28da, 7)
new_vector <- append(new_vector, input$f28pl, 8)
new_vector <- append(new_vector, input$f28sd, 9)
new_vector <- append(new_vector, input$f28dm, 10)
new_vector <- append(new_vector, input$f28ai, 11)
new_vector <- append(new_vector, input$f28fa, 12)
new_vector <- append(new_vector, input$f28fb, 13)
new_vector <- append(new_vector, input$f28oc, 14)
new_vector <- append(new_vector, input$f28pd, 15)
}else{
new_vector <- append(new_vector, input$f27sa2, 1)
new_vector <- append(new_vector, input$f27sb2, 2)
new_vector <- append(new_vector, input$f27cs2, 3)
new_vector <- append(new_vector, input$f27is2, 4)
new_vector <- append(new_vector, input$f27px2, 5)
new_vector <- append(new_vector, input$f28in2, 6)
new_vector <- append(new_vector, input$f28da2, 7)
new_vector <- append(new_vector, input$f28pl2, 8)
new_vector <- append(new_vector, input$f28sd2, 9)
new_vector <- append(new_vector, input$f28dm2, 10)
new_vector <- append(new_vector, input$f28ai2, 11)
new_vector <- append(new_vector, input$f28fa2, 12)
new_vector <- append(new_vector, input$f28fb2, 13)
new_vector <- append(new_vector, input$f28oc2, 14)
new_vector <- append(new_vector, input$f28pd2, 15)
}
results <- eventReactive(input$goButton,{
return (new_vector)
})
output$value <- renderPrint({ results() })
}
shinyApp(ui = ui, server = server)
Upvotes: 3
Views: 1747
Reputation: 21
If I understand right your question, I think you should use isolate
function to achieve this. The idea is easy to understand. You make an actionButton
and when it's clicked the plot (or another type of output ) is calculated. The point is to isolate the inputs in order to make them no reactive and not change untill you click the button.
Here you have the full explanation: https://shiny.rstudio.com/articles/isolation.html
I'll put an example with plotOutput:
The idea is to make an action button in the UI
part of your app just like this actionButton("goButtoncomparacio", "Make the plot!",width = "200px",icon=icon("play-circle"))
Then , in the server
part of your app:
output$plotComparacio<-renderPlot({
input$goButtoncomparacio
#You isolate each one of your input.
#This will make that they dont change untill you click the button.
embassament<-isolate({input$embcomparacio})
anysfons<-isolate({input$riboncomparacio})
anys1<-isolate({input$datescomparacio1})
anys2<-isolate({input$datescomparacio2})
anys3<-isolate({input$datescomparacio3})
mitjana<-isolate({input$mitjanaComparacio})
fons<-isolate({input$fonscomparacio})
efemeri<-isolate({input$efemeridescomparacio})
previ<-isolate({input$previsionscomparacio})
myplot<-ggplot()+whatever you want to plot
})
I hope this helps you. I found it the easiest way to make "Do the plot!" button.
Upvotes: 2
Reputation: 22827
eventReactive
is the way to approach this.
Here is your example modified so that it only returns "result 1"
if one of the three conditions is true
input$a=="A"
input$f=="A"
input$k=="A"
otherwise it returns "result 3"
. However note that it doesn't return anything at all until you hit the submit button.
Somehow eventReactive
is not very well known in the shiny world - but this kind of scenario is exactly what it is meant for. I didn't stumble across it until I had been writing Shiny programs regularly for over a year.
library(shiny)
dataset <- diamonds
marks <- 0:100
grades <- c("A","B","C","D","E","F")
ui <- fluidPage(
tags$head(tags$style(HTML("
h2 {
text-align: center;
}
h3 {
text-align: center;
}
h6 {
text-align: center;
color:red;
}
#goButton
{
width: 100%;
}
")
)
),
verticalLayout
(
wellPanel
(
titlePanel("Get Recommendation for Year 4 or 5 Courses"),
h6("* Set the value of input field as 'NA', if you received a remark of Absent (ABS), Medical Circumstances (MC), Exemption (EX), Synoptic Course in absence (NC), Discretionary credits (DC), or any other reason")
)
),
fluidRow
(
column(2,
wellPanel(
radioButtons("type", label = h3("Select Type"),
choices = list("Grades" = 'grades', "Marks" = 'marks'),
selected = 'grades')
)
),
conditionalPanel
(
condition = "input.type == 'grades'",
column
(2,
wellPanel
(
h3("Year 1"),
selectInput('a', 'A',c('NA', grades)),
selectInput('b', 'B',c('NA', grades)),
selectInput('c', 'C',c('NA', grades)),
selectInput('d', 'D',c('NA', grades)),
selectInput('e', 'E',c('NA', grades))
)
),
column
(2,
wellPanel
(
h3("Year 2"),
selectInput('f', 'F',c('NA', grades)),
selectInput('g', 'G',c('NA', grades)),
selectInput('h', 'H',c('NA', grades)),
selectInput('i', 'I',c('NA', grades)),
selectInput('j', 'J',c('NA', grades))
)
),
column
(2,
wellPanel
(
h3("Year 3"),
selectInput('k', 'K',c('NA', grades)),
selectInput('l', 'L',c('NA', grades)),
selectInput('m', 'M',c('NA', grades)),
selectInput('n', 'N',c('NA', grades)),
selectInput('o', 'O',c('NA', grades))
)
)
),
conditionalPanel
(
condition = "input.type == 'marks'",
column
(2,
wellPanel
(
h3("Year 1"),
selectInput('a', 'A',c('NA', marks)),
selectInput('b', 'B',c('NA', marks)),
selectInput('c', 'C',c('NA', marks)),
selectInput('d', 'D',c('NA', marks)),
selectInput('e', 'E',c('NA', marks))
)
),
column
(2,
wellPanel
(
h3("Year 2"),
selectInput('f', 'F',c('NA', marks)),
selectInput('g', 'G',c('NA', marks)),
selectInput('h', 'H',c('NA', marks)),
selectInput('i', 'I',c('NA', marks)),
selectInput('j', 'J',c('NA', marks))
)
),
column
(2,
wellPanel
(
h3("Year 3"),
selectInput('k', 'K',c('NA', marks)),
selectInput('l', 'L',c('NA', marks)),
selectInput('m', 'M',c('NA', marks)),
selectInput('n', 'N',c('NA', marks)),
selectInput('o', 'O',c('NA', marks))
)
)
),
column
(4,
actionButton("goButton", "Submit"),
wellPanel
(
h3("Results"),
verbatimTextOutput("value")
)
)
)
)
server <- function(input, output)
{
#Do Prediction
results <- eventReactive(input$goButton,{
if (input$k=="A" | input$f=="A" | input$a=="A" ){
return("result 1")
} else {
return("result 3")
}
})
#Get Results
#results <- c("result 1","result 2","result 3");
output$value <- renderPrint({ results() })
}
shinyApp(ui = ui, server = server)
Upvotes: 2