(1) est.lucid-check whether requried data are missing; (2) boot.lucid…

…: suppress automatic printing
USCbiostats · Jan 4, 2022 · 5e3823f · 5e3823f
1 parent ab329a8
commit 5e3823f
Show file tree

Hide file tree

Showing 2 changed files with 55 additions and 20 deletions.
diff --git a/R/boot_lucid.R b/R/boot_lucid.R
@@ -33,14 +33,34 @@
 #' boot1 <- boot.lucid(G = sim2[, 1:10], Z = sim2[, 11:20], Y = as.matrix(sim2[, 21]),
 #'  model = fit1, R = 100, n = num_workers)
 #' }
-boot.lucid <- function(G, Z, Y, CoG = NULL, CoY = NULL, model, R = 100, n = detectCores(), Zdiff = FALSE) {
+boot.lucid <- function(G, 
+                       Z, 
+                       Y, 
+                       CoG = NULL, 
+                       CoY = NULL, 
+                       model, 
+                       R = 100, 
+                       n = detectCores(), 
+                       Zdiff = FALSE) {
   ss <- model$select
   G <- as.matrix(G[, ss$selectG])
   Z <- as.matrix(Z[, ss$selectZ])
   dimG <- ncol(G); dimZ <- ncol(Z); dimCoY <- ncol(CoY); dimCoG  <- ncol(CoG); K <- model$K
   alldata <- as.data.frame(cbind(G, Z, Y, CoG, CoY))
-  bootstrap <- boot(data = alldata, statistic = lucid_par, R = R, parallel = "multicore", ncpus = n,
-                    dimG = dimG, dimZ = dimZ, dimCoY = dimCoY, dimCoG = dimCoG, model = model, Zdiff = Zdiff)
+  cat("Use Bootstrap resampling to derive 95% CI for LUCID")
+  invisible(capture.output(
+    bootstrap <- boot(data = alldata, 
+                      statistic = lucid_par, 
+                      R = R, 
+                      parallel = "multicore", 
+                      ncpus = n,
+                      dimG = dimG, 
+                      dimZ = dimZ, 
+                      dimCoY = dimCoY, 
+                      dimCoG = dimCoG, 
+                      model = model, 
+                      Zdiff = Zdiff)
+  ))
   sd <- sapply(1:length(bootstrap$t0), function(x) sd(bootstrap$t[, x]))
   if(Zdiff == FALSE){
     model.par <- c(model$pars$beta[-1, c(FALSE, ss$selectG)], as.vector(t(model$pars$mu[, ss$selectZ])), model$pars$gamma$beta)
@@ -90,8 +110,11 @@ lucid_par <- function(data, indices, dimG, dimZ, dimCoY, dimCoG, model, Zdiff) {
                                Y = Y,
                                CoY = CoY, 
                                CoG = CoG,
-                               family = model$family, control = model$par.control,
-                               modelName = model$modelName, K = model$K, tune = model$par.tune))
+                               family = model$family, 
+                               control = model$par.control,
+                               modelName = model$modelName, 
+                               K = model$K, 
+                               tune = model$par.tune))
     if("try-error" %in% class(try_lucid)){
       next
     } else{

diff --git a/R/est_lucid.R b/R/est_lucid.R
@@ -69,10 +69,14 @@ est.lucid <- function(G,
   init_impute <- match.arg(init_impute)
 
   ## 1.1 check data format ====
-  if(!is.matrix(G)) {
-    G <- as.matrix(G)
-    if(!is.numeric(G)) {
-      stop("Input data 'G' should be numeric; categorical variables should be transformed into dummies")
+  if(is.null(G)) {
+    stop("Input data 'G' is missing")
+  } else {
+    if(!is.matrix(G)) {
+      G <- as.matrix(G)
+      if(!is.numeric(G)) {
+        stop("Input data 'G' should be numeric; categorical variables should be transformed into dummies")
+      }
     }
   }
   if(is.null(colnames(G))){
@@ -82,10 +86,14 @@ est.lucid <- function(G,
   }
   colnames(G) <- Gnames
 
-  if(!is.matrix(Z)) {
-    Z <- as.matrix(Z)
-    if(!is.numeric(Z)) {
-      stop("Input data 'Z' should be numeric")
+  if(is.null(Z)) {
+    stop("Input data 'Z' is missing")
+  } else {
+    if(!is.matrix(Z)) {
+      Z <- as.matrix(Z)
+      if(!is.numeric(Z)) {
+        stop("Input data 'Z' should be numeric")
+      }
     }
   }
   if(is.null(colnames(Z))){
@@ -94,13 +102,17 @@ est.lucid <- function(G,
     Znames <- colnames(Z)
   }
 
-  if(!is.matrix(Y)) {
-    Y <- as.matrix(Y)
-    if(!is.numeric(Y)) {
-      stop("Input data 'Y' should be numeric; binary outcome should be transformed them into dummies")
-    }
-    if(ncol(Y) > 1) {
-      stop("Only continuous 'Y' or binary 'Y' is accepted")
+  if(is.null(Y)) {
+    stop("Input data 'Y' is missing")
+  } else {
+    if(!is.matrix(Y)) {
+      Y <- as.matrix(Y)
+      if(!is.numeric(Y)) {
+        stop("Input data 'Y' should be numeric; binary outcome should be transformed them into dummies")
+      }
+      if(ncol(Y) > 1) {
+        stop("Only continuous 'Y' or binary 'Y' is accepted")
+      }
     }
   }
   if(is.null(colnames(Y))) {