在更改閃亮DT數據表中的數據集時保留所選行

Question

我正在使用DT包在我的shiny應用程序中顯示數據表。由於我提供了不同的數據集，我有單選按鈕來選擇它們，並且數據表自動更新。

我想要做的是在切換數據集時預先選擇df1的df2中的可用行。目前，我的選擇總是被抹去。當我嘗試保存選定的行（取消註釋兩行）時，我的表格會直接重置。

library(shiny) 
library(DT) 

df1 <- data.frame(names=letters, 
        values=1:26) 
df2 <- data.frame(names=letters, 
        values=(1:26)*2)[seq(1,26,2),] 

ui <- shinyUI(
    fluidPage(
    sidebarLayout(
     sidebarPanel(
     radioButtons("dataset", label=h5("Select dataset"), 
        choices=list("df1"='df1', 
            "df2"='df2'), 
        selected='df1', inline=TRUE) 
    ), 
     mainPanel(
     DT::dataTableOutput("name_table") 
    ) 
    ) 
) 
) 

服務器端...

server <- function(input, output, session) { 
    getDataset <- reactive({ 
    result <- list() 
    result[['dataset']] <- switch(input$dataset, 
        'df1'=df1, 
        'df2'=df2) 
    # result[['selection']] <- 
    # as.numeric(input$name_table_rows_selected) 
    return(result) 
    }) 
    output$name_table <- DT::renderDataTable({ 
    DT::datatable(getDataset()[['dataset']], 
        options=list(pageLength=5)) 

    }) 
    name_proxy = DT::dataTableProxy('name_table') 
} 

shinyApp(ui, server) 

我用DT表，因爲我需要的代理和與數據表中的一些互動。

Answer 1

可以節省選擇行時要改變DF像

server <- function(input, output, session) { 
    dd=reactiveValues(select=NULL) 

    observeEvent(input$dataset,{ 
    dd$select=as.numeric(isolate(input$name_table_rows_selected)) 
    }) 

    getDataset <- reactive({ 
    result <- list() 
    result[['dataset']] <- switch(input$dataset, 
            'df1'=df1, 
            'df2'=df2) 

    return(result) 
    }) 
    output$name_table <- DT::renderDataTable({ 
    DT::datatable(getDataset()[['dataset']], 
        options=list(pageLength=5), 
        selection = list(mode = 'multiple', selected =dd$select ) 
    ) 

    }) 
    name_proxy = DT::dataTableProxy('name_table') 
} 

shinyApp(ui, server) 

或者@drmariod變異的位修改：使用eventReactive代替reactive

server <- function(input, output, session) { 
    getDataset <- eventReactive(input$dataset,{ 
    result <- list() 
    result[['dataset']] <- switch(input$dataset, 
            'df1'=df1, 
            'df2'=df2) 
    result[['selection']] <- testing() 
    return(result) 
    }) 
    testing <- function() { 
    list(selected=as.numeric(input$name_table_rows_selected)) 
    } 
    output$name_table <- DT::renderDataTable({ 
    DT::datatable(getDataset()[['dataset']], 
        options=list(pageLength=5), 
        selection=getDataset()[['selection']]) 

    }) 
    name_proxy = DT::dataTableProxy('name_table') 
} 

Answer 2

嗯，它看起來像我找到了解決方案，但我想知道是否有更好的解決方案。

server <- function(input, output, session) { 
    getDataset <- reactive({ 
    result <- list() 
    result[['dataset']] <- switch(input$dataset, 
        'df1'=df1, 
        'df2'=df2) 
    result[['selection']] <- testing() 
    return(result) 
    }) 
    testing <- function() { 
    list(selected=as.numeric(input$name_table_rows_selected)) 
    } 
    output$name_table <- DT::renderDataTable({ 
    DT::datatable(getDataset()[['dataset']], 
        options=list(pageLength=5), 
        selection=getDataset()[['selection']]) 

    }) 
    name_proxy = DT::dataTableProxy('name_table') 
} 

我想知道，有時會出現processing消息。並在每次點擊桌子上短暫地「閃爍」...會很好，以得到更好的答案。只有