Merge pull request #74 from SebKrantz/development

Development

Author: SebKrantz

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

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
 
 

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")))