如何使用嵌套图加速反应？

如何解决如何使用嵌套图加速反应？

我正在尝试将附加信息插入 R 中的 $match - 一个大约有 3600 行。我尝试在每一行下嵌套一个图（类似于 this，但使用嵌套图而不是子表）。我能完成这项工作的唯一方法是在 reactable 中使用 plotly，如下所示：

reactable

但遗憾的是，对于如此大量的数据，这需要永远输出表格，而我试图使其更快的任何内容（例如 library(reactable) library(magrittr) library(plotly) my_diamonds <- diamonds my_diamonds$cats <- cut(my_diamonds$price,850) my_diamonds <- my_diamonds[ order(my_diamonds$cut,my_diamonds$cats),] data <- unique(my_diamonds[,c("cut","cats")]) reactable(data,details = function(index) { diam_data <- my_diamonds[my_diamonds$cut == data$cut[index] & my_diamonds$cats == data$cats[index],] plot_ly(diam_data,x = ~1:nrow(diam_data),y = ~y,type = 'scatter',mode = 'lines') # %>% toWebGL() } ) ）都没有任何改变。我真正关心的是速度，以及与每一行相关联的某种可视化 - 我并不特别关心它是 toWebGL() 还是其他东西。

第二种选择是为每一行使用内嵌 HTML 小部件（显示为 here）。在我的例子中，如果添加：

plotly

这不像 data_parcels <- split(my_diamonds,list(my_diamonds$cats,my_diamonds$cut),drop = T) data$nested_points <- sapply(data_parcels,'[[','y') data$sparkline <- NA library(sparkline) reactable(data,columns = list( sparkline = colDef(cell = function(value,index) { sparkline(data$nested_points[[index]]) }) )) 选项那样慢，但在更大的方案中仍然非常慢。关于如何加快任一示例速度的任何想法，任何人？

解决方法

PaulM 和我一起研究了一个解决方案，并设法加速了其中一个选项：涉及在线迷你图的选项。事实证明，基于一些分析工作，使该过程特别缓慢的不是绘制迷你图本身，而是从 R 中翻译它们的后续工作，以便它们可以合并到 HTML reactable 表中.

因此，为了完全绕过缓慢的转换过程，我们编写了一个代码模板，可以围绕要绘制的数据点进行包装。这是我们然后直接提供给 reactable 的内容，以及 html = TRUE 参数，以便将代码解释为这样，而不是常规文本。

此后的最后一个障碍是确保即使用户对列进行排序或导航到不同的结果页面，迷你图（每行一个）仍然显示 - 通常迷你图会在与表格交互时消失这边走。为此，我们确保 reactable 将在任何点击后 10 毫秒后重新绘制。

这是一个包含在 shiny 中的示例，它显示了所有这些操作以及旧（慢）版本。对我来说，加速版本的渲染时间大约为 0.5 秒，而旧版本的渲染时间大约为 13 秒。

library(reactable)
library(magrittr)
library(plotly)
library(sparkline)
library(shiny)
library(shinycssloaders)
library(shinyWidgets)


if (interactive()) {
  
  # Init objects
  t0 <- NULL
  t1 <- NULL
  
  my_diamonds <- diamonds
  my_diamonds$cats <- cut(my_diamonds$price,850)
  my_diamonds <- my_diamonds[ order(my_diamonds$cut,my_diamonds$cats),]
  data <- unique(my_diamonds[,c("cut","cats")])
  
  data_parcels <- split(my_diamonds,list(my_diamonds$cats,my_diamonds$cut),drop = T)
  data$nested_points <- sapply(data_parcels,'[[','y')
  data$sparkline <- NA
  
  
  ui <- shinyUI(
    basicPage(
      br(),radioGroupButtons(
        inputId = "speedChoice",label = "Speed",choices = c("Fast","Slow"),status = "danger"
      ),br(),verbatimTextOutput("timeElapsed"),shinycssloaders::withSpinner(
        reactableOutput("diamonds_table")
      ),# Small JS script to re-render a reactable table so that the sparklines show 
      # after the user has modified the table (sorted a col or navigated to a given page of results)
      tags$script('document.getElementById("diamonds_table").addEventListener("click",function(event){
                             setTimeout(function(){
                             console.log("rerender")
                                        HTMLWidgets.staticRender()
                             },10);
                          })
                           ')
    )
  )
  
  server <- function(input,output,session) {
    
    output$diamonds_table <- renderReactable({
      
      if (input$speedChoice == "Fast") {
        
        t0 <<- Sys.time()
        
        part1 <- '<span id="htmlwidget-spark-' # + ID
        part2 <- '" class="sparkline html-widget"></span><script type="application/json" data-for="htmlwidget-spark-' # + ID
        part3 <- '">{"x":{"values":[' # + values
        part4 <- '],"options":{"height":20,"width":60},"width":60,"height":20},"evals":[],"jsHooks":[]}</script>'
        
        out <- list(length = nrow(data))
        for (i in 1:nrow(data)) {
          vals <- paste0(data$nested_points[[i]],collapse = ',')
          out[[i]] <- paste0(part1,i,part2,part3,vals,part4)
        }
        data$sparkline <- out
        
        
        tab <- reactable(data,columns = list(
                           sparkline = colDef(html = TRUE,cell = function(value,index) {
                                                return(htmltools::HTML(value))
                                              }
                           )
                         )
        ) %>%
          spk_add_deps() %>% 
          htmlwidgets::onRender(jsCode = "
                      function(el,x) {
                      HTMLWidgets.staticRender();
                      console.log('render happening')
                      }")
        
        t1 <<- Sys.time()
        
        return(tab)
        
      } else {
        
        # Classic,but slow version:
        t0 <<- Sys.time()
        tab <- reactable(data,columns = list(
                           sparkline = colDef(cell = function(value,index) {
                             data$nested_points[[index]] %>%
                               sparkline::sparkline()
                           }
                           )
                         )
        )
        t1 <<- Sys.time()
        
        return(tab)
        
      }
    })
    
    
    output$timeElapsed <- renderText({
      input$speedChoice # Connect to reactable update cycle
      return(t1 - t0)
    })
    
  }
  
  shinyApp(ui = ui,server = server)
  
}