Versão mais eficiente deste loop R

Question

Estou acostumado com Python e JS, e muito novo em R, mas gosto dele para análise de dados.Eu estava procurando criar um novo campo em meu quadro de dados, com base em alguma lógica if/else, e tentei fazer isso de maneira padrão/procedimental:

for (i in 1:nrow(df)) {
  if (is.na(df$First_Payment_date[i]) == TRUE) {
    df$User_status[i] = "User never paid"
  } else if (df$Payment_Date[i] >= df$First_Payment_date[i]) {
    df$User_status[i] = "Paying user"
  } else if (df$Payment_Date[i] < df$First_Payment_date[i]) {
    df$User_status[i] = "Attempt before first payment"
  } else {
    df$User_status[i] = "Error"
  }
}

Mas foi MUITO lento.Tentei executar isso em um quadro de dados de aproximadamente 3 milhões de linhas e demorou muito, muito tempo.Alguma dica sobre a maneira "R" de fazer isso?

Observe que o df$Payment_Date e df$First_Payment_date os campos são formatados como datas.

Answer 1

estou comparando data.frame e data.table para um conjunto de dados relativamente grande.

Primeiro geramos alguns dados.

set.seed(1234)
library(data.table)
df = data.frame(First_Payment_date=c(sample(c(NA,1:100),1000000, replace=1)),
                 Payment_Date=c(sample(1:100,1000000, replace=1)))
dt = data.table(df)

Em seguida, configure o benchmark.Estou testando entre a resposta do @BondedDust e seu data.table equivalência.Modifiquei ligeiramente (depurei) seu código.

library(microbenchmark)

test_df = function(){
    df$User_status <- "Error"
    df$User_status[ is.na(df$First_Payment_date) ] <- "User never paid"
    df$User_status[ df$Payment_Date >= df$First_Payment_date ] <- "Paying user"
    df$User_status[ df$Payment_Date < df$First_Payment_date ] <- "Attempt before first payment"
}

test_dt = function(){
    dt[, User_status := "Error"]
    dt[is.na(First_Payment_date), User_status := "User never paid"]
    dt[Payment_Date >= First_Payment_date, User_status := "Paying user"]
    dt[Payment_Date < First_Payment_date, User_status := "Attempt before first payment"]
}

microbenchmark(test_df(), test_dt(), times=10)

O resultado: data.table é 4x mais rápido que data.frame para os dados de 1 milhão de linhas gerados.

> microbenchmark(test_df(), test_dt(), times=10)
Unit: milliseconds
      expr       min        lq    median        uq       max neval
 test_df() 247.29182 256.69067 287.89768 319.34873 330.33915    10
 test_dt()  66.74265  69.42574  70.27826  72.93969  80.89847    10

Observação

data.frame é mais rápido que data.table para conjunto de dados pequeno (digamos, 10.000 linhas).

Answer 2

Se você inicializar com "erro" e depois substituir as condições enumeradas usando a indexação lógica, isso deverá ser muito mais rápido.Essas instruções if(){}else{} para cada linha estão matando você.

df$User_status <- "Error"
df$User_status[ is.na(df$First_Payment_date) ] <- "User never paid"
df$User_status[ df$Payment_Date >= df$First_Payment_date ] <- "Paying user"
df$User_status[ df$Payment_Date < df$First_Payment_date ] <- "Attempt before first payment"

Answer 3

Não tenho certeza de que isso irá acelerar muito, mas você deverá ver alguma melhoria em relação ao for loop que você tinha antes.O elsenão são realmente necessários nessas condições.

Além disso, R tem funções que atuam como for loops e outros tipos de loops.Ver ?apply.

Experimente, veja como funciona.Não posso testar porque não temos seus dados.

> df$User_status[i] <- rep("Error", nrow(df)) 
      ## allocate a vector, fill it with "Error"

> sapply(seq(nrow(df)), function(i){

    if(is.na(df$First_Payment_date[i])){ 
      gsub("Error", "User never paid", df$User_status[i]) }

    if(df$Payment_Date[i] >= df$First_Payment_date[i]){
      gsub("Error", "Paying user", df$User_status[i]) }

    if (df$Payment_Date[i] < df$First_Payment_date[i]) {
      gsub("Error", "Attempt before first payment", df$User_status[i]) }

    })

Answer 4

A maneira usual de lidar com esse tipo de coisa é através ifelse.

df$User_status <- with(df,
    ifelse(is.na(First_Payment_date), "User never paid",
    ifelse(Payment_Date >= First_Payment_date, "Paying user",
    ifelse(Payment_Date < First_Payment_date, "Attempt before first payment",
    "Error"))))