3

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

Community
  • 1
  • 1
Murlidhar Fichadia
  • 2,589
  • 6
  • 43
  • 93

2 Answers2

2

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)
Mike Wise
  • 22,131
  • 8
  • 81
  • 104
  • I appreciate your help, one simple question, before I pull the input values and store it in a vector, I need to find if user selected type as 'Grades' or 'Marks' because then I know whether to use input$f27sa or input$f27sa2. how do I check? I did this: if (input.type == 'marks'){...}else {...} but gives error: object not found 'input.type'. in short how to check which radio button is selected. – Murlidhar Fichadia Apr 05 '17 at 21:19
  • Let me have a look. – Mike Wise Apr 05 '17 at 21:20
  • 1
    I think you need to use "input$type". The "." character has no particular significance in R - unlike Javascript for example. It is just another character. The $ is a selector into a list in R, so I think that is what you mean to use. – Mike Wise Apr 05 '17 at 21:23
  • you have to use validate need try probably – Ferroao Apr 05 '17 at 21:53
  • Yeah, the `input.type` form is used in the UI part where the conditional is passed to javascript. Thus the "." selector instead of the "$" selector. Interesting. Didn't know how `conditionalPanel` worked until now. – Mike Wise Apr 05 '17 at 22:04
2

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.