R Shiny 设置复选框控制值到数据框特定列中的值

Question

我想在加载数据表时将复选框值设置为“YN”列中的相应值。我试图修改我发现的一个示例，该示例使用复选框控件来更新“YN”值。这正是我所需要的，但是，最初复选框的值默认为“TRUE”，而不是 datafame 中的“YN”值。我创建了一个函数“valueFromData”，我认为它最初会填充控件，但是，它似乎不起作用。请建议如何正确实现。非常感谢你。这是代码:

library(shiny)
library(DT)
shinyApp(
  ui = fluidPage(
    DT::dataTableOutput('x1'),
  ),
  
  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
    }
    # obtain the values of check-boxes from 'data'YN'
    valueFromData = function(id, len) {
      print(id)
      print(len)
      unlist(lapply(seq_len(len), function(i) {
        print(i)
        print(df1$YN[i])
        value = print(df1$YN[i])
        #print(value)
        #if (is.null(value)) TRUE else value
      }))
    }
    
    # obtain the values of inputs
    shinyValue = function(id, len) {
      unlist(lapply(seq_len(len), function(i) {
        value = input[[paste0(id, i)]]
        #print(value)
        if (is.null(value)) TRUE else value
      }))
    }
    
    
    n = 10
    df1 = data.frame(
      month = month.abb[1:n],
      YN = rep(c(FALSE, TRUE), times = c(5,5)),
      ID = seq_len(n),
      stringsAsFactors = FALSE
    )
    df2 = data.frame(
      cb = shinyInput(checkboxInput, n, 'cb_', value = valueFromData('cb_', n), width='1px'),
      df1,
      stringsAsFactors = FALSE
      )
    
    loopData = reactive({
      df2$cb <<- shinyInput(checkboxInput, n, 'cb_', value = shinyValue('cb_', n), width='1px')
      df2$YN <<- shinyValue('cb_', n)
      df2
    })
    
    output$x1 = DT::renderDataTable(
      isolate(loopData()),
      escape = FALSE, selection = 'none',
      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()); } ')
      ))
    
    proxy = dataTableProxy('x1')
    
    observe({
      replaceData(proxy, loopData(), resetPaging = FALSE)
    })
    
  }
)

Answer 1

这里有一个方法:

library(shiny)
library(DT)

shinyApp(
  
  ui = fluidPage(
    DTOutput('x1'),
  ),
  
  server = function(input, output, session) {
    
    # create a character vector of shiny inputs
    shinyInput = function(FUN, len, id, value, width) {
      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], width = width))
      }
      inputs
    }

    # obtain the values of inputs
    shinyValue = function(id, len, initial) {
      vapply(seq_len(len), function(i) {
        value = input[[paste0(id, i)]]
        if (is.null(value)) initial[i] else value
      }, FUN.VALUE = logical(1))
    }
    
    n = 10
    YN = rep(c(FALSE, TRUE), times = c(5,5))
    df1 = data.frame(
      cb = shinyInput(checkboxInput, n, 'cb_', 
                      value = YN, width='30px'),
      month = month.abb[1:n],
      YN = YN,
      ID = seq_len(n),
      stringsAsFactors = FALSE
    )

    loopData = reactive({
      values = shinyValue('cb_', n, initial = YN)
      dat = df1
      dat$cb = shinyInput(checkboxInput, n, 'cb_',
                            value = values,
                            width = '30px')
      dat$YN = values
      dat
    })
    
    output$x1 = renderDT(
      df1, class = "display compact",
      escape = FALSE, selection = 'none',
      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()); } ')
      ))
    
    proxy = dataTableProxy('x1')
    
    observe({
      replaceData(proxy, loopData(), resetPaging = FALSE)
    })
    
  }
)

---

编辑

另一种方式，应该更高效:

library(shiny)
library(DT)

df <- data.frame(item = c("a", "b", "c"), YN = c(TRUE, FALSE, FALSE))

shinyCheckbox <- function(id, values) {
  inputs <- character(length(values))
  for(i in seq_along(inputs)) {
    inputs[i] <- 
      as.character(
        checkboxInput(paste0(id, i), label = NULL, value = values[i], width = "20px")
      )
  }
  inputs
}

callback <- c(
  "$('[id^=check]').on('click', function(){",
  "  var id = this.getAttribute('id');",
  "  var i = parseInt(/check(\\d+)/.exec(id)[1]);",
  "  var value = $(this).prop('checked');",
  "  var cell = table.cell(i-1, 2).data(value).draw();",
  "})"
)

server <- function(input, output, session) {
  output$tbl <- renderDT(
    server = FALSE, escape = FALSE, callback = JS(callback),
    options = list(
      dom = 't', paging = FALSE, ordering = FALSE,
      columnDefs = list(
        list(targets = "_all", className = "dt-center"),
        list(targets = 3, width = "20px")
      ),
      preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
      drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
    ), {
      df$check <- shinyCheckbox("check", df$YN)
      df
    }
  )
}

ui <- fluidPage(
  DTOutput("tbl")
)

shinyApp(ui, server)