Indexing a variable twice in R shiny

Question

I'm trying to do some integration testing on my Shiny app, but I don't know what I'm doing wrong. I suspect it has to do with the fact I used the "$" twice when trying to access the likelihood, color, and riskMessage variables. I keep running into this error:

Error in checkEqualsNumeric(output$coloredBox$likelihoodOfHarm, 0.75) : 
  Modes: NULL, numeric
Lengths: 0, 1
target is NULL, current is numeric

Here is my Shiny app code, with my attempt to test the Shiny app at the bottom. Any help is greatly appreciated!

displayColoredBox<- function(color, riskMessage){
  sidebarPanel(style=sprintf("background-color: %s; width: 300px; height: 300px;", color),
               h3(sprintf("%s", riskMessage)) )  }

app <- shinyApp(
  ui = fluidPage(
    
    div(
      id = "form",
      sliderInput("count1", "First Slider Input", value=0, min=0, max=5000),
      sliderInput("count2", "Second Slider Input", value=0, min=0, max=5000),
      uiOutput("coloredBox")
    )),
  
  server <- function(input, output, session) {
    
    output$coloredBox<-renderUI({
      req(input$count1)
      req(input$count2)
      
      count1 <- input$count1;
      count2 <- input$count2;
      
      likelihood <- (count1*count2)/5000000
      
      if (likelihood>1) {
        color="red"
        riskMessage="Extreme risk!"
        
      } else if (likelihood>.65){
        color="orange"
        riskMessage="Very high risk!"
      }
      else if (likelihood>.35){
        color="yellow"
        riskMessage="High risk!"
      }
      else if (likelihood>.10){
        color="blue"
        riskMessage="Moderate risk!"
      } else {
        color="green"
        riskMessage="Low risk!"
      }
      
      coloredBox=displayColoredBox(color, riskMessage)
      
    })
  }
)

testServer(app, {
  session$setInputs(count1 = 1500)
  session$setInputs(count2 = 2500)

  checkEqualsNumeric(output$coloredBox$likelihood, 0.75)
  checkEquals(output$coloredBox$riskMessage, "Very high risk!")
  checkEquals(output$coloredBox$color, "orange")

  
})

Answer 1

output objects in Shiny Apps are not lists that you can access in the way you are trying to. In contrast, they are HTML objects. The shiny-way would be the following: Store your values as reactives that change according to the inputs. Check if the reactives have the desired values.

displayColoredBox<- function(color, riskMessage){
  sidebarPanel(style=sprintf("background-color: %s; width: 300px; height: 300px;", color),
               h3(sprintf("%s", riskMessage)) )  }

library(RUnit)
app <- shinyApp(
  ui = fluidPage(
    
    div(
      id = "form",
      sliderInput("count1", "First Slider Input", value=0, min=0, max=5000),
      sliderInput("count2", "Second Slider Input", value=0, min=0, max=5000),
      uiOutput("coloredBox")
    )),
  
  server <- function(input, output, session) {
    
    likelihood <- reactive((input$count1*input$count2)/5000000)
    boxValues <- reactiveValues(color="", riskMessage="")
    
    observe({
      req(input$count1)
      req(input$count2)
      if (likelihood()>1) {
        boxValues$color="red"
        boxValues$riskMessage="Extreme risk!"
        
      } else if (likelihood()>.65){
        boxValues$color="orange"
        boxValues$riskMessage="Very high risk!"
      }
      else if (likelihood()>.35){
        boxValues$color="yellow"
        boxValues$riskMessage="High risk!"
      }
      else if (likelihood()>.10){
        boxValues$color="blue"
        boxValues$riskMessage="Moderate risk!"
      } else {
        boxValues$color="green"
        boxValues$riskMessage="Low risk!"
      }
    })
    
    
    output$coloredBox<-renderUI({
      displayColoredBox(boxValues$color, boxValues$riskMessage)
    })
  }
)


testServer(app, {
  session$setInputs(count1 = 1500)
  session$setInputs(count2 = 2500)
  
  checkEquals(likelihood(), 0.75)
  checkEquals(boxValues$riskMessage, "Very high risk!")
  checkEquals(boxValues$color, "orange")
  
  
})