Skip to content

Commit

Permalink
version 3.0.1
Browse files Browse the repository at this point in the history
  • Loading branch information
@park-jun @cran-robot
park-jun authored and cran-robot committed Jan 21, 2020
1 parent 26a3460 commit 9ab7f2b
Show file tree
Hide file tree
Showing 10 changed files with 48 additions and 165 deletions.
14 changes: 7 additions & 7 deletions DESCRIPTION
View file
@@ -1,12 +1,12 @@
Package: intccr
Type: Package
Title: Semiparametric Competing Risks Regression under Left Truncation
and Interval Censoring with Missing Cause of Failure
Version: 3.0.0
Title: Semiparametric Competing Risks Regression under Interval
Censoring
Version: 3.0.1
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 for interval-censored competing risks data as described in Bakoyannis, Yu, & Yiannoutsos (2017) <doi:10.1002/sim.7350>, left-truncated and interval-censored competing risks data, and interval-censored compering risks data and missing cause of failure. We provide 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: 2019-12-09
Description: Semiparametric regression models on the cumulative incidence function for interval-censored competing risks data as described in Bakoyannis, Yu, & Yiannoutsos (2017) <doi:10.1002/sim.7350>. In addition, missing event types or left truncation are considered. We provide 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: 2020-01-20
Imports: alabama (>= 2015.3.1), doParallel, foreach, MASS, parallel,
stats, utils
Suggests: R.rsp
Expand All @@ -17,6 +17,6 @@ LazyData: true
RoxygenNote: 6.1.1
VignetteBuilder: R.rsp
NeedsCompilation: no
Packaged: 2019-12-09 18:53:08 UTC; Jun
Packaged: 2020-01-21 01:09:36 UTC; Jun
Repository: CRAN
Date/Publication: 2019-12-09 19:20:03 UTC
Date/Publication: 2020-01-21 06:30:04 UTC
18 changes: 9 additions & 9 deletions MD5
View file
@@ -1,16 +1,16 @@
4271129abaf7164ab1e28d5f154e54fa *DESCRIPTION
acdec472b032a4c971d4a4d50d2f9135 *DESCRIPTION
bfddfbce17af67677c37991f43026fc2 *NAMESPACE
8569cda45648e08a7fdb854f5fd75303 *R/Surv2.R
a12e3702f256a38c0151787b668dcf03 *R/bsderivs.R
4e5d9dd93c20f0419e47d672114233c6 *R/bssmle.R
edd7ff7a664399f71303a0d9be8a6614 *R/bssmle_aipw.R
b2afaab16a59d87d7fdd408001e979b2 *R/bssmle.R
4b784a10597e406f3d2e9ce8b7053b88 *R/bssmle_aipw.R
07d58b1540f17c49ba1f3c9aaf8ea7f7 *R/bssmle_lse.R
fcf24c03df21b329ada9be9d68c16864 *R/bssmle_lse_lt.R
8f74baf4273a7dd6d413a3c3f6eaa8cc *R/bssmle_lt.R
87790789e6f617d5a2869ca7287f3c6e *R/bssmle_se.R
5e0d9f720fdfe75e628f052b70735ab0 *R/bssmle_se_aipw.R
fba4eeac4c43f8c91a412d40282af337 *R/bssmle_se_aipw.R
51470dc0e22890f734e2117f9d7fd758 *R/ciregic.R
b633a157b96e649e7122f7d8c752badf *R/ciregic_aipw.R
4b713d568e48c40dba53c8ae26dce4a4 *R/ciregic_aipw.R
cc5326a4f40686672b2cd3e4bad11d04 *R/ciregic_lt.R
2ca18cf172fb7fabee5e55d34fcfbe6f *R/dataprep.R
f135f934fb799c42ced5353049b4f8a0 *R/dataprep_lt.R
Expand All @@ -26,8 +26,8 @@ e620b869f8ba1c54417672276944e2c1 *R/simdata.R
1e520da4fa12944e1099fed53cd1cfb7 *R/simdata_lt.R
f39d49f1d082514ec9ca110cf03b31f9 *R/waldtest.R
116e4214762e04d61a55ba53d833389c *build/vignette.rds
3515c633332cdd9d1d5940321dcd27fa *data/fit.RData
930a1c079a72fb46d25d5ef0a40a89b8 *data/fit_aipw.RData
9770ad110e058546251688a59d43188f *data/fit.RData
9328268fab9e5fe19cc680dbae2c5be1 *data/fit_aipw.RData
3ed1036c0449463e83820e33e860bb73 *data/fit_lt.RData
53cb826850deb94719d43789216bcf4d *data/longdata.rda
ae4c0e79296c4d208f1d20aaf5ec429e *data/longdata_lt.rda
Expand All @@ -46,9 +46,9 @@ abc7eeed53393bb83039366936c7b32e *man/bssmle_lse.Rd
6705d2f302e7d282783d65abd58aeece *man/bssmle_lse_lt.Rd
82cfc18d6e8bcd5d4184e6e23e3e8e87 *man/bssmle_lt.Rd
914cfbe3ce27419e67911ac3cdb5b826 *man/bssmle_se.Rd
83dca97846ed33153accb4acf4e1ed9f *man/bssmle_se_aipw.Rd
2caf20779a3add1fdf1e1c38aa69cc1c *man/bssmle_se_aipw.Rd
072b1393d0f61d5b3775c18cf55a9c4f *man/ciregic.Rd
3f782b9aa139779a074a552c9087c8f4 *man/ciregic_aipw.Rd
91bc502ebfc9ddd888d56c3952529261 *man/ciregic_aipw.Rd
c3511b3d9eadefa581e57dcb2cad8fb4 *man/ciregic_lt.Rd
4f32ae3933e3414267ead1b85b7bcbd8 *man/dataprep.Rd
fbb30a80d4fe611df538c75c5b4f11b8 *man/dataprep_lt.Rd
Expand Down
70 changes: 0 additions & 70 deletions R/bssmle.R
View file
Expand Up @@ -289,81 +289,11 @@ bssmle <- function(formula, data, alpha, k = 1) {
unname(ui)
}

