2017-09-20 1 views
1

Ich habe einen Algorithmus in R erstellt, um mehrere Sensorwerte unter einem Zeitstempel zusammenzufassen.Fehler beim Beschleunigen Algorithmus

Die meisten Sensorwerte werden alle 500 ms gemessen, einige Sensoren melden jedoch nur Änderungen. Dazu musste ich einen Algorithmus erstellen, der zu einem bestimmten Zeitpunkt den letzten bekannten Wert eines Sensors annimmt.

Jetzt funktioniert der Algorithmus, aber es ist so langsam, dass, wenn ich anfangen würde, es für die tatsächlichen 20+ Sensoren zu verwenden, würde es Ewigkeiten dauern, um abzuschließen. Meine Hypothese ist, dass es langsam ist, weil ich Datenframes nutze oder auf meine Daten zugreife.

Ich habe versucht, es schneller zu machen, indem ich nur einmal durch jeden Datenrahmen lief und nicht für jeden Zeitstempel über sie hinwegging. Ich habe auch den gesamten für die Daten benötigten Speicherplatz vorab zugewiesen.

Alle Vorschläge wären sehr willkommen. Ich bin sehr neu in der Sprache R, so dass ich nicht wirklich weiß, welche Datentypen langsam und welche schnell sind.

library(tidyverse) 
library(tidytext) 
library(stringr) 
library(readr) 
library(dplyr) 
library(pracma)  

# take a list of dataframes as a parameter 
generalise_data <- function(dataframes, timeinterval){ 
    if (typeof(dataframes) == "list"){ 
    # get the biggest and smallest datetime stamp from every dataframe 
    # this will be used to calculate the size of the resulting frame ((largest time - smallest time)/1000 = dataframe rows) 
    # this means one value every second 

    largest_time <- 0 
    smallest_time <- as.numeric(Sys.time())*1000 # everything will be smaller than the current time 
    for (i in 1:length(dataframes)){ 
     dataframe_max <- max(dataframes[[i]]$TIMESTAMP) 
     dataframe_min <- min(dataframes[[i]]$TIMESTAMP) 

     if (dataframe_max > largest_time) largest_time <- dataframe_max 
     if (dataframe_min < smallest_time) smallest_time <- dataframe_min 
    } 

    # result dataframe wil have ... rows 
    result.size <- floor((largest_time - smallest_time)/timeinterval) 
    sprintf("Result size: %i", result.size) 

    # create a numeric array that contains the indexes of every dataframe, all set to 1 
    dataframe_indexes <- numeric(length(dataframes)) 
    dataframe_indexes[dataframe_indexes == 0] <- 1 

    # data vectors for the dataframe 
    result.timestamps <- numeric(result.size) 
    result <- list(result.timestamps) 
    for (i in 2:(length(dataframes)+1)) result[[i]] <- numeric(result.size) # add an empty vector for every datapoint 

    # use progressbar 
    pb <- txtProgressBar(1, result.size, style = 3) 

    # make a for loop to run through every data row of the resulting data frame (creating a row every run through) 
    # every run through increase the index of dataframes until the resulting row exceeds the result rows timestamp, than go one index back 
    #for (i in 1:200){ 
    for (i in 1:result.size){ 
     current_timestamp <- smallest_time + timeinterval*(i-1) 
     result[[1]][i] <- current_timestamp 

     for (i2 in 1:length(dataframes)){ 
     while (dataframes[[i2]]$TIMESTAMP[dataframe_indexes[i2]] < current_timestamp && dataframes[[i2]]$TIMESTAMP[dataframe_indexes[i2]] != max(dataframes[[i2]]$TIMESTAMP)){ 
      dataframe_indexes[i2] <- dataframe_indexes[i2]+1 
     } 

     if (dataframe_indexes[i2] > 1){ 
      dataframe_indexes[i2] <- dataframe_indexes[i2]-1 # take the one that's smaller 
     } 

     result[[i2+1]][i] <- dataframes[[i2]]$VALUE[dataframe_indexes[i2]] 
     } 

     setTxtProgressBar(pb, i) 
    } 

    close(pb) 

    result.final <- data.frame(result) 

    return(result.final) 
    } else { 
    return(NA) 
    } 
} 
+1

Wenn der Code funktioniert, gehört dies wahrscheinlich auf [codereview.se]. Ohne sich in Ihren Code zu vertiefen, hat er eine Menge Loops. Möglichkeiten zu finden, Ihren Code zu vektorisieren und/oder Dinge wie 'sapply' zu verwenden, um einige der Schleifen zu eliminieren, könnte helfen. Ein Buch, das ich hilfreich gefunden habe: "Efficient R Programming" von Gillespie und Lovelace –

