北京大学金融时间序列分析讲义第28章： 状态空间模型

例28.1 考虑Alcoa股票日现实波动率数据的局部水平模型，
时间期间为2003-01-02到2004-05-07，
共340个观测。

da <- readr::read_table("aa-3rv.txt", 
  col_names=FALSE)

ts.alcoa <- ts(log(da[[2]]))

library(statespacer)
ssr1 <- statespacer(
  y = cbind(as.vector(ts.alcoa)),
  local_level_ind = TRUE,
  initial = rep(0.5*log(var(ts.alcoa)), 2),
  verbose = TRUE)

c("Var_obs"=ssr1$system_matrices$H$H, 
  "Var_level"=ssr1$system_matrices$Q$level)

smsd <- sqrt(ssr1$smoothed$V[1,1,])
plot(ts.alcoa, ylim=c(-1.5, 3))
lines(as.vector(time(ts.alcoa)), 
  ssr1$smoothed$level, col="green")
lines(as.vector(time(ts.alcoa)), 
  ssr1$smoothed$level - 1.96*smsd,
  lty=2, col="cyan")
lines(as.vector(time(ts.alcoa)), 
  ssr1$smoothed$level + 1.96*smsd,
  lty=2, col="cyan")
legend("bottomleft", lty=c(1,1,2), 
  col=c("black", "green", "cyan"),
  legend=c("Obs", "Smoothed", "95% CL"))

library(KFAS)
## 模型设定
kfas01a <- SSModel(
  ts.alcoa ~ SSMtrend(
    1, Q=list(matrix(NA))), 
  H=matrix(NA))
## 超参数估计
kfas01b <- fitSSM(
  kfas01a, rep(log(var(ts.alcoa)), 2), method="BFGS")
c("Var_obs"=c(kfas01b$model$H), 
  "Var_level"=c(kfas01b$model$Q))

## 用估计的超参数进行滤波平滑
kfas01c <- KFS(kfas01b$model)

c("水平值平滑差距"=max(abs(c(ssr1$smoothed$level) - c(kfas01c$muhat))),
  "水平值平滑方差差距"=max(abs(c(ssr1$smoothed$V) - c(kfas01c$V_mu))))

library(dlm)
dlm(
  FF = 1,  # $Z_t$矩阵
  V = 0.8, # $\sigma_e^2$
  GG = 1,  # $T_t$矩阵
  W = 0.1, # $\sigma_{\eta}^2$
  m0 = 0,  # 与$a_1$作用相同，为$\mu_0$期望
  C0 = 100 # 与$P_1$作用相同，为$\mu_0$方差
)

dlmModPoly(
  order = 1,  # 局部水平模型
  dV = 0.8, # $\sigma_e^2$
  dW = 0.1, # $\sigma_{\eta}^2$
  C0 = 100 # 与$P_1$作用相同，为$\mu_0$方差
)

buildFun <- function(para){
  dlmModPoly(
    order = 1,
    dV = exp(para[[1]]),
    dW = exp(para[[2]])
  )
}

fit_dlm <- dlmMLE(
  ts.alcoa,       # 输入的观测值序列
  parm = c(0, 0), # 超参数对数值的初值
  build = buildFun
)
fit_dlm$conv

dlm_al <- buildFun(fit_dlm$par)

c("Var_obs"=V(dlm_al), 
  "Var_level"=W(dlm_al))

例28.2 考虑尼罗河1871-1970年的年流量数据，
单位是108立方米，
在1898-1899年有明显的变点。
用局部水平模型建模并考虑变点的拟合。

plot(Nile, main="Annual flow of Nile")
abline(v = c(1898, 1899), lty=3, col="yellow")

library(dlm)
buildFun <- function(para){
  mod <- dlmModPoly(
    order = 1,
    dV = exp(para[[1]]) # $\sigma_e^2$，非时变  
  )
  mod$JW <- matrix(1)   # 示性函数，表示$\sigma_{\eta_t}^2$时变
  # mod$X: 用来保存时变的成分
  mod$X <- cbind(rep(exp(para[[2]]), length(Nile)))
  # 给t=1898年的观测的$\eta_t$方差放大
  jj <- which(time(Nile) == 1899)[1]
  mod$X[jj,1] <- mod$X[jj,1] * (1 + exp(para[[3]]))
  
  mod
}

