vendredi 11 mars 2022

checkBox elements with editable cells in Shiny DT datatable

I have built upon yihui's suggestion to add checkboxes to a DT datatable. I also need to be able to edit values in cells (not the checkboxes, the adjacent columns. The behavior is follows: I click on a checkbox, edit the value in the second column, after which the checkbox is unchecked again. Desired behavior: the checkbox remain as were checked/unchecked previously. I suppose it's due to the proxy update, but I have no idea how to make the cells editable otherways. Any ideas? This is the code:

library(shiny)

library(DT)

shinyApp( ui = fluidPage(DT::dataTableOutput('x1')),

server = function(input, output) {
    # 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,  width = "20px", ...))
        }
        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)) NA else value
        }))
    }
    
    # default global search value
    if (!exists("default_search")) default_search <- ""
    
    # default column search values
    if (!exists("default_search_columns")) default_search_columns <- NULL
    
    # a sample data frame
    res = data.frame(
        v2 = shinyInput(checkboxInput, 10, 'v2_', value = FALSE),
        v4 = sample(LETTERS, 10, TRUE),
        stringsAsFactors = FALSE
    )
    
    #Container to store edits
    reactive_df = reactiveValues(df = NULL)
    
    observe({
        reactive_df$edited_df <- res
    })
    
    # render the table containing shiny inputs
    output$x1 = DT::renderDataTable(
        res
        , server = TRUE
        , escape = FALSE
        , filter = 'top'
        , selection = list(mode="single", target="cell")
        , editable = list(target = "cell", disable = list(columns = 1))
        , options = list(
            scrollX = TRUE
            # , paging = TRUE
            # ,searching = TRUE
            ,fixedColumns = TRUE
            ,autoWidth = TRUE
            ,columnDefs = list(list(targets = c(1), searchable = FALSE)) #make the checkbox columns unsearchable
            ,ordering = TRUE
            # # default column search strings and global search string
            ,searchCols = default_search_columns
            ,search = list(regex = FALSE, caseInsensitive = FALSE, search = default_search)
            ,preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }')
            ,drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
        )
    )
    # make a proxy of the data table so it can be edited after it's been rendered
    proxy = DT::dataTableProxy("x1")
    
    observeEvent(input$x1_cell_edit, {
        info = input$x1_cell_edit
        reactive_df$edited_df <<- editData(reactive_df$edited_df, info)
        replaceData(proxy, reactive_df$edited_df, resetPaging = FALSE)  
    })

}

)




Aucun commentaire:

Enregistrer un commentaire