+0

Ich habe meine Loops sehr sorgfältig ausgewählt, die einzige, die mehr Zeit benötigt als etwa 50ms ist: 'for (i in 1: result.size) {' jedoch da ist eine for-Schleife drin, die es vielleicht etwas verlangsamt ... Danke für den Vorschlag, es im Code Review zu veröffentlichen – Milan

+0

Mit 'for .. for ... while' hast du tief verschachtelte Loops, was auch sein mag das Problem. Es gibt Profiling-Tools, mit denen genau festgestellt werden kann, wo das Problem liegt. –

Antwort

1

Ich reparierte es heute, indem ich jeden Datenrahmen zu einer Matrix änderte. Der Code lief in 9,5 Sekunden statt in 70 Minuten.

Fazit: Datenrahmen sind sehr schlecht für die Leistung.

library(tidyverse) 
library(tidytext) 
library(stringr) 
library(readr) 
library(dplyr) 
library(pracma) 
library(compiler)  

# take a list of dataframes as a parameter 
generalise_data <- function(dataframes, timeinterval){ 
    time.start <- Sys.time() 
    if (typeof(dataframes) == "list"){ 
    # store the sizes of all the dataframes 
    resources.largest_size <- 0 
    resources.sizes <- numeric(length(dataframes)) 

    for (i in 1:length(dataframes)){ 
     resources.sizes[i] <- length(dataframes[[i]]$VALUE) 
     if (resources.sizes[i] > resources.largest_size) resources.largest_size <- resources.sizes[i] 
    } 

    # generate a matrix that can hold all needed dataframe values 
    resources <- matrix(nrow = resources.largest_size, ncol = length(dataframes)*2) 
    for (i in 1:length(dataframes)){ 
     j <- i*2 
     resources[1:resources.sizes[i],j-1] <- dataframes[[i]]$TIMESTAMP 
     resources[1:resources.sizes[i],j] <- dataframes[[i]]$VALUE 
    } 

    # get the biggest and smallest datetime stamp from every dataframe 
    # this will be used to calculate the size of the resulting frame ((largest time - smallest time)/1000 = dataframe rows) 
    # this means one value every second 
    largest_time <- 0 
    smallest_time <- as.numeric(Sys.time())*1000 # everything will be smaller than the current time 
    for (i in 1:length(dataframes)){ 
     dataframe_max <- max(dataframes[[i]]$TIMESTAMP) 
     dataframe_min <- min(dataframes[[i]]$TIMESTAMP) 

     if (dataframe_max > largest_time) largest_time <- dataframe_max 
     if (dataframe_min < smallest_time) smallest_time <- dataframe_min 
    } 

    # result dataframe wil have ... rows 
    result.size <- floor((largest_time - smallest_time)/timeinterval) 
    sprintf("Result size: %i", result.size) 

    # create a numeric array that contains the indexes of every dataframe, all set to 1 
    dataframe_indexes <- numeric(length(dataframes)) 
    dataframe_indexes[dataframe_indexes == 0] <- 1 

    # data matrix for the result 
    result <- matrix(data = 0, nrow = result.size, ncol = length(dataframes)+1) 

    # use progressbar 
    pb <- txtProgressBar(1, result.size, style = 3) 

    # make a for loop to run through every data row of the resulting data frame (creating a row every run through) 
    # every run through increase the index of dataframes until the resulting row exceeds the result rows timestamp, than go one index back 
    #for (i in 1:200){ 
    for (i in 1:result.size){ 
     current_timestamp <- smallest_time + timeinterval*(i-1) 
     result[i,1] <- current_timestamp 

     for (i2 in 1:length(dataframes)){ 
     j <- i2*2 
     while (resources[dataframe_indexes[i2],j-1] < current_timestamp && resources[dataframe_indexes[i2],j-1] != resources.sizes[i2]){ 
      dataframe_indexes[i2] <- dataframe_indexes[i2]+1 
     } 

     # at the moment the last value of the array is never selected, needs to be fixed 
     if (dataframe_indexes[i2] > 1){ 
      dataframe_indexes[i2] <- dataframe_indexes[i2]-1 # take the one that's smaller 
     } 

     result[i,i2+1] <- resources[dataframe_indexes[i2], j] #dataframes[[i2]]$VALUE[dataframe_indexes[i2]] 
     } 

     setTxtProgressBar(pb, i) 
    } 

    close(pb) 

    result.final <- data.frame(result) 

    time.end <- Sys.time() 
    print(time.end-time.start) 

    return(result.final) 
    } else { 
    return(NA) 
    } 
}