r - 如何根据复选框输入创建反应表？

Question

我想创建一个显示两个表格的 Shiny 应用程序。第一个显示所有数据，第二个应该显示数据的子集。用户应该能够通过复选框选择要从第一个表中排除的行，并记录排除文本输入的原因。是的，它应该是一个复选框列，而不是在功能上使用内置的 DT rows_selected。

此外，以前“排除”的行（最终从文件中读取）也应包含在排除列表中。这将在应用程序启动时被读取。

我有一些办法。但我不确定如何根据交互式复选框输入（即在运行时添加的新排除项）来更新第二个表。我怎么能这样做？

library(shiny)
library(DT)

# references 
# https://yihui.shinyapps.io/DT-radio/

shinyInputCheckboxes <- function(FUN, len, id, disqualifiedIDs, ...) {
    # adapted from more general shinyInput function, not most efficient
    inputs <- character(len)
    for (i in seq_len(len)) {
        if(i %in% disqualifiedIDs) {
            inputs[i] <- as.character(FUN(paste0(id, i), label = NULL, value = TRUE, ...))
        }
        else {
            inputs[i] <- as.character(FUN(paste0(id, i), label = NULL, value = FALSE, ...))
        }
    }
    inputs
}

shinyInputText <- function(FUN, len, id, disqualifiedIDs, disqualified_trials, ...) {
    # adapted from more general shinyInput function, not most efficient
    inputs <- character(len)
    for (i in seq_len(len)) {
        if(i %in% disqualifiedIDs) {
            print(i)
            print(as.character(disqualified_trials[disqualified_trials$ID == i, "exclusion_reason"]))
            inputs[i] <- as.character(FUN(paste0(id, i), label = NULL, value = as.character(disqualified_trials[disqualified_trials$ID == i, "exclusion_reason"]), ...))
        }
        else {
            inputs[i] <- as.character(FUN(paste0(id, i), label = NULL, ...))
        }
    }
    inputs
}



# Define UI for application that draws a histogram
ui <- fluidPage(

    DT::dataTableOutput("main"),
    
    tags$h2('Excluded Rows'),
    
    tableOutput("sub")
)



# Define server logic required to draw a histogram
server <- function(input, output) {
    
    # this table would be read in from a file eventually
    mainStart <- data.frame(ID = 1:10, 
                            exclude = c(FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE), 
                            exclusion_reason = LETTERS[11:20]
                            )
    
    disqualified_trials_ids <- which(mainStart$exclude)
    
    # render a bunch of input fields
    exclude <- shinyInputCheckboxes(checkboxInput, nrow(mainStart), 'exclude_', disqualified_trials_ids)
    exclusion_reason <- shinyInputText(textInput, nrow(mainStart), 'exclusion_reason_', disqualified_trials_ids, mainStart)
    
    main <- mainStart
    main$exclude <- exclude
    main$exclusion_reason <- exclusion_reason
    
    # render the main table of all data
    output$main <- renderDataTable({ main }, server = FALSE, escape = FALSE, selection = 'single', options = list(
        preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')))
    
    # render the subset table
    output$sub <- renderTable({ 
        mainStart[disqualified_trials_ids, ]
    })

}


shinyApp(ui = ui, server = server)

标签： rshinydatatable