Modérateur : Groupe des modérateurs
Code : Tout sélectionner
## J'ai exécuté votre code précedamment, donc j'ai toutes les variables en mémoire. Notamment, tableau1,
## qui est le résultat attendu.
library(tidyr)
suppressPackageStartupMessages(library(dplyr))
(table_totales <-
bind_rows(
data,
data %>% mutate(DATE = DATE - 1),
data %>% mutate(DATE = DATE - 2)
) %>%
group_by(IPP, DATE) %>%
summarise(total = sum(compteur), .groups = "drop") %>%
filter(DATE >=min(data$DATE), DATE <=max(data$DATE) - 2) %>%
pivot_wider(id_cols = IPP, names_from = DATE, values_from = total, values_fill = 0)
)
#> # A tibble: 6 x 8
#> IPP `2020-01-01` `2020-01-02` `2020-01-03` `2020-01-04` `2020-01-05`
#> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 2001 4 5 6 5 2
#> 2 2012 1 5 5 5 1
#> 3 2200 1 1 1 0 0
#> 4 3352 1 2 2 3 2
#> 5 4785 0 0 1 1 1
#> 6 5628 1 1 0 0 0
#> # … with 2 more variables: `2020-01-06` <dbl>, `2020-01-07` <dbl>
# Ce tableau n'est pas identique au votre solution pour deux raisons :
# 1. Votre IPP_list n'est pas ordonnée,
# 2. vous avez mis 2220 dans IPP_list tandis que dans les données il y a 2200.
# Est-ce un erreur, ou bien vous voulez garder la possibilité des codes absentes
# ?
#
# Dans ce dernier cas, il vous faut ajouter encore :
table_totales <-
data.frame(
IPP = IPP_list
) %>%
left_join(
table_totales,
by = "IPP"
) %>%
mutate_all(replace_na, 0) %>%
arrange(IPP)
## Vérification : là on retrouve exactement votre solution (sauf pour l'arrangement)
identical(
tableau1 %>% arrange(IPP),
table_totales
)
#> [1] TRUE
Code : Tout sélectionner
data <- data.frame(
IPP = c(rep("2001", 9), rep("2012", 9), "2200", rep("3352", 4), "5628", "4785"),
DATE = c(
"01/01/2020", "01/01/2020", "02/01/2020", "03/01/2020", "04/01/2020",
"04/01/2020", "04/01/2020", "05/01/2020", "05/01/2020", "01/01/2020",
"04/01/2020", "04/01/2020", "04/01/2020", "04/01/2020", "04/01/2020",
"07/01/2020", "08/01/2020", "09/01/2020", "03/01/2020", "02/01/2020",
"04/01/2020", "05/01/2020", "06/01/2020", "02/01/2020", "05/01/2020"
),
compteur = c(rep(1, 25))
)
data$DATE <- as.Date(data$DATE, "%d/%m/%Y")
Code : Tout sélectionner
library("data.table", warn.conflicts = FALSE)
dta <- as.data.table(data)
results <- dcast(
data = dta[
CJ(IPP = IPP, DATE = seq(min(DATE), max(DATE), "1 day"), unique = TRUE),
on = .(IPP, DATE)
][
.(IPP = IPP, start = DATE, end = DATE + 2),
on = .(IPP, DATE >= start, DATE <= end),
somme_compteur := sum(compteur, na.rm = TRUE),
by = .EACHI
][
,
unique(.SD),
.SDcols = c("IPP", "DATE", "somme_compteur")
],
formula = IPP ~ DATE,
value.var = "somme_compteur",
fill = 0
)
Code : Tout sélectionner
results
#> IPP 2020-01-01 2020-01-02 2020-01-03 2020-01-04 2020-01-05 2020-01-06 2020-01-07 2020-01-08 2020-01-09
#> 1: 2001 4 5 6 5 2 0 0 0 0
#> 2: 2012 1 5 5 5 1 2 3 2 1
#> 3: 2200 1 1 1 0 0 0 0 0 0
#> 4: 3352 1 2 2 3 2 1 0 0 0
#> 5: 4785 0 0 1 1 1 0 0 0 0
#> 6: 5628 1 1 0 0 0 0 0 0 0
Code : Tout sélectionner
library("data.table", warn.conflicts = FALSE)
library("tidyr", warn.conflicts = FALSE)
library("dplyr", warn.conflicts = FALSE)
periode_interet <- seq(as.Date("01/01/2020", "%d/%m/%Y"), as.Date("09/01/2020", "%d/%m/%Y"), 1)
periode_interet2 <- seq(as.Date("01/01/2020", "%d/%m/%Y"), as.Date("07/01/2020", "%d/%m/%Y"), 1) # s'arrête 2 jours avant avant
periode_interet3 <- data.frame("jour" = periode_interet2)
periode_interet3$compteur <- 1
periode_interet3 <- spread(periode_interet3, jour, compteur)
IPP_list <- c("2001", "2012", "2220", "3352", "5628", "4785")
data <- data.frame(
IPP = c(rep("2001", 9), rep("2012", 9), "2200", rep("3352", 4), "5628", "4785"),
DATE = c(
"01/01/2020", "01/01/2020", "02/01/2020", "03/01/2020", "04/01/2020",
"04/01/2020", "04/01/2020", "05/01/2020", "05/01/2020", "01/01/2020",
"04/01/2020", "04/01/2020", "04/01/2020", "04/01/2020", "04/01/2020",
"07/01/2020", "08/01/2020", "09/01/2020", "03/01/2020", "02/01/2020",
"04/01/2020", "05/01/2020", "06/01/2020", "02/01/2020", "05/01/2020"
),
compteur = c(rep(1, 25))
)
data$DATE <- as.Date(data$DATE, "%d/%m/%Y")
bm <- bench::mark(check = FALSE,
base = {
tableau1 <- data.frame(matrix(NA, ncol = length(periode_interet2), nrow = length(IPP_list)))
colnames(tableau1) <- periode_interet2
tableau1$IPP <- IPP_list
tableau1 <- tableau1[, c(8, 1:7)]
for (i in 2:(length(periode_interet2) + 1)) {
for (j in 1:length(IPP_list)) {
tableau1[j, i] <- sum(
data$compteur[
data$IPP == IPP_list[j] & (
data$DATE >= periode_interet[i - 1] & data$DATE <= periode_interet[i + 2 - 1]
)
]
)
}
}
},
tidy = {
bind_rows(
data,
data %>% mutate(DATE = DATE - 1),
data %>% mutate(DATE = DATE - 2)
) %>%
group_by(IPP, DATE) %>%
summarise(total = sum(compteur), .groups = "drop") %>%
filter(DATE >=min(data$DATE), DATE <=max(data$DATE) - 2) %>%
pivot_wider(id_cols = IPP, names_from = DATE, values_from = total, values_fill = 0)
},
dt = {
dta <- as.data.table(data)
dcast(
data = dta[
CJ(IPP = IPP, DATE = seq(min(DATE), max(DATE), "1 day"), unique = TRUE),
on = .(IPP, DATE)
][
.(IPP = IPP, start = DATE, end = DATE + 2),
on = .(IPP, DATE >= start, DATE <= end),
somme_compteur := sum(compteur, na.rm = TRUE),
by = .EACHI
][
,
unique(.SD),
.SDcols = c("IPP", "DATE", "somme_compteur")
],
formula = IPP ~ DATE,
value.var = "somme_compteur",
fill = 0
)
}
)
plot(bm)
Code : Tout sélectionner
bm
#> # A tibble: 3 x 6
#> expression min median `itr/sec` mem_alloc `gc/sec`
#> <bch:expr> <bch:tm> <bch:tm> <dbl> <bch:byt> <dbl>
#> 1 base 13.2ms 14.1ms 68.7 3.73MB 19.2
#> 2 tidy 21.3ms 21.9ms 45.6 3.46MB 12.7
#> 3 dt 10.5ms 11ms 90.0 3.67MB 6.59
Facundo Muñoz a écrit :Juste par curiosité, vous disiez que cela prenait 8 h avec votre code original. Cet approche a t'il amélioré la performance ?
Mickael Canouil a écrit :Bonjour,
une approche avec data.table pour vraiment une question de performance : ...
Facundo Muñoz a écrit :Super.
Juste par curiosité, vous disiez que cela prenait 8 h avec votre code original. Cet approche a t'il amélioré la performance ?
ƒacu.-
Retourner vers « Questions en cours »
Utilisateurs parcourant ce forum : Aucun utilisateur enregistré et 1 invité