J'essaie de calculer la moyenne de certaines données selon une séquence de dates non régulière. Par exemple, j'ai des données de niveau minute pour des périodes spécifiques de la journée et je suis intéressé par le calcul de moyennes de 5 minutes. Cependant, je ne sais pas comment le paramètre width fonctionne dans rollapply lorsqu'il est spécifié sous forme de liste.
library(tidyverse)
library(zoo)
length = 16
set.seed(10)
dxf <- data.frame(
date = seq(Sys.time(), by = "59 sec", length.out = length),
value = runif(length)
)
# Create a "discontinuity"
dxf$date[8:length] <- dxf$date[8:length] + 3600*24
# Add some noise
dxf$date <- dxf$date + runif(length, 0, 1)
diff(dxf$date)
dxf %>%
arrange(date) %>%
mutate(
diff = c(as.numeric(diff(date)), NA),
mean = rollapply(value, width = 5, mean, partial = TRUE, align = "left")
)
# This is what I need. Therefore, I need a variable width but adjusting to the discontinuity in the rows.
mean1 <- mean(dxf$value[1:5])
mean2 <- mean(dxf$value[2:6])
mean3 <- mean(dxf$value[3:7])
mean4 <- NA # Only have 4 values mean(dxf$value[4:7])
mean5 <- NA # Only have 3 values mean(dxf$value[5:7])
mean6 <- NA # Only have 2 values mean(dxf$value[6:7])
mean7 <- NA # Only have 1 values mean(dxf$value[7:7])
mean8 <- mean(dxf$value[7:11])
etc.
3 Réponses :
Je pense que c'est un problème délicat. Voici une approche
1 Générer une séquence de 1 min de la première à la dernière date / heure
2 Interpoler donc nous avons une valeur à chaque 1 min. Cela inclut l'interpolation à travers la discontinuité
3 Calculez la moyenne de 5 min en fonction des valeurs interpolées sur 1 min
4 Supprimez les valeurs où l'écart dans les valeurs de date / heure d'origine est trop grand / p>
Aussi, faites attention aux fuseaux horaires, mieux vaut les définir sur une valeur ou UTC délibérément choisie, ce que font les fonctions de lubrification par défaut.
library(tidyverse)
library(RcppRoll)
library(lubridate)
dxf <- tibble(
date = seq(from = ymd_hms('2019-08-14 09:06:05'), by = "59 sec", length.out = 30),
value = runif(30)
)
dxf$date[15:30] <- dxf$date[15:30] + 3600*24 # discontinuing
dxf$date <- dxf$date + round(runif(30)) # noise
dxf <- dxf %>%
mutate(date = ymd_hms(date),
date_num = as.numeric(date),
diff = date_num - lag(date_num))
discontinuity <- which(dxf$diff > 70)
n = nrow(dxf)
date_seq <- seq(from = dxf$date_num[1], to = dxf$date_num[n], by = 60) # create a 1 min sequence
value_interp = approx(x = dxf$date_num, y = dxf$value, xout = date_seq) # interpolate values for the 5 min sequence
df <- tibble(
date = as_datetime(date_seq),
mean_value = RcppRoll::roll_mean(value_interp$y, n = 5, fill = NA, align = 'left'))
df %>%
filter(date < dxf$date[discontinuity - 1] | date > dxf$date[discontinuity])
Pour le moment, j'évite d'interpoler les données mais merci pour la suggestion.
Nous pourrions extraire la date, les regrouper puis utiliser rollmean
set.seed(10) dxf <- data.frame( date = seq(Sys.time(), by = "59 sec", length.out = length), value = runif(length) ) dxf$date[8:length] <- dxf$date[8:length] + 3600*24 dxf$date <- dxf$date + runif(length, 0, 1)
data
library(dplyr) dxf %>% mutate(d1 = as.Date(date)) %>% group_by(d1) %>% mutate(mean = zoo::rollmean(value, 5, align = "left", fill = NA)) %>% ungroup %>% select(-d1) # date value mean # <dttm> <dbl> <dbl> # 1 2019-08-14 12:49:09 0.507 0.404 # 2 2019-08-14 12:50:08 0.307 0.347 # 3 2019-08-14 12:51:07 0.427 0.341 # 4 2019-08-14 12:52:07 0.693 NA # 5 2019-08-14 12:53:06 0.0851 NA # 6 2019-08-14 12:54:05 0.225 NA # 7 2019-08-14 12:55:04 0.275 NA # 8 2019-08-15 12:56:02 0.272 0.507 # 9 2019-08-15 12:57:01 0.616 0.476 #10 2019-08-15 12:58:01 0.430 0.472 #11 2019-08-15 12:59:00 0.652 0.457 #12 2019-08-15 12:59:58 0.568 0.413 #13 2019-08-15 13:00:58 0.114 NA #14 2019-08-15 13:01:56 0.596 NA #15 2019-08-15 13:02:56 0.358 NA #16 2019-08-15 13:03:54 0.429 NA
Ici w [i] est le nombre d'éléments de date qui sont inférieurs ou égaux à date [i] + 300 moins i - 1 en notant que 300 correspond à 300 secondes.
date <- dxf$date w <- findInterval(date + 300, date) - seq_along(date) + 1 rollapply(dxf$value, w, mean, align = "left") * ifelse(w < 5, NA, 1) # same sapply(seq_along(w), function(i) mean(dxf$value[seq(i, length = w[i])])) * ifelse(w < 5, NA, 1)
Peut-être supprimer ou remplacer les mauvaises données par
NAavantrollapply?La valeur de la ligne 14 est utilisée pour calculer la moyenne des lignes 10, 11, 12, 13 et 14. Donc, si
valeur [14]est définie sur NAmean [10:14] < / code> sera NA@TonyLadson; Correct. J'ai changé un peu le reprex pour le raccourcir mais j'aurai besoin de NA dans ce cas pour la ligne 4: 7.