fit_nile <- dlmMLE(
  Nile,
  parm = c(0, 0, 0), 
  build = buildFun)
fit_nile$conv

dlm_nile <- buildFun(fit_nile$par)

dlm_nile$X[c(1, which(time(Nile) == 1899)[1]), 1]

filt_nile <- dlmFilter(Nile, dlm_nile)
sm_nile <- dlmSmooth(filt_nile)

sme_nile <- dropFirst(sm_nile$s)

smv_nile <- dlmSvd2var(sm_nile$U.S, sm_nile$D.S) |> 
  unlist() |>
  dropFirst()

plot(Nile, type="o", main="Smoothed Nile Flow")
lines(sme_nile, col="red")
lines(sme_nile - 1.96 * sqrt(smv_nile), lty=3, col="green")
lines(sme_nile + 1.96 * sqrt(smv_nile), lty=3, col="green")
abline(v=c(1898, 1899), lty=3, col="yellow")

plot(UKgas, main="UK quarterly gas consumption")

plot(log(UKgas), main="UK quarterly gas consumption(log scale)")

library(dlm)
lGas <- log(UKgas)
dlmGas <- dlmModPoly() + dlmModSeas(4)

buildFun <- function(para){
  dlmGas <- dlmModPoly() + dlmModSeas(4)
  # 仅指定了时变斜率和季节项的方差，
  # 没有指定局部水平的方差
  diag(W(dlmGas))[2:3] <- exp(para[1:2])
  V(dlmGas) <- exp(para[3])
  
  dlmGas
}
fit_gas <- dlmMLE(
  lGas,
  parm = log(c(10^-5, 10^-3, 10^-3)), 
  build = buildFun )
fit_gas$conv

dlmGas <- buildFun(fit_gas$par)

sm_gas <- dlmSmooth(lGas, mod=dlmGas)
da_tmp <- cbind(
  lGas,
  dropFirst(sm_gas$s[, c(1,3)]))
colnames(da_tmp) <- c("Gas", "Trend", "Seasonal")
plot(da_tmp, type="o", 
  main = "UK gas consumption structral model")

filt_gas <- dlmFilter(lGas, mod = dlmGas)
fore_gas <- dlmForecast(filt_gas, nAhead = 20)
# 预测
gas_pred20 <- fore_gas$a[,1]
# 预测标准误差
gas_predse <- fore_gas$R |>
  sapply(\(x) sqrt(x[1,1]))
# 将末尾一段与预测结果连接
da_tmp <- ts.union(
  window(lGas, start=c(1982,1)),
  window(sm_gas$s[,1], start=c(1982,1)),
  gas_pred20,
  gas_pred20 - 1.645*gas_predse,
  gas_pred20 + 1.645*gas_predse)
plot(da_tmp, plot.type = "single",
  type = "o", 
  pch = c(1, 0, 20, 3, 3),
  col = c("darkgrey", "darkgrey", 
    "brown", "yellow", "yellow"),
  ylab = "Gas consumption prediction"
  )

28.4.4.1 数据预处理

因为取正值的变量建模时比较受限制，
所以将这些变量取对数值。

library(statespacer)
library(datasets)
da <- as.xts(Seatbelts) |> coredata()
for(v in c("drivers", "front", "rear", "PetrolPrice", "kms"))
  da[, v] <- log(da[,v])

28.4.4.2 确定性水平和季节项、有回归自变量的一元模型

以小汽车交通事故死亡、重伤人数（对数值）为因变量。
以汽油价格（对数值）和是否实行了安全带法令为自变量。
模型为

yt=μt+1=γt+1=μt+γt+β1x1t+β2x2t+et,μt,−∑j=111γt+1−j.

y <- cbind(da[,"drivers"])
ssmr1 <- statespacer(
  y = y, # 因变量
  local_level_ind = TRUE, # 是否有局部水平项
  # 设置局部水平项误差方差为零，从而非随机:
  format_level = matrix(0), 
  BSM_vec = 12, # 季节项的周期
  # 设置季节项误差项方差为零，从而非随机:
  format_BSM_list = list(matrix(0)), 
  # 添加的外生自变量，每个因变量分量需要输入一个自变量矩阵，
  # 所以即使是一元因变量也需要用列表
  addvar_list = list(as.matrix(
    da[, c("PetrolPrice", "law")])),
  method = "BFGS",
  # 唯一的方差参数$\sigma_e^2$的初值，
  # 算法中使用其对数值的2倍以确保取正值
  initial = 0.5 * log(var(c(y))), 
  verbose = TRUE)

