Блестящие виджеты в DT Table - PullRequest
Новая
       44

Блестящие виджеты в DT Table

1 голос
/ 07 марта 2019

Я пытаюсь включить блестящие виджеты, такие как textInput, selectInput (single), sliderInput и selectInput (множественный) в строках таблицы DT.Когда виджеты находятся непосредственно на странице, они отображаются правильно, однако, когда они помещены в таблицу, некоторые из них отображаются неправильно.

textInput в порядке, а selectInput (single) в основном в порядкесохранить для некоторых различий CSS, но selectInput (несколько) не отображается правильно, и sliderInput определенно не отображается правильно.Кажется, что виджеты, которые полагаются на JavaScript, имеют проблемы.Есть ли способ заставить эти виджеты корректно работать в таблице DT?

Вот мой воспроизводимый пример.Я использовал необработанный 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)

1 Ответ

4 голосов
/ 07 марта 2019

Слайдеры

Для слайдеров вы должны начать с ввода текста: 

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 для вариантов.

Вы можете передать код JavaScript с опцией initComplete: 

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)
                ))
  })

}

Затем вы получите ползунок для первой строкитолько:

enter image description here

Это потому, что пять текстовых входов имеют одинаковый идентификатор.Вы должны установить другой идентификатор для пяти текстовых вводов: 

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

enter image description here

Чтобы установить начальные значения 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] возвращает значения ползунка в следующем формате: "3;15".

...