在 DT 中单击时更新 data.frame

Question

我的 data.frame 有一个逻辑列。我想用 DT::renderDataTable 显示数据，并且我想在单击某行时切换逻辑列中的值。

我找到了 working example 但我尝试使用 reactive 而不是 reactiveValues/observeEvent。

现在显示设备标识符并在单击一行时进行一些处理，但是，值不会改变。这是示例：

library(shiny)
library(DT)
ui <- shiny::fluidPage(
    DT::dataTableOutput("myTable")
)

server <- function(input, output, session) {

    tableData = reactive({
        ans <-  data.frame(
            Name = LETTERS[1:6], 
            YesNo= rep(c(TRUE,FALSE), each=3),
            stringsAsFactors=FALSE
        )
        
        # transform T/F to checkbox symbol / NA 
        ans$YesNo <- ifelse(ans$YesNo, 
            as.character(shiny::icon("ok", lib = "glyphicon")), NA
        )
        
        # handle click on row
        if(!is.null(input$myTable_rows_selected)) {
            r_idx <- input$myTable_rows_selected[1]
            message("r_idx: ", r_idx)
            ans[r_idx, "YesNo"] <- ifelse(is.na(ans[r_idx, "YesNo"]),
                as.character(shiny::icon("ok", lib = "glyphicon")), NA
            )
        
            #Send proxy (no need to refresh whole table)
            DT::replaceData(DT::dataTableProxy('myTable'), ans)
        }
        ans
    })
 
    output$myTable = DT::renderDataTable({tableData()}, 
        selection = list(mode = "single", target = 'row'), 
        style = "bootstrap",
        rownames = FALSE, 
        colnames = c("Letter", "Yes?"),
        options = list(lengthMenu = c(5, 10, 25, 50, 100), pageLength = 5),
        escape=FALSE # do not show html code
    )
  
}

shinyApp(ui, server)

我卡住了。任何提示表示赞赏。

Answer 1

我不想重复自己，所以我就把评论留在那里。这是全局赋值 <<- 的另一种方法。所以你不需要使用 reactiveValues 或 reactive 或 reactiveVal.

library(shiny)
library(DT)
ui <- shiny::fluidPage(
    DT::dataTableOutput("myTable")
)

server <- function(input, output, session) {
    ans <<-  data.frame(
        Name = LETTERS[1:6], 
        YesNo= rep(c(TRUE,FALSE), each=3),
        stringsAsFactors=FALSE
    )
    ans$YesNo <<- ifelse(ans$YesNo, 
                        as.character(shiny::icon("ok", lib = "glyphicon")), NA
    )
    proxy <- dataTableProxy('myTable')
    
    observeEvent(input$myTable_rows_selected, {
        req(input$myTable_rows_selected)
        r_idx <- input$myTable_rows_selected[1]
        ans$YesNo[r_idx] <<- ifelse(is.na(ans$YesNo[r_idx]), as.character(shiny::icon("ok", lib = "glyphicon")), NA)
        DT::replaceData(dataTableProxy('myTable'), data = ans)
    })
    output$myTable = DT::renderDataTable({ans}, 
                                         selection = list(mode = "single", target = 'row'),
                                         style = "bootstrap",
                                         # rownames = FALSE,
                                         colnames = c("Letter", "Yes?"),
                                         options = list(lengthMenu = c(5, 10, 25, 50, 100), pageLength = 5),
                                         escape=FALSE # do not show html code
    )
    
}

shinyApp(ui, server)

我注释掉了rownames = FALSE。如果包含此内容，则更新将不起作用。不知道为什么，感觉是DT的bug

在 DT 中单击时更新 data.frame

Updating a data.frame when clicked in DT

r

shiny

reactive