[R-es] Optimizar bucle for

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.