在R Shiny中将变量索引两次

问题描述

我正在尝试在Shiny应用程序上进行一些集成测试，但是我不知道自己做错了什么。我怀疑这与我尝试访问可能性，颜色和RiskMessage变量时两次使用“ $”有关。 我一直遇到这个错误：

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

这是我的Shiny应用程序代码，我尝试在底部测试Shiny应用程序。任何帮助将不胜感激！

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

  
})

解决方法

Shiny Apps中的

output对象不是您可以尝试访问的列表。相反，它们是HTML对象。闪亮的方式如下：将值存储为根据输入而变化的电抗。检查电抗器是否具有所需的值。

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