Скользящая регрессия с помощью dplyr
У меня есть датафреймы "дата", "компания" и "возврат", воспроизводимые с помощью кода ниже:
library(dplyr)
n.dates <- 60
n.stocks <- 2
date <- seq(as.Date("2011-07-01"), by=1, len=n.dates)
symbol <- replicate(n.stocks, paste0(sample(LETTERS, 5), collapse = ""))
x <- expand.grid(date, symbol)
x$return <- rnorm(n.dates*n.stocks, 0, sd = 0.05)
names(x) <- c("date", "company", "return")
С этим фреймом данных я могу рассчитать среднесуточную рыночную доходность и добавить этот результат в новый столбец "market.ret".
x <- group_by(x, date)
x <- mutate(x, market.ret = mean(x$return, na.rm = TRUE))
Теперь я хочу сгруппировать все свои данные по разным компаниям (в данном случае 2).
x <- group_by(x, company)
После этого я хотел бы подобрать "return" к "market.ret", вычислить коэффициент линейной регрессии и сохранить наклоны в новом столбце. Если я хочу выполнить подгонку для всего набора данных в данной компании, тогда я могу просто вызвать lm():
group_by(x, company) %>%
do(data.frame(beta = coef(lm(return ~ market.ret,data = .))[2])) %>%
left_join(x,.)
Однако я на самом деле хочу сделать линейную регрессию на "скользящей" основе, то есть для каждого дня отдельно в течение 20-дневного периода трейлинга. Я хочу использовать rollapply(), но не знаю, как передать два столбца в функцию. Любая помощь или предложение с благодарностью.
Примечание. Ниже приведен код, который я использовал для расчета 20-дневного скользящего стандартного отклонения доходности, что может оказаться полезным:
sdnoNA <- function(x){return(sd(x, na.rm = TRUE))}
x <- mutate(x, sd.20.0.d = rollapply(return, FUN = sdnoNA, width = 20, fill = NA))
2 ответа
## lms is a function which calculate the linear regression coefficient
lms <- function(y, x){
s = which(is.finite(x * y))
y = y[s]
x = x[s]
return(cov(x, y)/var(x))
}
## z is a dataframe which stores our final result
z <- data.frame()
## x has to be ungrouped
x <- ungroup(x)
## subset with "filter" and roll with "rollapply"
symbols <- unique(x$company)
for(i in 1:length(symbols)){
temp <- filter(x, company == symbols[i])
z <- rbind(z, mutate(temp, beta = rollapply(temp[, c(3, 4)],
FUN = function(x) lms(x[, 1], x[, 2]),
width = 20, fill = NA,
by.column = FALSE, align = "right")))
}
## final result
print(z)
Вот dplyr решение
#####
# setup data as OP (notice the fix when computing the market return)
library(dplyr)
set.seed(41797642)
n.dates <- 60
n.stocks <- 2
date <- seq(as.Date("2011-07-01"), by=1, len=n.dates)
symbol <- replicate(n.stocks, paste0(sample(LETTERS, 5), collapse = ""))
x <- expand.grid(date, symbol)
x$return <- rnorm(n.dates*n.stocks, 0, sd = 0.05)
names(x) <- c("date", "company", "return")
x <- x %>%
group_by(date) %>%
mutate(market.ret = mean(return))
#####
# compute coefs using rollRegres
library(rollRegres)
func <- . %>% {
roll_regres.fit(x = cbind(1, .$market.ret),
y = .$return, width = 20L)$coefs }
out <- x %>%
group_by(company) %>%
# make it explicit that data needs to be sorted
arrange(date, .by_group = TRUE) %>%
do(cbind(reg_col = select(., market.ret, return) %>% func,
date_col = select(., date))) %>%
ungroup
head(out[!is.na(out$reg_col.1), ], 5)
#R # A tibble: 5 x 4
#R company reg_col.1 reg_col.2 date
#R <fct> <dbl> <dbl> <date>
#R 1 SNXAD -0.0104 0.746 2011-07-20
#R 2 SNXAD -0.00953 0.755 2011-07-21
#R 3 SNXAD -0.0124 0.784 2011-07-22
#R 4 SNXAD -0.0167 0.709 2011-07-23
#R 5 SNXAD -0.0148 0.691 2011-07-24
tail(out[!is.na(out$reg_col.1), ], 5)
#R # A tibble: 5 x 4
#R company reg_col.1 reg_col.2 date
#R <fct> <dbl> <dbl> <date>
#R 1 UYLTS -0.00276 0.837 2011-08-25
#R 2 UYLTS 0.0000438 0.928 2011-08-26
#R 3 UYLTS 0.000250 0.936 2011-08-27
#R 4 UYLTS -0.000772 0.886 2011-08-28
#R 5 UYLTS 0.00173 0.902 2011-08-29
Это очень близко к ответу здесь, который довольно близок к этому ответу, хотя с использованием rollRegres пакет.