Для цикла в R без лишних вычислений, занимающих слишком много времени (эффективность кода) - PullRequest
0 голосов
/ 05 апреля 2019

У меня большой фрейм данных, который занимает много времени для вычисления цикла for, я попытался удалить все вычисления, чтобы рассчитать цикл for, но у меня все еще есть неэффективный код. Я новичок в R, но я думаю, что должен быть лучший способ кодирования моего цикла for. Если бы вы могли предоставить некоторые рекомендации, это будет оценено.

В моем dataFrame содержится 2 772 807 obs из 6 переменных. enter image description here

Упрощенный код (все еще занимает много времени):

    library("tictoc")
    tic()

    dataFlights <- read_delim("U.S._DOT_O&D_Monthly_Traffic_Report.tsv",
                              "\t", escape_double = FALSE, trim_ws = TRUE)

    dataFlights["Connections"] = ""

    pb <- txtProgressBar(min = 0, max = nrow(dataFlights), style = 3)

    for (row in 1:nrow(dataFlights)) {
      dataFlights[row,7] <- 1
      setTxtProgressBar(pb, row)
    }
    close(pb)
    toc()

Оригинальный код:


    #Reads DOT public flight information for 2017 & 2018, 
    #and computes the number of connections 
    #per route (Cp#1 or Cp#2) into a new column. Possible results 0,1, or 2 connections. 

    library("tictoc")
    tic()

    dataFlights <- read_delim("U.S._DOT_O&D_Monthly_Traffic_Report.tsv",
                              "\t", escape_double = FALSE, trim_ws = TRUE)

    dataFlights["Connections"] = ""  

    pb <- txtProgressBar(min = 0, max = nrow(dataFlights), style = 3)

    for (row in 1:nrow(dataFlights)) {
      if(is.na(dataFlights[row,2]) & is.na(dataFlights[row,3])){
        dataFlights[row,7] <- 0
      } else if (is.na(dataFlights[row,2]) | is.na(dataFlights[row,3])) {
        dataFlights[row,7] <- 1
      } else {
        dataFlights[row,7] <- 2
      }
      setTxtProgressBar(pb, row)
    }
    close(pb)
    toc()

Ответы [ 2 ]

4 голосов
/ 05 апреля 2019

Как указано в комментариях, это можно сделать без усилий с помощью ifelse

# data
set.seed(123)
n <- 1e+6
dataFlights <- data.frame(x1 = runif(n), 
                          x2 = sample(c(runif(n/2), rep(NA, n/2)), n),
                          x3 = sample(c(runif(n/2), rep(NA, n/2)), n),
                          stringsAsFactors = FALSE
                          )

# conditions
na_2 <- is.na(.subset2(dataFlights, 2)) 
na_3 <- is.na(.subset2(dataFlights, 3))
na_sum <- na_2 + na_3

# ifelse
dataFlights$x4 <- ifelse(na_sum == 2, 0, ifelse(na_sum == 1, 1, 2))
head(dataFlights)
#          x1        x2        x3 x4
# 1 0.2875775        NA        NA  0
# 2 0.7883051 0.4415287        NA  1
# 3 0.4089769        NA 0.3130298  1
# 4 0.8830174 0.3077688        NA  1
# 5 0.9404673        NA        NA  0
# 6 0.0455565 0.5718788        NA  1

где для простоты я установил столбец 4 вместо столбца 7.

3 голосов
/ 05 апреля 2019

Несколько предложений:

dataFlights["Connections"] = ""

В этой части, если вы используете NA вместо "", размер данных будет меньше. Для сравнения я создал матрицу 3 000 000 x 3, чтобы увидеть размер. Различался только один столбец, у которого "" был размер 268 МБ, а у NA - всего около 60 МБ. Чем меньше размер, тем быстрее будет индекс.

pb <- txtProgressBar(min = 0, max = nrow(dataFlights), style = 3)

for (row in 1:nrow(dataFlights)) {
  dataFlights[row,7] <- 1
  setTxtProgressBar(pb, row)
}

На каждой итерации вы присваиваете 1 ячейке matrix / data.frame. Это назначение является вычислительно дорогим шагом. Для вашего примера это может быть полностью векторизовано. Вот несколько способов заставить 7-й столбец заменить ваш for цикл

rowSums

col7.rowSums = rowSums(!is.na(dataFlights[, 2:3]))

sapply

col7.sapply = sapply(1:nrow(dataFlights), function(x) sum(!is.na(dataFlights[x, 2:3])))

1020 * применить * col7.apply = apply(!is.na(dataFlights[, 2:3]), 1, sum) Microbenchmark

Unit: microseconds
     expr      min         lq        mean    median        uq        max neval
 for.loop 52604.86 56768.5590 58810.55595 58137.651 60064.056  81958.717   100
  rowSums    35.87    49.2225    61.23889    53.845    72.010    139.409   100
   sapply 49756.32 53131.1065 55778.95541 54414.455 56154.496 102558.473   100
    apply   997.21  1060.5380  1225.48577  1135.066  1254.936   3864.779   100
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...