漂亮切换渲染为复选框

Question

我有一个简单的应用程序，它应该在反应表的每一行中都有一个“prettySwitch”小部件，但由于某种原因，这些小部件显示为复选框。

代码如下：

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

Answer 1

prettySwitch

创建一个具有 HTML 依赖性的对象，该对象在应用

as.character

.

时丢失

最简单的方法是在您的 UI 中包含一个

prettySwitch

（但不在表中）以使此 HTML 依赖项可用。如果您不想在 UI 中使用这样的小部件，请包含并隐藏它：

  ui = fluidPage(
    tags$div(
      style = "display: none;",
      prettySwitch("dummy", label = NULL)
    ),
    DT::dataTableOutput('x1'),
    verbatimTextOutput('x2')
  )