閃亮：在更改輸入後，保持對數據表中的框進行檢查

Question

我想在我的閃亮應用中實現複選框;不過，我面臨兩個問題：

1. 後，我重新排序列，在數據表中任何檢查消失（例如，嘗試通過mpg訂購表）
2. 後，我刪除列，在數據表中任何檢查消失（例如，取消選中從Columns to show:箱）

這是我的虛擬實例（這是從this SO answer的代碼修改後的版本）：

library(shiny) 
TABLE = mtcars 
TABLE$id = 1:nrow(mtcars) 
APP <- list() 

APP$ui <- pageWithSidebar(
    headerPanel(NULL), 
    sidebarPanel(
     checkboxGroupInput("show_vars", "Columns to show:", 
          names(TABLE), selected = names(TABLE)) 
    ), 
    mainPanel(
     dataTableOutput("resultTABLE") 
    ) 
) 
APP$server <- function(input, output, session) { 

    output$resultTABLE = renderDataTable({ 
     addCheckboxButtons <- paste0('<input type="checkbox" name="row', 
            TABLE$id, '" value="', TABLE$id, '">',"") 
     cbind(Pick = addCheckboxButtons, TABLE[, input$show_vars, drop = FALSE]) 
    }, escape = FALSE) 
} 

runApp(APP) 

部

APP作品，但爲全面落實我需要解決的問題1和2

Answer 1

基礎上所以在你的問題回答中提供：

library(shiny) 
mymtcars = mtcars 
mymtcars$id = 1:nrow(mtcars) 
runApp(
    list(ui = pageWithSidebar(
    headerPanel('Examples of DataTables'), 
    sidebarPanel(
     checkboxGroupInput('show_vars', 'Columns to show:', names(mymtcars), 
         selected = names(mymtcars)) 
    ), 
    mainPanel(
     dataTableOutput("mytable") 
    ) 
) 
    , server = function(input, output, session) { 

    strd<-reactiveValues(tr=0, slrows=character(length=nrow(mymtcars))) 


    #preserve selected rows in a reactive element 
    rowSelect <- reactive({ 
     input$rows 
    }) 
    # use reactive value that's equal to 'checked' parameter for html code 
    observe({ 
     strd$slrows<-ifelse(mymtcars$id %in% as.numeric(rowSelect()),'checked','') 
    }) 

    #use observer for column checkboxinput to detect first run 
    observeEvent(input$show_vars, { 
     strd$tr<-strd$tr+1 
     print(strd$tr) 
    }, ignoreNULL = TRUE) 


    output$mytable = renderDataTable({ 
     #if first run - nothing is checked 
     if (strd$tr==1){ 
     addCheckboxButtons <- paste0('<input type="checkbox" name="row', mymtcars$id, '" value="', mymtcars$id, '" >',"") 

     } else{ 
     # add 'checked' parameter for html depending if id is present in selected rows reactive value 
     addCheckboxButtons <- paste0('<input type="checkbox" name="row', mymtcars$id, '" value="', mymtcars$id,'" ', 
            strd$slrows,'>',"") 
     } 
     #Display table with checkbox buttons 
     (cbind(Pick=addCheckboxButtons, mymtcars[, input$show_vars, drop=FALSE])) 
    }, options = list(orderClasses = TRUE, lengthMenu = c(5, 25, 50), pageLength = 25), 
    escape=FALSE, callback = "function(table) { 
    table.on('change.dt', 'tr td input:checkbox', function() { 
    setTimeout(function() { 
    Shiny.onInputChange('rows', $(this).add('tr td input:checkbox:checked').parent().siblings(':last-child').map(function() { 
    return $(this).text(); 
    }).get()) 
    }, 10); 
    }); 
    }") 
    } 
) 
) 

類似，但DT方法：（多一點因爲您不會爲每行創建輸入，因此它不會爲每個反應值觸發器重新創建表（這是列和行的刻度）。它僅在列無效值觸發器中重新創建表。您還可以使用colvis在按鈕推廣，以純DT解決方案相處

library(shiny) 
library(DT) 
mymtcars<-mtcars 

shinyApp(
    ui = pageWithSidebar(
    headerPanel('Examples of DataTables'), 
    sidebarPanel(
     checkboxGroupInput('show_vars', 'Columns to show:', names(mymtcars), 
         selected = names(mymtcars)) 
    ), 
    mainPanel(
     verbatimTextOutput("selrows"), 
     DT::dataTableOutput("mytable") 
    ) 
), 


    server = function(input, output) { 

    strd<-reactiveValues(tr=0, slrows=c(0,0)) 

    observe({ 
     if(strd$tr==1){ 
     strd$slrows<-0 
     } else strd$slrows<-input$mytable_rows_selected 
    }) 

    rowSelect <- reactive({ 
     input$mytable_rows_selected 
    }) 

    observeEvent(input$show_vars, { 
     strd$tr<-strd$tr+1 
     print(strd$tr) 
    }, ignoreNULL = TRUE) 


    output$mytable = DT::renderDataTable({ 
     datatable(mymtcars[, input$show_vars, drop=F], rownames=FALSE,options = list(pageLength = 10), 
       selection = list(mode='multiple', target='row', 
           selected = strd$slrows) ) 

    } 
    ) 

    output$selrows<-renderPrint({ 
     input$mytable_rows_selected 
    }) 
    } 
)