add shinyWidgets into datatable in R - shiny

Question

I am currently trying to add nice user input from shinyWidgets into a DT datatable.
I tried to follow the example from DT github with the radioButtons, which is working fine :
library(DT)
library(shinyWidgets)
m = data.frame(matrix(
as.character(1:5), nrow = 12, ncol = 5, byrow = TRUE,
dimnames = list(month.abb, LETTERS[1:5])
), stringsAsFactors = F)
for (i in seq_len(nrow(m))) {
m[i, ] = sprintf(
'<input type="radio" name="%s" value="%s"/>',
month.abb[i], m[i, ]
)
}
datatable(m, escape = FALSE, options = list(dom = 't', paging = FALSE, ordering = FALSE))
I would like now to have a sixth column with a likert scale, just like presented here : http://shinyapps.dreamrs.fr/shinyWidgets/
The div information is given when the command is executed in the R console. So I tried to add it just like the radioButtons :
library(DT)
library(shinyWidgets)
m = data.frame(matrix(
as.character(1:5), nrow = 12, ncol = 5, byrow = TRUE,
dimnames = list(month.abb, LETTERS[1:5])
), stringsAsFactors = F)
for (i in seq_len(nrow(m))) {
m[i, ] = sprintf(
'<input type="radio" name="%s" value="%s"/>',
month.abb[i], m[i, ]
)
}
m$new_input <- NA
for (i in seq_len(nrow(m))) {
m[i, 6] = sprintf(
'<div class="form-group shiny-input-container">
<label class="control-label" for="Id102">Your choice:</label>
<input class="js-range-slider sw-slider-text" data-data-type="text" data-force-edges="true" data-from="0" data-from-fixed="false" data-from-shadow="false" data-grid="true" data-hide-min-max="false" data-keyboard="true" data-prettify-enabled="false" data-swvalues="["Strongly disagree","Disagree","Neither agree nor disagree","Agree","Strongly agree"]" data-to-fixed="false" data-to-shadow="false" id="%s"/>
</div>',
paste("slider",month.abb[i], sep = "_")
)
}
datatable(m, escape = FALSE, options = list(dom = 't', paging = FALSE, ordering = FALSE))
Unfortunately, this is clearly not giving the input from shinyWidgets.
Any idea ?

Answer 1

Here is an example.
library(shiny)
library(shinyWidgets)
library(DT)
ui <- fluidPage(
br(),
DTOutput("dt"),
br(),
tags$label("Slider1:"),
verbatimTextOutput("choice1"),
tags$label("Slider2:"),
verbatimTextOutput("choice2")
)
sti <- function(id){
as.character(sliderTextInput(
inputId = id,
label = "Your choice:",
grid = TRUE,
force_edges = TRUE,
choices = c("Disagree", "Agree"))
)
}
js <- c(
"function(settings){",
" $('[id^=slider]').each(function(){",
" $(this).ionRangeSlider({values: $(this).data('swvalues')});",
" });",
"}"
)
server <- function(input, output){
dat <- data.frame(
word = c("hello", "goodbye"),
status = c(sti("slider1"), sti("slider2"))
)
output[["dt"]] <- renderDT({
dtable <- datatable(dat, escape = FALSE,
callback = JS(c('Shiny.unbindAll(table.table().node());',
'Shiny.bindAll(table.table().node());')),
options = list(
initComplete = JS(js)
))
dep1 <- htmltools::htmlDependency(
"ionrangeslider", "2.1.6",
src = "www/shared/ionrangeslider",
script = "js/ion.rangeSlider.min.js",
stylesheet = c("css/ion.rangeSlider.css", "css/ion.rangeSlider.skinShiny.css"),
package = "shiny")
dep2 <- htmltools::htmlDependency(
"strftime", "0.9.2",
src = "www/shared/strftime",
script = "strftime-min.js",
package = "shiny")
dep3 <- htmltools::htmlDependency(
"shinyWidgets", "0.4.5",
src = "www",
script = "shinyWidgets-bindings.min.js",
stylesheet = "shinyWidgets.css",
package = "shinyWidgets")
dtable$dependencies <- c(dtable$dependencies, list(dep1,dep2,dep3))
dtable
}, server = FALSE)
output[["choice1"]] <- renderPrint(input[["slider1"]])
output[["choice2"]] <- renderPrint(input[["slider2"]])
}
shinyApp(ui, server)