## Starting the optimisation procedure at: 2023-05-26 09:26:42

## initial  value -0.443442 
## final  value -0.735372 
## converged

## Finished the optimisation procedure at: 2023-05-26 09:26:42

## Time difference of 0.0513920783996582 secs

观测误差方差σ2e估计：

ssmr1$system_matrices$H$H[1,1]

## [1] 0.007402481

非随机的局部水平μ的平滑估计：

ssmr1$smoothed$level[1,1]

## [1] 6.401571

第一个自变量，即汽油价格对数值，的回归系数：

ssmr1$smoothed$addvar_coeff[1, 1]

## [1] -0.4521301

第二个自变量，即强制安全带法令是否实行，的回归系数，
和相应标准误差估计，
t统计量值：

c(coef = ssmr1$smoothed$addvar_coeff[1, 2],
  se = ssmr1$smoothed$addvar_coeff_se[1, 2],
  tstat = ssmr1$smoothed$addvar_coeff[1, 2] /
    ssmr1$smoothed$addvar_coeff_se[1, 2])

##        coef          se       tstat 
## -0.19713947  0.02072792 -9.51081922

由此计算的法令影响的t统计量低于−2，
在0.05水平下显著，
认为法令生效后水平伤亡水平显著降低。

下面将原始数据与平滑拟合结果（包括局部水平、季节项与自变量作用）作图：

plot(da[, c("drivers")], type = "l", ylim = c(6.95, 8.1),
     xlab = "year", ylab = "logarithm of drivers")
lines(seq(tsp(Seatbelts)[1], tsp(Seatbelts)[2], 1/tsp(Seatbelts)[3]), 
      ssmr1$smoothed$level
      + ssmr1$smoothed$BSM12
      + ssmr1$smoothed$addvar, 
      type = 'l', col = "red")
legend("topright",
  c("log(drivers)", "Smoothed fit"), 
  lty = c(1,1), lwd=c(2.5, 2.5), col = c("black", "red"))

28.4.4.3 随机水平和季节项、有回归自变量的一元模型

模型为

yt=μt+1=γt+1=μt+γt+β1x1t+β2x2t+et,μt+ηt,−∑j=111γt+1−j+ζt.

和确定性的μ, γt相比，
程序只需将零方差改为非零方差：

y <- cbind(da[,"drivers"])
ssmr2 <- statespacer(
  y = y, # 因变量
  local_level_ind = TRUE, # 是否有局部水平项
  # 设置局部水平项误差方差为非零，从而随机:
  format_level = matrix(1), 
  BSM_vec = 12, # 季节项的周期
  # 设置季节项误差项方差为零，从而随机:
  format_BSM_list = list(matrix(1)), 
  # 添加的外生自变量，每个因变量分量需要输入一个自变量矩阵，
  # 所以即使是一元因变量也需要用列表
  addvar_list = list(as.matrix(da[, c("PetrolPrice", "law")])),
  method = "BFGS",
  # 唯一的方差参数$\sigma_e^2$的初值，
  # 算法中使用其对数值的2倍以确保取正值
  initial = log(var(as.vector(y))), 
  verbose = TRUE)

## Warning: Number of initial parameters is less than the required amount of
## parameters (3), recycling the initial parameters the required amount of times.

## Starting the optimisation procedure at: 2023-05-26 09:26:42

## initial  value -0.172423 
## iter  10 value -0.893962
## iter  20 value -0.915493
## iter  30 value -0.915515
## final  value -0.915517 
## converged

## Finished the optimisation procedure at: 2023-05-26 09:26:43

## Time difference of 0.770241975784302 secs

程序中还修改了原来的迭代初值，
原来的迭代初值导致迭代过程出错。
初值需要三个方差参数对应的初值，
这里只给了一个初值，
就重复利用。

估计结果：

## 观测误差方差估计
ssmr2$system_matrices$H$H[1,1]

## [1] 0.003786183

## 局部水平的系统方程的误差方差估计
ssmr2$system_matrices$Q$level[1,1]

## [1] 0.0002676875

## 季节项的系统方程的误差方差估计
ssmr2$system_matrices$Q$BSM12[1,1]

