R Shiny：根据观察事件中的反应表达式检查条件

Question

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?

Answer 1

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"
      )
    }
  })

Answer 2

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")
    }})