Muchas gracias, Carlos!!
Pura màgia tu código que funciona a la perfección!
No se si conseguiré entenderlo nunca, pero lo intento.
Puedo preguntarte como funciona esto de :
delta = c(1000, diff(dates)))
¿Como es que en el primer registro coge 1000 i en los otros diff(dates)?
Muchas gracias y saludos: me has ahorrado muchas horas!
On Mon, 7 Oct 2024 16:02:17 +0200
"Carlos J. Gil Bellosta" <gilbello...@gmail.com> wrote:
> Prueba así:
>
> ---
>
> 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"))
> )
>
>
> # important!
> df <- df[order(df$id, df$dates),]
>
> 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))
> df <- ddply(df, .(id), transform, borrar = cumsum(borrar))
> n_borrar <- sum(df$borrar == 1)
> print(n_borrar)
> df <- df[df$borrar != 1,]
> }
> ---
>
> El programa no hacía lo que documentaba sino otra cosa distinta. Ahora solo
> borra una línea por id en cada pasada, la de la primera fila que está a
> menos de 6 meses de la anterior (por id). Antes podía haber borrado más de
> una fila.
>
> Un saludo,
>
> Carlos J. Gil Bellosta
> http://www.datanalytics.com
>
>
> On Mon, 7 Oct 2024 at 14:50, Griera <gri...@yandex.com> wrote:
>
> > 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" <gilbello...@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 <gri...@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@r-project.org
> > > > https://stat.ethz.ch/mailman/listinfo/r-help-es
> > > >
> >
_______________________________________________
R-help-es mailing list
R-help-es@r-project.org
https://stat.ethz.ch/mailman/listinfo/r-help-es
