[R-es] Optimizar bucle for

[Griera]

Muchas gracias, Carlos, por esta ayuda!

Desconocia la existencia de ddply y me cuesta interpretar el código. Estoy en ello.

Realmente es mucho, pero mucho, más rápido. 

El problema es que si lo aplico a la tabla dde pruebas:
  id      dates
1  1 2023-01-01
2  1 2023-05-15
3  1 2023-12-01
4  2 2023-01-01
5  2 2023-04-01
6  2 2023-12-01
7  1 2023-03-15
8  3 2023-01-01

dif_days <- 180		# Cambiado 6 meses
df <- data.frame(
  id = c(1, 1, 1, 2, 2, 2, 1, 3),
  dates = 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"))
)

Borra incluso los registros de más de meses y solo queda:
> df
  id      dates delta borrar
1  1 2023-01-01  1000      0
2  2 2023-01-01  1000      0
3  3 2023-01-01  1000      0

¿Sabes que puede estar pasando?

Muchas gracias por la ayuda y saludos!

On Mon, 7 Oct 2024 13:24:56 +0200
"Carlos J. Gil Bellosta" <gilbellosta using gmail.com> wrote:

> 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
> >