## [1] 1.161438e-06

## 关于汽油价格对数值这一自变量的回归系数估计
ssmr2$smoothed$addvar_coeff[1, 1]

## [1] -0.2913944

第二个自变量，即强制安全带法令是否实行，的回归系数，
和相应标准误差估计，
t统计量值：

c(coef = ssmr2$smoothed$addvar_coeff[1, 2],
  se = ssmr2$smoothed$addvar_coeff_se[1, 2],
  tstat = ssmr2$smoothed$addvar_coeff[1, 2] /
    ssmr2$smoothed$addvar_coeff_se[1, 2])

##        coef          se       tstat 
## -0.23773735  0.04631717 -5.13281209

结果表明法令生效后伤亡水平显著降低。

原始数据与拟合结果（拟合结果是平滑结果，
利用了平滑的局部水平与自变量线性组合）：

plot(da[, c("drivers")], type = "l", ylim = c(6.95, 8.1),
     xlab = "year", ylab = "logarithm of drivers")
lines(seq(tsp(Seatbelts)[1], tsp(Seatbelts)[2], 1/tsp(Seatbelts)[3]), 
      ssmr2$smoothed$level 
      + ssmr2$smoothed$BSM12
      + ssmr2$smoothed$addvar, 
      type = 'l', col = "red")
legend("topright",
  c("log(drivers)", "smoothed fit"), 
  lty = c(1,1), lwd=c(2.5, 2.5), col = c("black", "red"))

与非随机的水平和季节项的拟合结果比较，
随机的水平和季节项使得拟合结果更贴近原始数据。

实际上，从季节项的系统方程的误差方差10−6级别可以看出季节项的随机性很小，
下面作平滑估计的季节项图形：

plot(seq(tsp(Seatbelts)[1], tsp(Seatbelts)[2], 1/tsp(Seatbelts)[3]), 
     ssmr2$smoothed$BSM12,
     type = "l", ylim = c(-0.2, 0.3),
     xlab = "year", ylab = "stochastic seasonal")
abline(h = 0)

我们将随机的季节项改为非随机：

y <- cbind(da[,"drivers"])
ssmr3 <- statespacer(
  y = y, # 因变量
  local_level_ind = TRUE, # 是否有局部水平项
  # 设置局部水平项误差方差为非零，从而随机:
  format_level = matrix(1), 
  BSM_vec = 12, # 季节项的周期
  # 设置季节项误差项方差为零，从而非随机:
  format_BSM_list = list(matrix(0)), 
  # 添加的外生自变量，每个因变量分量需要输入一个自变量矩阵，
  # 所以即使是一元因变量也需要用列表
  addvar_list = list(as.matrix(
    da[, c("PetrolPrice", "law")])),
  method = "BFGS",
  # 唯一的方差参数$\sigma_e^2$的初值，
  # 算法中使用其对数值的2倍以确保取正值
  initial = log(var(c(y))), 
  verbose = TRUE)

## Warning: Number of initial parameters is less than the required amount of
## parameters (2), recycling the initial parameters the required amount of times.

## Starting the optimisation procedure at: 2023-05-26 09:26:44

## initial  value -0.577129 
## iter  10 value -0.912856
## final  value -0.912859 
## converged

## Finished the optimisation procedure at: 2023-05-26 09:26:44

## Time difference of 0.247884035110474 secs

估计结果：

## 观测误差方差估计
ssmr3$system_matrices$H$H[1,1]

## [1] 0.004033516

## 局部水平的系统方程的误差方差估计
ssmr3$system_matrices$Q$level[1,1]

## [1] 0.0002681651

## 关于汽油价格对数值这一自变量的回归系数估计
ssmr3$smoothed$addvar_coeff[1, 1]

## [1] -0.2767301

第二个自变量，即强制安全带法令是否实行，的回归系数，
和相应标准误差估计，
t统计量值：

c(coef = ssmr3$smoothed$addvar_coeff[1, 2],
  se = ssmr3$smoothed$addvar_coeff_se[1, 2],
  tstat = ssmr3$smoothed$addvar_coeff[1, 2] /
    ssmr3$smoothed$addvar_coeff_se[1, 2])

##       coef         se      tstat 
## -0.2375904  0.0464483 -5.1151578

结果表明法令生效后伤亡水平显著降低。

比较三个模型的AIC：

