带有反应过滤器的 R 闪亮可编辑表 - 使用表编辑更新过滤器

Question

edit: Here is the solution to the original problem. I found it after scouring stack and the other part, persistent filters was found on a blog. May anyone who finds this never have to suffer like I have.

source_data <- 
  iris %>% 
  mutate(Species = as.factor(Species))

source_data$Date <- Sys.time() + seq_len(nrow(source_data))

# default global search value
if (!exists("default_search")) default_search <- ""

# default column search values
if (!exists("default_search_columns")) default_search_columns <- NULL


shinyApp(
  ui = fluidPage(
    DT::dataTableOutput('dataTable')
  ),
  server = function(input, output, session) {
    
    reactive_values <- reactiveValues(source_data = NULL)

    observe({
      reactive_values$source_data <- source_data
    })

    output$dataTable <- DT::renderDataTable(
      reactive_values$source_data,
      editable = list(target = "cell", disable = list(columns = c(1, 2))),
      filter = "top",
      selection = 'none',
      options = list(
        scrollX = TRUE,
        stateSave = FALSE,
        searchCols = default_search_columns,
        search = list(
          regex = FALSE,
          caseInsensitive = FALSE,
          search = default_search
        )
      )
    )

    proxy <- dataTableProxy('dataTable')
    
    observe({
      input$dataTable_cell_edit
      
      # when it updates, save the search strings so they're not lost
      isolate({
        # update global search and column search strings
        default_search <- input$dataTable_search
        default_search_columns <- c("", input$dataTable_search_columns)
        
        # update the search terms on the proxy table (see below)
        proxy %>%
          updateSearch(keywords =
                         list(global = default_search,
                              columns = default_search_columns))
      })
    })
    
    observeEvent(input$dataTable_cell_edit, {
      info = input$dataTable_cell_edit
      str(info)
      i <- info$row
      j <- info$col
      v <- info$value
      reactive_values$source_data[i, j] <<- DT:::coerceValue(v, reactive_values$source_data[i, j])
      source_data[i, j] <<- DT:::coerceValue(v, reactive_values$source_data[i, j])
      replaceData(proxy, source_data, resetPaging = FALSE, rownames = FALSE)
    })
  }
)

I have spent days trying to find just the right solution to this problem and while I've seen many discussions nothing quite "works" how I need it to.

I need my solution to meet these requirements;

1. the table is editable
2. There are filters that are reactive to the contents of the table
3. When new values are entered into the table the edits are a) saved into the data b) reflected in the filters

I've tried DT while it has the nicest looking output I couldn't get the DT filters to update and if you made an edit and filtered the table the edit would be reverted.

rHandsOnTable had a better looking edit option but same issues as above.

dqshiny, an augment for rHandsonTable enables me to save the data and it updates the filter, but the filter options weren't good, the "select" input doesn't seem let me select nothing to display all results. And because my actual data has a lot of text in each box as I horizontally scroll the height of the cells change and this makes the filters and cell widths desync.

With that said here is what I've tried, I hope someone can help me figure out

### DT that doesn't update filters but saves content
shinyApp(
  ui = fluidPage(
    DT::dataTableOutput('x1')
  ),
  server = function(input, output, session) {
    x = iris
    x$Date = Sys.time() + seq_len(nrow(x))
    output$x1 = DT::renderDataTable(x, editable = TRUE, filter = "top", selection = 'none', rownames = FALSE)
    
    proxy = dataTableProxy('x1')
    
    observeEvent(input$x1_cell_edit, {
      info = input$x1_cell_edit
      str(info)
      i = info$row
      j = info$col + 1
      v = info$value
      x[i, j] <<- DT:::coerceValue(v, x[i, j])
      replaceData(proxy, x, resetPaging = FALSE, rownames = FALSE)
    })
  }
)

dqShiny "works" but in my full dataset when I set each column's filter type something must be wrong with how it processes the data because it's discarding a lot of rows out of hand and I can't figure out why. Also can't turn off filters for specific columns. all or nothing as far as I can tell.

# library(tidyverse)
# library(shiny)
# library(rhandsontable)
# install.packages("remotes")
# library(remotes)
# remotes::install_github("daqana/dqshiny")
# library(dqshiny)

shinyApp(
  ui = fluidPage(
    dq_handsontable_output("randomTable", 9L)
  ),
  server = function(input, output, session) {
    hw <- c("Hello", "my", "funny", "world!")
    data <- data.frame(A = rep(hw, 500), B = hw[c(2,3,4,1)],
      C = 1:500, D = Sys.Date() - 0:499, stringsAsFactors = FALSE)
    
   dq_render_handsontable(
    "randomTable",
    data = data,
    width_align = TRUE,
    filters = c("Select"),
    table_param =
      list(
        height = 800,
        readOnly = TRUE,
        stretchH = "all",
        highlightCol = TRUE,
        highlightRow = TRUE
      ),
    col_param =
      list(
        list(col = c("A", "B"), readOnly = FALSE, colWidths = "100%"),
        list(col = c("C", "D"), colWidths = 300)
      ),
    horizontal_scroll = TRUE
   )
  }
)

and then simple hands on table that I can't get to work even a little.

shinyApp(
  ui = fluidPage(
    rHandsontableOutput("randomTable")
  ),
  
  server = function(input, output, session) {
    hw <- c("Hello", "my", "funny", "world!")
    data <- data.frame(
      A = rep(hw, 500),
      B = hw[c(2, 3, 4, 1)],
      C = 1:500,
      D = Sys.Date() - 0:499,
      stringsAsFactors = FALSE
    )
    
    output$randomTable <- renderRHandsontable({
      data %>%
        rhandsontable(
          height = 800,
          readOnly = TRUE,
          stretchH = "all",
          colWidths = "100%"
        ) %>%
        hot_col(c("A", "B"), readOnly = FALSE) %>%
        hot_col(c("C", "D"), colWidths = 300) %>%
        hot_table(highlightCol = TRUE, highlightRow = TRUE)
    })
  }
)

Answer 1

Perhaps you are looking for this

### DT updates filters 
shinyApp(
  ui = fluidPage(
    DT::dataTableOutput('x1')
  ),
  server = function(input, output, session) {
    dfx <- reactiveValues(data=NULL)
    observe({
      x <- iris
      x$Date = Sys.time() + seq_len(nrow(x))
      dfx$data <- x
    })
    
    output$x1 = renderDT(dfx$data, editable = TRUE, filter = "top", selection = 'none', rownames = FALSE)
    
    #proxy = dataTableProxy('x1')
    
    observeEvent(input$x1_cell_edit, {
      info = input$x1_cell_edit
      str(info)
      i = info$row
      j = info$col + 1
      v = info$value
      dfx$data[i, j] <<- DT:::coerceValue(v, dfx$data[i, j])
      
      #replaceData(proxy, x, resetPaging = FALSE, rownames = FALSE)
    })
  }
)