r - 在 Shiny 中从大数据图中高效渲染数据点

Question

目标
实现 Shiny 应用程序以有效地可视化和调整上传的数据集。每个集合可能包含 100000 到 200000 行。数据调整完成后，即可下载调整后的数据。分步骤:

资料上传

数据选择与可视化

数据(点)去除

下载选项

问题
虽然该应用程序主要工作，但数据可视化和删除需要太多时间。
代码
样本数据
生成了一些示例数据。数据可以上传到 Shiny 的应用程序。样本数据分布与我的实际数据不相似。实际数据包含清晰可辨的异常值，看起来像带峰的光谱。

a = sample(1:1e12, 1e5, replace=TRUE)
b = sample(1:1e12, 1e5, replace=TRUE)
dummy1 = data.frame(Frequency = a, Amplitude = a)
dummy2 = data.frame(Frequency = b, Amplitude = b)
dummy3 = data.frame(Frequency = a, Amplitude = b)
# Sample data
write.csv(dummy1,'dummy1.csv')
write.csv(dummy2,'dummy2.csv')
write.csv(dummy3,'dummy2.csv')

Shiny 的应用程序
该应用程序获取上传的数据并绘制它。 (可以将样本虚拟数据上传到应用程序。)可以删除部分数据点并可以下载新数据。

# Packages
library(shiny)
library(ggplot2)
library(data.table)
# UI
ui = fluidPage(
    fluidRow(selectInput("selection", "Set Selection:", choices = '', selected = '', multiple = TRUE)),
    fluidRow(plotOutput(outputId = "plot", brush = "plot_brush_"), 
             downloadButton('download',"Download the data"))
)

# Server
server = function(session, input, output){
    # Pop up for data upload
    query_modal = modalDialog(title = "Upload Spectrum",
                              fileInput("file", 
                              "file",
                              multiple = TRUE,
                              accept = c(".csv")),
                              easyClose = FALSE)
    showModal(query_modal)

    ## Upload
    mt1 = reactive({
       req(input$file)
       cs = list()
       for(nr in 1:length(input$file[ , 1])){
          c = read.csv(input$file[[nr, 'datapath']])
          cs[[nr]] = data.table(Frequency = as.numeric(c[[1]]), 
                                Amplitude = as.numeric(c[[2]]), 
                                Indicator = as.factor(nr))}
        c = do.call(rbind, cs)
        c = reactiveValues(data = c)
        return(c)})

    ## Input selection
    observeEvent(
      mt1(),
      updateSelectInput(
        session, 
        "selection", 
        "Set Selection:", 
        choices = levels(mt1()$data$Indicator), 
        selected = 'Entire'))
    
    ## Plot
    output$plot <- renderPlot({
      mt = mt1()$data
      mt = mt[mt$Indicator %in% input$selection,]
      p = ggplot(mt, aes(Frequency, Amplitude, color = Indicator)) 
      p + geom_point(show.legend = TRUE)})
    
    ## Download
    output$download = downloadHandler(
      filename = function(){paste(gsub('.{1}$', '', input$file$name[1]), 'manipulated', '.csv', sep= '')}, 
      content = function(fname){
        mt = mt1()$data
        mt = mt[, .SD, .SDcols= c('Frequency', 
                                  'Amplitude', 
                                  'Indicator')]
        write.csv(mt, fname, row.names = FALSE)})
    
    ## Adjust
    observe({
      d = mt$data
      keep = mt$data[!Indicator %in% input$selection]
      df = brushedPoints(d, brush = input$plot_brush_, allRows = TRUE) 
      df = df[selected_ == FALSE]
      df$selected_ = NULL
      mt$data = rbind(keep , df[Indicator %in% input$selection,  ])})
}

# Run app
shinyApp(ui = ui, server = server)

Answer 1

您可以使用 matplotlib R 和 Shiny 中的 Python 绘图库，带有 reticulate包裹 :

设置包和库:

install.packages('reticulate')

