Shiny widgets in DT Table

Question

I\'m trying to include shiny widgets such as textInput, selectInput (single), sliderInput, and selectInput (multiple) in the rows of a DT table. When the widgets are direct

Answer 1

Sliders

For the sliders, you have to start with a text input:

SLIDER = ''

and then turn it into a slider with JavaScript:

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

See ionRangeSlider for the options.

You can pass the JavaScript code with the initComplete option:

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

  output$table <- renderDT({
    data <- data.frame(ROW = 1:5,
                       TEXT = '',
                       SINGLE_SELECT = '
                       
                       A
                       B
                       C
                       ',
                       SLIDER = '',
                       MULTIPLE_SELECT = '
                       
                       A
                       B
                       C
                       ',
                       stringsAsFactors = FALSE)

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

}

Then you get the slider for the first row only:

That's because the five text inputs have the same id. You have to set a different id for the five text inputs:

SLIDER = sapply(1:5, function(i) {
  sprintf('', i)
}),

Then use this JavaScript code to turn them into sliders:

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

To set the initial values of from and to, it's better to give them in the value argument of the input text like this:

SLIDER = sapply(1:5, function(i) {
  sprintf('', i)
})

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

Multiple selects

To get the desired display of a multiple select, you have to call selectize():

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

Similarly, this applies to the first multiple select only. Use individual id's to apply to the five ones.

Binding

Finally, you have to bind the inputs to get their value available in 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()); } ')
            )
)

Now you can get the values in input$Slider1, input$Slider2, ..., and input$mselect. Note that input$Slider[1/2/3/4/5] returns the values of the slider in this format: "3;15".