I've got a simple app which should have a 'prettySwitch' widget in each row of a reactive table, but for some reason the widgets are displaying as checkboxes.
Here is the code:
library(shiny)
library(shinyWidgets)
library(DT)
Labels <- c(
"Invalid Speciation",
"Invalid Fraction",
"Invalid Unit"
)
Explanations <- c(
"The speciation provided for a given characteristic is not valid. Would you like to remove invalid speciation data?",
"Remote invalid fraction data?",
"Remove data width invalid units for a given characteristic and media combination?"
)
shinyApp(
ui = fluidPage(
DT::dataTableOutput('x1'),
verbatimTextOutput('x2')
),
server = function(input, output, session) {
# create a character vector of shiny inputs
shinyInput = function(FUN, len, id, value, ...) {
if (length(value) == 1) value <- rep(value, len)
inputs = character(len)
for (i in seq_len(len)) {
inputs[i] = as.character(FUN(paste0(id, i), label = NULL, value = value[i]))
}
inputs
}
newInput = function(len, id, value, ...){
if (length(value) == 1) value <- rep(value, len)
inputs = character(len)
for (i in seq_len(len)) {
inputs[i] = as.character(prettySwitch(paste0(id, i), label = NULL, value = value[i], status = "primary", fill = TRUE))
}
inputs
}
# obtain the values of inputs
shinyValue = function(id, len) {
unlist(lapply(seq_len(len), function(i) {
value = input[[paste0(id, i)]]
if (is.null(value)) TRUE else value
}))
}
n = length(Labels)
r <- newInput(n, 'switch_', TRUE)
df = data.frame(
Label = Labels,
Explanation = Explanations,
Remove = r,
stringsAsFactors = FALSE)
loopData = reactive({
df$Remove <<- newInput(n, 'switch_', TRUE, shinyValue('switch_', n))
df
})
output$x1 = DT::renderDataTable(
isolate(loopData()),
escape = FALSE, selection = 'none', rownames=FALSE,
options = list(
dom = 't', paging = FALSE, ordering = FALSE,
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
))
output$x2 = renderPrint({
data.frame(Selected = Labels[shinyValue('switch_', n)])
})
}
)
prettySwitch
creates an object having a HTML dependency which is lost when applying as.character
.
The easiest way is to include a prettySwitch
in your UI (but not in the table) to make this HTML dependency available. If you don't want such a widget in your UI, include it and hide it:
ui = fluidPage(
tags$div(
style = "display: none;",
prettySwitch("dummy", label = NULL)
),
DT::dataTableOutput('x1'),
verbatimTextOutput('x2')
)