heq_g0 <- function(x) {
b1 <- x[(2 * n + 1):(2 * n + q)]
b2 <- x[(2 * n + q + 1):(2 * n + 2 * q)]

ui <- rep(0, 2 * (n - 1))

cif1 <- function(xi, eta){
if(a1 > 0){
(1 + a1 * exp(xi + eta))^(-1 / a1)
} else if(a1 == 0){
exp(-exp(xi + eta))
}
}
cif2 <- function(xi, eta){
if(a2 > 0){
(1 + a2 * exp(xi + eta))^(-1 / a2)
} else if(a2 == 0){
exp(-exp(xi + eta))
}
}

for(i in 1:dim(comb)[1]){
eta1 <- b1 %*% t(comb[i,])
eta2 <- b2 %*% t(comb[i,])
minmax <- (cif1(xi = x[1], eta = eta1) + cif2(xi = x[(n + 1)], eta = eta2)) - 2
ui <- c(ui, minmax)
}
unname(ui)
}

heq_jac_g0 <- function(x) {
b1 <- x[(2 * n + 1):(2 * n + q)]
b2 <- x[(2 * n + q + 1):(2 * n + 2 * q)]
nBS <- 2 * n

ui <- matrix(rep(0, times = (nBS * (nBS - 2))), ncol = nBS, nrow = (nBS - 2), byrow = TRUE)

zero <- matrix(rep(0, times = (dim(ui)[1] * (2 * q))), ncol = (2 * q))
ui <- cbind(ui, zero)

line <- c(rep(0, times = n),
rep(0, times = n))

dcif1 <- function(xi, eta){
if(a1 > 0){
(1 + a1 * exp(xi + eta))^(-(1 / a1) - 1) * exp(xi + eta)
} else if(a1 == 0){
exp(-exp(xi + eta)) * exp(xi + eta)
}
}
dcif2 <- function(xi, eta){
if(a2 > 0){
(1 + a2 * exp(xi + eta))^(-(1 / a2) - 1) * exp(xi + eta)
} else if(a2 == 0){
exp(-exp(xi + eta)) * exp(xi + eta)
}
}

for(i in 1:dim(comb)[1]){
line_i <- c(line, unlist(comb[i,]), unlist(comb[i,]))
eta1 <- b1 %*% t(comb[i,])
eta2 <- b2 %*% t(comb[i,])
minmax <- line_i * (as.vector(dcif1(xi = x[1], eta = eta1)) + as.vector(dcif2(xi = x[(n + 1)], eta = eta2)))
ui <- rbind(ui, minmax)
}
unname(ui)
}

est <- try(alabama::constrOptim.nl(par = b0,
fn = nLL,
gr = Grad,
hin = eval_g0,
hin.jac = eval_jac_g0,
heq = heq_g0,
heq.jac = heq_jac_g0,
control.optim = list(maxit = 2000),
control.outer = list(trace = FALSE)), silent = TRUE)

