version 1.0.5

cran · Jan 16, 2019 · d9c557b · d9c557b
1 parent 49980fe
commit d9c557b
Show file tree

Hide file tree

Showing 4 changed files with 54 additions and 37 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -2,11 +2,11 @@ Package: intccr
 Type: Package
 Title: Semiparametric Competing Risks Regression under Interval
         Censoring
-Version: 1.0.4
+Version: 1.0.5
 Author: Giorgos Bakoyannis <gbakogia@iu.edu>, Jun Park <jp84@iu.edu>
 Maintainer: Jun Park <jp84@iu.edu>
 Description: Semiparametric regression models on the cumulative incidence function with interval-censored competing risks data as described in Bakoyannis, Yu, & Yiannoutsos (2017) <doi:10.1002/sim.7350>. The main function fits the proportional subdistribution hazards model (Fine-Gray model), the proportional odds model, and other models that belong to the class of semiparametric generalized odds rate transformation models.
-Date: 2018-11-29
+Date: 2019-01-16
 Imports: alabama (>= 2015.3.1), doParallel, foreach, parallel,
         numDeriv, stats, utils
 Depends: R (>= 2.14.0)
@@ -15,6 +15,6 @@ Encoding: UTF-8
 LazyData: true
 RoxygenNote: 6.0.1
 NeedsCompilation: no
-Packaged: 2018-11-29 22:45:17 UTC; Jun
+Packaged: 2019-01-16 17:33:34 UTC; Jun
 Repository: CRAN
-Date/Publication: 2018-11-29 23:00:03 UTC
+Date/Publication: 2019-01-16 18:00:03 UTC
diff --git a/MD5 b/MD5
@@ -1,8 +1,8 @@
-95ca388a25844d7df9559e77d4010789 *DESCRIPTION
+c9567f3868abff995a5ab9297264e5a3 *DESCRIPTION
 1ca814efa8634030f77a2824178d39e9 *NAMESPACE
 eb22a4010601a62acd8264f17939a06b *R/bssmle.R
-7e6c4986cef67d1b983ca385d91eb11f *R/bssmle_se.R
-5348efc7be4406fe95357370c0d92f2d *R/ciregic.R
+0983fa325427673b475633b919cfe65d *R/bssmle_se.R
+eeca2ee1fed13d7c14489f76acd2fc46 *R/ciregic.R
 a805c7c0052ca0c72a6b5e69bb21effc *R/dataprep.R
 309784dcab7b3f0386e51f1561c64341 *R/longdata.R
 1dfea5d46a5b3e7f1c5fc2e81a0b4704 *R/naive_b.R

diff --git a/R/bssmle_se.R b/R/bssmle_se.R
@@ -51,17 +51,17 @@ bssmle_se <- function(formula, data, alpha, do.par, nboot) {
                       .combine = "rbind",
                       .export = c("naive_b", "bssmle"),
                       .packages = c("splines", "stats", "alabama", "utils")) %dopar% {
-                        #pb <- utils::txtProgressBar(max = nboot, style = 3)
-                        #utils::setTxtProgressBar(pb, j)
+                        pb <- utils::txtProgressBar(max = nboot, style = 3)
+                        utils::setTxtProgressBar(pb, j)
                         par <- bssmle(formula,
                                       data = tmp[[j]],
                                       alpha)
                         q <- length(par[[2]])
                         n <- (length(par[[1]]) - 2 * q) / 2
                         pars <- par[[1]][(2 * n + 1):(2 * n + 2 * q)]
                         return(pars)
+                        close(pb)
                       }
-    #close(pb)
     parallel::stopCluster(clst)
     rownames(res.bt) <- c()
   }

