如何创建一个动态应用程序，以便在我的表更新时，输入变量选项和输出也更新？

Question

我正在创建一个动态闪亮的应用程序，它的工作方式类似于查找表——它允许用户选择输入值，并作为回报给出两个对应的输出值（一个数字和一个字符），它们存在于同一个表中。

我的代码需要是动态的，这样当数据框改变时，用户界面也会随之改变。例如，如果数据表包含 3 个输入变量而不是 2 个，则侧边栏中需要多一个 selectInput 框。如果一个变量最终有 3 个可能的值而不是 2 个，则需要另一种选择。

因此，我的代码需要：

1. 检查更新的表格，
2. 查看有多少变量并相应地更新侧边栏中的输入选项
3. 更新每个变量的值范围
4. 相应地更新输出。

下面是一个简化的代码：

{
  library(shiny)
  library(shinydashboard)
  library(shinyjs)
}

Test <- data.frame(
  stringsAsFactors = FALSE,
  input1 = c("precarious", "precarious", "good"),
  input2 = c("precarious", "moderate", "precarious"),
  NumericOutput = c(3.737670877,6.688008306,8.565495761),
  CharacterOutput = c("precarious", "moderate", "good")
)

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$input2 == input$b],
                     collapse = ", "),
      subtitle = NULL)
  })
  
  
  output$info_box2 <- renderValueBox({
    valueBox(value = paste0(
      "Assessment: ",
      Test$CharacterOutput[Test$input1 == input$a & Test$input2 == input$b], 
      collapse = ", "),
      subtitle = NULL)
  })
}

shinyApp(ui, server)

Answer 1

这里是代码大纲。我采用了您提供的逻辑 - 输入列是完成过滤的部分，输出列是完成一些聚合的部分。您只请求了动态过滤而不是输出。 data 是被动的，因为从您的文本中可以明显看出您想要更改数据集。您需要在其响应性中编写代码，因为您没有提供除 Testdata.frame 之外的任何信息。

library(shiny)
library(shinydashboard)
library(shinyjs)

Test <- data.frame(
  stringsAsFactors = FALSE,
  input1 = c("precarious", "precarious", "good"),
  input2 = c("precarious", "moderate", "precarious"),
  NumericOutput = c(3.737670877,6.688008306,8.565495761),
  CharacterOutput = c("precarious", "moderate", "good")
)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    uiOutput("dynamicSidebar")
  ),
  dashboardBody(fluidRow(valueBoxOutput("info_box1", width = 6)),
                fluidRow(valueBoxOutput("info_box2", width = 6)))
)

server <- function(input, output){
  
  rv <- reactiveValues()
  data <- reactive({Test})
  
  output$dynamicSidebar <- renderUI({

    req(data())
    
    rv$input_cols <- names(data()) %>% str_subset("^input")
    input_values <- data() %>%
      select(rv$input_cols) %>% 
      map(unique)
    
    rv$input_cols %>%
      map2(input_values, ~selectInput(.x, .x, choices = .y))
  })
  
  observe({
    
    cond <- reactiveValuesToList(input) %>%
      .[rv$input_cols] %>%
      imap(~str_c(.y, "=='", .x, "'")) %>%
      str_c(collapse = "&")
    
    rv$filtered_data <- data() %>%
      filter(eval(parse(text = cond))) 
  })
  
  output$info_box1 <- renderValueBox({
    
    req(rv$filtered_data)
    
    my_value <- if(nrow(rv$filtered_data) > 0){
      str_c(rv$filtered_data[["NumericOutput"]],collapse = ", ")
    } else {
      "empty data"
    }
    
    valueBox(
      subtitle = "Score in %: ",
      value = my_value
    )
  })


  output$info_box2 <- renderValueBox({
    
    req(rv$filtered_data)
    
    my_value <- if(nrow(rv$filtered_data) > 0){
      str_c(rv$filtered_data[["CharacterOutput"]], collapse = ", ")
    } else {
      "empy data"
    }
    
    valueBox(
      subtitle = "Assessment:",
      value = my_value
    )
  })
}

shinyApp(ui, server)