R Shiny 根据同一 table 内的反应性更新 DT 单元

Question

我正在尝试更新数据table 对象（在 Shiny 内）中的单元格，具体取决于在同一 table、不同列中所做的选择。 Shiny 输入 ID 已注册，可以访问其值。但是，使用其代理替换 DT 中的数据似乎不起作用（列 ANIMAL 应根据列 GROUP 更改）。有人知道如何实现吗？

library(shiny)
library(DT)

# JS function to render selectize input in DT object
js <- c(
  "function(settings){",
  "  $('#selectNR').selectize()",
  "}"
)

ui <- fluidPage(
  h4("Reactivity within table: no response."),
  fluidRow(
    DTOutput(outputId = "tableNR"),
    verbatimTextOutput('selectedGroupNR')
  )
)

server <- function(input, output, session) {
  getData <- reactive({
    data.frame(
      GROUP = '<select id="selectNR" class="form-control">
                       <option value="A" selected>A</option>
                       <option value="B">B</option>
                       <option value="C">C</option>
                    </select>',
      ANIMAL = 'Dog',
      stringsAsFactors = FALSE, check.names = FALSE)
  })
  
  output$tableNR <- renderDT({
    datatable(data = isolate(getData()),
              selection = "none",
              escape = FALSE,
              rownames = TRUE,
              options =
                list(dom = 't',
                     initComplete = JS(js),
                     preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                     drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
                ))
  })
  # Set up proxy to update table when new selection is done.
  proxyNR <- dataTableProxy('tableNR')
  observeEvent(input$selectNR, {
    toReplace <- getData()
    toReplace$ANIMAL <- switch(input$selectNR,
                               'A' = 'Dog',
                               'B' = 'Cat',
                               'C' = 'Fish')
    DT::replaceData(proxyNR, toReplace, resetPaging = TRUE)
  })
  # As a check
  output$selectedGroupNR <- renderPrint({
    paste0('Selected group = ', input$selectNR)
  })
}
shinyApp(ui = ui, server = server)

Answer 1

这是一个解决方案。您还必须更新 <select>。

library(shiny)
library(DT)

ui <- fluidPage(
  h4("Reactivity within table: no response."),
  fluidRow(
    DTOutput(outputId = "tableNR"),
    verbatimTextOutput('selectedGroupNR')
  )
)

group <- function(letter){
  paste0(
    '<select id="selectNR" class="form-control">',
    ifelse(letter == "A", 
           '<option value="A" selected>A</option>',
           '<option value="A">A</option>'),
    ifelse(letter == "B", 
           '<option value="B" selected>B</option>',
           '<option value="B">B</option>'),
    ifelse(letter == "C", 
           '<option value="C" selected>C</option>',
           '<option value="C">C</option>'),
    '</select>'
  )
}

server <- function(input, output, session) {
  getData <- reactive({
    data.frame(
      GROUP = '<select id="selectNR" class="form-control">
                       <option value="A">A</option>
                       <option value="B">B</option>
                       <option value="C">C</option>
                    </select>',
      ANIMAL = 'Dog',
      stringsAsFactors = FALSE, check.names = FALSE)
  })
  
  output$tableNR <- renderDT({
    datatable(data = isolate(getData()),
              selection = "none",
              escape = FALSE,
              rownames = TRUE,
              options =
                list(dom = 't',
                     preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                     drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
                ))
  })
  # Set up proxy to update table when new selection is done.
  proxyNR <- dataTableProxy('tableNR')
  observeEvent(input$selectNR, {
    toReplace <- getData()
    toReplace$GROUP <- group(input$selectNR)
    toReplace$ANIMAL <- switch(input$selectNR,
                               'A' = 'Dog',
                               'B' = 'Cat',
                               'C' = 'Fish')
    replaceData(proxyNR, toReplace, resetPaging = FALSE)
  })
  # As a check
  output$selectedGroupNR <- renderPrint({
    paste0('Selected group = ', input$selectNR)
  })
}
shinyApp(ui = ui, server = server)

R Shiny 根据同一 table 内的反应性更新 DT 单元

R Shiny update DT cell based on reactivity within same table

r

shiny

dt