c(ssmr1$diagnostics$AIC, 
  ssmr2$diagnostics$AIC, 
  ssmr3$diagnostics$AIC)

## [1] -1.314494 -1.653950 -1.659052

第三个模型的AIC最小。

28.4.4.4 前后座驾乘人员同时建模的二元模型

考虑前座驾乘人员和后座乘客死亡、重伤人数对数的二元模型，
都以汽油价格对数值、行驶里程对数值和安全带法令为自变量。

y <- da[,c("front", "rear")]
Xmat <- da[,c("PetrolPrice", "kms", "law")]
ssmr4 <- statespacer(y = y, # 输入数据是两列矩阵，二元时间序列
  # 观测方程误差项方差阵格式，这里是无限制的二阶方差阵
  H_format = matrix(1,2,2),
  local_level_ind = TRUE,
  # 局部水平的系统方程的误差项方差设置，无限制：
  format_level = matrix(1, 2, 2), 
  BSM_vec = 12,
  # 季节项的系统方程的误差项方差设置，设置为零，表示非随机季节项
  format_BSM_list = list(matrix(0, 2, 2)),
  # 每个因变量所需的自变量矩阵：
  addvar_list = list(Xmat, Xmat),
  method = "BFGS",
  initial = 0.5 * log(diag(var(y))),
  verbose = TRUE)

## Warning: Number of initial parameters is less than the required amount of
## parameters (6), recycling the initial parameters the required amount of times.

## Starting the optimisation procedure at: 2023-05-26 09:26:45

## initial  value 0.389588 
## iter  10 value -1.583525
## iter  20 value -1.676129
## iter  30 value -1.676530
## final  value -1.676537 
## converged

## Finished the optimisation procedure at: 2023-05-26 09:26:56

## Time difference of 11.4353930950165 secs

观测方程误差方差阵估计：

ssmr4$system_matrices$H$H

##             [,1]        [,2]
## [1,] 0.005402166 0.004449533
## [2,] 0.004449533 0.008566858

局部水平的系统方程的误差方差阵估计：

ssmr4$system_matrices$Q$level

##              [,1]         [,2]
## [1,] 0.0002556392 0.0002247045
## [2,] 0.0002247045 0.0002319561

6个回归系数及相应的t统计量：

data.frame(
  x1 = c("front PetrolPrice", "front kms", "front law", 
    "rear PetrolPrice", "rear kms", "rear law"),
  x2 = ssmr4$smoothed$addvar_coeff[1,],
  x3 = ssmr4$smoothed$addvar_coeff[1,] 
  / ssmr4$smoothed$addvar_coeff_se[1,]) |>
  knitr::kable(
    col.names=c("", "Coef", "t stat"),
    digits=4  )

与常识一致的是，
后排乘客的伤亡数并不受安全带法令的影响。
汽油价格上升对前排驾乘人员伤亡数有抑制作用。
行驶里程数对前排驾乘人员伤亡数没有显著影响，
但对后排乘客伤亡有正向的影响。

程序中还可以限制某个方差阵的秩，
比如取format_level为

(1100)

可以限制水平的系统方差的误差方差阵（2×2方差阵）为秩等于1。

library(statespacer)
library(YieldCurve, quietly=TRUE, warn.conflicts=FALSE)

data(FedYieldCurve)
str(FedYieldCurve)

xts.yc <- FedYieldCurve["1984-12-31/2000-12-01"]
date.yc <- index(xts.yc)
y.yc <- coredata(xts.yc)
plot(xts.yc, multi.panel=FALSE)

## 保存自定义设置用的列表
spec <- list()
## 自己规定H矩阵（观测误差的方差阵）
spec$H_spec <- TRUE
## 状态向量维数，3个beta, 3个常数beta均值
spec$state_num <- 6

## 待估参数个数20个，包括：
##   1个 - $\lambda$
##   1个 - $\sigma_e^2$
##   6个 - $\Sigma_{\boldsymbol\eta}\ 3 \times 3$对称阵
##   9个 - $\Phi_{3\times 3}$矩阵
##   3个 - $\boldsymbol\mu$
spec$param_num <- 20

## 状态方程中$R$矩阵不起作用，方差结构直接编写在矩阵$Q$中
spec$R <- diag(1, 6, 6) # $I_6$

