在Shiny应用上进行集成测试

问题描述

我正试图在这个闪亮的应用程序上使用集成测试，但是在阅读了该应用程序后，我不确定自己做错了什么。我不断收到此错误：isModuleServer（app）中的错误：找不到对象“会话” 我也收到此错误：错误：找不到对象“输出”

感谢您的帮助。

library(shiny)
displayColoredBox<- function(color,riskMessage){
  sidebarPanel(style=sprintf("background-color: %s; width: 300px; height: 300px;",color),h3(sprintf("%s",riskMessage)) )  }
shinyApp(
  ui = fluidPage(
    
    div(
      id = "form",sliderInput("count1","First Slider Input",value=0,min=0,max=5000),sliderInput("count2","Second Slider Input",uIoUtput("coloredBox")
    )),server <- function(input,output) {
    
    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!"
      }
      
      displayColoredBox(color,riskMessage)
      
    })
  }
)

testServer({
  session$setInputs(count1 = 1500)
  session$setInputs(count2 = 2500)
  
  stopifnot(output$likelihood == 0.75)
  stopifnot(output$riskMessage == "Very high risk!")
  stopifnot(output$color == "orange")
  
})

解决方法

将您的应用分配给一个对象，该对象必须是testServer的第一个参数。另外，声明您的server函数具有一个session参数。

编辑：为了在shinyTest中使用变量，我们使用了reactive，它返回了list以及要测试的组件。

app <- shinyApp(
  ui = fluidPage(
    
    div(
      id = "form",sliderInput("count1","First Slider Input",value=0,min=0,max=5000),sliderInput("count2","Second Slider Input",uiOutput("coloredBox")
    )),server <- function(input,output,session) {
    getRiskAndColor<-reactive({
      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!"
      }
      list(color=color,riskMessage=riskMessage,likelihood=likelihood)
    })
    
    output$coloredBox<-renderUI({
      colorRisk<-getRiskAndColor()
      displayColoredBox(colorRisk$color,colorRisk$riskMessage)
      
    })
  }
)

接下来，我们向testServer提供app。请注意，getRiskAndColor反应值及其组成部分是可访问的。

testServer(app,{
  session$setInputs(count1 = 1500)
  session$setInputs(count2 = 2500)
  rc<-getRiskAndColor()
  stopifnot(rc$likelihood == 0.75)
  cat("Correct likelihood value!\n")
  stopifnot(rc$riskMessage == "Very high risk!")
  cat("Correct risk message!\n")
  stopifnot(rc$color == "orange")
  cat("Correct color!\n")
})

#Correct likelihood value!
#Correct risk message!
#Correct color!    

成功！