# Install python environment
reticulate::install_miniconda() 
# if Python is already installed, you can specify the path with use_python(path)

# Install matplotlib library
reticulate::py_install('matplotlib')

测试安装:

library(reticulate)
mpl <- import("matplotlib")
mpl$use("Agg") # Stable non interactive backend
mpl$rcParams['agg.path.chunksize'] = 0 # Disable error check on too many points

plt <- import("matplotlib.pyplot")
np <- import("numpy")

# generate lines cloud
xx = np$random$randn(100000L)
yy = np$random$randn(100000L)

plt$figure()
plt$plot(xx,yy)
plt$savefig('test.png')
plt$close(plt$gcf())

测试.png:

使用 matplotlib在 Shiny 中，1e5 段的绘制持续时间低于 2 秒:

# Packages
library(shiny)
library(ggplot2)
library(data.table)
# UI
ui = fluidPage(
  fluidRow(selectInput("selection", "Set Selection:", choices = '', selected = '', multiple = TRUE)),
  fluidRow(imageOutput(outputId = "image"), 
           downloadButton('download',"Download the data"))
)

# Server
server = function(session, input, output){
  
  # Setup Python objects
  mpl <- reticulate::import("matplotlib")
  plt <- reticulate::import("matplotlib.pyplot")
  mpl$use("Agg") 
  mpl$rcParams['agg.path.chunksize'] = 0
  
  
  # Pop up for data upload
  query_modal = modalDialog(title = "Upload Spectrum",
                            fileInput("file", 
                                      "file",
                                      multiple = TRUE,
                                      accept = c(".csv")),
                            easyClose = FALSE)
  showModal(query_modal)
  
  ## Upload
  mt1 = reactive({
    req(input$file)
    cs = list()
    for(nr in 1:length(input$file[ , 1])){
      c = read.csv(input$file[[nr, 'datapath']])
      cs[[nr]] = data.table(Frequency = as.numeric(c[[1]]), 
                            Amplitude = as.numeric(c[[2]]), 
                            Indicator = as.factor(nr))}
    c = do.call(rbind, cs)
    c = reactiveValues(data = c)
    return(c)})
  
  ## Input selection
  observeEvent(
    mt1(),
    updateSelectInput(
      session, 
      "selection", 
      "Set Selection:", 
      choices = levels(mt1()$data$Indicator), 
      selected = 'Entire'))
  
  ## Render matplotlib image
  output$image <- renderImage({
    # Read myImage's width and height. These are reactive values, so this
    # expression will re-run whenever they change.
    width  <- session$clientData$output_image_width
    height <- session$clientData$output_image_height
    
    # For high-res displays, this will be greater than 1
    pixelratio <- session$clientData$pixelratio
    
    # A temp file to save the output.
    outfile <- tempfile(fileext='.png')
    
    # Generate the image file
    mt = mt1()$data
    mt = mt[mt$Indicator %in% input$selection,]
    xx = mt$Frequency
    yy = mt$Amplitude
    
    plt$figure()
    plt$plot(xx,yy)
    plt$savefig(outfile)
    plt$close(plt$gcf())
    
    # Return a list containing the filename
    list(src = outfile,
         width = width,
         height = height,
         alt = "This is alternate text")
  }, deleteFile = TRUE)
  
  ## Download
  output$download = downloadHandler(
    filename = function(){paste(gsub('.{1}$', '', input$file$name[1]), 'manipulated', '.csv', sep= '')}, 
    content = function(fname){
      mt = mt1()$data
      mt = mt[, .SD, .SDcols= c('Frequency', 
                                'Amplitude', 
                                'Indicator')]
      write.csv(mt, fname, row.names = FALSE)})
  
  ## Adjust
  observe({
    mt = mt1()
    df = brushedPoints(mt$data, brush = input$plot_brush_, allRows = TRUE) 
    mt$data = df[df$selected_ == FALSE,  ]})
}

# Run app
shinyApp(ui = ui, server = server)

您需要手动处理颜色，因为 matplotlib不是 ggplot2