Expand Down
79 changes: 7 additions & 72 deletions R/bssmle_aipw.R
View file
Expand Up @@ -98,10 +98,15 @@ bssmle_aipw <- function(formula, aux, data, alpha, k) {
}

## Data for the probability of missingness
data.ipw <- tempdat[delta != 0, ]
if("sub" %in% ls()) {
data.ipw <- tempdat[sub == 1, ]
} else {
data.ipw <- tempdat[delta != 0, ]
}

## Data for the probability of cause of interest
if("sub" %in% ls()) {
data.aipw <- tempdat[sub == 1, ]
data.aipw <- tempdat[sub == 1 & r == 1, ]
} else {
data.aipw <- tempdat[r == 1 & delta != 0, ]
}
Expand Down Expand Up @@ -382,81 +387,11 @@ bssmle_aipw <- function(formula, aux, data, alpha, k) {
unname(ui)
}

heq_g0 <- function(x) {
b1 <- x[(2 * n + 1):(2 * n + q)]
b2 <- x[(2 * n + q + 1):(2 * n + 2 * q)]

ui <- rep(0, 2 * (n - 1))

cif1 <- function(xi, eta){
if(a1 > 0){
(1 + a1 * exp(xi + eta))^(-1 / a1)
} else if(a1 == 0){
exp(-exp(xi + eta))
}
}
cif2 <- function(xi, eta){
if(a2 > 0){
(1 + a2 * exp(xi + eta))^(-1 / a2)
} else if(a2 == 0){
exp(-exp(xi + eta))
}
}

for(i in 1:dim(comb)[1]){
eta1 <- b1 %*% t(comb[i,])
eta2 <- b2 %*% t(comb[i,])
minmax <- (cif1(xi = x[1], eta = eta1) + cif2(xi = x[(n + 1)], eta = eta2)) - 2
ui <- c(ui, minmax)
}
unname(ui)
}

heq_jac_g0 <- function(x) {
b1 <- x[(2 * n + 1):(2 * n + q)]
b2 <- x[(2 * n + q + 1):(2 * n + 2 * q)]
nBS <- 2 * n

ui <- matrix(rep(0, times = (nBS * (nBS - 2))), ncol = nBS, nrow = (nBS - 2), byrow = TRUE)

zero <- matrix(rep(0, times = (dim(ui)[1] * (2 * q))), ncol = (2 * q))
ui <- cbind(ui, zero)

line <- c(rep(0, times = n),
rep(0, times = n))

dcif1 <- function(xi, eta){
if(a1 > 0){
(1 + a1 * exp(xi + eta))^(-(1 / a1) - 1) * exp(xi + eta)
} else if(a1 == 0){
exp(-exp(xi + eta)) * exp(xi + eta)
}
}
dcif2 <- function(xi, eta){
if(a2 > 0){
(1 + a2 * exp(xi + eta))^(-(1 / a2) - 1) * exp(xi + eta)
} else if(a2 == 0){
exp(-exp(xi + eta)) * exp(xi + eta)
}
}

for(i in 1:dim(comb)[1]){
line_i <- c(line, unlist(comb[i,]), unlist(comb[i,]))
eta1 <- b1 %*% t(comb[i,])
eta2 <- b2 %*% t(comb[i,])
minmax <- line_i * (as.vector(dcif1(xi = x[1], eta = eta1)) + as.vector(dcif2(xi = x[(n + 1)], eta = eta2)))
ui <- rbind(ui, minmax)
}
unname(ui)
}