## 初始状态$\boldsymbol\alpha_1$的方差，元素都取为0，因为平稳
spec$P_inf <- matrix(0, 6, 6)

## 指定状态向量中不输出到观测的分量，
## 当压缩观测向量为标量时可提高计算效率
spec$state_only <- 4:6

spec$sys_mat_fun <- function(param) {
  ## 输入20个参数，具体意义见前面注释和说明
  
  # 8个期限，即$\tau$值
  maturity <- c(3, 6, 12, 24, 36, 60, 84, 120)
  
  # 从取了对数的参数值恢复$\lamabda$的值
  lambda <- exp(2 * param[1])
  
  # \sigma_e^2的值
  sigma2 <- exp(2 * param[2])
  
  # H是观测方程的误差向量的协方差阵参数。
  # 注意每个$t$对应的观测值是$8\times 1$向量。
  H <- sigma2 * diag(1, 8, 8)
  
  # 观测方程的Z矩阵，一个$8 \times 6$矩阵，
  # 前三列对应于$\beta_{1t}$, $\beta_{2t}$, $\beta_{3t}$
  # 后三列对应于$\beta$的三个均值，系数为0
  lambda_maturity <- lambda * maturity
  ze <- exp(-lambda_maturity)
  Z <- matrix(1, 8, 3)
  Z[, 2] <- (1 - ze) / lambda_maturity
  Z[, 3] <- Z[, 2] - ze
  
  # 状态方程的误差方差阵（$6 \times 6$）的左上角$3 \times 3$部分
  # 使用6个参数
  Q <- Cholesky(
    param = param[3:8], 
    decompositions = FALSE, 
    format = matrix(1, 3, 3))
  
  # 从输入的9个矩阵元素生成满足平稳性条件的向量自回归系数矩阵$\Phi$
  Tmat <- CoeffARMA(
    A = array(param[9:17], dim = c(3, 3, 1)),
    variance = Q,
    ar = 1, ma = 0)$ar[,,1]

  # 生成初始状态$\boldsymbol\alpha_1$的方差阵，确保其满足平稳性条件
  T_kronecker <- kronecker(Tmat, Tmat)
  Tinv <- solve(
    diag(1, dim(T_kronecker)[1], 
         dim(T_kronecker)[2]) - T_kronecker)
  vecQ <- matrix(Q)
  vecPstar <- Tinv %*% vecQ
  P_star <- matrix(vecPstar, dim(Tmat)[1], dim(Tmat)[2])


  ## 添加对应于常数均值的部分
  # 在观测方程的矩阵Z中增加对应于常数均值的3列
  Z <- cbind(Z, matrix(0, 8, 3)) 
  # 在状态方程的误差方差阵中增加对应于常数均值的部分，都是0
  Q <- BlockMatrix(Q, matrix(0, 3, 3)) 
  # 在6维的状态方程中，设置转移矩阵$T$
  Tmat <- cbind(Tmat, diag(1, 3, 3) - Tmat)
  Tmat <- rbind(Tmat, cbind(matrix(0, 3, 3), diag(1, 3, 3)))
  # 初始状态的方差阵中对应于常数均值部分方差和协方差为0
  P_star <- BlockMatrix(P_star, matrix(0, 3, 3))
  
  # $\beta$的均值是最后的3个待估参数，
  # 也作为$t=1$时$\beta$的初始分布均值
  a1 <- matrix(param[18:20], 6, 1) 
  
  # 函数返回模型所需的所有系统矩阵
  return(list(
    H = H,   # 观测误差随机向量的方差阵
    Z = Z,   # 观测方程的观测矩阵
    Tmat = Tmat, # 状态方程的状态转移矩阵
    Q = Q,   # 状态方程的误差随机向量的方差阵
    a1 = a1, # 初始状态的均值
    P_star = P_star)) # 初始状态的方差阵
}

spec$transform_fun <- function(param) {
  lambda <- exp(2 * param[1])
  sigma2 <- exp(2 * param[2])
  means <- param[18:20]
  return(c(lambda, sigma2, means))
}

initial <- c(
  -1, # $0.5 \ln\lambda$
  -2, # $0.5 \ln\sigma_e^2$
  # $\Sigma_{\boldsymbol\eta}$的LDL分解中D的对角元素的0.5倍对数值
  -1, -1, -1, 
  # $\Sigma_{\boldsymbol\eta}$的LDL分解中L的元素值
  0, 0, 0, 
  # VAR(1)模型系数矩阵
  1, 0, 0, 
  0, 1, 0, 
  0, 0, 1, 
  # 三个beta的均值
  0, 0, 0) 