diff --git a/R/ciregic.R b/R/ciregic.R
@@ -80,8 +80,7 @@ ciregic.default <- function(formula, data, alpha, do.par, nboot){
       beta <- est$beta[(2 * n + 1):(2 * n + 2 * q)]
       gamma <- est$beta[1:(2 * n)]
       temp <- paste(rep(est$varnames, 2), c(rep("cause 1", q), rep("cause 2", q)), sep = ",")
-      rownames(Sigma) <- temp
-      colnames(Sigma) <- temp
+      rownames(Sigma) <- colnames(Sigma) <- temp
     } else {
       Sigma <- NA
       numboot <- 0
@@ -133,9 +132,8 @@ ciregic.default <- function(formula, data, alpha, do.par, nboot){
 print.ciregic <- function(x, ...){
   if(x$convergence == "Did not converge"){
     print("Did not converge")
-    varnames <- x$varnames
-    coef <- matrix(x$coefficients, ncol = 2)
-    rownames(coef) <- x$varnames
+    coeff <- matrix(x$coefficients, ncol = 2)
+    rownames(coeff) <- x$varnames
 
     cat("Call:\n")
     print(x$call)
@@ -145,12 +143,11 @@ print.ciregic <- function(x, ...){
       cat("Failure cause", i)
       cat("\n")
       cat("Coefficients:\n")
-      print(coef[ ,i])
+      print(coeff[ ,i])
     }
   } else {
-    varnames <- x$varnames
-    coef <- matrix(x$coefficients, ncol = 2)
-    rownames(coef) <- x$varnames
+    coeff <- matrix(x$coefficients, ncol = 2)
+    rownames(coeff) <- x$varnames
 
     cat("Call:\n")
     print(x$call)
@@ -160,7 +157,7 @@ print.ciregic <- function(x, ...){
       cat("Failure cause", i)
       cat("\n")
       cat("Coefficients:\n")
-      print(coef[ ,i])
+      print(coeff[ ,i])
     }
   }
 }
@@ -243,9 +240,8 @@ summary.ciregic <- function(object, ...){
 #' @export
 print.summary.ciregic <- function(x, ...){
   if(is.na(x$vcov[1])) {
-    varnames <- x$varnames
-    coef <- matrix(x$coefficients, ncol = 2)
-    rownames(coef) <- x$varnames
+    coeff <- matrix(x$coefficients, ncol = 2)
+    rownames(coeff) <- x$varnames
 
     cat("Call:\n")
     print(x$call)
@@ -255,25 +251,46 @@ print.summary.ciregic <- function(x, ...){
       cat("Failure cause", i)
       cat("\n")
       cat("Coefficients:\n")
-      print(coef[ ,i])
+      print(coeff[ ,i])
     }
   } else {
     q <- length(x$coefficients) / 2
-    res <- cbind(x$coefficients, x$se, x$z, x$p)
 
-    rownames(res) <- rep(x$varnames, times = 2)
-    colnames(res) <- c("Estimate", "Std. Error", "z value", "Pr(>|z|)")
+    if(q > 1){
+      res <- cbind(x$coefficients, x$se, x$z, x$p)
 
-    cat("Call:\n")
-    print(x$call)
-    cat("\n")
-    cat("Failure cause 1")
-    cat("\n")
-    printCoefmat(res[1:q, ], P.values = TRUE, has.Pvalue = TRUE, digits = 4)
-    cat("\n")
-    cat("Failure cause 2")
-    cat("\n")
-    printCoefmat(res[(1+q):(2*q), ], P.values = TRUE, has.Pvalue = TRUE, digits = 4)
+      rownames(res) <- rep(x$varnames, times = 2)
+      colnames(res) <- c("Estimate", "Std. Error", "z value", "Pr(>|z|)")
+
+      cat("Call:\n")
+      print(x$call)
+      cat("\n")
+      cat("Failure cause 1")
+      cat("\n")
+      printCoefmat(res[1:q, ], P.values = TRUE, has.Pvalue = TRUE, digits = 4)
+      cat("\n")
+      cat("Failure cause 2")
+      cat("\n")
+      printCoefmat(res[(1 + q):(2 * q), ], P.values = TRUE, has.Pvalue = TRUE, digits = 4)
+    } else {
+      res <- cbind(x$coefficients, x$se, x$z, x$p)
+      colnames(res) <- c("Estimate", "Std. Error", "z value", "Pr(>|z|)")
+
+      res1 <- as.data.frame(t(res[1:q, ]))
+      res2 <- as.data.frame(t(res[(q + 1):(2 * q), ]))
+
+      rownames(res1) <- rownames(res2) <- rep(x$varnames)
+      cat("Call:\n")
+      print(x$call)
+      cat("\n")
+      cat("Failure cause 1")
+      cat("\n")
+      printCoefmat(res1, P.values = TRUE, has.Pvalue = TRUE, digits = 4)
+      cat("\n")
+      cat("Failure cause 2")
+      cat("\n")
+      printCoefmat(res2, P.values = TRUE, has.Pvalue = TRUE, digits = 4)
+    }
   }
 }