roulement optimisée des fonctions sur des séries chronologiques avec fenêtre

La plupart des réponses suggèrent D'insérer NA pour rendre les séries chronologiques régulières. Toutefois, cela peut être lent dans le cas de longues séries chronologiques. En outre, il ne fonctionne pas pour les fonctions qui ne peuvent pas être utilisées avec NA.

l'argument width de rollapply (paquet zoo) peut être une liste (voir l'aide de rollapply pour plus de détails). Basé sur ceci j'ai écrit une fonction qui crée une liste à utiliser avec rollapply comme paramètre de largeur. La fonction extrait des index pour les objets de zoo irréguliers si le la fenêtre mobile doit être basée sur le temps et non sur l'index. Par conséquent, l'index de l'objet zoo doit être l'heure réelle.

# Create a zoo object where index represents time (e.g. in seconds) 

d <- zoo(c(1,1,1,1,1,2,2,2,2,2,16,25,27,27,27,27,27,31),     
         c(1:5,11:15,16,25:30,31))

# Create function 

createRollapplyWidth = function(zoodata, steps, window ){   

  mintime =  min(time(zoodata))     

  maxtime =  max(time(zoodata)) 

  spotstime = seq(from = mintime , to = maxtime, by = steps)

  spotsindex = list() 

    for (i in 1:length(spotstime)){
    spotsindex[[i]] =  as.numeric(which(spotstime[i]  <=  time(zoodata) & time(zoodata) < spotstime[i] + window))}

  rollapplywidth = list()
    for (i in 1:length(spotsindex)){
    if (!is.na(median(spotsindex[[i]])) ){ 
      rollapplywidth[[round(median(spotsindex[[i]]))]] = spotsindex[[i]] - round(median(spotsindex[[i]]))}
  }
  return(rollapplywidth)
  }


# Create width parameter for rollapply using function

rollwidth =  createRollapplyWidth(zoodata = d, steps = 5, window = 5) 

# Use parameter in rollapply 

result = rollapply(d, width = rollwidth , FUN =  sum, na.rm = T) 
result

Limitation: non basée sur la date mais sur le temps en secondes. Le paramètre "partial" de rollapply ne fonctionne pas.

Voici mon bricolage avec le problème. Si cela correspond à ce que vous vouliez (Je ne sais pas si c'est satisfaisant en termes de vitesse), je peux l'écrire comme une réponse plus détaillée (même si c'est basé sur l'idée de @rbatt).

library(zoo)
library(dplyr)

# create a long time series
start <- as.Date("1800-01-01")
end <- as.Date(Sys.Date())

df <- data.frame(V1 = seq.Date(start, end, by = "day"))
df$V2 <- sample(1:10, nrow(df), replace = T)

# make it an irregular time series by sampling 10000 rows
# including allowing for duplicates (replace = T)
df2 <- df %>% 
  sample_n(10000, replace = T)

# create 'complete' time series & join the data & compute the rolling median
df_rollmed <- data.frame(V1 = seq.Date(min(df$V1), max(df$V1), by = "day")) %>% 
  left_join(., df2) %>% 
  mutate(rollmed = rollapply(V2, 5, median, na.rm = T, align = "right", partial = T)) %>% 
  filter(!is.na(V2)) # throw out the NAs from the complete dataset

N'ont pas vérifié la vitesse mais si aucune date a plus de max.dup occurences, alors ce doit être que le dernier 5 * max.dup entrées contiennent les 5 derniers jours de sorte que la ligne la fonction fn ci-dessous passe àrollapplyr le ferai:

k <- 5

dates <- as.numeric(DF$date)
values <- DF$value

max.dup <- max(table(dates))

fn <- function(ix, d = dates[ix], v = values[ix], n = length(ix)) median(v[d >= d[n]-k])

rollapplyr(1:nrow(DF), max.dup * k, fn, partial = TRUE)
## [1] 5.0 4.5 4.0 1.0 0.5 0.0 0.0 0.0 2.5 3.0

Remarque: Nous avons utilisé ce pour DF:

 Lines <- "
      date  value
 1/11/2011      5
 1/11/2011      4
 1/11/2011      2
 8/11/2011      1
13/11/2011      0
14/11/2011      0
15/11/2011      0
18/11/2011      1
21/11/2011      4
 5/12/2011      3
"
DF <- read.table(text = Lines, header = TRUE)
DF$date <- as.Date(DF$date, format = "%d/%m/%Y")

nous pouvons le faire simplement en utilisant Application de base comme suit:

première mise en place des données (basée sur la note de @G-grothendieck)

library(data.table)
Lines <- "
      date  value
1/11/2011      5
1/11/2011      4
1/11/2011      2
8/11/2011      1
13/11/2011      0
14/11/2011      0
15/11/2011      0
18/11/2011      1
21/11/2011      4
5/12/2011      3
"
DT <- as.data.table(read.table(text = Lines, header = TRUE))
DT$date <- as.Date(DF$date, format = "%d/%m/%Y")
DT$row <- 1:NROW(DF)
setkey(DT, row, date) #mark columns as sorted, for speed

notez que j'ai ajouté un vecteur à la table de données contenant le numéro de ligne, de sorte que nous pouvons passer le numéro de ligne dans la fonction appliquer. J'ai également utilisé la table de données pour simplifier la syntaxe pour l'étape suivante, et pour accélérer la fonction si elle est appliquée à de grands tableaux. Maintenant, nous utilisons s'appliquent comme suit:

roll.median.DT <- function(x){
  this.date <- as.Date(x[1])
  this.row <- as.numeric(x[3])
  median(DT[row <= this.row & date >= (this.date-5)]$value) #NB DT is not defined within function, so it is found from parent scope
}
apply(DT, FUN=roll.median.DT, MARGIN = 1)
[1] 5.0 4.5 4.0 1.0 0.5 0.0 0.0 0.0 2.5 3.0