diff --git a/R/EMBM_MQ.R b/R/EMBM_MQ.R index a6db55f..99797d9 100644 --- a/R/EMBM_MQ.R +++ b/R/EMBM_MQ.R @@ -58,7 +58,7 @@ EMstepBMMQ = function(X, A, C, Q, R, Z_0, V_0, XW0, NW, dgind, dnkron, dnkron_in Qsr = (EZZ[sr, sr] - tcrossprod(A_new[sr, srp, drop = FALSE], EZZ_FB[sr, srp, drop = FALSE])) / TT Q_new[sr, sr] = if(rQi == 2L) Qsr else diag(diag(Qsr)) } else Q_new[sr, sr] = diag(r) - Q_new[rpC1nq, rpC1nq] = diag(diag(crossprod(Zsmooth[, rpC1nq, drop = FALSE]) + sum3(Vsmooth[rpC1nq, rpC1nq,, drop = FALSE])) / TT) + Q_new[rpC1nq, rpC1nq] = diag(diag(crossprod(Zsmooth[, rpC1nq, drop = FALSE]) + sum3(Vsmooth[rpC1nq, rpC1nq,, drop = FALSE])) / TT, nrow = nq) # E(X'X) & E(X'Z) # Estimate matrix C using maximum likelihood approach diff --git a/R/init_cond.R b/R/init_cond.R index c0c57ee..4eeb350 100644 --- a/R/init_cond.R +++ b/R/init_cond.R @@ -129,7 +129,7 @@ init_cond_MQ <- function(X, X_imp, F_pc, v, n, r, p, TT, nq, rRi, rQi) { Q[1:r, 1:r] <- switch(rQi + 1L, diag(r), diag(fvar(var$res)), cov(var$res)) Q[(rpC+1):(rpC+nq), (rpC+1):(rpC+nq)] <- if(rRi == 2L) cov(res[, -seq_len(nm), drop = FALSE], use = "pairwise.complete.obs") else if(rRi == 1L) - diag(fvar(res[, -seq_len(nm)], na.rm = TRUE)) else diag(nq) + diag(fvar(res[, -seq_len(nm), drop = FALSE], na.rm = TRUE), nrow = nq) else diag(nq) diag(Q)[diag(Q) == 0] <- 1e-6 # Prevent singularity in Kalman Filter diff --git a/tests/testthat/test-DFM.R b/tests/testthat/test-DFM.R index 9d0f930..bb9fb4c 100644 --- a/tests/testthat/test-DFM.R +++ b/tests/testthat/test-DFM.R @@ -103,3 +103,13 @@ expect_equal(mod$F_twostep, mod_BM$F_twostep, tolerance = 1e-2) expect_equal(mod$F_qml, mod_BM$F_qml, tolerance = 1e-2) expect_equal(mod$A, mod_BM$A, tolerance = 1e-1) +# testing #73 +y<-as.xts(rnorm(100),order.by = seq(from=as.Date("1980-04-01"),length.out=100,by="quarter")-1) +x1<-as.xts(rnorm(100),order.by = seq(from=as.Date("1980-02-01"),length.out=100,by="month")-1) +x2<-as.xts(rnorm(100),order.by = seq(from=as.Date("1980-02-01"),length.out=100,by="month")-1) + +data<-cbind(y,x1,x2) +data["1988-03-31",1]<-NA +data1<-data[time(data)<="1987-12-31"] + +expect_visible(DFM(data1[,c("x1","x2","y")], r = 1, p = 1, quarterly.vars = c("y")))