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

编程问答 2022-06-06

问题描述

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

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])
      replaceData(proxy,source_data,resetPaging = FALSE,rownames = FALSE)
    })
  }
)

我花了几天的时间来寻找解决这个问题的正确方法，尽管我看到很多讨论都没有“起作用”我的需要。

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

  1. 表格是可编辑的
  2. 有些过滤器对表格的内容有反应
  3. 在表中输入新值时，所做的编辑将a）保存到数据b）反映在过滤器中

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

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

dqshiny，rHandsonTable的增强功能使我能够保存数据并更新过滤器，但是过滤器选项不是很好，“选择”输入似乎没有让我什么都没选择以显示所有结果。而且由于我在水平滚动单元格的高度时每个框内的实际数据都有很多文本，因此高度和高度会发生变化，从而使过滤器和单元格宽度不同步。

话虽如此，这是我的尝试，希望有人能帮助我弄清楚

### DT that doesn't update filters but saves content
shinyApp(
  ui = fluidPage(
    DT::dataTableOutput('x1')
  ),session) {
    x = iris
    x$Date = Sys.time() + seq_len(nrow(x))
    output$x1 = DT::renderDataTable(x,editable = TRUE,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,x[i,x,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)
  ),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")
  ),"world!")
    data <- data.frame(
      A = rep(hw,stringsAsFactors = FALSE
    )
    
    output$randomTable <- renderRHandsontable({
      data %>%
        rhandsontable(
          height = 800,colWidths = "100%"
        ) %>%
        hot_col(c("A",readOnly = FALSE) %>%
        hot_col(c("C",colWidths = 300) %>%
        hot_table(highlightCol = TRUE,highlightRow = TRUE)
    })
  }
)

解决方法

也许您正在寻找这个

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

output

dthandsontablerrshiny