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-es] Optimizar bucle for
5 messages · Carlos J. Gil Bellosta, Griera
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
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 en 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 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
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 <griera en 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" <gilbellosta en 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 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
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" <gilbellosta en 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 <griera en 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" <gilbellosta en 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 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