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

Posted 2023-03-22

【中文标题】带有反应过滤器的 R 闪亮可编辑表 - 使用表编辑更新过滤器

【英文标题】：R shiny editable table with reactive filters - update filters with table edits

【发布时间】：2021-02-05 23:48:10

【问题描述】：

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

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

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

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

表格是可编辑的 有些过滤器会对表格的内容产生反应 在表格中输入新值时，编辑会 a) 保存到数据中 b) 反映在过滤器中

我尝试过 DT，虽然它的输出看起来最好，但我无法更新 DT 过滤器，如果您进行了编辑并过滤了表格，则编辑将被还原。

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

dqshiny，rHandsonTable 的增强功能使我能够保存数据并更新过滤器，但过滤器选项不好，“选择”输入似乎不允许我选择任何内容来显示所有结果。而且因为我的实际数据在每个框中都有很多文本，因为我水平滚动单元格的高度会发生变化，这会使过滤器和单元格宽度不同步。

以上就是我尝试过的方法，希望有人能帮我弄清楚

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

然后简单的手放在桌子上，我什至无法开始工作。

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

【参考方案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)
    )
  
)

【讨论】：

是的，前几天晚上我已经回答了这个问题。但这还不是全部。更改值时过滤器将刷新。但我也想通了。感谢您的支持。