Murlidhar Fichadia
Murlidhar Fichadia

Reputation: 2609

Get inputs from Shiny UI app to the server on Submit or Action button

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.

myCode

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)

snapshot of shiny UI App

Upvotes: 3

Views: 1747

Answers (2)

Arnau Muns Orenga
Arnau Muns Orenga

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

Mike Wise
Mike Wise

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

  • the year1 input$a=="A"
  • the year2 input$f=="A"
  • the year3 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

Related Questions