R - Schnelle Methode zur Berechnung des rollenden Mittelwerts bei unterschiedlicher Breite

Question

Ich habe einen Datenrahmen, der Bankaktiva für mehrere Daten (Zeiten) enthält. Jede Bank hat eine eindeutige ID:

# Sample Data 
time <- c(51, 52, 53, 55, 56, 51, 52, 51, 52, 53) 
id <- c(1234, 1234, 1234, 1234, 1234, 2345, 2345, 3456, 3456, 3456) 
name <- c("BANK A", "BANK A", "BANK A", "BANK A", "BANK A", "BANK B", "BANK B", "BANK C", 
      "BANK C", "BANK C") 
assets <- c(5000, 6000, 4000, 7000, 8000, 10000, 12000, 30000, 35000, 40000) 
df <- data.frame(time, id, name, assets) 

> df 
    time id name assets 
1 51 1234 BANK A 5000 
2 52 1234 BANK A 6000 
3 53 1234 BANK A 4000 
4 55 1234 BANK A 7000 
5 56 1234 BANK A 8000 
6 51 2345 BANK B 10000 
7 52 2345 BANK B 12000 
8 51 3456 BANK C 30000 
9 52 3456 BANK C 35000 
10 53 3456 BANK C 40000 

Für jede Bank ich die Roll Mittel der Vermögenswerte berechnet werden soll, variiert die Breite entsprechend der Anzahl von aufeinanderfolgenden Zeitwerte. Der rollierende Mittelwert muss also alle verfügbaren aufeinanderfolgenden vorherigen Werte der Asssets einer Bank enthalten. Wenn für eine Bank kein vorheriger Wert verfügbar ist, entspricht sie den Aktiva. Deshalb füge ich eine Spalte, die die Anzahl von aufeinanderfolgenden Zeit-Werte zählt und als verwenden rollapplyr aus dem Zoo-Paket, das mir das gewünschte Ergebnis liefert, aber mit einem großen Datensatz es ist viel zu langsam:

# Calculate number of consecutive times 
require(dplyr) 
df <- df %>% 
    mutate(number.time = 1) %>% # insert column for number.time, start value = 1 
    group_by(id) %>% 
    arrange(time) # correct order for moving average 

for(i in 2:nrow(df)) # Start loop in second row, end in last row of df 
    df$number.time[i] <- 
    ifelse(df$time[i] == df$time[i-1]+1, # Is time consecutive? 
      df$number.time[i - 1] + 1,  # If yes: add 1 to previous number.time 
      1)        # If no: set number.time = 1 
# Moving Average 
require(zoo) 
df %>% 
    mutate(mov.average = rollapplyr(data = assets, 
            width = number.time, # use number.time for width 
            FUN = mean, 
            fill = NA, 
            na.rm = TRUE)) 
Source: local data frame [10 x 6] 
Groups: id [3] 

    time id name assets number.time mov.average 
    (dbl) (dbl) (fctr) (dbl)  (dbl)  (dbl) 
1  51 1234 BANK A 5000   1  5000 
2  52 1234 BANK A 6000   2  5500 
3  53 1234 BANK A 4000   3  5000 
4  55 1234 BANK A 7000   1  7000 
5  56 1234 BANK A 8000   2  7500 
6  51 2345 BANK B 10000   1  10000 
7  52 2345 BANK B 12000   2  11000 
8  51 3456 BANK C 30000   1  30000 
9  52 3456 BANK C 35000   2  32500 
10 53 3456 BANK C 40000   3  35000 

Wie Könnte ich diese Ausgabe mit einer schnelleren Funktion erhalten? Ich kenne rollmean von Zoo sowie SMA von TTR und ma von der Vorhersage, aber diese erlauben nicht für unterschiedliche Breite. Meine Frage könnte auch mit this question und dieser rblog zusammenhängen, aber ich bin nicht vertraut mit C++ noch weiß ich viel über das Schreiben von Funktionen, so dass ich diese Beiträge nicht wirklich verstehe.

EDIT 1: Beachten Sie, dass in meinem Code oben ist es nicht die for-Schleife, aber die Rollapplyr, die eine Menge Zeit braucht.

EDIT 2: Der Rollmittelwert darf nicht mehr als die letzten 4 Werte enthalten. Das sind so viele aufeinanderfolgende Werte, wie es nach der Zeitvariablen, aber nicht mehr als die letzten 4 Werte gibt. Entschuldigung für die ungenaue Frage! :/Meine Formulierung basierte auf der Annahme, die "number.time" -Spalte zu verwenden, in der es einfach gewesen wäre, alle Werte auf maximal = 4 zu begrenzen.

Answer 1

Zuerst erstellen Sie eine Gruppierungsvariable g und berechnen Sie dann die Rollmittel. Beachten Sie, dass rollsum ist wesentlich schneller als rollapply aber nicht unterstützt partial die Abhilfe erforderlich gezeigt:

library(zoo) # rollsum 

g <- with(df, cumsum(ave(time, id, FUN = function(x) c(1, diff(x) != 1)))) 
roll4 <- function(x) rollsum(c(0, 0, 0, x), 4)/pmin(4, seq_along(x)) 
transform(df, avg = ave(assets, g, FUN = roll4)) 

geben:

time id name assets avg 
1 51 1234 BANK A 5000 5000 
2 52 1234 BANK A 6000 5500 
3 53 1234 BANK A 4000 5000 
4 55 1234 BANK A 7000 7000 
5 56 1234 BANK A 8000 7500 
6 51 2345 BANK B 10000 10000 
7 52 2345 BANK B 12000 11000 
8 51 3456 BANK C 30000 30000 
9 52 3456 BANK C 35000 32500 
10 53 3456 BANK C 40000 35000 

Answer 2

Verwenden Sie cumsum.

Wenn Sie nur eine Bank haben, versuchen:

cumsum(df$assets)/seq(nrow(df)) 

Was tun, wenn Sie mehr als eine Bank haben, ich als excersize verlassen. Hinweis: Sie können Schleifen vollständig vermeiden, indem Sie rle verwenden.

Hier ist die Funktion "Cumsum mit Neustarts", die Ihnen helfen soll.

cumsum.r <- function(vals, restart) { 
    if (!is.vector(vals) || !is.vector(restart)) stop("expect vectors") 
    if (length(vals) != length(restart)) stop("different length") 
    # assume restart = FFTFFFTFFFFT 
    len = length(vals) # 12 
    restart[1]=T # TFTFFFTFFFFT 
    ind = which(restart) # (1,3,7,12) 
    ind = rep(ind, c(ind[-1],len+1)-ind) # 1,1,3,3,3,3,7,7,7,7,7,12 
    vals.c = cumsum(vals) 
    vals.c - vals.c[ind] + vals[ind] 
}