[R-es] Optimizar bucle for
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 en 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 en r-project.org https://stat.ethz.ch/mailman/listinfo/r-help-es