如何包含多个输入法并在 DT 中呈现输出

Question

我正在使用 Shiny 创建和实施一项调查。其中一个问题是典型的 matrix/battery 问题，底部两行是回答问题的两种不同方式。第一个是一行复选框，允许受访者 select 多列，以及一行单选按钮，只允许他们 select 一列。

我已经能够仅使用一行单选按钮或多行单选按钮来创建矩阵问题。我还能够运行 this 使用文本和复选框输入的示例，但是每当我包含单选按钮时，一切似乎都停止工作。

下面是一个简单的示例，可以让您了解我想要做什么。我省略了提交按钮，但包括了 y1 和 y2 的输出，以表明当按钮被 selected 时似乎断开连接。

# UI
ui <- fluidPage(DT::dataTableOutput("X1"),
                verbatimTextOutput("y1"),
                verbatimTextOutput("y2"))

# Server
server <- function (input, output) {
  # Set up matrix
  X <- matrix(runif(10), nrow = 2)

  # Create the HTML for radio buttons
  radio_buttons <- matrix(0, nrow = nrow(X), ncol = 1)
  checkbox_buttons <- matrix(0, nrow = nrow(X), ncol = 1)
  for (i in seq_len(nrow(X))) {
    radio_buttons[i, ] <- sprintf('<input type = "radio" name = "%s" value = "%s"/>',
                                  paste0("y1"), i)
    checkbox_buttons[i, ] <- sprintf('<input type = "checkbox" name = "%s" value = "%s"/>',
                                    paste0("y2"), i)
  }

  # Add to X
  X <- cbind(X, checkbox_buttons, radio_buttons)

  # Render the table
  output$X1 <- DT::renderDataTable(
    t(X), server = FALSE, escape = FALSE, selection = 'none', options = list(
      dom = "t", paging = FALSE, ordering = FALSE,
      preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
      drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
    )
  )

  output$y1 <- renderPrint({input$y1})
  output$y2 <- renderPrint({input$y2})
}

# App
shinyApp(ui = ui, server = server)

table 渲染良好，但似乎输入值未注册。

任何解决方案的想法将不胜感激。

注意！真正的table更大，列数是动态创建的。我还将实现最多检查三个框。

Answer 1

问题

您的代码有几个问题：

复选框元素需要引用 id 属性。
单选按钮需要一个带有 id 和 class = "shiny-input-radiogroup" 的父元素（tr 是一个合适的元素）-> 我们需要通过 JavaScript 添加在回调函数中。
您想为您的输入 y1 和 y2 命名，但这已经是您的输出的名称。

代码

library(shiny)
library(DT)

# UI
ui <- fluidPage(DT::dataTableOutput("X1"),
                verbatimTextOutput("y1"),
                verbatimTextOutput("y2"))

# Server
server <- function (input, output) {
  # Set up matrix
  X <- matrix(runif(10), nrow = 2)

  # Create the HTML for radio buttons
  radio_buttons <- matrix(0, nrow = nrow(X), ncol = 1)
  checkbox_buttons <- matrix(0, nrow = nrow(X), ncol = 1)
  for (i in seq_len(nrow(X))) {
    radio_buttons[i, ] <- sprintf('<input type = "radio" name = "%s" value = "%s" %s/>',
                                  paste0("rb_1"), i, ifelse(i==1, 'checked = "checked"', ""))
    checkbox_buttons[i, ] <- sprintf('<input type = "checkbox" value = "%s" id = "%s" />',
                                     i, paste0("cb_", i))
  }

  # Add to X
  X <- cbind(X, checkbox_buttons, radio_buttons)

  # Render the table
  output$X1 <- DT::renderDataTable(
    t(X), server = FALSE, escape = FALSE, selection = 'none', options = list(
      dom = "t", paging = FALSE, ordering = FALSE,
      drawCallback = JS('function() {
                           var $radio_row = $(\'tr:has(input[name="rb_1"])\');
                           var $row = this.api().table().rows($radio_row);
                           var $this = $($row.nodes(0));
                           $this.attr("id", "rb_1");
                           $this.addClass("shiny-input-radiogroup");
                           Shiny.unbindAll(this.api().table().node());
                           Shiny.bindAll(this.api().table().node());
                         }')
    )
  )

  output$y1 <- renderPrint({list(input$cb_1, input$cb_2)})
  output$y2 <- renderPrint(input$rb_1)
}

# App
shinyApp(ui = ui, server = server)

如何包含多个输入法并在 DT 中呈现输出

How to include multiple input methods and render the output in DT

r

shiny

dt