diff --git a/R/checkInputs.R b/R/checkInputs.R index 5c49275..136fb76 100644 --- a/R/checkInputs.R +++ b/R/checkInputs.R @@ -18,7 +18,7 @@ #' default this is set to \code{max(ftime)}. #' @param SL.ftime A character vector or list specification to be passed to the #' \code{SL.library} argument in the call to \code{SuperLearner} for the -#' outcome regression (either cause-specific hazards or conditional mean). +#' outcome regression, either cause-specific hazards or conditional mean. #' See \code{?SuperLearner} for more information on how to specify valid #' \code{SuperLearner} libraries. It is expected that the wrappers used #' in the library will play nicely with the input variables, which will @@ -36,8 +36,8 @@ #' variables, which will be \code{names(adjustVars)}. #' @param glm.ftime A character specification of the right-hand side of the #' equation passed to the \code{formula} option of a call to \code{glm} -#' for the outcome regression (either cause-specific hazards or -#' conditional mean). Ignored if \code{SL.ftime != NULL}. Use \code{"trt"} +#' for the outcome regression, either cause-specific hazards or +#' conditional mean. Ignored if \code{SL.ftime != NULL}. Use \code{"trt"} #' to specify the treatment in this formula (see examples). The formula #' can additionally include any variables found in #' \code{names(adjustVars)}. @@ -300,7 +300,8 @@ checkInputs <- function(ftime, } # check that one of glm.ftime or SL.ftime is specified if(is.null(glm.ftime) & is.null(SL.ftime)) { - warning("glm.ftime and SL.ftime not specified. Computing empirical estimates.") + warning("glm.ftime and SL.ftime not specified. Computing empirical + estimates.") if(method == "hazard") { glm.ftime <- paste0("-1 + ", paste0("I(t == ", unique(ftime[ftype > 0]), ")", collapse = "+"), "+", @@ -342,7 +343,8 @@ checkInputs <- function(ftime, adjustVars <- data.frame(dummy = rep(1,length(ftime))) } else { if(all(apply(adjustVars, 2, function(x){length(unique(x)) == 1}))) { - warning("Columns of adjustVars are constantly valued. Computing unadjusted estimates.") + warning("Columns of adjustVars are constantly valued. Computing unadjusted + estimates.") if(is.null(glm.trt)) { glm.trt <- "1" } diff --git a/R/estimateCensoring.R b/R/estimateCensoring.R index caccc01..524d149 100644 --- a/R/estimateCensoring.R +++ b/R/estimateCensoring.R @@ -24,15 +24,15 @@ #' \code{t == t0} is different than if \code{t != t0}. #' @param SL.ctime A character vector or list specification to be passed to the #' \code{SL.library} argument in the call to \code{SuperLearner} for the -#' outcome regression (either cause-specific hazards or conditional mean). -#' See \code{?SuperLearner} for more information on how to specify valid +#' outcome regression, either cause-specific hazards or conditional mean. +#' See \code{?SuperLearner} for more information on how to specify valid #' \code{SuperLearner} libraries. It is expected that the wrappers used #' in the library will play nicely with the input variables, which will #' be called \code{"trt"} and \code{names(adjustVars)}. #' @param glm.ctime A character specification of the right-hand side of the #' equation passed to the \code{formula} option of a call to \code{glm} -#' for the outcome regression (either cause-specific hazards or -#' conditional mean). Ignored if \code{SL.ctime != NULL}. Use \code{"trt"} +#' for the outcome regression, either cause-specific hazards or +#' conditional mean. Ignored if \code{SL.ctime != NULL}. Use \code{"trt"} #' to specify the treatment in this formula (see examples). The formula #' can additionally include any variables found in #' \code{names(adjustVars)}. @@ -77,7 +77,7 @@ estimateCensoring <- function(dataList, if(!all(dataList[[1]]$C == 0)) { ctimeForm <- sprintf("%s ~ %s", "C", glm.ctime) ctimeMod <- glm(as.formula(ctimeForm), - data = dataList[[1]][include,], + data = dataList[[1]][include, ], family = "binomial") ctimeMod <- cleanglm(ctimeMod) } else { @@ -94,14 +94,14 @@ estimateCensoring <- function(dataList, # get predictions from ctimeMod if(all(class(ctimeMod) != "noCens")) { dataList <- lapply(dataList, function(x) { - g_dC <- rep(1, length(x[,1])) + g_dC <- rep(1, length(x[, 1])) if(t0 != 1) { # temporarily replace time with t-1 # NOTE: this will fail if t enters model as a factor x$t <- x$t - 1 suppressWarnings( - g_dC <- 1-predict(ctimeMod, newdata = x, type = "response") + g_dC <- 1 - predict(ctimeMod, newdata = x, type = "response") ) # put time back to normal @@ -120,11 +120,12 @@ estimateCensoring <- function(dataList, }) } } else { - if(class(SL.ctime) != "SuperLearner"){ + if(class(SL.ctime) != "SuperLearner") { if(!all(dataList[[1]]$C == 0)){ ctimeMod <- SuperLearner(Y = dataList[[1]]$C[include], - X = dataList[[1]][include,c("t", "trt", - names(adjustVars))], + X = dataList[[1]][include, + c("t", "trt", + names(adjustVars))], id = dataList[[1]]$id[include], family = "binomial", SL.library = SL.ctime, diff --git a/R/estimateHazards.R b/R/estimateHazards.R index 17b2591..2c9a3a5 100644 --- a/R/estimateHazards.R +++ b/R/estimateHazards.R @@ -29,15 +29,15 @@ #' variables to adjust for in the regression. #' @param SL.ftime A character vector or list specification to be passed to the #' \code{SL.library} argument in the call to \code{SuperLearner} for the -#' outcome regression (either cause-specific hazards or conditional mean). +#' outcome regression, either cause-specific hazards or conditional mean. #' See \code{?SuperLearner} for more information on how to specify valid #' \code{SuperLearner} libraries. It is expected that the wrappers used #' in the library will play nicely with the input variables, which will #' be called \code{"trt"} and \code{names(adjustVars)}. #' @param glm.ftime A character specification of the right-hand side of the #' equation passed to the \code{formula} option of a call to \code{glm} -#' for the outcome regression (either cause-specific hazards or -#' conditional mean). Ignored if \code{SL.ftime != NULL}. Use \code{"trt"} +#' for the outcome regression, either cause-specific hazards or +#' conditional mean. Ignored if \code{SL.ftime != NULL}. Use \code{"trt"} #' to specify the treatment in this formula (see examples). The formula #' can additionally include any variables found in #' \code{names(adjustVars)}. @@ -74,10 +74,10 @@ estimateHazards <- function(dataList, J, adjustVars, # formula Qj.form <- sprintf("%s ~ %s", paste("N", j, sep = ""), glm.ftime) - # add up all events less than current j to see who to include in regression + # sum all events less than current j to see who to include in regression NlessthanJ <- rep(0, nrow(dataList[[1]])) for(i in J[J < j]) { - NlessthanJ <- NlessthanJ + dataList[[1]][[paste0("N",i)]] + NlessthanJ <- NlessthanJ + dataList[[1]][[paste0("N", i)]] } # fit GLM @@ -94,16 +94,20 @@ estimateHazards <- function(dataList, J, adjustVars, # get predictions back dataList <- lapply(dataList, function(x, j) { suppressWarnings( - x[[paste0("Q",j,"PseudoHaz")]] <- predict(Qj.mod, type = 'response', newdata = x) + x[[paste0("Q",j,"PseudoHaz")]] <- predict(Qj.mod, type = "response", + newdata = x) ) if(j != min(J)) { - x[[paste0("hazLessThan",j)]] <- rowSums(cbind(rep(0, nrow(x)), - x[, paste0('Q', J[J < j], 'Haz')])) - x[[paste0("Q",j,"Haz")]] <- x[[paste0("Q",j,"PseudoHaz")]] * (1-x[[paste0("hazLessThan",j)]]) + x[[paste0("hazLessThan", j)]] <- rowSums(cbind(rep(0, nrow(x)), + x[, paste0('Q', + J[J < j], + "Haz")])) + x[[paste0("Q", j, "Haz")]] <- x[[paste0("Q", j, "PseudoHaz")]] * + (1 - x[[paste0("hazLessThan", j)]]) } else { - x[[paste0("hazLessThan",j)]] <- 0 - x[[paste0("Q",j,"Haz")]] <- x[[paste0("Q",j,"PseudoHaz")]] + x[[paste0("hazLessThan", j)]] <- 0 + x[[paste0("Q", j, "Haz")]] <- x[[paste0("Q", j, "PseudoHaz")]] } x }, j = j) @@ -116,28 +120,32 @@ estimateHazards <- function(dataList, J, adjustVars, NlessthanJ <- rep(0, nrow(dataList[[1]])) for(i in J[J < j]) { - NlessthanJ <- NlessthanJ + dataList[[1]][[paste0("N",i)]] + NlessthanJ <- NlessthanJ + dataList[[1]][[paste0("N", i)]] } dataList <- lapply(dataList, function(x, j) { if(j != min(J)) { - x[[paste0("hazLessThan",j)]] <- rowSums(cbind(rep(0, nrow(x)), - x[, paste0('Q', J[J < j], 'Haz')])) + x[[paste0("hazLessThan", j)]] <- rowSums(cbind(rep(0, nrow(x)), + x[, paste0("Q", + J[J < j], + "Haz")])) } else { - x[[paste0("hazLessThan",j)]] <- 0 + x[[paste0("hazLessThan", j)]] <- 0 } x }, j = j) - Ytilde <- (dataList[[1]][[paste0("N",j)]] - dataList[[1]][[paste0("l",j)]])/ - (pmin(dataList[[1]][[paste0("u",j)]],1-dataList[[1]][[paste0("hazLessThan",j)]]) - - dataList[[1]][[paste0("l",j)]]) + Ytilde <- (dataList[[1]][[paste0("N", j)]] - + dataList[[1]][[paste0("l", j)]]) / + (pmin(dataList[[1]][[paste0("u", j)]], 1 - + dataList[[1]][[paste0("hazLessThan", j)]]) - + dataList[[1]][[paste0("l", j)]]) if(class("glm.ftime") != "list") { Qj.mod <- stats::optim(par = rep(0, ncol(X)), fn = LogLikelihood, Y = Ytilde, X = X, method = "BFGS", gr = grad, control = list(reltol = 1e-7, maxit = 50000)) } else { - Qj.mod <- glm.ftime[[paste0("J",j)]] + Qj.mod <- glm.ftime[[paste0("J", j)]] } if(Qj.mod$convergence != 0) { stop("convergence failure") @@ -146,11 +154,14 @@ estimateHazards <- function(dataList, J, adjustVars, eval(parse(text = paste0("ftimeMod$J", j, " <- Qj.mod"))) dataList <- lapply(dataList, function(x, j) { newX <- stats::model.matrix(stats::as.formula(Qj.form), data = x) - x[[paste0("Q",j,"PseudoHaz")]] <- plogis(newX %*% beta) - x[[paste0("Q",j,"Haz")]] <- (pmin(x[[paste0("u",j)]], 1 - x[[paste0("hazLessThan",j)]]) - - x[[paste0("l",j)]])*x[[paste0("Q",j,"PseudoHaz")]] + x[[paste0("l",j)]] + x[[paste0("Q", j, "PseudoHaz")]] <- plogis(newX %*% beta) + x[[paste0("Q", j, "Haz")]] <- (pmin(x[[paste0("u", j)]], 1 - + x[[paste0("hazLessThan", j)]]) - + x[[paste0("l", j)]]) * + x[[paste0("Q", j, "PseudoHaz")]] + + x[[paste0("l", j)]] x - },j = j) + }, j = j) } } } @@ -159,37 +170,41 @@ estimateHazards <- function(dataList, J, adjustVars, # add all events less than current j to see who to include in regression NlessthanJ <- rep(0, nrow(dataList[[1]])) for (i in J[J < j]) { - NlessthanJ <- NlessthanJ + dataList[[1]][[paste0("N",i)]] + NlessthanJ <- NlessthanJ + dataList[[1]][[paste0("N", i)]] } if(class(SL.ftime[[1]]) != "SuperLearner") { - Qj.mod <- SuperLearner(Y = dataList[[1]][[paste0("N",j)]][NlessthanJ == 0], + Qj.mod <- SuperLearner(Y = dataList[[1]][[paste0("N", + j)]][NlessthanJ == 0], X = dataList[[1]][NlessthanJ == 0, - c('t', 'trt', names(adjustVars))], + c("t", "trt", + names(adjustVars))], id = dataList[[1]]$id[NlessthanJ == 0], family = stats::binomial(), SL.library = SL.ftime, verbose = verbose) } else { - Qj.mod <- SL.ftime[[paste0("J",j)]] + Qj.mod <- SL.ftime[[paste0("J", j)]] } - ftimeMod[[paste0("J",j)]] <- Qj.mod + ftimeMod[[paste0("J", j)]] <- Qj.mod # get predictions back dataList <- lapply(dataList, function(x, j){ suppressWarnings( - x[[paste0("Q",j,"PseudoHaz")]] <- predict(Qj.mod, onlySL = TRUE, - newdata = x[,c('t', 'trt', names(adjustVars))])[[1]] + x[[paste0("Q", j, "PseudoHaz")]] <- predict(Qj.mod, onlySL = TRUE, + newdata = x[, c("t", "trt", names(adjustVars))])[[1]] ) if(j != min(J)) { - x[[paste0("hazLessThan",j)]] <- rowSums(cbind(rep(0, nrow(x)), - x[, paste0('Q', J[J < j], 'Haz')])) - x[[paste0("Q",j,"Haz")]] <- x[[paste0("Q",j,"PseudoHaz")]] * - (1 - x[[paste0("hazLessThan",j)]]) + x[[paste0("hazLessThan", j)]] <- rowSums(cbind(rep(0, nrow(x)), + x[, paste0("Q", + J[J < j], + "Haz")])) + x[[paste0("Q", j, "Haz")]] <- x[[paste0("Q", j, "PseudoHaz")]] * + (1 - x[[paste0("hazLessThan", j)]]) } else { - x[[paste0("Q",j,"Haz")]] <- x[[paste0("Q",j,"PseudoHaz")]] - x[[paste0("hazLessThan",j)]] <- 0 + x[[paste0("Q", j, "Haz")]] <- x[[paste0("Q", j, "PseudoHaz")]] + x[[paste0("hazLessThan", j)]] <- 0 } x }, j = j) diff --git a/R/estimateIteratedMean.R b/R/estimateIteratedMean.R index 3eff98b..5420bd7 100644 --- a/R/estimateIteratedMean.R +++ b/R/estimateIteratedMean.R @@ -32,15 +32,15 @@ #' variables to adjust for in the regression. #' @param SL.ftime A character vector or list specification to be passed to the #' \code{SL.library} argument in the call to \code{SuperLearner} for the -#' outcome regression (either cause-specific hazards or conditional mean). +#' outcome regression, either cause-specific hazards or conditional mean. #' See \code{?SuperLearner} for more information on how to specify valid #' \code{SuperLearner} libraries. It is expected that the wrappers used #' in the library will play nicely with the input variables, which will #' be called \code{"trt"} and \code{names(adjustVars)}. #' @param glm.ftime A character specification of the right-hand side of the #' equation passed to the \code{formula} option of a call to \code{glm} -#' for the outcome regression (either cause-specific hazards or -#' conditional mean). Ignored if \code{SL.ftime != NULL}. Use \code{"trt"} +#' for the outcome regression, either cause-specific hazards or +#' conditional mean. Ignored if \code{SL.ftime != NULL}. Use \code{"trt"} #' to specify the treatment in this formula (see examples). The formula #' can additionally include any variables found in #' \code{names(adjustVars)}. @@ -73,10 +73,10 @@ estimateIteratedMean <- function(wideDataList, t, whichJ, allJ, t0, adjustVars, if(t != 1) { for(j in allJ) { # exclude previously failed subjects - include[wideDataList[[1]][[paste0("N",j,".",t-1)]]==1] <- FALSE + include[wideDataList[[1]][[paste0("N", j, ".", t - 1)]] == 1] <- FALSE } # exclude previously censored subjects - include[wideDataList[[1]][[paste0("C.",t-1)]]==1] <- FALSE + include[wideDataList[[1]][[paste0("C.", t - 1)]] == 1] <- FALSE } ## determine the outcome for the regression @@ -84,34 +84,35 @@ estimateIteratedMean <- function(wideDataList, t, whichJ, allJ, t0, adjustVars, paste("Q", whichJ, "star.", t + 1, sep = "")) ## create an indicator of any failure prior to t - wideDataList <- lapply(wideDataList, function(x, t){ + wideDataList <- lapply(wideDataList, function(x, t) { if(length(allJ) > 1) { - x[[paste0("NnotJ.",t-1)]] <- - rowSums(cbind(rep(0, nrow(x)), x[, paste0('N', allJ[allJ != whichJ], '.', t - 1)])) + x[[paste0("NnotJ.", t - 1)]] <- + rowSums(cbind(rep(0, nrow(x)), x[, paste0("N", allJ[allJ != whichJ], + ".", t - 1)])) } else { - x[[paste0("NnotJ.",t-1)]] <- 0 + x[[paste0("NnotJ.", t - 1)]] <- 0 } x - },t = t) + }, t = t) - lj.t <- paste0("l",whichJ,".",t) - uj.t <- paste0("u",whichJ,".",t) - Qtildej.t <- paste0("Qtilde",whichJ,".",t) - Nj.tm1 <- paste0("N",whichJ,".",t-1) - Qj.t <- paste0("Q",whichJ,".",t) - NnotJ.tm1 <- paste0("NnotJ.",t-1) + lj.t <- paste0("l", whichJ, ".", t) + uj.t <- paste0("u", whichJ, ".", t) + Qtildej.t <- paste0("Qtilde", whichJ, ".", t) + Nj.tm1 <- paste0("N", whichJ, ".", t - 1) + Qj.t <- paste0("Q", whichJ, ".", t) + NnotJ.tm1 <- paste0("NnotJ.", t - 1) ## GLM code if(is.null(SL.ftime)) { if(is.null(bounds)) { # with no bounds Qform <- paste(outcomeName, "~", glm.ftime) suppressWarnings({ Qmod <- stats::glm(as.formula(Qform), family = "binomial", - data = wideDataList[[1]][include,]) + data = wideDataList[[1]][include, ]) wideDataList <- lapply(wideDataList, function(x, whichJ, t) { suppressWarnings( - x[[Qj.t]] <- x[[Nj.tm1]] + (1-x[[NnotJ.tm1]]-x[[Nj.tm1]])* - predict(Qmod,newdata=x,type="response") + x[[Qj.t]] <- x[[Nj.tm1]] + (1 - x[[NnotJ.tm1]] - x[[Nj.tm1]]) * + predict(Qmod, newdata = x, type = "response") ) x }, t = t, whichJ = whichJ) @@ -119,16 +120,18 @@ estimateIteratedMean <- function(wideDataList, t, whichJ, allJ, t0, adjustVars, } else { # with bounds Qform <- paste(outcomeName, "~", glm.ftime) X <- model.matrix(as.formula(Qform), data = wideDataList[[1]][include, ]) - Ytilde <- (wideDataList[[1]][include,outcomeName] - wideDataList[[1]][[lj.t]][include])/ - (wideDataList[[1]][[uj.t]][include] - wideDataList[[1]][[lj.t]][include]) + Ytilde <- (wideDataList[[1]][include, outcomeName] - + wideDataList[[1]][[lj.t]][include]) / + (wideDataList[[1]][[uj.t]][include] - + wideDataList[[1]][[lj.t]][include]) Qmod <- optim(par = rep(0, ncol(X)), fn = LogLikelihood, Y = Ytilde, X = X, method = "BFGS", gr = grad, control = list(reltol = 1e-7, maxit = 50000)) beta <- Qmod$par wideDataList <- lapply(wideDataList, function(x, j, t) { newX <- model.matrix(as.formula(Qform), data = x) - x[[Qj.t]] <- x[[Nj.tm1]] + (1-x[[NnotJ.tm1]]-x[[Nj.tm1]])* - (plogis(newX%*%beta)*(x[[uj.t]]-x[[lj.t]]) + x[[lj.t]]) + x[[Qj.t]] <- x[[Nj.tm1]] + (1 - x[[NnotJ.tm1]] - x[[Nj.tm1]]) * + (plogis(newX %*% beta) * (x[[uj.t]] - x[[lj.t]]) + x[[lj.t]]) x }, j = whichJ, t = t) @@ -137,10 +140,10 @@ estimateIteratedMean <- function(wideDataList, t, whichJ, allJ, t0, adjustVars, if(is.null(bounds)) { # with no bounds # some stability checks # number of unique outcome values - nUniq <- length(unique(wideDataList[[1]][include,outcomeName])) + nUniq <- length(unique(wideDataList[[1]][include, outcomeName])) cvControl <- SuperLearner::SuperLearner.CV.control() if(t == t0) { - # if there are less than 2 events at t0, just fit regression using only Z + # if there are less than 2 events at t0, fit regression using only Z nE <- sum(wideDataList[[1]][include, outcomeName]) ignoreSL <- nE <= 2 if(ignoreSL) { @@ -149,8 +152,8 @@ estimateIteratedMean <- function(wideDataList, t, whichJ, allJ, t0, adjustVars, data = wideDataList[[1]][include, ]) wideDataList <- lapply(wideDataList, function(x, whichJ, t) { suppressWarnings( - x[[Qj.t]] <- x[[Nj.tm1]] + (1-x[[NnotJ.tm1]]- x[[Nj.tm1]])* - predict(Qmod,newdata=data.frame(trt=x$trt)) + x[[Qj.t]] <- x[[Nj.tm1]] + (1 - x[[NnotJ.tm1]]- x[[Nj.tm1]]) * + predict(Qmod, newdata = data.frame(trt = x$trt)) ) x }, t = t, whichJ = whichJ) @@ -159,7 +162,7 @@ estimateIteratedMean <- function(wideDataList, t, whichJ, allJ, t0, adjustVars, simplify <- nE <= cvControl$V if(simplify) cvControl <- list(V = nE - 1, stratifyCV = TRUE) suppressWarnings( - Qmod <- SuperLearner::SuperLearner(Y = wideDataList[[1]][include,outcomeName], + Qmod <- SuperLearner::SuperLearner(Y = wideDataList[[1]][include, outcomeName], X = wideDataList[[1]][include, c("trt", names(adjustVars))], SL.library = SL.ftime, cvControl = cvControl, @@ -167,8 +170,9 @@ estimateIteratedMean <- function(wideDataList, t, whichJ, allJ, t0, adjustVars, verbose = verbose) ) wideDataList <- lapply(wideDataList, function(x, whichJ, t) { - x[[Qj.t]] <- x[[Nj.tm1]] + (1-x[[NnotJ.tm1]]-x[[Nj.tm1]])* - predict(Qmod, newdata = x[, c('trt', names(adjustVars))], onlySL = TRUE)$pred + x[[Qj.t]] <- x[[Nj.tm1]] + (1 - x[[NnotJ.tm1]] - x[[Nj.tm1]]) * + predict(Qmod, newdata = x[, c("trt", names(adjustVars))], + onlySL = TRUE)$pred x }, t = t, whichJ = whichJ) } @@ -183,8 +187,9 @@ estimateIteratedMean <- function(wideDataList, t, whichJ, allJ, t0, adjustVars, ) wideDataList <- lapply(wideDataList, function(x, whichJ, t) { suppressWarnings( - x[[Qj.t]] <- x[[Nj.tm1]] + (1-x[[Nj.tm1]]-x[[NnotJ.tm1]])* - predict(Qmod, newdata = x[, c('trt', names(adjustVars))], onlySL = TRUE)$pred + x[[Qj.t]] <- x[[Nj.tm1]] + (1 - x[[Nj.tm1]] - x[[NnotJ.tm1]]) * + predict(Qmod, newdata = x[, c("trt", names(adjustVars))], + onlySL = TRUE)$pred ) x }, t = t, whichJ = whichJ) diff --git a/R/estimateTreatment.R b/R/estimateTreatment.R index 3d2c7b0..c71856a 100644 --- a/R/estimateTreatment.R +++ b/R/estimateTreatment.R @@ -37,7 +37,8 @@ #' \code{SuperLearner} object. Otherwise, \code{NULL} #' #' @importFrom stats as.formula predict model.matrix optim glm -#' @importFrom SuperLearner SuperLearner SuperLearner.CV.control All SL.mean SL.glm SL.step +#' @importFrom SuperLearner SuperLearner SuperLearner.CV.control All SL.mean +#' SL.glm SL.step #' estimateTreatment <- function(dat, adjustVars, glm.trt = NULL, SL.trt = NULL, @@ -71,16 +72,16 @@ estimateTreatment <- function(dat, adjustVars, glm.trt = NULL, SL.trt = NULL, suppressWarnings( pred <- predict(trtMod, type = "response") ) - dat[[paste0("g_",max(dat$trt))]] <- pred - dat[[paste0("g_",min(dat$trt))]] <- 1-pred + dat[[paste0("g_", max(dat$trt))]] <- pred + dat[[paste0("g_", min(dat$trt))]] <- 1 - pred } } # truncate propensities eval(parse(text = paste0("dat$g_", min(dat$trt), "[dat$g_", min(dat$trt), "< gtol]<- gtol"))) - eval(parse(text=paste0("dat$g_", max(dat$trt), "[dat$g_", max(dat$trt), - "< gtol]<- gtol"))) + eval(parse(text = paste0("dat$g_", max(dat$trt), "[dat$g_", max(dat$trt), + "< gtol]<- gtol"))) out <- list(dat = dat, trtMod = if(returnModels & length(unique(dat$trt)) > 1) diff --git a/R/fluctuateHazards.R b/R/fluctuateHazards.R index 4330db7..c843bad 100644 --- a/R/fluctuateHazards.R +++ b/R/fluctuateHazards.R @@ -57,10 +57,12 @@ fluctuateHazards <- function(dataList, allJ, ofInterestJ, nJ, uniqtrt, ntrt, t0, # calculate offset term and outcome dataList <- lapply(dataList, function(x, j, allJ) { - x$thisScale <- pmin(x[[paste0("u",j)]],1-x[[paste0("hazNot",j)]]) - x[[paste0("l",j)]] - x$thisOffset <- stats::qlogis(pmin((x[[paste0("Q",j,"Haz")]] - x[[paste0("l",j)]])/x$thisScale, - 1-.Machine$double.neg.eps)) - x$thisOutcome <- (x[[paste0("N",j)]] - x[[paste0("l",j)]])/x$thisScale + x$thisScale <- pmin(x[[paste0("u", j)]], 1 - x[[paste0("hazNot", j)]]) - + x[[paste0("l", j)]] + x$thisOffset <- stats::qlogis(pmin((x[[paste0("Q", j, "Haz")]] - + x[[paste0("l", j)]]) / x$thisScale, + 1 - .Machine$double.neg.eps)) + x$thisOutcome <- (x[[paste0("N", j)]] - x[[paste0("l", j)]]) / x$thisScale x }, j = j, allJ = allJ) @@ -87,16 +89,19 @@ fluctuateHazards <- function(dataList, allJ, ofInterestJ, nJ, uniqtrt, ntrt, t0, eps <- c(eps, beta) dataList <- lapply(dataList, function(x, j) { - x[[paste0("Q",j,"PseudoHaz")]][x$trt==z] <- plogis(x$thisOffset[x$trt==z] + + x[[paste0("Q", j, "PseudoHaz")]][x$trt == z] <- + plogis(x$thisOffset[x$trt == z] + suppressWarnings( as.matrix( - Matrix::Diagonal(x=x$thisScale[x$trt==z])%*% - as.matrix(x[x$trt==z,c(cleverCovariatesNotSelf, cleverCovariatesSelf)]) - )%*% as.matrix(beta) + Matrix::Diagonal(x = x$thisScale[x$trt == z]) %*% + as.matrix(x[x$trt == z, c(cleverCovariatesNotSelf, + cleverCovariatesSelf)]) + ) %*% as.matrix(beta) ) ) - x[[paste0("Q",j,"Haz")]][x$trt==z] <- x[[paste0("Q",j,"PseudoHaz")]][x$trt==z]* - x$thisScale[x$trt==z] + x[[paste0("l",j)]][x$trt==z] + x[[paste0("Q", j, "Haz")]][x$trt == z] <- x[[paste0("Q", j, + "PseudoHaz")]][x$trt == z] * + x$thisScale[x$trt == z] + x[[paste0("l", j)]][x$trt ==z ] x }, j = j) diff --git a/R/fluctuateIteratedMean.R b/R/fluctuateIteratedMean.R index a6ced6b..fee7066 100644 --- a/R/fluctuateIteratedMean.R +++ b/R/fluctuateIteratedMean.R @@ -65,10 +65,10 @@ fluctuateIteratedMean <- function(wideDataList, t, uniqtrt, whichJ, allJ, t0, if(t != 1) { for(j in allJ) { # exclude previously failed subjects - include[wideDataList[[1]][[paste0("N",j,".",t-1)]] == 1] <- FALSE + include[wideDataList[[1]][[paste0("N", j, ".", t - 1)]] == 1] <- FALSE } # exclude previously censored subjects - include[wideDataList[[1]][[paste0("C.",t-1)]]==1] <- FALSE + include[wideDataList[[1]][[paste0("C.", t - 1)]] == 1] <- FALSE } if(is.null(bounds)) { wideDataList <- lapply(wideDataList, function(x, t) { @@ -88,7 +88,7 @@ fluctuateIteratedMean <- function(wideDataList, t, uniqtrt, whichJ, allJ, t0, # fluctuation model suppressWarnings( flucMod <- stats::glm(stats::as.formula(flucForm), family = "binomial", - data = wideDataList[[1]][include,], + data = wideDataList[[1]][include, ], start = rep(0, length(uniqtrt))) ) # get predictions back @@ -109,23 +109,24 @@ fluctuateIteratedMean <- function(wideDataList, t, uniqtrt, whichJ, allJ, t0, } else { if(!Gcomp) { cleverCovariates <- paste0("H", uniqtrt, ".", t) - lj.t <- paste0("l",whichJ,".",t) - uj.t <- paste0("u",whichJ,".",t) - Qtildej.t <- paste0("Qtilde",whichJ,".",t) - Nj.tm1 <- paste0("N",whichJ,".",t-1) - Qj.t <- paste0("Q",whichJ,".",t) - NnotJ.tm1 <- paste0("NnotJ.",t-1) + lj.t <- paste0("l", whichJ, ".", t) + uj.t <- paste0("u", whichJ, ".", t) + Qtildej.t <- paste0("Qtilde", whichJ, ".", t) + Nj.tm1 <- paste0("N", whichJ, ".", t - 1) + Qj.t <- paste0("Q", whichJ, ".", t) + NnotJ.tm1 <- paste0("NnotJ.", t - 1) # calculate offset term and outcome wideDataList <- lapply(wideDataList, function(x) { - x[["thisOutcome"]] <- (x[[outcomeName]] - x[[lj.t]])/(x[[uj.t]]-x[[lj.t]]) + x[["thisOutcome"]] <- (x[[outcomeName]] - x[[lj.t]]) / + (x[[uj.t]] - x[[lj.t]]) x[["thisScale"]] <- x[[uj.t]] - x[[lj.t]] - x[[Qtildej.t]] <- x[[Nj.tm1]] + (1-x[[NnotJ.tm1]]-x[[Nj.tm1]])* - (x[[Qj.t]] - x[[lj.t]])/x[["thisScale"]] - x[[Qtildej.t]][x[[Qtildej.t]]==1] <- 1-.Machine$double.neg.eps + x[[Qtildej.t]] <- x[[Nj.tm1]] + (1 - x[[NnotJ.tm1]]-x[[Nj.tm1]]) * + (x[[Qj.t]] - x[[lj.t]]) / x[["thisScale"]] + x[[Qtildej.t]][x[[Qtildej.t]] == 1] <- 1 - .Machine$double.neg.eps x$thisOffset <- 0 - x$thisOffset[(x[[NnotJ.tm1]] + x[[Nj.tm1]])==0] <- - stats::qlogis(x[[Qtildej.t]][(x[[NnotJ.tm1]] + x[[Nj.tm1]])==0]) + x$thisOffset[(x[[NnotJ.tm1]] + x[[Nj.tm1]]) == 0] <- + stats::qlogis(x[[Qtildej.t]][(x[[NnotJ.tm1]] + x[[Nj.tm1]]) == 0]) x }) @@ -145,15 +146,15 @@ fluctuateIteratedMean <- function(wideDataList, t, uniqtrt, whichJ, allJ, t0, wideDataList <- lapply(wideDataList, function(x) { x[[paste0("Q",whichJ,"star.",t)]] <- x[[Nj.tm1]] + - (1 - x[[NnotJ.tm1]] - x[[Nj.tm1]])* (plogis(x$thisOffset + - as.matrix(x[, cleverCovariates]) %*% as.matrix(beta))*x$thisScale - + x[[lj.t]]) + (1 - x[[NnotJ.tm1]] - x[[Nj.tm1]]) * (plogis(x$thisOffset + + as.matrix(x[, cleverCovariates]) %*% as.matrix(beta)) * + x$thisScale + x[[lj.t]]) x }) } } else { wideDataList <- lapply(wideDataList, function(x, t) { - x[[paste0("Q",whichJ,"star.",t)]] <- x[[Qj.t]] + x[[paste0("Q", whichJ, "star.", t)]] <- x[[Qj.t]] x }, t = t) } diff --git a/R/getHazardInfluenceCurve.R b/R/getHazardInfluenceCurve.R index f0264e4..f85a13a 100644 --- a/R/getHazardInfluenceCurve.R +++ b/R/getHazardInfluenceCurve.R @@ -32,19 +32,29 @@ getHazardInfluenceCurve <- function(dataList, dat, allJ, ofInterestJ, nJ, uniqtrt, t0, verbose, ...) { for(z in uniqtrt) { for(j in ofInterestJ) { - dat[[paste0("margF",j,".z",z,".t0")]] <- - mean(dataList[[1]][[paste0("F",j,".z",z,".t0")]][dataList[[1]]$t==min(dataList[[1]]$t)]) + dat[[paste0("margF", j, ".z", z, ".t0")]] <- + mean(dataList[[1]][[paste0("F", j, ".z", z, + ".t0")]][dataList[[1]]$t == + min(dataList[[1]]$t)]) - dat[[paste0("F",j,".z",z,".t0")]] <- - dataList[[1]][[paste0("F",j,".z",z,".t0")]][dataList[[1]]$t==min(dataList[[1]]$t)] + dat[[paste0("F", j, ".z", z, ".t0")]] <- + dataList[[1]][[paste0("F", j, ".z", z, ".t0")]][dataList[[1]]$t == + min(dataList[[1]]$t)] thisD <- NULL for(jTild in allJ) { - H <- paste0("H",j,".j",ifelse(jTild==j,"Self","NotSelf"),".z",z) - thisD <- cbind(thisD, dataList[[1]][[H]]/(1-dataList[[1]][[paste0("hazNot",j)]])* - (dataList[[1]][[paste0("N",jTild)]] - dataList[[1]][[paste0("Q",jTild,"Haz")]])) + H <- paste0("H", j, ".j", ifelse(jTild == j, "Self", "NotSelf"), + ".z", z) + thisD <- cbind(thisD, dataList[[1]][[H]] / + (1 - dataList[[1]][[paste0("hazNot", j)]]) * + (dataList[[1]][[paste0("N", jTild)]] - + dataList[[1]][[paste0("Q", jTild, "Haz")]])) } - dat[[paste0("D.j",j,".z",z)]] <- unlist(by(rowSums(thisD), dataList[[1]]$id, FUN=sum)) + - dat[[paste0("F",j,".z",z,".t0")]] - dat[[paste0("margF",j,".z",z,".t0")]] + dat[[paste0("D.j", j, ".z", z)]] <- unlist(by(rowSums(thisD), + dataList[[1]]$id, + FUN = sum)) + + dat[[paste0("F", j, ".z", z, ".t0")]] + - dat[[paste0("margF", j, ".z", z, + ".t0")]] } } return(dat) diff --git a/R/grad.R b/R/grad.R index 68d4a80..bf9729c 100644 --- a/R/grad.R +++ b/R/grad.R @@ -11,10 +11,10 @@ #' @return Numeric vector of the gradient of the parameter vector grad <- function(beta, Y, X){ - pi <- stats::plogis(X%*%beta) - pi[pi==0] <- .Machine$double.neg.eps - pi[pi==1] <- 1-.Machine$double.neg.eps - gr <- crossprod(X, Y-pi) + pi <- stats::plogis(X %*% beta) + pi[pi == 0] <- .Machine$double.neg.eps + pi[pi == 1] <- 1 - .Machine$double.neg.eps + gr <- crossprod(X, Y - pi) return(-gr) } @@ -31,10 +31,10 @@ grad <- function(beta, Y, X){ #' @return Numeric vector of the gradient of the parameter vector -grad_offset <- function(beta, Y, H, offset=NULL){ - pi <- stats::plogis(cbind(offset,H)%*%c(1,beta)) - pi[pi==0] <- .Machine$double.neg.eps - pi[pi==1] <- 1-.Machine$double.neg.eps - gr <- crossprod(H, Y-pi) +grad_offset <- function(beta, Y, H, offset = NULL){ + pi <- stats::plogis(cbind(offset, H) %*% c(1, beta)) + pi[pi == 0] <- .Machine$double.neg.eps + pi[pi == 1] <- 1 - .Machine$double.neg.eps + gr <- crossprod(H, Y - pi) return(-gr) } diff --git a/R/makeDataList.R b/R/makeDataList.R index 977c046..6451f9f 100644 --- a/R/makeDataList.R +++ b/R/makeDataList.R @@ -25,38 +25,42 @@ makeDataList <- function(dat, J, ntrt, uniqtrt, t0, bounds = NULL, ...) { n <- nrow(dat) - dataList <- vector(mode = "list", length = ntrt+1) + dataList <- vector(mode = "list", length = ntrt + 1) rankftime <- match(dat$ftime, sort(unique(dat$ftime))) # first element used for estimation dataList[[1]] <- dat[rep(1:nrow(dat), rankftime), ] for(j in J) { - dataList[[1]][[paste0("N",j)]] <- 0 - dataList[[1]][[paste0("N",j)]][cumsum(rankftime)] <- as.numeric(dat$ftype==j) + dataList[[1]][[paste0("N", j)]] <- 0 + dataList[[1]][[paste0("N", j)]][cumsum(rankftime)] <- + as.numeric(dat$ftype == j) } dataList[[1]]$C <- 0 dataList[[1]]$C[cumsum(rankftime)] <- as.numeric(dat$ftype == 0) - + n.row.ii <- nrow(dataList[[1]]) uniqftime <- unique(dat$ftime) orduniqftime <- uniqftime[order(uniqftime)] row.names(dataList[[1]])[row.names(dataList[[1]]) %in% - paste(row.names(dat))] <- paste0(row.names(dat),".0") - dataList[[1]]$t <- orduniqftime[as.numeric(paste(unlist(strsplit(row.names(dataList[[1]]), ".", - fixed = TRUE))[seq(2, n.row.ii * 2, 2)])) + 1] + paste(row.names(dat))] <- paste0(row.names(dat), + ".0") + dataList[[1]]$t <- + orduniqftime[as.numeric(paste(unlist(strsplit(row.names(dataList[[1]]), ".", + fixed = TRUE))[seq(2, n.row.ii + * 2, 2)])) + 1] if(!is.null(bounds)){ boundFormat <- data.frame(t = bounds$t) for(j in J){ if(paste("l", j, sep = "") %in% colnames(bounds)) { - boundFormat[[paste0("l",j)]] <- bounds[,paste0("l",j)] + boundFormat[[paste0("l", j)]] <- bounds[, paste0("l", j)] } else { - boundFormat[[paste0("l",j)]] <- 0 + boundFormat[[paste0("l", j)]] <- 0 } if(paste("u", j, sep = "") %in% names(bounds)) { - boundFormat[[paste0("u",j)]] <- bounds[,paste0("u",j)] + boundFormat[[paste0("u", j)]] <- bounds[, paste0("u", j)] } else { - boundFormat[[paste0("u",j)]] <- 1 + boundFormat[[paste0("u", j)]] <- 1 } } suppressMessages( @@ -72,8 +76,8 @@ makeDataList <- function(dat, J, ntrt, uniqtrt, t0, bounds = NULL, ...) { } } else { for(j in J){ - dataList[[1]][[paste0("l",j)]] <- 0 - dataList[[1]][[paste0("u",j)]] <- 1 + dataList[[1]][[paste0("l", j)]] <- 0 + dataList[[1]][[paste0("u", j)]] <- 1 } } @@ -83,9 +87,10 @@ makeDataList <- function(dat, J, ntrt, uniqtrt, t0, bounds = NULL, ...) { dataList[[i + 1]]$t <- rep(1:t0, n) for(j in J){ typejEvents <- dat$id[which(dat$ftype == j)] - dataList[[i+1]][[paste0("N",j)]] <- 0 - dataList[[i+1]][[paste0("N",j)]][dataList[[i+1]]$id %in% typejEvents & - dataList[[i+1]]$t >= dataList[[i+1]]$ftime] <- 1 + dataList[[i + 1]][[paste0("N", j)]] <- 0 + dataList[[i + 1]][[paste0("N", j)]][dataList[[i + 1]]$id %in% + typejEvents & dataList[[i + 1]]$t >= + dataList[[i + 1]]$ftime] <- 1 } censEvents <- dat$id[which(dat$ftype == 0)] dataList[[i + 1]]$C <- 0 @@ -108,9 +113,9 @@ makeDataList <- function(dat, J, ntrt, uniqtrt, t0, bounds = NULL, ...) { dataList[[i + 1]][tmp, paste0("u", j)] <- 1 } } else { - for(j in J){ - dataList[[i+1]][[paste0("l",j)]] <- .Machine$double.eps - dataList[[i+1]][[paste0("u",j)]] <- 1-.Machine$double.eps + for(j in J) { + dataList[[i + 1]][[paste0("l", j)]] <- .Machine$double.eps + dataList[[i + 1]][[paste0("u", j)]] <- 1 - .Machine$double.eps } } } diff --git a/R/makeWideDataList.R b/R/makeWideDataList.R index 2678e2b..05134e8 100644 --- a/R/makeWideDataList.R +++ b/R/makeWideDataList.R @@ -64,15 +64,16 @@ makeWideDataList <- function(dat, names(wideDataList) <- c("obs", uniqtrt) for(z in uniqtrt) wideDataList[[paste0(z)]]$trt <- z - + wideDataList <- lapply(wideDataList, function(x){ # make clever covariates for(z in uniqtrt) { for(t in 1:t0) { - x[[paste0("H",z,".",t)]] <- - (x$trt==z & x[[paste0("C.",t-1)]]==0) / (x[[paste0("G_dC.",t)]]*x[[paste0("g_",z,".",t)]]) + x[[paste0("H", z, ".", t)]] <- + (x$trt == z & x[[paste0("C.", t - 1)]] == 0) / + (x[[paste0("G_dC.", t)]] * x[[paste0("g_", z, ".", t)]]) } - x[[paste0("H",z,".0")]] <- (x$trt==z) / x[[paste0("g_",z,".",t)]] + x[[paste0("H", z, ".0")]] <- (x$trt == z) / x[[paste0("g_", z, ".", t)]] } x }) diff --git a/R/mean.tmle.R b/R/mean.tmle.R index c88744b..14b2f2a 100644 --- a/R/mean.tmle.R +++ b/R/mean.tmle.R @@ -250,7 +250,7 @@ mean_tmle <- function(ftime, ftype, trt, eval(parse(text = paste("wideDataList[[1]]$Q", j, "star.0.Z", uniqtrt[z], " <- rep(thisEst,n)", sep = ""))) eval(parse(text = paste("wideDataList[[1]]$Q", j, "star.1.Z", uniqtrt[z], - " <- wideDataList[[(z+1)]]$Q", j, "star.1", + " <- wideDataList[[(z + 1)]]$Q", j, "star.1", sep = ""))) } } diff --git a/R/rv144.R b/R/rv144.R index 38c991d..c21376f 100644 --- a/R/rv144.R +++ b/R/rv144.R @@ -6,7 +6,8 @@ #' #' @format A data frame with 15,955 rows and 10 columns: #' \describe{ -#' \item{ftime}{number of six month visit windows until first recorded incidence of HIV} +#' \item{ftime}{number of six month visit windows until first recorded +#' incidence of HIV} #' \item{ftype}{the genotype of HIV (0 = censored, 1 = amino acid site 169 #' matched, 2 = amino acid site 169 mismatched)} #' \item{vax}{vaccine assignment (0 = placebo, 1 = vaccine)} diff --git a/R/updateVariables.R b/R/updateVariables.R index d554368..c36bfe6 100644 --- a/R/updateVariables.R +++ b/R/updateVariables.R @@ -36,7 +36,8 @@ updateVariables <- function(dataList, allJ, ofInterestJ, nJ, uniqtrt, ntrt, t0, for(j in ofInterestJ) { # calculate CIF at time t - x[[paste0("F",j,".t")]] <- unlist(by(x[,paste0("Q",j,"Haz")]*S.tminus1,x$id,FUN=cumsum)) + x[[paste0("F", j, ".t")]] <- unlist(by(x[, paste0("Q", j, "Haz")] * + S.tminus1, x$id, FUN = cumsum)) } x }, allJ = allJ) @@ -47,13 +48,14 @@ updateVariables <- function(dataList, allJ, ofInterestJ, nJ, uniqtrt, ntrt, t0, Fj.t0.allZ <- vector(mode = "list", length = ntrt) for(i in 1:ntrt) { t0.mod <- dataList[[i + 1]]$ftime[1] - Fj.t0.allZ[[i]] <- dataList[[i+1]][[paste0("F",j,".t")]][dataList[[i+1]]$t==t0.mod] + Fj.t0.allZ[[i]] <- dataList[[i + 1]][[paste0("F", j, + ".t")]][dataList[[i + 1]]$t == t0.mod] } dataList <- lapply(dataList, function(x, j, uniqtrt, Fj.t0.allZ) { for(i in seq_along(uniqtrt)) { ind <- tapply(X = x$id, INDEX = x$id, FUN = NULL) - x[[paste0("F",j,".z",uniqtrt[i],".t0")]] <- Fj.t0.allZ[[i]][ind] + x[[paste0("F", j, ".z", uniqtrt[i], ".t0")]] <- Fj.t0.allZ[[i]][ind] } x }, j = j, uniqtrt = uniqtrt, Fj.t0.allZ = Fj.t0.allZ) @@ -74,7 +76,7 @@ updateVariables <- function(dataList, allJ, ofInterestJ, nJ, uniqtrt, ntrt, t0, ".t"))], by = c("id", "t", "trt")) } else { - # the next times it's called those columns will exist but we want them replaced + # the next times it's called those columns will exist but want them replaced # with the values from dataList[[>1]] dataList[[1]] <- merge(dataList[[1]][, -colInd], Reduce(rbind, @@ -89,10 +91,14 @@ updateVariables <- function(dataList, allJ, ofInterestJ, nJ, uniqtrt, ntrt, t0, dataList <- lapply(dataList, function(x, allJ) { for(j in allJ) { if(length(allJ) > 1) { - x[[paste0("hazNot",j)]] <- rowSums(cbind(rep(0, nrow(x)),x[,paste0('Q',allJ[allJ != j],'Haz')])) - x[[paste0("hazNot",j)]][x[[paste0("hazNot",j)]]==1] <- 1-.Machine$double.neg.eps + x[[paste0("hazNot", j)]] <- rowSums(cbind(rep(0, nrow(x)), + x[, paste0("Q", + allJ[allJ != j], + "Haz")])) + x[[paste0("hazNot", j)]][x[[paste0("hazNot", j)]] == 1] <- + 1 - .Machine$double.neg.eps } else { - x[[paste0("hazNot",j)]] <- 0 + x[[paste0("hazNot", j)]] <- 0 } } x @@ -104,13 +110,16 @@ updateVariables <- function(dataList, allJ, ofInterestJ, nJ, uniqtrt, ntrt, t0, for(z in uniqtrt) { for(j in ofInterestJ) { x[[paste0("H", j, ".jSelf.z", z)]] <- - (x$ftime >= x$t & x$trt == z)/(x[[paste0("g_",z)]]*x$G_dC) * - (1-x[[paste0("hazNot",j)]]) * ((x$t < t0) * (1-(x[[paste0("F",j,".z",z,".t0")]]- - x[[paste0("F",j,".t")]])/c(x$S.t)) + as.numeric(x$t==t0)) - x[[paste0("H", j, ".jNotSelf.z", z)]] <- - - (x$ftime >= x$t & x$trt ==z)/(x[[paste0("g_",z)]]*x$G_dC) * - (1-x[[paste0("hazNot",j)]]) * ((x$t < t0)*(x[[paste0("F",j,".z",z,".t0")]] - - x[[paste0("F",j,".t")]])/c(x$S.t)) + (x$ftime >= x$t & x$trt == z)/(x[[paste0("g_", z)]] * x$G_dC) * + (1 - x[[paste0("hazNot", j)]]) * + ((x$t < t0) * (1 - (x[[paste0("F", j, ".z", z, ".t0")]] - + x[[paste0("F", j, ".t")]]) / + c(x$S.t)) + as.numeric(x$t == t0)) + x[[paste0("H", j, ".jNotSelf.z", z)]] <- + - (x$ftime >= x$t & x$trt == z)/(x[[paste0("g_", z)]] * x$G_dC) * + (1 - x[[paste0("hazNot", j)]]) * + ((x$t < t0) * (x[[paste0("F", j, ".z", z, ".t0")]] - + x[[paste0("F", j, ".t")]]) / c(x$S.t)) } } x diff --git a/R/utils.R b/R/utils.R index 2c85400..a639b8f 100644 --- a/R/utils.R +++ b/R/utils.R @@ -10,7 +10,7 @@ #' #' @return A matrix with columns giving the lower and upper confidence limits #' for each parameter. These will be labeled as (1-level)/2 and -#' 1 - (1-level)/2 in percent. The default is 2.5% and 97.5%. +#' 1-(1-level)/2 in percent. The default is 2.5% and 97.5%. #' #' @export #' diff --git a/man/checkInputs.Rd b/man/checkInputs.Rd index 008dff0..e32a976 100644 --- a/man/checkInputs.Rd +++ b/man/checkInputs.Rd @@ -33,7 +33,7 @@ default this is set to \code{max(ftime)}.} \item{SL.ftime}{A character vector or list specification to be passed to the \code{SL.library} argument in the call to \code{SuperLearner} for the -outcome regression (either cause-specific hazards or conditional mean). +outcome regression, either cause-specific hazards or conditional mean. See \code{?SuperLearner} for more information on how to specify valid \code{SuperLearner} libraries. It is expected that the wrappers used in the library will play nicely with the input variables, which will @@ -54,8 +54,8 @@ variables, which will be \code{names(adjustVars)}.} \item{glm.ftime}{A character specification of the right-hand side of the equation passed to the \code{formula} option of a call to \code{glm} -for the outcome regression (either cause-specific hazards or -conditional mean). Ignored if \code{SL.ftime != NULL}. Use \code{"trt"} +for the outcome regression, either cause-specific hazards or +conditional mean. Ignored if \code{SL.ftime != NULL}. Use \code{"trt"} to specify the treatment in this formula (see examples). The formula can additionally include any variables found in \code{names(adjustVars)}.} diff --git a/man/confint.survtmle.Rd b/man/confint.survtmle.Rd index dd5845c..5174f3d 100644 --- a/man/confint.survtmle.Rd +++ b/man/confint.survtmle.Rd @@ -20,7 +20,7 @@ return confidence intervals for (default is to return all).} \value{ A matrix with columns giving the lower and upper confidence limits for each parameter. These will be labeled as (1-level)/2 and - 1 - (1-level)/2 in percent. The default is 2.5% and 97.5%. + 1-(1-level)/2 in percent. The default is 2.5% and 97.5%. } \description{ Computes confidence intervals for a fitted \code{survtmle} object. diff --git a/man/estimateCensoring.Rd b/man/estimateCensoring.Rd index 6cb6dcf..2da9336 100644 --- a/man/estimateCensoring.Rd +++ b/man/estimateCensoring.Rd @@ -21,16 +21,16 @@ Needed only because the naming convention for the regression if \item{SL.ctime}{A character vector or list specification to be passed to the \code{SL.library} argument in the call to \code{SuperLearner} for the -outcome regression (either cause-specific hazards or conditional mean). -See \code{?SuperLearner} for more information on how to specify valid +outcome regression, either cause-specific hazards or conditional mean. +See \code{?SuperLearner} for more information on how to specify valid \code{SuperLearner} libraries. It is expected that the wrappers used in the library will play nicely with the input variables, which will be called \code{"trt"} and \code{names(adjustVars)}.} \item{glm.ctime}{A character specification of the right-hand side of the equation passed to the \code{formula} option of a call to \code{glm} -for the outcome regression (either cause-specific hazards or -conditional mean). Ignored if \code{SL.ctime != NULL}. Use \code{"trt"} +for the outcome regression, either cause-specific hazards or +conditional mean. Ignored if \code{SL.ctime != NULL}. Use \code{"trt"} to specify the treatment in this formula (see examples). The formula can additionally include any variables found in \code{names(adjustVars)}.} diff --git a/man/estimateHazards.Rd b/man/estimateHazards.Rd index 1179381..97017cc 100644 --- a/man/estimateHazards.Rd +++ b/man/estimateHazards.Rd @@ -17,7 +17,7 @@ variables to adjust for in the regression.} \item{SL.ftime}{A character vector or list specification to be passed to the \code{SL.library} argument in the call to \code{SuperLearner} for the -outcome regression (either cause-specific hazards or conditional mean). +outcome regression, either cause-specific hazards or conditional mean. See \code{?SuperLearner} for more information on how to specify valid \code{SuperLearner} libraries. It is expected that the wrappers used in the library will play nicely with the input variables, which will @@ -25,8 +25,8 @@ be called \code{"trt"} and \code{names(adjustVars)}.} \item{glm.ftime}{A character specification of the right-hand side of the equation passed to the \code{formula} option of a call to \code{glm} -for the outcome regression (either cause-specific hazards or -conditional mean). Ignored if \code{SL.ftime != NULL}. Use \code{"trt"} +for the outcome regression, either cause-specific hazards or +conditional mean. Ignored if \code{SL.ftime != NULL}. Use \code{"trt"} to specify the treatment in this formula (see examples). The formula can additionally include any variables found in \code{names(adjustVars)}.} diff --git a/man/estimateIteratedMean.Rd b/man/estimateIteratedMean.Rd index 2c4199c..f0e4dd5 100644 --- a/man/estimateIteratedMean.Rd +++ b/man/estimateIteratedMean.Rd @@ -27,7 +27,7 @@ variables to adjust for in the regression.} \item{SL.ftime}{A character vector or list specification to be passed to the \code{SL.library} argument in the call to \code{SuperLearner} for the -outcome regression (either cause-specific hazards or conditional mean). +outcome regression, either cause-specific hazards or conditional mean. See \code{?SuperLearner} for more information on how to specify valid \code{SuperLearner} libraries. It is expected that the wrappers used in the library will play nicely with the input variables, which will @@ -35,8 +35,8 @@ be called \code{"trt"} and \code{names(adjustVars)}.} \item{glm.ftime}{A character specification of the right-hand side of the equation passed to the \code{formula} option of a call to \code{glm} -for the outcome regression (either cause-specific hazards or -conditional mean). Ignored if \code{SL.ftime != NULL}. Use \code{"trt"} +for the outcome regression, either cause-specific hazards or +conditional mean. Ignored if \code{SL.ftime != NULL}. Use \code{"trt"} to specify the treatment in this formula (see examples). The formula can additionally include any variables found in \code{names(adjustVars)}.} diff --git a/man/rv144.Rd b/man/rv144.Rd index dbbaed5..f910138 100644 --- a/man/rv144.Rd +++ b/man/rv144.Rd @@ -6,7 +6,8 @@ \title{Mock RV144 data set} \format{A data frame with 15,955 rows and 10 columns: \describe{ - \item{ftime}{number of six month visit windows until first recorded incidence of HIV} + \item{ftime}{number of six month visit windows until first recorded + incidence of HIV} \item{ftype}{the genotype of HIV (0 = censored, 1 = amino acid site 169 matched, 2 = amino acid site 169 mismatched)} \item{vax}{vaccine assignment (0 = placebo, 1 = vaccine)}