Я хочу приспособить DLM с изменяющимися во времени коэффициентами, то есть расширением к обычной линейной регрессии,
.
У меня есть предиктор ( ) и переменная отклика ( y t ), ежегодный морской и внутренний вылов рыбы соответственно с 1950 - 2011 гг. Я хочу следовать регрессионной модели DLM,
где уравнение эволюции системы
со страницы 43 «Динамические линейные модели с R» Petris et al.
Некоторое кодирование здесь,
fishdata <- read.csv("http://dl.dropbox.com/s/4w0utkqdhqribl4/fishdata.csv", header=T)
x <- fishdata$marinefao
y <- fishdata$inlandfao
lmodel <- lm(y ~ x)
summary(lmodel)
plot(x, y)
abline(lmodel)
Очевидно, что изменяющиеся во времени коэффициенты регрессионной модели здесь более уместны. Я следую его примеру со страниц 121 - 125 и хочу применить это к своим собственным данным. Это кодировка из примера
############ PAGE 123
require(dlm)
capm <- read.table("http://shazam.econ.ubc.ca/intro/P.txt", header=T)
capm.ts <- ts(capm, start = c(1978, 1), frequency = 12)
colnames(capm)
plot(capm.ts)
IBM <- capm.ts[, "IBM"] - capm.ts[, "RKFREE"]
x <- capm.ts[, "MARKET"] - capm.ts[, "RKFREE"]
x
plot(x)
outLM <- lm(IBM ~ x)
outLM$coef
acf(outLM$res)
qqnorm(outLM$res)
sig <- var(outLM$res)
sig
mod <- dlmModReg(x,dV = sig, m0 = c(0, 1.5), C0 = diag(c(1e+07, 1)))
outF <- dlmFilter(IBM, mod)
outF$m
plot(outF$m)
outF$m[ 1 + length(IBM), ]
########## PAGES 124-125
buildCapm <- function(u){
dlmModReg(x, dV = exp(u[1]), dW = exp(u[2:3]))
}
outMLE <- dlmMLE(IBM, parm = rep(0,3), buildCapm)
exp(outMLE$par)
outMLE
outMLE$value
mod <- buildCapm(outMLE$par)
outS <- dlmSmooth(IBM, mod)
plot(dropFirst(outS$s))
outS$s
Я хочу быть в состоянии построить оценки сглаживания plot(dropFirst(outS$s))
для моих собственных данных, которые у меня возникают проблемы при выполнении.
ОБНОВИТЬ
Теперь я могу создать эти графики, но я не думаю, что они правильные.
fishdata <- read.csv("http://dl.dropbox.com/s/4w0utkqdhqribl4/fishdata.csv", header=T)
x <- as.numeric(fishdata$marinefao)
y <- as.numeric(fishdata$inlandfao)
xts <- ts(x, start=c(1950,1), frequency=1)
xts
yts <- ts(y, start=c(1950,1), frequency=1)
yts
lmodel <- lm(yts ~ xts)
#################################################
require(dlm)
buildCapm <- function(u){
dlmModReg(xts, dV = exp(u[1]), dW = exp(u[2:3]))
}
outMLE <- dlmMLE(yts, parm = rep(0,3), buildCapm)
exp(outMLE$par)
outMLE$value
mod <- buildCapm(outMLE$par)
outS <- dlmSmooth(yts, mod)
plot(dropFirst(outS$s))
> summary(outS$s); lmodel$coef
V1 V2
Min. :87.67 Min. :1.445
1st Qu.:87.67 1st Qu.:1.924
Median :87.67 Median :3.803
Mean :87.67 Mean :4.084
3rd Qu.:87.67 3rd Qu.:6.244
Max. :87.67 Max. :7.853
(Intercept) xts
273858.30308 1.22505
Оценка сглаживания пересечения (V1) далека от коэффициента регрессии lm. Я предполагаю, что они должны быть ближе друг к другу.
lmodel$coef
оценкам. Я предполагаю, что сюжеты неверны, но я могу ошибаться.