DT表中的閃亮小部件

Question

我正在嘗試在DT表的行中包含閃亮的窗口小部件，例如textInput，selectInput（單個），sliderInput和selectInput（多個）。 當窗口小部件直接位於頁面上時，它們將正確顯示，但是，當將它們放在表中時，其中的一些窗口將無法正確顯示。

除了一些CSS差異之外，textInput很好，而selectInput（單個）在大多數情況下都很好，但是selectInput（多個）不能正確顯示，並且sliderInput絕對不能正確顯示。 看來依賴javascript的小部件就是有問題的小部件。 有沒有辦法使這些小部件在DT表中正常工作？

這是我的可復制示例。 將小部件放在表中時，我使用了原始HTML，但是我直接從每個小部件的閃亮函數生成的HTML中獲取了原始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)

Answer 1

滑桿

對於滑塊，必須從文本輸入開始：

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()",
  "}"
)

同樣，這僅適用於第一個多重選擇。 使用個人編號將其應用於五個編號。

捆綁

最后，您必須綁定輸入以使其在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]以以下格式返回input$Slider[1/2/3/4/5]的值： "3;15" 。