fit <- statespacer(
  y = y.yc,
  self_spec_list = spec,
  collapse = TRUE,
  initial = initial,
  method = "BFGS",
  control = list(maxit = 200),
  verbose = TRUE)

plot(date.yc, fit$smoothed$a[, 1], type = 'l', 
  xlab = "year", ylab = "Level of yield curve")

plot(date.yc, fit$smoothed$a[, 2], type = 'l', 
  xlab = "year", ylab = "Slope of yield curve")

plot(date.yc, fit$smoothed$a[, 3], type = 'l', 
  xlab = "year", ylab = "Shape of yield curve")

parameters <- data.frame(
  Parameter = c("lambda", "sigma2", "mu1", "mu2", "mu3"), 
  Value = fit$system_matrices$self_spec,
  SE = fit$standard_errors$self_spec
)
knitr::kable(parameters, digits=4)

fit$system_matrices$T$self_spec[1:3, 1:3]

fit$system_matrices$Q$self_spec[1:3, 1:3]

28.4.6.1 模型

考虑时变系数的资产定价模型(CAPM)：

rt=β0,t+1=β1,t+1=β0t+β1trM,t+et, et∼ iid N(0,σ2e),β0,t+ut, ut∼ iid N(0,σ2u),β1,t+vt, vt∼ iid N(0,σ2v),

其中{et}, {ut}, {vt}相互独立，
rt是某金融资产的超额收益率，
rM,t是市场的超额收益率。
可以写成状态空间模型

rt=(β0,t+1β1,t+1)=(1,rM,t)(β0tβ1t)+et,(1001)(β0,tβ1,t)+(utvt).

令状态变量αt=(β0t,β1t)T,
观测变量为rt，且

Zt=Tt=Qt=(1,rM,t),Ht=σ2e,I2,Rt=I,ηt=(ut,vt)T,(σ2u00σ2v),

则时变系数CAPM对应于状态空间模型

rt=αt+1=Ztαt+et, et∼N(0,Ht),Ttαt+Rtηt, ηt∼N(0,Qt).

28.4.6.2 通用动力的例子

数据（收益率单位：百分之一）：

da_gm <- readr::read_table(
  "m-fac9003.txt",
  col_types = cols(.default=col_double()))[,c("GM", "SP5")]
nda <- nrow(da_gm)
ts.gm <- ts(as.matrix(da_gm),
  start=c(1990, 1), frequency=12)
plot(as.xts(ts.gm),
  main="GM和标普500的月度超额收益率(%)")

28.4.6.3 滚动计算回归的简单做法

尝试滚动地进行线性回归，
取固定的拟合时间窗口为24个月，
获得动态的系数估计：

wh <- 24 # 滚动窗口
n <- nrow(da_gm)
betamat <- matrix(NA, n, 2)
for(t in wh:n){
  tind <- (t-wh+1):t
  betamat[t,] <- 
    lm(GM ~ SP5, data=da_gm[tind,]) |>
    coef()
}
ts.beta <- ts(
  betamat, start=c(1990, 1), frequency=12)
plot(ts.beta)

这个结果可以作为基准。

28.4.6.4 使用KFAS包拟合时变系数回归模型

statespacer包没有提供时变系数回归模型，
而Zt依赖于t时statespacer包没有提供自定义方法。

使用KFAS包。
这个包提供了SSMregression()函数，
可以指定带有随机游动斜率的回归模型，
但不支持随机截距项，
尝试使用自定义的对应于截距项的自变量会使得滤波平滑失败。

我们使用SScustom()直接指定各个矩阵。

library(KFAS)

# 将每一行是一个$Z_t$值的矩阵，
# 转换成$1 \times m \times n$的数组，
# $m$是状态空间维数，$n$是样本量
dim2to3 <- function(M){
  M <- t(M)
  dim(M) <- c(1, dim(M))
  M
}

# Zt: 用三维数组表示的$Z_t, t=1,2,\dots,n$，
# 第三下标代表$t$,
# Zt[,,t]是$1 \times m$矩阵$Z_t$
Zt <- dim2to3(cbind(1, da_gm[["SP5"]]))

