[R-es] Optimizar bucle for

[Carlos J. Gil Bellosta]

Hola, ¿qué tal?

Modifica esto:

----

library(plyr)

n_reg <- 332505
n_ids <- 63738

dif_days <- 90

df <- data.frame(
  id = sample(n_ids, n_reg, replace = T),
  dates = sample(1000, n_reg, replace = T)
)

# important!
df <- df[order(df$id, df$date),]

n_borrar <- 1

while (n_borrar > 0) {
  df <- ddply(df, .(id), transform, delta = c(1000, diff(dates)))
  # find the first register by id in less than dif_days
  df <- ddply(df, .(id), transform, borrar = cumsum(delta < dif_days))
  n_borrar <- sum(df$borrar == 1)
  print(n_borrar)
  df <- df[df$borrar != 1,]
}

----

Se puede hacer un poco mejor (sacando los ids que ya están limpios de la
iteración), pero no vale la pena: tarda un par de minutos.

Un saludo,

Carlos J. Gil Bellosta
http://www.datanalytics.com


On Mon, 7 Oct 2024 at 12:01, Griera <griera using yandex.com> wrote:

> Hola a todos:
>
> Tengo un bucle que tarda horas y me gustaría optimizarlo. Me explico.
> Simplificando, tengo una tabla con 332.505 registros de 63.738 individuos.
> Cada registro es una medida realiza de unos
> días a unos meses o años después de la anterior. Lo que quiero es borrar
> aquellos registros que entre él y el anterior hayan transcurrido menos
> de 6 meses, de manera que me quede una tabla con sólo aquellas medidas
> realizadas al menos 6 meses después de la anterior.
>
> La tabla simplificada (no diferencio entre medida y ID y con una nueva
> columna “BORRAR”) seria:
>
> ## Código
> df <- data.frame(
>   ID = c(1, 1, 1, 2, 2, 2, 1, 3),
>   date = as.Date(c("2023-01-01", "2023-05-15", "2023-12-01", "2023-01-01",
> "2023-04-01", "2023-12-01", "2023-03-15", "2023-01-01")),
>   BORRAR = 0)
>
> ## El código con el bucle (doble bucle) es:
>
> # Definir umbral : 6 meses: si registro posterior menor 6 meses: borrar
> umbral <- 30.5 * 6
>
> # Ordenar por ID i fecha
> df <- df[order(df$ID, df$date), ]
>
> # Bucle per cada ID
> for (id in unique(df$ID)) {
>   # Filtrar per ID actual
>   subset_df <- df[df$ID == id, ]
>
>   # Si hay más de un registro borrar aquellos de más de 6 meses
>   if (nrow(subset_df) > 1) {
>     # Inicializar la referencia del primer registro no borrado
>     reference_date <- subset_df$date[1]
>
>     for (i in 2:nrow(subset_df)) {
>       # Calcular la diferencia en días respecto a la referencia
>       diff_days <- as.numeric(difftime(subset_df$date[i], reference_date,
> units = "days"))
>
>       # Si la diferencia es menor que el umbral, marcado para borrar
>       if (diff_days < umbral) {
>         df$BORRAR[df$ID == id & df$date == subset_df$date[i]] <- 1
>       } else {
>         # Actualizar la fecha referencia al nuevo registro no borrado
>         reference_date <- subset_df$date[i]
>       }   ## Fin de if (diff_days < umbral)
>                 }                       ## Fin del for (I in
> 2:nrow(subset_df))
>   }                             ## Fin de (nrow(subset_df) > 1)
> }
>
> # Resultado sin borrar registros
> df
>
> ## fin Código
>
> El problema es que tarda muchas horas en ejecutarse. He intentado
> optimizarlo (antes tardaba más), pero ya no se más R. ¿Algunas
> sugerencias pera que vaya más rápido?
>
> Muchas gracias de antemano por su ayuda.
>
> _______________________________________________
> R-help-es mailing list
> R-help-es using r-project.org
> https://stat.ethz.ch/mailman/listinfo/r-help-es
>

	[[alternative HTML version deleted]]