Home > database >  R Shiny: Check condition based on reactive expressions in observeEvent
R Shiny: Check condition based on reactive expressions in observeEvent

Time:08-02

I would like to build a Shiny App with two tabs:

In one tab, some values are entered as input. In the next tab, the user can find an output that is based on the values entered in the first tab.

However, before proceeding to the output I want to check if summing up three entries will give the fourth entry. To do so, I want to use reactive expressions that contain the values of the different entries.

Here is an example of what I would like to do:

# clean environment
rm(list = ls(all = TRUE))

library(shiny)

# Create user interface (UI)
u <- tagList(
  navbarPage(
    # UI for input
    title = "",
    id = "Example_App",
    tabPanel("Model input",
             fluidRow(
               column(11, offset = 0,  
                      br(), 
                      h4("Model input"),
                      br(), 
                      sidebarPanel(
                        div(textInput('str_Input1', 'Input 1\n', "",
                                     placeholder = "5.6, 6.7, 4.1"), class = "subheading"),
                        div(textInput('str_Input2', 'Input 2\n', "",
                                      placeholder = "5.6, 6.7, 4.1"), class = "subheading"),
                        div(textInput('str_Input3', 'Input 3\n', "",
                                      placeholder = "5.6, 6.7, 4.1"), class = "subheading"),
                        div(textInput('str_Input4', 'Input 4\n', "",
                                      placeholder = "5.6, 6.7, 4.1"), class = "subheading"),
                        actionButton('jumpToModelOutput', 'Run')),
                      mainPanel(
                        h4('You entered'),
                        verbatimTextOutput("oid_Input1"),
                        verbatimTextOutput("oid_Input2"),
                        verbatimTextOutput("oid_Input3"),
                        verbatimTextOutput("oid_Input4"))))),
    # UI for output
    tabPanel("Model output",
             fluidRow(
               column(11, offset = 0,
                      br(),
                      h4('Your output will be here.'))
                      ))))

# Define server output
s <- shinyServer(function(input, output, session) {

  # Define reactive expressions
  num_Input1 <- reactive(as.numeric(unlist(strsplit(input$str_Input1,","))))
  num_Input2 <- reactive(as.numeric(unlist(strsplit(input$str_Input2,","))))
  num_Input3 <- reactive(as.numeric(unlist(strsplit(input$str_Input3,","))))
  num_Input4 <- reactive(as.numeric(unlist(strsplit(input$str_Input4,","))))
  
  # Define server output for input check
  output$oid_Input1 <- renderPrint({
    cat("Input 1:\n")
    print(num_Input1())
    })
  output$oid_Input2 <- renderPrint({
    cat("Input 2:\n")
    print(num_Input2())
  })
  output$oid_Input3 <- renderPrint({
    cat("Input 3:\n")
    print(num_Input3())
  })
  output$oid_Input4 <- renderPrint({
    cat("Input 4:\n")
    print(num_Input4())
  })
  
  
  # Check if conditions are fulfilled before switching to Model output
  observeEvent(input$jumpToModelOutput, {
     if(!all.equal((num_Input1()   num_Input2()   num_Input3()),num_Input4())){
       showNotification("Error.", type = "error")
     }else{
          updateTabsetPanel(session, "Example_App",
                            selected = "Model output")
        }})

})

# Create the Shiny app 
shinyApp(u, s)

When I enter "1,2,3" into all tabs and press the button, the App stops and I get the following message: "Listening on enter image description here

CodePudding user response:

all.equal returns a string if the elements are not equal, and you can't use a ! on a string. You can first check with isTRUE if it's TRUE or not and then negate it (note: you can't use isFALSE because in case it's not TRUE, all.equal returns a string). If you expect the elements to be exactly equal, you could use identical to make things easier.

I've also summed up all element in each input before adding them, is this what you wanted to do?

# Check if conditions are fulfilled before switching to Model output
  observeEvent(input$jumpToModelOutput, {
    if(!isTRUE(all.equal((sum(num_Input1())   sum(num_Input2())   sum(num_Input3())),sum(num_Input4())))){
      showNotification("Error.", type = "error")
    }else{
      updateTabsetPanel(session, "Example_App",
                        selected = "Model output")
    }})
  • Related