Переведите R для l oop в функцию применения - PullRequest
Новая
       26

Переведите R для l oop в функцию применения

0 голосов
/ 19 февраля 2020

Я написал для l oop в своем коде 

for(i in 2:nrow(ProductionWellYear2)) {

  if (ProductionWellYear2[i,ncol(ProductionWellYear2)] == 0) {
    ProductionWellYear2[i, ncol(ProductionWellYear2)] = ProductionWellYear2[i-1,ncol(ProductionWellYear2)] +1}


  else {ProductionWellYear2[i,ncol(ProductionWellYear2)] = ProductionWellYear2[i,ncol(ProductionWellYear2)]}


  }

Однако это очень трудоемкий процесс, поскольку в этом кадре данных более 800 тыс. Строк. Как я могу сделать это быстрее и избежать для l oop?

Ответы [ 2 ]

2 голосов
/ 19 февраля 2020

Вы можете использовать условное присвоение, используя потенциал R. в качестве векторизованного языка.

Рассмотрите этот начальный кадр данных: 

          X1          X2         X3 year
1  1.3709584 -0.09465904 -0.1333213 2014
2 -0.5646982  2.01842371  0.6359504    0
3  0.3631284 -0.06271410 -0.2842529 2016
4  0.6328626  1.30486965 -2.6564554    0
5  0.4042683  2.28664539 -2.4404669 2018
6 -0.1061245 -1.38886070  1.3201133    0
7  1.5115220 -0.27878877 -0.3066386 2020

Затем выполните: 

num.col <- ncol(ProductionWellYear2)  # to keep code short

ProductionWellYear2[ProductionWellYear2[num.col] == 0, num.col] <- 
  ProductionWellYear2[which(ProductionWellYear2[num.col] == 0) - 1, num.col] + 1

Результирующий фрейм данных: 

           X1         X2          X3 year
1 -0.16137564 -1.0344340 -2.18025447 2014
2  0.60828818  1.8149734  1.11955225 2015
3  0.02006922  1.1641742  2.08033131 2016
4 -0.70472925  0.4136222  0.95275587 2017
5  0.43061575  1.0180987 -0.26629157 2018
6 -2.49764918  0.5957401 -2.06162220 2019
7 -1.00775410  1.1497179 -0.03193637 2020

Данные: 

ProductionWellYear2 <- structure(list(X1 = c(1.37095844714667, -0.564698171396089, 0.363128411337339, 
0.63286260496104, 0.404268323140999, -0.106124516091484, 1.51152199743894
), X2 = c(-0.0946590384130976, 2.01842371387704, -0.062714099052421, 
1.30486965422349, 2.28664539270111, -1.38886070111234, -0.278788766817371
), X3 = c(-0.133321336393658, 0.635950398070074, -0.284252921416072, 
-2.65645542090478, -2.44046692857552, 1.32011334573019, -0.306638594078475
), year = c(2014, 0, 2016, 0, 2018, 0, 2020)), row.names = c(NA, 
-7L), class = "data.frame")
0 голосов
/ 19 февраля 2020

Это должно сработать для вас, но, не видя ваших данных, я не могу убедиться, что результаты - это то, что вы хотите. Это, как говорится, на самом деле в этом процессе не так много иного, как изначально написано, но бенчмаркинг действительно показывает, что он быстрее с моими примерами данных, но не обязательно "быстро". 

library(microbenchmark)
# Create fake data
set.seed(1)
ProductionWellYear <- data.frame(A = as.integer(rnorm(2500)),
                                 B = as.integer(rnorm(2500)),
                                 C = as.integer(rnorm(2500))
)

# Copy it to confirm results of both processes are the same
ProductionWellYear2 <- ProductionWellYear


# Slightly modified original version
cols <- ncol(ProductionWellYear)
method1 <- function(){
  for(i in 2:nrow(ProductionWellYear)) {
    if (ProductionWellYear[i, cols] == 0) {
      ProductionWellYear[i, cols] = ProductionWellYear[i - 1, cols] +1
    }
    else {
      ProductionWellYear[i, cols] = ProductionWellYear[i, cols]
    }
  }
}

# New version
cols <- ncol(ProductionWellYear2)
method2 <- function() {
  sapply(2:nrow(ProductionWellYear2), function(i) {
    if (ProductionWellYear2[i, cols] == 0) {
      ProductionWellYear2[i, cols] <<- ProductionWellYear2[i - 1, cols] +1
    }
  })
}


# Comparing the outputs
all(ProductionWellYear == ProductionWellYear2)
#[1] TRUE

result <- microbenchmark(method1(), method2())
result
#Unit: milliseconds
#      expr      min       lq     mean   median       uq       max neval
#  method1() 151.78802 167.3932 190.14905 176.2855 197.60406 337.9904   100
#  method2()  45.56065  53.7744  67.55549  59.9299  72.81873 174.1417   100
...