R shiny editable table with reactive filters - 使用 table edits 更新过滤器

Question

编辑：这是原始问题的解决方案。我在搜索堆栈和另一部分后找到了它，持久过滤器是在博客上找到的。愿任何发现这一点的人永远不必像我一样受苦。

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)
    })
  }
)

我花了好几天时间试图找到解决这个问题的正确方法，虽然我看过很多讨论，但没有什么能完全“有效”地满足我的需要。

我需要我的解决方案来满足这些要求；

table 是 editable
有些过滤器对 table
当新值输入 table 时，编辑 a) 保存到数据 b) 反映在过滤器中

我已经尝试过 DT，虽然它具有最好看的输出，但我无法更新 DT 过滤器，如果您进行编辑并过滤 table，编辑将被还原。

rHandsOnTable 具有更好看的编辑选项，但存在与上述相同的问题。

dqshiny，rHandsonTable 的一个扩展使我能够保存数据并更新过滤器，但过滤器选项不好，“select”输入似乎不让我 select nothing 显示所有结果。因为我的实际数据在每个框中都有很多文本，因为我水平滚动时单元格的高度发生变化，这使得过滤器和单元格宽度不同步。

说了这么多，我试过了，希望有人能帮我弄清楚

### 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 “有效”，但在我的完整数据集中，当我设置每一列的过滤器类型时，它处理数据的方式一定有问题，因为它丢弃了很多行，我无法弄清楚为什么。也无法关闭特定列的过滤器。据我所知，全有或全无。

# 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
   )
  }
)

然后是简单的动手操作 table，我什至无法开始工作。

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

也许您正在寻找这个

### 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)
    })
  }
)

R shiny editable table with reactive filters - 使用 table edits 更新过滤器

R shiny editable table with reactive filters - update filters with table edits

r

shiny

dt

handsontable