mod_gm <- SSModel(
  da_gm$GM ~ SSMcustom(
    Z = Zt, # 观测方程的载荷阵
    T = diag(2), # 状态方程的转移矩阵
    # 状态的初始值
    a1 = c(0, 1),
    # Q是状态方程扰动项方差阵
    Q = diag(NA, 2)),
  # H是观测方程误差方差阵
  H = NA)
fit_gm <- fitSSM(
  mod_gm, 
  inits = c(0,0,0), 
  method="BFGS") #"Nelder-Mead") 
fit_gm$optim.out$value

## [1] 589.0349

估计的随机截距和随机斜率的扰动标准差：

sqrt(diag(fit_gm$model$Q[,,1]))

## [1] 0.0043620203 0.0006551979

估计的回归误差项标准差：

sqrt(fit_gm$model$H[,,1])

## [1] 8.108269

计算平滑结果：

res_gm <- KFS(fit_gm$model)

GM原始值与拟合值（使用平滑）的曲线：

plot(ts.gm[,"GM"], main="GM and fitted")
lines(as.vector(time(ts.gm)), 
  c(fitted(res_gm, filtered=FALSE)),
  col="red")

如果前面的程序中没有指定a1 = c(0, 1)，
即初始的随机截距、随机斜率，
则拟合上图在左端的拟合效果很差。

估计的时变截距项和时变斜率项：

states <- as.matrix(coef(res_gm))
states[,2] <- states[,1] + states[,2]
states <- states[,2:3]
plot(ts(states, start=c(1990, 1), frequency=12))

可以看出，
时变的截距项β0t和时变斜率项β1t的变化范围很小。
与滚动回归得到的结果不一致，
基本上没有起到时变的效果。

使用KFAS的SSMregression()，
仅使用随机斜率项：

mod_gm <- SSModel(
  da_gm$GM ~ SSMregression(
    ~ da_gm$SP5,
    # Q是状态方程扰动项方差阵
    Q = NA),
  # H是观测方程误差方差阵
  H = NA)
fit_gm <- fitSSM(
  mod_gm, 
  inits = c(0, 0), 
  method="BFGS")
res_gm <- KFS(fit_gm$model)

拟合结果：

plot(ts.gm[,"GM"], main="GM and fitted with time-varying beta")
lines(as.vector(time(ts.gm)), 
  c(fitted(res_gm, filtered=FALSE)),
  col="red")

这个拟合结果比较合理。

随机斜率项估计：

states <- as.matrix(coef(res_gm))
plot(ts(states[,2], start=c(1990, 1), frequency=12),
  main="Time-varying Regression Slope")

这个结果与滚动窗口回归计算的斜率项还是不一致，
但是变化范围比较小，
有一定合理性。

28.4.6.5 使用dlm包拟合时变系数回归模型

dlm包也支持时变系数回归，
可以用dlm尝试估计时变截距和斜率。

输入超参数的建模函数：

library(dlm)
buildFun <- function(para){
  dlmModReg(
    cbind(da_gm[["SP5"]]), # 自变量值
    dV = exp(para[1]),  # 回归误差方差
    dW= exp(para[2:3])) # 状态方差误差方差
}

超参数最大似然估计：

fit_dlm <- dlmMLE(
  da_gm[["GM"]],
  parm = c(0,-2,-2),
  build = buildFun)
fit_dlm$conv

## [1] 0

估计的数值算法收敛。
提取最优参数的模型：

dlm_gm <- buildFun(fit_dlm$par)

回归误差项标准差：

##          [,1]
## [1,] 8.130086

随机截距项和斜率项的标准差：

W(dlm_gm) |> diag() |> sqrt()

## [1] 9.177050e-04 1.271935e-06

估计得到的状态方程扰动项标准差很小，
比KFAS模型得到的结果小得多，
使得截距和斜率基本等于常数。

利用最大似然估计得到的超参数进行滤波和平滑：

filt_gm <- dlmFilter(da_gm[["GM"]], dlm_gm)
smth_gm <- dlmSmooth(filt_gm)

平滑得到的时变截距项和时变斜率项：

plot(ts(
  smth_gm$s[-1,1:2], 
  start=c(1990, 1), 
  frequency=12),
  main="Time-varying intercept and slope")

与KFAS的结果不一致。
另外，实际上截距和斜率的变化范围很小，
基本上是常数。