RShiny UI 子选项复选框？

Question

我有一个基本的 RShiny 应用程序，它有一个反应式复选框，它根据复选框中选择的数据（df 列）绘制时间序列数据。我当前的代码生成一个带有复选框输入的 UI，如下所示：

    # Load R packages
library(shiny)
library(shinyBS)

##example df in similar format to the data I'm working with
Both <- data.frame(
  Year  = c("1990", "1991", "1992", "1993"),
  SST_anomaly_GOM = c("-1.1", "0.23", "0.87", "-0.09"),
  SST_anomaly_GB = c("-1.1", "0.23", "0.87", "-0.09"),
  SST_anomaly_MAB = c("-1.1", "0.23", "0.87", "-0.09"),
  BT_anomaly_GOM = c("-2.5", "0.55", "1.20", "-0.19"),
  BT_anomaly_GB = c("-1.1", "0.05", "1.24", "-0.29"),
  BT_anomaly_MAB = c("-1.1", "-1.08", "0.67", "-2.40")
)

# Define UI
ui <- fluidPage(
  # useShinyBS
    "Visualizing Indicators", #app title
    tabPanel("",      # tab title
             sidebarPanel(width=6,
                          
                          checkboxGroupInput("variable", label = "Checkbox", choiceNames  = gsub("_", " ", colnames(Both[2:7])), 
                                                choiceValues = colnames(Both[2:7]), 
                                                ),
             ), # sidebarPanel
    ), #tabPanel
) # fluidPage

#Define Server:
server<- function (input,output){
   output$rendered <-   renderUI({
    })
}
# Create Shiny object
shinyApp(ui = ui, server = server)

这会产生这样的界面：

这很好，但有点重复，并且随着我最终想要包含到此列表中的更多时间序列变量，这对于用户筛选来说可能会很麻烦，并且会占用 UI 上的大量空间来列出此列表中的所有内容方式。

我的问题是如何调整我的代码，使其生成一个列出了唯一变量的界面，然后是每个感兴趣的子区域的复选框？（GOM、BG、MAB 等）我想到的一个例子是一个看起来更像这样的界面：

这可能吗？这对于我当前格式的 df 是否可能（例如我的示例 df 称为“两者”）。

谢谢！

Answer 1

为了为您的解决方案创建答案，我使用该DT包实现了一个复选框组输入。该解决方案分为两部分： 1.Helper功能。2. App.

示例图像

辅助函数

第一个辅助函数创建一个包含checkbox输入的数据表，每个输入都有一个唯一的id行名和列名的组合。

第二个辅助函数评估构造表中每个复选框的“选中”状态，返回一个矩阵，其中包含复选框表中每个单元格的TRUE/值。FALSE

应用程序

应用程序代码非常简单。

首先，我们使用第一个辅助函数创建一个示例表。

然后，我们使用 DT 渲染表格，确保禁用escape（以便可以渲染复选框）表格上的sorting、paging、 和。selection最重要的是，我们发送preDrawCallback和drawCallback JS函数来确保复选框已注册到shiny.

最后，每当用户与表格交互时，我们都会调用第二个辅助函数来评估复选框状态。您可以使用该信息做任何您想做的事情。

代码

# Checkbox Table Demo

library(shiny)
library(DT)


#### Helper Functions ####
#' Construct a checkbox table for an app.
construct_checkbox_table <- function(rows,
                                     cols,
                                     rownames,
                                     colnames) {
  checkbox_table <- matrix(
    character(),
    nrow = rows,
    ncol = cols,
    dimnames = list(rownames, colnames)
  )
  
  for (i in seq_len(rows)) {
    for (j in seq_len(cols)) {
      checkbox_table[i, j] <-
        sprintf(
          '<input id="%s,%s" type="checkbox" class="shiny-bound-input" />',
          rownames[[i]],
          colnames[[j]]
        )
    }
  }
  
  checkbox_table
}

#' Get the status of checkboxes in a checkbox table.
evaluate_checkbox_table_status <- function(input, input_table) {
  table_status <-
    matrix(
      logical(),
      nrow = nrow(input_table),
      ncol = ncol(input_table),
      dimnames = list(rownames(input_table), colnames(input_table))
    )
  
  table_rownames <- rownames(input_table)
  table_colnames <- colnames(input_table)
  
  for (i in seq_len(nrow(input_table))) {
    for (j in seq_len(ncol(input_table))) {
      table_status[i, j] <-
        input[[sprintf("%s,%s", table_rownames[[i]], table_colnames[[j]])]]
    }
  }
  
  table_status
}
#### End Helper Functions ####


#### App ####
# Create an example checkbox input table to use for the app
example_checkbox_table <-
  construct_checkbox_table(
    2,
    4,
    rownames = c("Annual Bottom Temp Absolute", "Bottom Temp Anomoly"),
    colnames = c("GOM", "GB", "MAB", "SS")
  )

ui <- fluidPage(DT::DTOutput("selection_table"),
                verbatimTextOutput("table_selections"),)

server <- function(input, output, session) {
  output$selection_table <- DT::renderDT({
    DT::datatable(
      example_checkbox_table,
      escape = FALSE,
      selection = "none",
      options = list(
        dom = "t",
        ordering = FALSE,
        paging = FALSE,
        preDrawCallback = JS(
          'function() { Shiny.unbindAll(this.api().table().node()); }'
        ),
        drawCallback = JS(
          'function() { Shiny.bindAll(this.api().table().node()); } '
        )
      )
    )
  }, server = FALSE)
  
  observeEvent(input$selection_table_cell_clicked, {
    output$table_selections <- renderPrint({
      evaluate_checkbox_table_status(input, example_checkbox_table)
    })
  })
}
#### End App ####

shinyApp(ui, server)