R Shiny, как заставить datatable реагировать на флажки в datatable

Я хотел бы, чтобы моя таблица данных отображала контент, который зависит от состояния флажков, содержащихся в таблице. Я нашел помощь в обоих случаях, включая флажки в DT, а также изменение содержимого таблицы данных, но когда я пытаюсь объединить эти решения, я не получаю то, что хочу. При установке флажка таблица перерисовывается дважды, в первый раз так, как я хочу, но через мгновение она переключается обратно.

Это код, который должен почти делать ... Есть ли кто-нибудь, чтобы помочь, пока я не сойду с ума?

library(shiny)
library(DT)
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, ...) {
      inputs = character(len)
      for (i in seq_len(len)) {
        inputs[i] = as.character(FUN(paste0(id, i), label = NULL, ...))
      }
      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 = 6
    df = data.frame(
      cb = shinyInput(checkboxInput, n, 'cb_', value = TRUE, width='1px'),
      month = month.abb[1:n],
      YN = rep(TRUE, n),
      ID = seq_len(n),
      stringsAsFactors = FALSE)

    loopData = reactive({
      df$YN <<- shinyValue('cb_', n)
      df
    })

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

    output$x2 = renderPrint({
      data.frame(Like = shinyValue('cb_', n))
    })
  }
)

r checkbox shiny dt
person Hans    schedule 18.02.2018    source источник

Ответы (1)


arrow_upward
11
arrow_downward

Да, ваш пример кода почти работает. Неправильно только то, что значение df$cb тоже нужно изменить.

Например, предположим, что вы щелкнули по второй строке, и input$cb_2 изменится. shiny запишет, что input$cb_2 был изменен на FALSE. Поскольку значение df$cb[[2]] по-прежнему было checkbox(..., value = TRUE), когда таблица будет перерисована, будет отображаться отмеченный флажок, и R подумал, что input$cb_2 снова изменился, и поэтому ваши данные будут изменены соответствующим образом.

Проверил пример кода, если что-то не очищено.

Рабочий пример кода

library(shiny)
library(DT)
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
    }

    # 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 = 6
    df = data.frame(
      cb = shinyInput(checkboxInput, n, 'cb_', value = TRUE, width='1px'),
      month = month.abb[1:n],
      YN = rep(TRUE, n),
      ID = seq_len(n),
      stringsAsFactors = FALSE)

    loopData = reactive({
      df$cb <<- shinyInput(checkboxInput, n, 'cb_', value = shinyValue('cb_', n), width='1px')
      df$YN <<- shinyValue('cb_', n)
      df
    })

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

    output$x2 = renderPrint({
      data.frame(Like = shinyValue('cb_', n))
    })
  }
)
person Shrek Tan    schedule 04.05.2018