est <- try(alabama::constrOptim.nl(par = b0,
fn = nLL,
gr = Grad,
hin = eval_g0,
hin.jac = eval_jac_g0,
heq = heq_g0,
heq.jac = heq_jac_g0,
control.optim = list(maxit = 2000),
control.outer = list(trace = FALSE)), silent = TRUE)
if(class(est) != "try-error"){
Expand Down
15 changes: 13 additions & 2 deletions R/bssmle_se_aipw.R
View file
Expand Up @@ -9,6 +9,7 @@
#' @param k a parameter that controls the number of knots in the B-spline with \eqn{0.5 \le }\code{k}\eqn{ \le 1}
#' @param do.par using parallel computing for bootstrap calculation. If \code{do.par = TRUE}, parallel computing will be used during the bootstrap estimation of the variance-covariance matrix for the regression parameter estimates.
#' @param nboot a number of bootstrap samples for estimating variances and covariances of the estimated regression coefficients. If \code{nboot = 0}, the function \code{ciregic} does dot perform bootstrap estimation of the variance matrix of the regression parameter estimates and returns \code{NA} in the place of the estimated variance matrix of the regression parameter estimates.
#' @param w.cores a number of cores that are assigned (the default is \code{NULL})
#' @keywords bssmle_aipw_se
#' @import foreach parallel
#' @importFrom doParallel registerDoParallel
Expand All @@ -20,7 +21,7 @@
#' \item{Sigma}{an estimated bootstrap variance-covariance matrix of the estimated regression coefficients}


bssmle_se_aipw <- function(formula, aux, data, alpha, k, do.par, nboot) {
bssmle_se_aipw <- function(formula, aux, data, alpha, k, do.par, nboot, w.cores = NULL) {
tmp <- list()
for(i in 1:nboot){
tmp[[i]] <- data[sample(dim(data)[1], replace = TRUE), ]
Expand All @@ -46,7 +47,17 @@ bssmle_se_aipw <- function(formula, aux, data, alpha, k, do.par, nboot) {
}
close(pb)
} else {
no.cores <- parallel::detectCores() - 1
if(is.null(w.cores)) {
no.cores <- parallel::detectCores() - 1
} else {
no.cores <- parallel::detectCores() - 1
if(w.cores > no.cores) {
no.cores <- parallel::detectCores() - 1
warning("The number of cores can't exeed to the available cores. We set the maximum number of available cores.")
} else {
no.cores <- w.cores
}
}
clst <- parallel::makeCluster(no.cores)
doParallel::registerDoParallel(clst)

Expand Down
7 changes: 4 additions & 3 deletions R/ciregic_aipw.R
View file
Expand Up @@ -9,6 +9,7 @@
#' @param k a parameter that controls the number of knots in the B-spline with \eqn{0.5 \le }\code{k}\eqn{ \le 1}
#' @param do.par an option to use parallel computing for bootstrap. If \code{do.par = TRUE}, parallel computing will be used during the bootstrap estimation of the variance-covariance matrix for the regression parameter estimates.
#' @param nboot a number of bootstrap samples for estimating variances and covariances of the estimated regression coefficients. If \code{nboot = 0}, the function \code{ciregic_aipw} does not perform bootstrap estimation of the variance-covariance matrix of the regression parameter estimates and returns \code{NA} in the place of the estimated variance-covariance matrix of the regression parameter estimates.
#' @param w.cores a number of cores that are assigned (the default is \code{NULL})
#' @return The function \code{ciregic_aipw} provides an object of class \code{ciregic_aipw} with components:
#' \item{varnames}{a vector containing variable names}
#' \item{varnames.aux}{a vector containing auxiliary variable names}
Expand Down Expand Up @@ -62,10 +63,10 @@
#' points(pred$t, pred$cif2, type = "l", col = 2)
#'
#' @export
ciregic_aipw <- function(formula, aux = NULL, data, alpha, k = 1, do.par, nboot) UseMethod("ciregic_aipw")
ciregic_aipw <- function(formula, aux = NULL, data, alpha, k = 1, do.par, nboot, w.cores = NULL) UseMethod("ciregic_aipw")

#' @export
ciregic_aipw.default <- function(formula, aux = NULL, data, alpha, k = 1, do.par, nboot) {
ciregic_aipw.default <- function(formula, aux = NULL, data, alpha, k = 1, do.par, nboot, w.cores = NULL) {
mc <- match.call()

if (k < .5 | k > 1)
Expand All @@ -75,7 +76,7 @@ ciregic_aipw.default <- function(formula, aux = NULL, data, alpha, k = 1, do.par

if(min(!is.na(est$beta)) == 1) {
if(nboot >= 1){
res <- bssmle_se_aipw(formula, aux = mc$aux, data, alpha, k, do.par, nboot)
res <- bssmle_se_aipw(formula, aux = mc$aux, data, alpha, k, do.par, nboot, w.cores)
Sigma <- res$Sigma
notcoverged <- res$notcoverged
numboot <- res$numboot
Expand Down
Binary file modified data/fit.RData
View file
Binary file not shown.
Binary file modified data/fit_aipw.RData
View file
Binary file not shown.
5 changes: 4 additions & 1 deletion man/bssmle_se_aipw.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

5 changes: 4 additions & 1 deletion man/ciregic_aipw.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 9ab7f2b

Please sign in to comment.