DT 错误：数据更改时保留先前选择的行

Question

在 Shiny 中，DT 会在数据源更改时保留先前选择的行。在下面的代码中，当您从表中选择行然后更改下拉值时，它仍会返回先前选定行的索引（来自先前的下拉值）。这似乎是 DT 库中的一个错误。我对修复它一无所知。我想存储所有选定的行，然后根据选定的行在valueboxoutput 中显示总和。是否还有一个选项可以让行保持选中状态，因为它是蓝色的？

library(shiny)
library(shinydashboard)
library(DT)
library(dplyr)

# FETCH DATA
mydata = mtcars
mydata$id = 1:nrow(mydata)

#Dashboard header carrying the title of the dashboard
header <- dashboardHeader(title = "My Dashboard")

######################
# Dashboard Sidebar
######################

sidebar <- dashboardSidebar(
  sidebarMenu(
    menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
    selectInput(
      "hyp",
      "Select:", 
      list(
        'All','drat','wt'
      ) , 
      selected =  "All", selectize = TRUE)
  )
)

# Dashboard Body

frow1 <- fluidRow(
  valueBoxOutput("value1")
)





frow2 <- fluidRow(
  box(DT::dataTableOutput("mytable"), width = 12)
)

# combine the two fluid rows to make the body
body <- dashboardBody(frow1, frow2)

####################
# Dashboard Page
###################
ui <- dashboardPage(title = 'Model', header, sidebar, body, skin='purple')

####################
# SERVER
###################

d = data.frame(stringsAsFactors = F)
server <- function(input, output, session) {
  dd = reactiveValues(select = NULL, select2 = NULL)

  # Render Table
  output$mytable = DT::renderDataTable({
    DT::datatable(test(), rownames= FALSE, extensions = c('FixedHeader'),
                  filter = 'top', 
                  selection=list(mode = 'multiple'), 
                  options = list( autoWidth = TRUE,
                                  scrollX = TRUE, 
                                  orderClasses = TRUE,
                                  pageLength = 50, 
                                  fixedHeader = TRUE,
                                  dom = 'Bfrtip'
                  ),escape=F)
  }
  )


  proxy = DT::dataTableProxy('mytable')

  test <- reactive({
    if(input$hyp == 'All') {
      result = mydata
    } else {
      result = mydata %>% dplyr::filter(UQ(as.name(input$hyp)) <= 3)
    }
    return(result)
  })


  mt = reactiveValues(ndt = NULL)

  observe({
    if (length(input$mytable_rows_selected) >0) {  
    mt$ndt<- test()[input$mytable_rows_selected,]
    }
  })

  observeEvent(input$hyp, {freezeReactiveValue(input, "mytable_rows_selected")})

  proxy = DT::dataTableProxy('mytable')
  observe({print(input$mytable_rows_selected)})
  observe({print(mt$ndt)})

  #creating the valueBoxOutput content
  output$value1 <- renderValueBox({
    c_a = sum(mydata[mt$ndt[["id"]],"mpg"], na.rm = T)
    valueBox(
      formatC(c_a, format="d", big.mark=',')
      ,'Total MPG'
      ,icon = icon("th",lib='glyphicon')
      ,color = "purple")
  })
}

runApp(list(ui = ui, server = server), launch.browser = TRUE)

更新

我设法部分修复了它。我现在面临的问题 - 当我取消选择行时，它不会改变总和计算。我还希望所有选定的行都保持突出显示。

  mt = reactiveValues(ndt = NULL)
  ft = reactiveValues(pa = NULL)

  observeEvent(input$mytable_rows_selected, {
    mu = data.frame(n = input$mytable_rows_selected, stringsAsFactors = F)
    mt$ndt<- test()[as.numeric(mu$n),]
    ft$pa = rbind(ft$pa, mt$ndt)
    ft$pa <- distinct(ft$pa, .keep_all = TRUE)
  }
  )

  #creating the valueBoxOutput content
  output$value1 <- renderValueBox({
    c_a = sum(ft$pa[,"mpg"], na.rm = T)
    valueBox(
      formatC(c_a, format="d", big.mark=',')
      ,'Total MPG'
      ,icon = icon("th",lib='glyphicon')
      ,color = "purple")
  })
}

Answer 1

总的来说，如果现在没有选择任何行，则需要清除 ft$pa，为此，您的观察者需要对 input$mytable_rows_selected 中的 NULL 值做出反应（此参数 ignoreNULL = FALSE 会有所帮助）。我对你的observeEvent做了简单的修改

observeEvent(input$mytable_rows_selected, ignoreNULL = FALSE, {
    mu = data.frame(n = input$mytable_rows_selected, stringsAsFactors = F)
    mt$ndt<- test()[as.numeric(mu$n),]
    ft$pa = rbind(ft$pa, mt$ndt)
    ft$pa <- distinct(ft$pa, .keep_all = TRUE)

    #clear reactive dataframe
    if (is.null(input$mytable_rows_selected))
      ft$pa <- ft$pa[-1,]
  })