Versión más eficiente de este bucle R

Question

Estoy acostumbrado a Python y JS, y soy bastante nuevo en R, pero lo disfruto para el análisis de datos.Estaba buscando crear un nuevo campo en mi marco de datos, basado en alguna lógica if/else, e intenté hacerlo de una manera estándar/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"
  }
}

Pero fue MUY lento.Intenté ejecutar esto en un marco de datos de aproximadamente 3 millones de filas y tomó demasiado tiempo.¿Algún consejo sobre la forma "R" de hacer esto?

Tenga en cuenta que el df$Payment_Date y df$First_Payment_date Los campos tienen el formato de fechas.

Answer 1

estoy comparando data.frame y data.table para conjuntos de datos relativamente grandes.

Primero generamos algunos datos.

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)

Luego configure el punto de referencia.Estoy probando entre la respuesta de @BondedDust y su data.table equivalencia.He modificado ligeramente (depurado) su 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)

El resultado: data.table es 4 veces más rápido que data.frame para los datos generados de 1 millón de filas.

> 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

Nota

data.frame es más rápido que data.table para conjuntos de datos pequeños (digamos, 10000 filas).

Answer 2

Si inicializa con "error" y luego sobrescribe las condiciones enumeradas utilizando la indexación lógica, esto debería ser mucho más rápido.Esas declaraciones if(){}else{} para cada fila te están matando.

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

No estoy seguro de que esto lo acelere mucho, pero deberías ver alguna mejora con respecto al for bucle que tenías antes.El elseNo son realmente necesarios en estas condiciones.

Además, R tiene funciones que actúan como for bucles y otros tipos de bucles.Ver ?apply.

Pruébalo y mira cómo funciona.No puedo probarlo porque no tenemos tus datos.

> 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

La forma habitual de manejar este tipo de cosas es a través de 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"))))