提高 R Shiny 的计算速度

Question

我正在尝试开发一个基本的 R 闪亮应用，但面临处理速度的问题。过程如下，我需要读取大约 500K 行的 csv 文件 -> 将文件拆分为更小的段 -> 计算每个段的新特征并显示结果。下面是我的UI.R 和Server.R
UI.R

library(shiny)
library(shinyBS)
library(shinycssloaders)
library(DT)


shinyUI(fluidPage( 
mainPanel(
#UI for choosing the file to input
fileInput("file1", label = (" Choose Drivecycle Data "),multiple = F),

#UI for showing the number of Rows in original dataset 
fluidRow(
  column(8, h4(helpText("Number of rows input dataset"))),
  column(3,verbatimTextOutput("totrows", placeholder = TRUE))),

#UI for showing the number of segments the data set had been split into
fluidRow(
  column(8, h4(helpText("Number of segmentations"))),
  column(3,verbatimTextOutput("totseg", placeholder = TRUE))),

fluidRow(
  column(8, downloadButton("subtablednld", label = 'Downloadcsv'))
),

tabsetPanel(

  #UI to show the original data set in First tab
  tabPanel("Table",icon = icon("table"),withSpinner(DT::dataTableOutput('table'), 
                                                    type = getOption("spinner.type", default = 8) )),

  #UI to show the  features of the segments of the orginal dataset in Second Tab
  tabPanel("Feature Table",icon = icon("table"),withSpinner(DT::dataTableOutput('table1'), 
                                                            type = getOption("spinner.type", default = 8) )),


),style = 'width:1000px;height"3000px'
)
)
)

Server.R

library(shiny)
library(earth)
library(tidyr)

options(shiny.maxRequestSize=300*1024^2) #increase the max upload file size 
to 30 MB
options(shiny.trace=TRUE)

# Define server logic required to draw a histogram
shinyServer(function(input, output) {

#Function to input data set using UI 
dataframe <- reactive( {

###  Create a data frame reading data file to be used by other functions..
inFile <- input$file1

data1 <- read.csv(inFile$datapath, header = TRUE)

 })

 #Display the input dataset
 observeEvent(input$file1,output$table <- renderDataTable({dataframe()}))

 #Show the number of rows in the input dataset
 observeEvent(input$file1,output$totrows<- renderText({nrow(dataframe())}))

 #Split the data set
 Splitfile <- function(){
 split(dataframe(), (seq(nrow(dataframe()))-1) %/% 200)
 }

 #Show the number of segments the data has been split into
 observeEvent(input$file1,output$totseg <-renderText({length(Splitfile())}))

  #Acceleration calculation function
  Acceleration <- function(){
  c <- lapply(1:length(Splitfile()), function(i)
  {

   acceleration <- c(0,diff(Splitfile()[[i]]$Vehicle.Speed)/2)


    })
 Splitfile <- mapply(cbind, Splitfile(), "acceleration" = c, SIMPLIFY = F)
 Splitfile
 }

 #Calculating Features 

  CaclFeatures <- function(){  
  FileFeatures <- lapply(1:length(Acceleration()), function(i){

   Velocity_mean <-round(mean(Acceleration()[[i]]$Vehicle.Speed),digits = 3)

   Variance_Velocity      <-round(var(Acceleration()[[i]]$Vehicle.Speed)*
                                    ((length(Acceleration( 
                               [[i]]$Vehicle.Speed)-1)/length(Acceleration() 
                               [[i]]$Vehicle.Speed))
                                   ,digits = 3)

      c(Velocity_mean,
        Variance_Velocity)

    })
     FileFeatures<- as.data.frame(do.call(rbind, FileFeatures))
     names(FileFeatures)[names(FileFeatures) == 'V1'] <- "Velocity_Mean"
     names(FileFeatures)[names(FileFeatures) == 'V2'] <- "Variance_Velocity"
    }

    #Display the table containing all features of all the segments
      output$table1 <- renderDataTable({
         CaclFeatures()},options = list(scrollX = TRUE))


    #Print to csv
       output$subtablednld <- downloadHandler(

         filename = function(){

              paste("dataset-", ".csv", sep = "")
           },

       content = function(file){

      write.csv(CaclFeatures(), file ,row.names = FALSE)
        }
         )

      })

如果我读取大约 2k 行的 csv 文件，该应用程序可以正常工作，但如果我读取的数据集超过 2k，则该应用程序无法正常工作，它既不会给出任何错误，也不会崩溃。微调器继续旋转，但无法显示结果。此外，在常规 R script 中使用相同的逻辑时，可以很好地处理超过 500k 的大型数据集，而我正在计算 22 的新功能。
目前，我正在使用8gb RAMi5 Processor的系统。有没有办法提高计算速度，当在我的任务管理器中检查时Rstudio 只使用大约47% - 52% 的内存，除了R studio 之外我没有其他进程在运行

编辑：可以使用以下代码创建示例数据，
drive <- as.data.frame(sample(1:50, 500000, replace = T))

Answer 1

您的整个计算似乎依赖于您的输入 data.frame 中的一些结构属性，因此我无法在合理的时间内生成一个工作示例，只需对您的代码进行微小的更改。

但是，您的代码评估在性能方面非常出色。

以Acceleration 为例。 在你的lapply，你调用Splitfile()，这是一个常规函数。假设拆分次数约为 2500，则调用此函数 2500 次。而split(dataframe(), (seq(nrow(dataframe()))-1) %/% 200)的操作在我的电脑上大约需要2秒，所以你等待5000秒，而Splitfiles()的结果总是一样的。然后，在CalcFeatures 内，您在每个lapply 循环内再次调用Acceleration() 四次。这使得大约等待时间为 5 000 * 2 500 * 4 = 50 000 000 秒或 578 天。

您可能对reactive 的概念感到困惑，其中函数调用只会返回当前值，并且重新计算是隐式的。

所以你要么：

1. 在函数的开头调用一次昂贵的函数。
   • 从files <- Splitfiles() 开始Acceleration，然后使用files。
   • 从acc <- Acceleration() 开始CalcFeatures，然后使用acc。
2. 把你的函数变成反应式。
   • Splitfiles <- reactive({ ... dataframe() ... })
   • Acceleration <- reactive({ ... Splitfiles() ... })
   • CalcFeature <- reactive({ ... Acceleration() ... })

这两个概念的混合并不好。坚持任何一个。