如何根據 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] 並且它有效。