Search code examples
rshinytabsreactiveaction-button

R Shiny: Check condition based on reactive expressions in observeEvent


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 http://127.0.0.1:3925 Warning: Error in !: invalid argument type"

Removing the ! gives the following message: Warning: Error in if: argument is not interpretable as logical

As far as I get the messages, the reactive expressions are not interpreted as numeric (?) but summing them up and printing them gives correct results.

Could anyone please help me finding the problem?


Solution

  • The issue is that all.equal returns a string containing a report of the difference in the passed values. That's why the docs (see ?all.equal) state:

    Do not use all.equal directly in if expressions—either use isTRUE(all.equal(....)) or identical if appropriate.

    Hence, to fix your issue wrap inside isTRUE:

    observeEvent(input$jumpToModelOutput, {
        if (!isTRUE(all.equal(num_Input1() + num_Input2() + num_Input3(), num_Input4()))) {
          showNotification("Error.", type = "error")
        } else {
          updateTabsetPanel(session, "Example_App",
            selected = "Model output"
          )
        }
      })
    

    enter image description here