在DT表格中使用Shiny小部件

Question

在DT表格中使用Shiny小部件

6

我正在尝试将像textInput、selectInput（单选）、sliderInput和selectInput（多选）这样的shiny小部件包含在DT表格的行中。当小部件直接放在页面上时，它们会正确显示，但是当将它们放入表格中时，其中一些小部件无法正确显示。

textInput正常，selectInput（单选）大部分正常，除了一些CSS差异，但selectInput（多选）不正确显示，sliderInput肯定不正确显示。似乎依赖于javascript的小部件有问题。有没有办法使这些小部件在DT表格中正确工作？

以下是我的可重现示例。当将它们放入表格中时，我使用了小部件的原始HTML，但是我直接从每个小部件的shiny函数生成的HTML中获取了这些代码。

library(shiny)
library(DT)

ui <- fluidPage(
  h3("This is how I want the widgets to look in the DT table."),
  fluidRow(column(3, textInput(inputId = "text",
                               label = "TEXT")),
           column(3, selectInput(inputId = "single_select",
                                 label = "SINGLE SELECT",
                                 choices = c("", "A", "B", "C"))),
           column(3, sliderInput(inputId = "slider",
                                 label = "SLIDER",
                                 min = 0,
                                 max = 10,
                                 value = c(0, 10))),
           column(3, selectizeInput(inputId = "multiple_select",
                                    label = "MULTIPLE SELECT",
                                    choices = c("", "A", "B", "C"),
                                    multiple = TRUE))),
  h3("This is how they actually appear in a DT table."),
  fluidRow(DTOutput(outputId = "table"))
)

server <- function(input, output, session) {

  output$table <- renderDT({
    data <- data.frame(ROW = 1:5,
                       TEXT = '<input id="text" type="text" class="form-control" value=""/>',
                       SINGLE_SELECT = '<select id="single_select" style="width: 100%;">
                                          <option value="" selected></option>
                                          <option value="A">A</option>
                                          <option value="B">B</option>
                                          <option value="C">C</option>
                                        </select>',
                       SLIDER = '<input class="js-range-slider" id="slider" data-type="double" data-min="0" data-max="10" data-from="0" data-to="10" data-step="1" data-grid="true" data-grid-num="10" data-grid-snap="false" data-prettify-separator="," data-prettify-enabled="true" data-keyboard="true" data-drag-interval="true" data-data-type="number"/>',
                       MULTIPLE_SELECT = '<select id="multiple_select" class="form-control" multiple="multiple">
                                            <option value=""></option>
                                            <option value="A">A</option>
                                            <option value="B">B</option>
                                            <option value="C">C</option>
                                          </select>',
                       stringsAsFactors = FALSE)

    datatable(data = data,
              selection = "none",
              escape = FALSE,
              rownames = FALSE)
  })

}

shinyApp(ui = ui, server = server)

- mosk915

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Stéphane Laurent · Accepted Answer

滑块

对于滑块，您需要从文本输入框开始：

SLIDER = '<input type="text" id="s" name="slider" value="" />'

然后使用JavaScript将其转换为滑块：

js <- c(
  "function(settings){",
  "  $('#s').ionRangeSlider({",
  "    type: 'double',",
  "    grid: true,",
  "    grid_num: 10,",
  "    min: 0,",
  "    max: 20,",
  "    from: 5,",
  "    to: 15",
  "  });",
  "}"
)

更多选项请参阅ionRangeSlider。

您可以使用initComplete选项传递JavaScript代码：

server <- function(input, output, session) {

  output$table <- renderDT({
    data <- data.frame(ROW = 1:5,
                       TEXT = '<input id="text" type="text" class="form-control" value=""/>',
                       SINGLE_SELECT = '<select id="single_select" style="width: 100%;">
                       <option value="" selected></option>
                       <option value="A">A</option>
                       <option value="B">B</option>
                       <option value="C">C</option>
                       </select>',
                       SLIDER = '<input type="text" id="s" name="slider" value="" />',
                       MULTIPLE_SELECT = '<select id="multiple_select" class="form-control" multiple="multiple">
                       <option value=""></option>
                       <option value="A">A</option>
                       <option value="B">B</option>
                       <option value="C">C</option>
                       </select>',
                       stringsAsFactors = FALSE)

    datatable(data = data,
              selection = "none",
              escape = FALSE,
              rownames = FALSE, 
              options = 
                list(
                  initComplete = JS(js)
                ))
  })

}

然后你仅针对第一行获取滑块：

这是因为这五个文本输入框具有相同的id。您必须为这五个文本输入框设置不同的id：

SLIDER = sapply(1:5, function(i) {
  sprintf('<input type="text" id="Slider%d" name="slider" value="" />', i)
}),

然后使用这段 JavaScript 代码将它们转换为滑块：

js <- c(
  "function(settings){",
  "  $('[id^=Slider]').ionRangeSlider({",
  "    type: 'double',",
  "    grid: true,",
  "    grid_num: 10,",
  "    min: 0,",
  "    max: 20,",
  "    from: 5,",
  "    to: 15",
  "  });",
  "}"
)

为了设置from和to的初始值，最好将它们作为输入文本框的value参数进行指定，例如:

SLIDER = sapply(1:5, function(i) {
  sprintf('<input type="text" id="Slider%d" name="slider" value="5;15" />', i)
})

js <- c(
  "function(settings){",
  "  $('[id^=Slider]').ionRangeSlider({",
  "    type: 'double',",
  "    grid: true,",
  "    grid_num: 10,",
  "    min: 0,",
  "    max: 20",
  "  });",
  "}"
)

多选

要获取多选框的所需显示效果，您需要调用selectize()：

MULTIPLE_SELECT = '<select id="mselect" class="form-control" multiple="multiple">
                       <option value=""></option>
                       <option value="A">A</option>
                       <option value="B">B</option>
                       <option value="C">C</option>
                    </select>'
js <- c(
  "function(settings){",
  "  $('[id^=Slider]').ionRangeSlider({",
  "    type: 'double',",
  "    grid: true,",
  "    grid_num: 10,",
  "    min: 0,",
  "    max: 20",
  "  });",
  "  $('#mselect').selectize()",
  "}"
)

同样地，这只适用于第一个多选框。使用单独的 id 来应用于剩余的五个。

绑定

最后，您必须绑定输入以便在 Shiny 中使用它们的值：

datatable(data = data,
          selection = "none",
          escape = FALSE,
          rownames = FALSE, 
          options = 
            list(
              initComplete = JS(js),
              preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
              drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
            )
)

现在您可以获得input$Slider1、input$Slider2等的值，以及input$mselect的值。请注意，input$Slider[1/2/3/4/5]以这种格式返回滑块的值："3;15"。