如何根据 ui 中选择的输入值在服务器中获取 output 值？

Question

我正在尝试创建一个 shiny 应用程序，该应用程序的工作方式类似于查找表——我使用数据框中的多个列作为侧边栏中的输入变量，并根据用户从下拉列表中选择的输入，我试图获得一个对应 output 用于存在于同一个表中的两个变量（一个数字和一个字符）。

但是，当我尝试链接我的输入以在服务器代码中获取匹配的 output 时，我的数字 output 变量出现以下错误：“警告：writeImpl 中的错误：要写入的文本必须是长度为一的字符向量”以及我的角色 output 变量的以下错误：“操作只能用于数字、逻辑或复杂类型”。

我需要帮助解决这个问题，谢谢。 我附上了我的简化代码和数据，其中包含两个输入和两个 output 变量以供参考。

这是我的数据：

"input1","input2","NumericOutput","CharacterOutput"
"precarious","precarious",0,"precarious"
"precarious","precarious",2.950337429,"precarious"
"precarious","precarious",4.827824883,"precarious"
"precarious","precarious",8.314587299,"precarious"
"precarious","precarious",7.276345388,"precarious"
"precarious","precarious",10.22668282,"precarious"
"precarious","precarious",12.10417027,"precarious"
"precarious","precarious",15.59093269,"precarious"
"precarious","precarious",0.622945146,"precarious"
"precarious","precarious",3.573282575,"precarious"
"precarious","precarious",5.450770029,"precarious"
"precarious","precarious",8.937532445,"precarious"
"precarious","precarious",7.899290535,"precarious"
"precarious","precarious",10.84962796,"precarious"
"precarious","precarious",12.72711542,"precarious"
"precarious","precarious",16.21387783,"precarious"
"precarious","precarious",3.737670877,"precarious"
"precarious","moderate",6.688008306,"precarious"
"good","precarious",8.565495761,"precarious"

这是我的代码：

## loading packages
{
  library(shiny)
  library(shinydashboard)
  library(htmltools)
  library(rvest)
  library(XML)
  library(measurements)
  library(ggplot2)
  library(ggrepel)
  library(plotly)
  library(shinyjs)
  library(shinyWidgets)
}

Test <- read.csv("Test.csv", stringsAsFactors = FALSE)
summary(Test)
lapply(Test,class)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    
    useShinyjs(), 
    
    selectInput ("a",label = colnames(Test[1]),
                 choices = (Test[[1]])),
    
    selectInput("b",colnames(Test[2]),
                choices = Test[[2]])
    
  ),
  
  dashboardBody(
    
    fluidRow(valueBoxOutput("info_box1", width = 6)),
    
    fluidRow(valueBoxOutput("info_box2", width = 6))
    
  )
)



server <- function(input, output) {
  
  output$info_box1 <- renderValueBox({
    valueBox(value = paste0("Score in %: ", 
                            Test$NumericOutput[Test$input1 == input$a]
                            & Test$NumericOutput[Test$input2 == input$b]),
             subtitle = NULL)  })
  
  
  output$info_box2 <- renderValueBox({
    valueBox(value = paste0("Assessment: ",(Test$CharacterOutput[Test$input1 == input$a])&
                              (Test$CharacterOutput[Test$input2 == input$b])),
             subtitle = NULL)
  })
  
  
}

shinyApp(ui, server)

Answer 1

欢迎来到stackoverflow，上面代码的问题是。 您提供的用于填充 selectInput 的选项并未识别 data.frame 的单行，但是valueBox的 value-argument 需要一个字符串。

我不确定您的预期结果是什么，但也许以下内容有助于理解问题所在：

## loading packages
{
  library(shiny)
  library(shinydashboard)
  library(shinyjs)
}

Test <- data.frame(
  stringsAsFactors = FALSE,
  input1 = c("precarious","precarious",
             "precarious","precarious","precarious","precarious",
             "precarious","precarious","precarious","precarious",
             "precarious","precarious","precarious","precarious",
             "precarious","precarious","precarious","precarious","good"),
  input2 = c("precarious","precarious",
             "precarious","precarious","precarious","precarious",
             "precarious","precarious","precarious","precarious",
             "precarious","precarious","precarious","precarious",
             "precarious","precarious","precarious","moderate",
             "precarious"),
  NumericOutput = c(0,2.950337429,4.827824883,
                    8.314587299,7.276345388,10.22668282,12.10417027,
                    15.59093269,0.622945146,3.573282575,5.450770029,8.937532445,
                    7.899290535,10.84962796,12.72711542,16.21387783,
                    3.737670877,6.688008306,8.565495761),
  CharacterOutput = c("precarious","precarious",
                      "precarious","precarious","precarious","precarious",
                      "precarious","precarious","precarious","precarious",
                      "precarious","precarious","precarious","precarious",
                      "precarious","precarious","precarious","precarious",
                      "precarious")
)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    useShinyjs(),
    selectInput("a", label = colnames(Test[1]),
                choices = unique(Test[[1]])),
    selectInput("b", colnames(Test[2]),
                choices = unique(Test[[2]]))
  ),
  dashboardBody(fluidRow(valueBoxOutput("info_box1", width = 6)),
                fluidRow(valueBoxOutput("info_box2", width = 6)))
)

server <- function(input, output) {
  output$info_box1 <- renderValueBox({
    valueBox(
      value = paste0("Score in %: ",
                     Test$NumericOutput[Test$input1 == input$a],
                     Test$NumericOutput[Test$input2 == input$b], collapse = ", "),
      subtitle = NULL)
  })
  output$info_box2 <- renderValueBox({
    valueBox(value = paste0(
      "Assessment: ",
      Test$CharacterOutput[Test$input1 == input$a],
      Test$CharacterOutput[Test$input2 == input$b], collapse = ", "),
    subtitle = NULL)
  })
}

shinyApp(ui, server)

Answer 2

通过检查所有条件，而不仅仅是满足任何一个条件，我基本上需要一个 output 变量的 output 值。

而不是使用 Test$NumericOutput[Test$input1 == input$a] & Test$NumericOutput[Test$input2 == input$b]

我使用了 Test$NumericOutput[Test$input1 == input$a & Test$input2 == input$b] 并且它有效。