Quick hack to get intercept only model.

haziqj · Apr 12, 2018 · 99fa7f2 · 99fa7f2
1 parent 881397e
commit 99fa7f2
Show file tree

Hide file tree

Showing 4 changed files with 16 additions and 8 deletions.
diff --git a/R/iprobit.R b/R/iprobit.R
@@ -44,6 +44,7 @@ iprobit.default <- function(y, ..., kernel = "linear", interactions = NULL,
     maxit          = 100,
     stop.crit      = 1e-5,
     silent         = FALSE,
+    int.only       = FALSE,  #intercept only model
     alpha0         = NULL,    # if NULL, parameters
     # lambda0        = NULL,  # are initialised
     w0             = NULL,    # in
@@ -90,7 +91,7 @@ iprobit.default <- function(y, ..., kernel = "linear", interactions = NULL,
         res$est.method <- "Laplace approximation."
       } else if (est.method["em.closed"]) {  # VB CLOSED-FORM
         res <- iprobit_bin(mod, maxit, stop.crit, silent, alpha0, theta0, w0,
-                           w.only = w.only)
+                           w.only = w.only, int.only = int.only)
         res$est.method <- "Closed-form VB-EM algorithm."
       } else {
         res <- iprobit_bin_metr(mod, maxit, stop.crit, silent, alpha0, theta0,
@@ -103,7 +104,8 @@ iprobit.default <- function(y, ..., kernel = "linear", interactions = NULL,
     } else {
       # Multinomial models -----------------------------------------------------
       if (est.method["em.closed"]) {  # VB CLOSED-FORM
-        res <- iprobit_mult(mod, maxit, stop.crit, silent, alpha0, theta0, w0)
+        res <- iprobit_mult(mod, maxit, stop.crit, silent, alpha0, theta0, w0,
+                            int.only = int.only)
         res$est.method <- "Closed-form VB-EM algorithm."
       } else {
         res <- iprobit_mult_metr(mod, maxit, stop.crit, silent, alpha0, theta0,

diff --git a/R/iprobit_bin.R b/R/iprobit_bin.R
@@ -19,7 +19,8 @@
 ################################################################################
 
 iprobit_bin <- function(mod, maxit = 100, stop.crit = 1e-5, silent = FALSE,
-                        alpha0 = NULL, theta0 = NULL, w0 = NULL, w.only = FALSE) {
+                        alpha0 = NULL, theta0 = NULL, w0 = NULL, w.only = FALSE,
+                        int.only = FALSE) {
   # Declare all variables and functions to be used into environment ------------
   iprobit.env <- environment()
   list2env(mod, iprobit.env)
@@ -90,8 +91,10 @@ iprobit_bin <- function(mod, maxit = 100, stop.crit = 1e-5, silent = FALSE,
         dt <- as.numeric(
           crossprod(ystar - alpha, Pl[[k]]) %*% w - sum(Sl[[k]] * W) / 2
         )
-        lambda[k] <- dt / ct[k]
-        lambdasq[k] <- 1 / ct[k] + (dt / ct[k]) ^ 2
+        if (!isTRUE(int.only)) {
+          lambda[k] <- dt / ct[k]
+          lambdasq[k] <- 1 / ct[k] + (dt / ct[k]) ^ 2
+        }
       }
       lambda   <- expand_lambda(lambda[1:p], intr, intr.3plus)
       lambdasq <- expand_lambda(lambdasq[1:p], intr, intr.3plus)

diff --git a/R/iprobit_mult.R b/R/iprobit_mult.R
@@ -19,7 +19,8 @@
 ################################################################################
 
 iprobit_mult <- function(mod, maxit = 10, stop.crit = 1e-5, silent = FALSE,
-                         alpha0 = NULL, theta0 = NULL, w0 = NULL) {
+                         alpha0 = NULL, theta0 = NULL, w0 = NULL, w.only = FALSE,
+                         int.only = FALSE) {
   # Declare all variables and functions to be used into environment ------------
   iprobit.env <- environment()
   list2env(mod, iprobit.env)
@@ -108,8 +109,10 @@ iprobit_mult <- function(mod, maxit = 10, stop.crit = 1e-5, silent = FALSE,
             sum(Sl[[k]] * W[[j]]) / 2
         )
       }
-      lambda[k, ] <- rep(sum(dt[k, ]) / sum(ct[k, ]), m)
-      lambdasq[k, ] <- rep(1 / sum(ct[k, ]) + lambda[k, 1] ^ 2, m)
+      if (!isTRUE(int.only)) {
+        lambda[k, ] <- rep(sum(dt[k, ]) / sum(ct[k, ]), m)
+        lambdasq[k, ] <- rep(1 / sum(ct[k, ]) + lambda[k, 1] ^ 2, m)
+      }
     }
 
     # Update H.lam and H.lam.sq ------------------------------------------------

diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf