diff --git a/NAMESPACE b/NAMESPACE index 38c61b61..b3297a6a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,15 @@ # Generated by roxygen2: do not edit by hand +S3method(getInit,ExponentialTransition) +S3method(getInit,WeibullTransition) +S3method(getResults,ExponentialTransition) +S3method(getResults,WeibullTransition) +S3method(getTarget,ExponentialTransition) +S3method(getTarget,WeibullTransition) +S3method(haz,ExponentialTransition) +S3method(haz,WeibullTransition) +S3method(survTrans,ExponentialTransition) +S3method(survTrans,WeibullTransition) export(ExpHazOS) export(ExpQuantOS) export(ExpSurvOS) @@ -18,26 +28,33 @@ export(avgHRExpOS) export(avgHRIntegExpOS) export(censoringByNumberEvents) export(empSignificant) +export(estimateParams) export(exponential_transition) export(getCensoredData) export(getClinicalTrials) export(getDatasetWideFormat) export(getEventsAll) +export(getInit) export(getNumberEvents) export(getOneClinicalTrial) export(getOneToTwoRows) export(getPCWDistr) export(getPCWHazard) +export(getResults) export(getSimulatedData) export(getSumPCW) +export(getTarget) export(getTimePoint) export(getWaitTimeSum) +export(haz) export(integrateVector) export(logRankTest) +export(negLogLik) export(passedLogRank) export(piecewise_exponential) export(prepareData) export(pwA) +export(survTrans) export(trackEventsPerTrial) export(weibull_transition) import(checkmate) diff --git a/NEWS.md b/NEWS.md index 0e16a950..5d400fdd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,7 @@ ### New Features - `prepareData` allows formatting of trial data for log-likelihood computation. +- `estimateParams` estimates parameters of exponential and Weibull transition hazards for a given data set. ### Bug Fixes diff --git a/R/estimateParams.R b/R/estimateParams.R index 7d900c26..880b1888 100644 --- a/R/estimateParams.R +++ b/R/estimateParams.R @@ -53,3 +53,307 @@ prepareData <- function(data) { as.data.frame(dataNew[, -which(names(dataNew) == "time")], row.names = seq_len(nrow(dataNew))) } + +#' Compute the Negative Log-Likelihood for a Given Data Set and Transition Model +#' +#' @param transition (`ExponentialTransition` or `WeibullTransition`)\cr +#' see [exponential_transition()] or [weibull_transition()] for details. +#' @param data (`data.frame`)\cr in the format created by [prepareData()]. +#' +#' @return The value of the negative log-likelihood. +#' @export +#' +#' @details +#' Calculates the negative log-likelihood for a given data set and transition model. It uses the hazard +#' and survival functions specific to the transition model. +#' +#' @examples +#' transition <- exponential_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6) +#' simData <- getOneClinicalTrial( +#' nPat = c(30), transitionByArm = list(transition), +#' dropout = list(rate = 0.8, time = 12), +#' accrual = list(param = "time", value = 1) +#' ) +#' negLogLik(transition, prepareData(simData)) +negLogLik <- function(transition, data) { + with(data, -sum(log(haz(transition, exit, trans)^status + * survTrans(transition, exit, trans) / survTrans(transition, entry, trans)))) +} + +#' Hazard Function for Different Transition Models +#' +#' @param transition (`ExponentialTransition` or `WeibullTransition`)\cr +#' see [exponential_transition()] or [weibull_transition()] for details. +#' @param t (`numeric`)\cr time at which hazard is to be computed. +#' @param trans (`integer`)\cr index specifying the transition type. +#' +#' @return The hazard rate for the specified transition and time. +#' @export +#' +#' @examples +#' transition <- exponential_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6) +#' haz(transition, 0.4, 2) +haz <- function(transition, t, trans) { + assert_class(transition, "TransitionParameters") + assert_numeric(t, lower = 0) + assert_subset(trans, c(1, 2, 3)) + UseMethod("haz") +} + +#' @describeIn haz for an exponential transition model. +#' @export +#' +#' @examples +#' transition <- exponential_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6) +#' haz(transition, 0.4, 2) +haz.ExponentialTransition <- function(transition, t, trans) { + # params (in this order): h01, h02, h12. + params <- unlist(transition$hazards, use.names = FALSE) + params[trans] +} + +#' @describeIn haz for the Weibull transition model. +#' @export +#' +#' @examples +#' transition <- weibull_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6, p01 = 2, p02 = 2.5, p12 = 3) +#' haz(transition, 0.4, 2) +haz.WeibullTransition <- function(transition, t, trans) { + # params (in this order): h01, h02, h12, p01, p02, p12. + params <- c(unlist(transition$hazards, use.names = FALSE), unlist(transition$weibull_rates, use.names = FALSE)) + params[trans] * params[trans + 3] * t^(params[trans + 3] - 1) +} + +#' Survival Function for Different Transition Models +#' +#' @param transition (`ExponentialTransition` or `WeibullTransition`)\cr +#' see [exponential_transition()] or [weibull_transition()] for details. +#' @param t (`numeric`)\cr time at which survival probability is to be computed. +#' @param trans (`integer`)\cr index specifying the transition type. +#' +#' @return The survival probability for the specified transition and time. +#' @export +#' +#' @examples +#' transition <- exponential_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6) +#' survTrans(transition, 0.4, 2) +survTrans <- function(transition, t, trans) { + assert_class(transition, "TransitionParameters") + assert_numeric(t, lower = 0) + assert_subset(trans, c(1, 2, 3)) + UseMethod("survTrans") +} + +#' @describeIn survTrans for the Exponential Transition Model +#' @export +#' +#' @examples +#' transition <- exponential_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6) +#' survTrans(transition, 0.4, 2) +survTrans.ExponentialTransition <- function(transition, t, trans) { + # params (in this order): h01, h02, h12. + params <- unlist(transition$hazards, use.names = FALSE) + exp(-params[trans] * t) +} + +#' @describeIn survTrans for the Weibull Transition Model +#' @export +#' +#' @examples +#' transition <- weibull_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6, p01 = 2, p02 = 2.5, p12 = 3) +#' survTrans(transition, 0.4, 2) +survTrans.WeibullTransition <- function(transition, t, trans) { + # params (in this order): h01, h02, h12, p01, p02, p12. + params <- c(unlist(transition$hazards, use.names = FALSE), unlist(transition$weibull_rates, use.names = FALSE)) + exp(-params[trans] * t^params[trans + 3]) +} + +#' Retrieve Initial Parameter Vectors for Likelihood Maximization +#' +#' @param transition (`ExponentialTransition` or `WeibullTransition`)\cr containing the initial parameters. +#' See [exponential_transition()] or [weibull_transition()] for details. +#' +#' @return The numeric vector of initial parameters for likelihood maximization. +#' @export +#' +#' @examples +#' transition <- exponential_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6) +#' getInit(transition) +getInit <- function(transition) { + assert_class(transition, "TransitionParameters") + UseMethod("getInit") +} + +#' @describeIn getInit for the Exponential Transition Model +#' @export +#' +#' @examples +#' transition <- exponential_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6) +#' getInit(transition) +getInit.ExponentialTransition <- function(transition) { + unlist(transition$hazards, use.names = FALSE) +} + +#' @describeIn getInit for the Weibull Transition Model +#' @export +#' +#' @examples +#' transition <- weibull_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6, p01 = 2, p02 = 2.5, p12 = 3) +#' getInit(transition) +getInit.WeibullTransition <- function(transition) { + c(unlist(transition$hazards, use.names = FALSE), unlist(transition$weibull_rates, use.names = FALSE)) +} + +#' Generate the Target Function for Optimization +#' +#' @param transition (`TransitionParameters`)\cr +#' specifying the distribution family. See [exponential_transition()] or [weibull_transition()] for details. +#' +#' @return Function that calculates the negative log-likelihood for the given parameters. +#' @export +#' +#' @details +#' This function creates a target function for optimization, computing the negative log-likelihood for given +#' parameters, data, and transition model type. +#' +#' @examples +#' transition <- exponential_transition(2, 1.3, 0.8) +#' simData <- getOneClinicalTrial( +#' nPat = c(30), transitionByArm = list(transition), +#' dropout = list(rate = 0.8, time = 12), +#' accrual = list(param = "time", value = 1) +#' ) +#' params <- c(1.2, 1.5, 1.6) # For ExponentialTransition +#' data <- prepareData(simData) +#' transition <- exponential_transition() +#' fun <- getTarget(transition) +#' fun(params, data) +getTarget <- function(transition) { + assert_class(transition, "TransitionParameters") + UseMethod("getTarget", transition) +} + +#' @describeIn getTarget for the Exponential Transition Model +#' @export +#' +#' @examples +#' transition <- exponential_transition(2, 1.3, 0.8) +#' simData <- getOneClinicalTrial( +#' nPat = c(30), transitionByArm = list(transition), +#' dropout = list(rate = 0.8, time = 12), +#' accrual = list(param = "time", value = 1) +#' ) +#' params <- c(1.2, 1.5, 1.6) +#' data <- prepareData(simData) +#' transition <- exponential_transition() +#' target <- getTarget(transition) +#' target(params, data) +getTarget.ExponentialTransition <- function(transition) { + function(params, data) { + negLogLik(transition = exponential_transition(h01 = params[1], h02 = params[2], h12 = params[3]), data = data) + } +} + +#' @describeIn getTarget for the Weibull Transition Model +#' @export +#' +#' @examples +#' transition <- weibull_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6, p01 = 2, p02 = 2.5, p12 = 3) +#' simData <- getOneClinicalTrial( +#' nPat = c(30), transitionByArm = list(transition), +#' dropout = list(rate = 0.8, time = 12), +#' accrual = list(param = "time", value = 1) +#' ) +#' params <- c(1.2, 1.5, 1.6, 0.8, 1.3, 1.1) +#' data <- prepareData(simData) +#' transition <- weibull_transition() +#' target <- getTarget(transition) +#' target(params, data) +getTarget.WeibullTransition <- function(transition) { + function(params, data) { + negLogLik(transition = weibull_transition( + h01 = params[1], h02 = params[2], h12 = params[3], + p01 = params[4], p02 = params[5], p12 = params[6] + ), data = data) + } +} + +#' Format Results of Parameter Estimation for Different Transition Models +#' +#' @param transition (`TransitionParameters`)\cr +#' see [exponential_transition()] or [weibull_transition()] for details. +#' @param res (`numeric` vector)\cr vector of parameter estimates from the likelihood maximization procedure. +#' +#' @return Returns a `TransitionParameters` object with parameter estimates. +#' @export +#' +#' @examples +#' results <- c(1.2, 1.5, 1.6) +#' getResults(exponential_transition(), results) +getResults <- function(transition, res) { + UseMethod("getResults") +} + +#' @describeIn getResults for the Exponential Transition Model +#' @export +#' +#' @examples +#' results <- c(1.2, 1.5, 1.6) +#' getResults(exponential_transition(), results) +getResults.ExponentialTransition <- function(transition, res) { + exponential_transition(h01 = res[1], h02 = res[2], h12 = res[3]) +} + +#' @describeIn getResults for the Weibull Transition Model +#' @export +#' +#' @examples +#' results <- c(1.2, 1.5, 1.6, 2, 2.5, 1) +#' getResults(weibull_transition(), results) +getResults.WeibullTransition <- function(transition, res) { + weibull_transition( + h01 = res[1], h02 = res[2], h12 = res[3], + p01 = res[4], p02 = res[5], p12 = res[6] + ) +} + +#' Estimate Parameters of the Multistate Model Using Clinical Trial Data +#' +#' @param data (`data.frame`)\cr in the format produced by [getOneClinicalTrial()]. +#' @param transition (`TransitionParameters` object)\cr specifying the assumed distribution of transition hazards. +#' Initial parameters for optimization can be specified here. +#' See [exponential_transition()] or [weibull_transition()] for details. +#' +#' @return Returns a `TransitionParameters` object with the estimated parameters. +#' @export +#' +#' @details +#' This function estimates parameters for transition models using clinical trial data. +#' The `transition` object can be initialized with starting values for parameter estimation. +#' It uses [stats::optim()] to optimize the parameters. +#' +#' @examples +#' transition <- exponential_transition(h01 = 2, h02 = 1.4, h12 = 1.6) +#' simData <- getOneClinicalTrial( +#' nPat = c(30), transitionByArm = list(transition), +#' dropout = list(rate = 0.3, time = 12), +#' accrual = list(param = "time", value = 1) +#' ) +#' # Initialize transition with desired starting values for optimization: +#' transition <- exponential_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6) +#' estimate <- estimateParams(simData, transition) +estimateParams <- function(data, transition) { + data <- prepareData(data) + par <- getInit(transition) + target <- getTarget(transition) + + res <- stats::optim( + par = par, + fn = target, + method = "L-BFGS-B", + lower = 1e-3, + data = data + )$par + + getResults(transition, res) +} diff --git a/R/getClinicalTrials.R b/R/getClinicalTrials.R index 48188cb4..d7612bc0 100644 --- a/R/getClinicalTrials.R +++ b/R/getClinicalTrials.R @@ -151,10 +151,22 @@ getDatasetWideFormat <- function(data) { newdata } +#' Helper Function for Adding Progress Bar to Trial Simulation +#' +#' @param x (`int`)\cr iteration index within lapply. +#' @param ... parameters transferred to [getOneClinicalTrial()], see [getOneClinicalTrial()] for details. +#' +#' @return This returns the same as [getOneClinicalTrial()], but updates the progress bar. +#' @keywords internal +runTrial <- function(x, pb, ...) { + utils::setTxtProgressBar(pb, x) + getOneClinicalTrial(...) +} + #' Simulation of a Large Number of Oncology Clinical Trials #' #' @param nRep (`int`)\cr number of simulated trials. -#' @param ... parameters transferred to [getOneClinicalTrial()], see [getOneClinicalTrial()] for details. +#' @param ... parameters transferred to [getOneClinicalTrial()], see [getOneClinicalTrial()] for details. #' @param seed (`int`)\cr random seed used for this simulation. #' @param datType (`string`)\cr possible values are `1rowTransition` and `1rowPatient`. #' @@ -175,13 +187,15 @@ getClinicalTrials <- function(nRep, ..., seed = 1234, datType = "1rowTransition" assert_choice(datType, c("1rowTransition", "1rowPatient")) set.seed(seed) + cat("Simulating", nRep, "trials:\n") + pb <- utils::txtProgressBar(min = 0, max = nRep, style = 3) # getOneClinicalTrial generates a single clinical trial with multiple arms. Generate nRep simulated trials: simulatedTrials <- lapply( seq_len(nRep), - FUN = function(x, ...) getOneClinicalTrial(...), + FUN = function(x, ...) runTrial(x, pb, ...), ... ) - + close(pb) # Final data set format: one row per patient or one row per transition? if (datType == "1rowPatient") { simulatedTrials <- lapply(simulatedTrials, getDatasetWideFormat) diff --git a/R/transitionParameters.R b/R/transitionParameters.R index 6b055425..89888f46 100644 --- a/R/transitionParameters.R +++ b/R/transitionParameters.R @@ -14,7 +14,7 @@ #' #' @examples #' exponential_transition(1, 1.6, 0.3) -exponential_transition <- function(h01, h02, h12) { +exponential_transition <- function(h01 = 1, h02 = 1, h12 = 1) { assert_positive_number(h01, zero_ok = TRUE) assert_positive_number(h02, zero_ok = TRUE) assert_positive_number(h12, zero_ok = TRUE) @@ -25,7 +25,7 @@ exponential_transition <- function(h01, h02, h12) { weibull_rates = list(p01 = 1, p02 = 1, p12 = 1), family = "exponential" ), - class = "TransitionParameters" + class = c("ExponentialTransition", "TransitionParameters") ) } @@ -67,7 +67,7 @@ piecewise_exponential <- function(h01, h02, h12, pw01, pw02, pw12) { weibull_rates = list(p01 = 1, p02 = 1, p12 = 1), family = "piecewise exponential" ), - class = "TransitionParameters" + class = c("PWCTransition", "TransitionParameters") ) } @@ -90,7 +90,7 @@ piecewise_exponential <- function(h01, h02, h12, pw01, pw02, pw12) { #' #' @examples #' weibull_transition(h01 = 1, h02 = 1.3, h12 = 0.5, p01 = 1.2, p02 = 1.3, p12 = 0.5) -weibull_transition <- function(h01, h02, h12, p01, p02, p12) { +weibull_transition <- function(h01 = 1, h02 = 1, h12 = 1, p01 = 1, p02 = 1, p12 = 1) { assert_positive_number(h01, zero_ok = TRUE) assert_positive_number(h02, zero_ok = TRUE) assert_positive_number(h12, zero_ok = TRUE) @@ -104,6 +104,6 @@ weibull_transition <- function(h01, h02, h12, p01, p02, p12) { intervals = list(pw01 = 0, pw02 = 0, pw12 = 0), family = "Weibull" ), - class = "TransitionParameters" + class = c("WeibullTransition", "TransitionParameters") ) } diff --git a/_pkgdown.yaml b/_pkgdown.yaml index 0e3eb836..bf401490 100644 --- a/_pkgdown.yaml +++ b/_pkgdown.yaml @@ -74,4 +74,21 @@ reference: - empSignificant - title: Parameter Estimation contents: + - estimateParams + - getInit + - getInit.ExponentialTransition + - getInit.WeibullTransition + - getResults + - getResults.ExponentialTransition + - getResults.WeibullTransition + - getTarget - prepareData + - title: Likelihood + contents: + - haz + - haz.ExponentialTransition + - haz.WeibullTransition + - survTrans + - survTrans.ExponentialTransition + - survTrans.WeibullTransition + - negLogLik diff --git a/inst/WORDLIST b/inst/WORDLIST index 338d7a0d..eceafda2 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -24,6 +24,7 @@ entryAct exitAct funder integrand +lapply multistate pre recruitTime diff --git a/man/estimateParams.Rd b/man/estimateParams.Rd new file mode 100644 index 00000000..dcadbca8 --- /dev/null +++ b/man/estimateParams.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/estimateParams.R +\name{estimateParams} +\alias{estimateParams} +\title{Estimate Parameters of the Multistate Model Using Clinical Trial Data} +\usage{ +estimateParams(data, transition) +} +\arguments{ +\item{data}{(\code{data.frame})\cr in the format produced by \code{\link[=getOneClinicalTrial]{getOneClinicalTrial()}}.} + +\item{transition}{(\code{TransitionParameters} object)\cr specifying the assumed distribution of transition hazards. +Initial parameters for optimization can be specified here. +See \code{\link[=exponential_transition]{exponential_transition()}} or \code{\link[=weibull_transition]{weibull_transition()}} for details.} +} +\value{ +Returns a \code{TransitionParameters} object with the estimated parameters. +} +\description{ +Estimate Parameters of the Multistate Model Using Clinical Trial Data +} +\details{ +This function estimates parameters for transition models using clinical trial data. +The \code{transition} object can be initialized with starting values for parameter estimation. +It uses \code{\link[stats:optim]{stats::optim()}} to optimize the parameters. +} +\examples{ +transition <- exponential_transition(h01 = 2, h02 = 1.4, h12 = 1.6) +simData <- getOneClinicalTrial( + nPat = c(30), transitionByArm = list(transition), + dropout = list(rate = 0.3, time = 12), + accrual = list(param = "time", value = 1) +) +# Initialize transition with desired starting values for optimization: +transition <- exponential_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6) +estimate <- estimateParams(simData, transition) +} diff --git a/man/exponential_transition.Rd b/man/exponential_transition.Rd index cc511f0e..8d272edc 100644 --- a/man/exponential_transition.Rd +++ b/man/exponential_transition.Rd @@ -4,7 +4,7 @@ \alias{exponential_transition} \title{Transition Hazards for Exponential Event Times} \usage{ -exponential_transition(h01, h02, h12) +exponential_transition(h01 = 1, h02 = 1, h12 = 1) } \arguments{ \item{h01}{(positive \code{number})\cr transition hazard for 0 to 1 transition.} diff --git a/man/getClinicalTrials.Rd b/man/getClinicalTrials.Rd index 19f6d1fa..0c4478a8 100644 --- a/man/getClinicalTrials.Rd +++ b/man/getClinicalTrials.Rd @@ -9,7 +9,7 @@ getClinicalTrials(nRep, ..., seed = 1234, datType = "1rowTransition") \arguments{ \item{nRep}{(\code{int})\cr number of simulated trials.} -\item{...}{parameters transferred to \code{\link[=getOneClinicalTrial]{getOneClinicalTrial()}}, see \code{\link[=getOneClinicalTrial]{getOneClinicalTrial()}} for details.} +\item{...}{parameters transferred to \code{\link[=getOneClinicalTrial]{getOneClinicalTrial()}}, see \code{\link[=getOneClinicalTrial]{getOneClinicalTrial()}} for details.} \item{seed}{(\code{int})\cr random seed used for this simulation.} diff --git a/man/getInit.Rd b/man/getInit.Rd new file mode 100644 index 00000000..b8f9859c --- /dev/null +++ b/man/getInit.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/estimateParams.R +\name{getInit} +\alias{getInit} +\alias{getInit.ExponentialTransition} +\alias{getInit.WeibullTransition} +\title{Retrieve Initial Parameter Vectors for Likelihood Maximization} +\usage{ +getInit(transition) + +\method{getInit}{ExponentialTransition}(transition) + +\method{getInit}{WeibullTransition}(transition) +} +\arguments{ +\item{transition}{(\code{ExponentialTransition} or \code{WeibullTransition})\cr containing the initial parameters. +See \code{\link[=exponential_transition]{exponential_transition()}} or \code{\link[=weibull_transition]{weibull_transition()}} for details.} +} +\value{ +The numeric vector of initial parameters for likelihood maximization. +} +\description{ +Retrieve Initial Parameter Vectors for Likelihood Maximization +} +\section{Methods (by class)}{ +\itemize{ +\item \code{getInit(ExponentialTransition)}: for the Exponential Transition Model + +\item \code{getInit(WeibullTransition)}: for the Weibull Transition Model + +}} +\examples{ +transition <- exponential_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6) +getInit(transition) +transition <- exponential_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6) +getInit(transition) +transition <- weibull_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6, p01 = 2, p02 = 2.5, p12 = 3) +getInit(transition) +} diff --git a/man/getResults.Rd b/man/getResults.Rd new file mode 100644 index 00000000..0f60d0d6 --- /dev/null +++ b/man/getResults.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/estimateParams.R +\name{getResults} +\alias{getResults} +\alias{getResults.ExponentialTransition} +\alias{getResults.WeibullTransition} +\title{Format Results of Parameter Estimation for Different Transition Models} +\usage{ +getResults(transition, res) + +\method{getResults}{ExponentialTransition}(transition, res) + +\method{getResults}{WeibullTransition}(transition, res) +} +\arguments{ +\item{transition}{(\code{TransitionParameters})\cr +see \code{\link[=exponential_transition]{exponential_transition()}} or \code{\link[=weibull_transition]{weibull_transition()}} for details.} + +\item{res}{(\code{numeric} vector)\cr vector of parameter estimates from the likelihood maximization procedure.} +} +\value{ +Returns a \code{TransitionParameters} object with parameter estimates. +} +\description{ +Format Results of Parameter Estimation for Different Transition Models +} +\section{Methods (by class)}{ +\itemize{ +\item \code{getResults(ExponentialTransition)}: for the Exponential Transition Model + +\item \code{getResults(WeibullTransition)}: for the Weibull Transition Model + +}} +\examples{ +results <- c(1.2, 1.5, 1.6) +getResults(exponential_transition(), results) +results <- c(1.2, 1.5, 1.6) +getResults(exponential_transition(), results) +results <- c(1.2, 1.5, 1.6, 2, 2.5, 1) +getResults(weibull_transition(), results) +} diff --git a/man/getTarget.Rd b/man/getTarget.Rd new file mode 100644 index 00000000..33349de0 --- /dev/null +++ b/man/getTarget.Rd @@ -0,0 +1,70 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/estimateParams.R +\name{getTarget} +\alias{getTarget} +\alias{getTarget.ExponentialTransition} +\alias{getTarget.WeibullTransition} +\title{Generate the Target Function for Optimization} +\usage{ +getTarget(transition) + +\method{getTarget}{ExponentialTransition}(transition) + +\method{getTarget}{WeibullTransition}(transition) +} +\arguments{ +\item{transition}{(\code{TransitionParameters})\cr +specifying the distribution family. See \code{\link[=exponential_transition]{exponential_transition()}} or \code{\link[=weibull_transition]{weibull_transition()}} for details.} +} +\value{ +Function that calculates the negative log-likelihood for the given parameters. +} +\description{ +Generate the Target Function for Optimization +} +\details{ +This function creates a target function for optimization, computing the negative log-likelihood for given +parameters, data, and transition model type. +} +\section{Methods (by class)}{ +\itemize{ +\item \code{getTarget(ExponentialTransition)}: for the Exponential Transition Model + +\item \code{getTarget(WeibullTransition)}: for the Weibull Transition Model + +}} +\examples{ +transition <- exponential_transition(2, 1.3, 0.8) +simData <- getOneClinicalTrial( + nPat = c(30), transitionByArm = list(transition), + dropout = list(rate = 0.8, time = 12), + accrual = list(param = "time", value = 1) +) +params <- c(1.2, 1.5, 1.6) # For ExponentialTransition +data <- prepareData(simData) +transition <- exponential_transition() +fun <- getTarget(transition) +fun(params, data) +transition <- exponential_transition(2, 1.3, 0.8) +simData <- getOneClinicalTrial( + nPat = c(30), transitionByArm = list(transition), + dropout = list(rate = 0.8, time = 12), + accrual = list(param = "time", value = 1) +) +params <- c(1.2, 1.5, 1.6) +data <- prepareData(simData) +transition <- exponential_transition() +target <- getTarget(transition) +target(params, data) +transition <- weibull_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6, p01 = 2, p02 = 2.5, p12 = 3) +simData <- getOneClinicalTrial( + nPat = c(30), transitionByArm = list(transition), + dropout = list(rate = 0.8, time = 12), + accrual = list(param = "time", value = 1) +) +params <- c(1.2, 1.5, 1.6, 0.8, 1.3, 1.1) +data <- prepareData(simData) +transition <- weibull_transition() +target <- getTarget(transition) +target(params, data) +} diff --git a/man/haz.Rd b/man/haz.Rd new file mode 100644 index 00000000..0aa75e77 --- /dev/null +++ b/man/haz.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/estimateParams.R +\name{haz} +\alias{haz} +\alias{haz.ExponentialTransition} +\alias{haz.WeibullTransition} +\title{Hazard Function for Different Transition Models} +\usage{ +haz(transition, t, trans) + +\method{haz}{ExponentialTransition}(transition, t, trans) + +\method{haz}{WeibullTransition}(transition, t, trans) +} +\arguments{ +\item{transition}{(\code{ExponentialTransition} or \code{WeibullTransition})\cr +see \code{\link[=exponential_transition]{exponential_transition()}} or \code{\link[=weibull_transition]{weibull_transition()}} for details.} + +\item{t}{(\code{numeric})\cr time at which hazard is to be computed.} + +\item{trans}{(\code{integer})\cr index specifying the transition type.} +} +\value{ +The hazard rate for the specified transition and time. +} +\description{ +Hazard Function for Different Transition Models +} +\section{Methods (by class)}{ +\itemize{ +\item \code{haz(ExponentialTransition)}: for an exponential transition model. + +\item \code{haz(WeibullTransition)}: for the Weibull transition model. + +}} +\examples{ +transition <- exponential_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6) +haz(transition, 0.4, 2) +transition <- exponential_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6) +haz(transition, 0.4, 2) +transition <- weibull_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6, p01 = 2, p02 = 2.5, p12 = 3) +haz(transition, 0.4, 2) +} diff --git a/man/negLogLik.Rd b/man/negLogLik.Rd new file mode 100644 index 00000000..f660f8be --- /dev/null +++ b/man/negLogLik.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/estimateParams.R +\name{negLogLik} +\alias{negLogLik} +\title{Compute the Negative Log-Likelihood for a Given Data Set and Transition Model} +\usage{ +negLogLik(transition, data) +} +\arguments{ +\item{transition}{(\code{ExponentialTransition} or \code{WeibullTransition})\cr +see \code{\link[=exponential_transition]{exponential_transition()}} or \code{\link[=weibull_transition]{weibull_transition()}} for details.} + +\item{data}{(\code{data.frame})\cr in the format created by \code{\link[=prepareData]{prepareData()}}.} +} +\value{ +The value of the negative log-likelihood. +} +\description{ +Compute the Negative Log-Likelihood for a Given Data Set and Transition Model +} +\details{ +Calculates the negative log-likelihood for a given data set and transition model. It uses the hazard +and survival functions specific to the transition model. +} +\examples{ +transition <- exponential_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6) +simData <- getOneClinicalTrial( + nPat = c(30), transitionByArm = list(transition), + dropout = list(rate = 0.8, time = 12), + accrual = list(param = "time", value = 1) +) +negLogLik(transition, prepareData(simData)) +} diff --git a/man/runTrial.Rd b/man/runTrial.Rd new file mode 100644 index 00000000..4da1a567 --- /dev/null +++ b/man/runTrial.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/getClinicalTrials.R +\name{runTrial} +\alias{runTrial} +\title{Helper Function for Adding Progress Bar to Trial Simulation} +\usage{ +runTrial(x, pb, ...) +} +\arguments{ +\item{x}{(\code{int})\cr iteration index within lapply.} + +\item{...}{parameters transferred to \code{\link[=getOneClinicalTrial]{getOneClinicalTrial()}}, see \code{\link[=getOneClinicalTrial]{getOneClinicalTrial()}} for details.} +} +\value{ +This returns the same as \code{\link[=getOneClinicalTrial]{getOneClinicalTrial()}}, but updates the progress bar. +} +\description{ +Helper Function for Adding Progress Bar to Trial Simulation +} +\keyword{internal} diff --git a/man/survTrans.Rd b/man/survTrans.Rd new file mode 100644 index 00000000..54c26d32 --- /dev/null +++ b/man/survTrans.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/estimateParams.R +\name{survTrans} +\alias{survTrans} +\alias{survTrans.ExponentialTransition} +\alias{survTrans.WeibullTransition} +\title{Survival Function for Different Transition Models} +\usage{ +survTrans(transition, t, trans) + +\method{survTrans}{ExponentialTransition}(transition, t, trans) + +\method{survTrans}{WeibullTransition}(transition, t, trans) +} +\arguments{ +\item{transition}{(\code{ExponentialTransition} or \code{WeibullTransition})\cr +see \code{\link[=exponential_transition]{exponential_transition()}} or \code{\link[=weibull_transition]{weibull_transition()}} for details.} + +\item{t}{(\code{numeric})\cr time at which survival probability is to be computed.} + +\item{trans}{(\code{integer})\cr index specifying the transition type.} +} +\value{ +The survival probability for the specified transition and time. +} +\description{ +Survival Function for Different Transition Models +} +\section{Methods (by class)}{ +\itemize{ +\item \code{survTrans(ExponentialTransition)}: for the Exponential Transition Model + +\item \code{survTrans(WeibullTransition)}: for the Weibull Transition Model + +}} +\examples{ +transition <- exponential_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6) +survTrans(transition, 0.4, 2) +transition <- exponential_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6) +survTrans(transition, 0.4, 2) +transition <- weibull_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6, p01 = 2, p02 = 2.5, p12 = 3) +survTrans(transition, 0.4, 2) +} diff --git a/man/weibull_transition.Rd b/man/weibull_transition.Rd index eb90a034..dd7f9c61 100644 --- a/man/weibull_transition.Rd +++ b/man/weibull_transition.Rd @@ -4,7 +4,7 @@ \alias{weibull_transition} \title{Transition Hazards for Weibull Distributed Event Times} \usage{ -weibull_transition(h01, h02, h12, p01, p02, p12) +weibull_transition(h01 = 1, h02 = 1, h12 = 1, p01 = 1, p02 = 1, p12 = 1) } \arguments{ \item{h01}{(positive \code{number})\cr transition hazard for 0 to 1 transition} diff --git a/tests/testthat/test-estimateParams.R b/tests/testthat/test-estimateParams.R index a004139a..b447cc21 100644 --- a/tests/testthat/test-estimateParams.R +++ b/tests/testthat/test-estimateParams.R @@ -14,3 +14,140 @@ test_that("prepareData works as expected", { actual <- prepareData(df) expect_snapshot(actual) }) + +# negLogLik ---- + +test_that("negLogLik works as expected for Exponential", { + transition <- exponential_transition(2, 1.3, 0.8) + data <- prepareData(getClinicalTrials( + nRep = 1, nPat = 50, seed = 1234, datType = "1rowPatient", + transitionByArm = list(transition), dropout = list(rate = 0.3, time = 12), + accrual = list(param = "intensity", value = 7) + )[[1]]) + actual1 <- negLogLik(transition, data) + expect_equal(actual1, 58.65772) +}) + +test_that("negLogLik works as expected for Weibull", { + transition <- weibull_transition(h01 = 0.2, h02 = 0.5, h12 = 1.6, p01 = 1, p02 = 2.5, p12 = 3) + data <- prepareData(getClinicalTrials( + nRep = 1, nPat = 50, seed = 1234, datType = "1rowPatient", + transitionByArm = list(transition), dropout = list(rate = 0.3, time = 12), + accrual = list(param = "intensity", value = 7) + )[[1]]) + actual2 <- negLogLik(transition, data) + expect_equal(actual2, 54.644006) +}) + +# haz ---- + +test_that("haz works as expected for Exponential", { + transition <- exponential_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6) + actual1 <- haz(transition, 0.4, 2) + expect_equal(actual1, 1.5) +}) + +test_that("haz works as expected for Weibull", { + transition <- weibull_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6, p01 = 2, p02 = 2.5, p12 = 3) + actual2 <- haz(transition, 0.4, 2) + expect_equal(actual2, 0.9486833) +}) + +# survTrans---- + +test_that("survTrans works as expected for Exponential", { + transition <- exponential_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6) + actual1 <- survTrans(transition, 0.4, 2) + expect_equal(actual1, 0.54881164) +}) + +test_that("survTrans works as expected for Weibull", { + transition <- weibull_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6, p01 = 2, p02 = 2.5, p12 = 3) + actual2 <- survTrans(transition, 0.1, 3) + expect_equal(actual2, 0.99840128) +}) + +# getInit ---- + +test_that("getInit works as expected for Exponential", { + transition <- exponential_transition(h01 = 2.2, h02 = 0.5, h12 = 1.3) + actual1 <- getInit(transition) + expect_equal(actual1, c(2.2, 0.5, 1.3)) +}) + +test_that("getInit works as expected for Weibull", { + transition <- weibull_transition(h01 = 0.2, h02 = 0.5, h12 = 1.6, p01 = 1, p02 = 2.5, p12 = 3) + actual2 <- getInit(transition) + expect_equal(actual2, c(0.2, 0.5, 1.6, 1, 2.5, 3)) +}) + +# getTarget ---- + +test_that("getTarget works as expected for Exponential", { + transition <- exponential_transition(2, 1.3, 0.8) + data <- prepareData(getClinicalTrials( + nRep = 1, nPat = 50, seed = 1234, datType = "1rowPatient", + transitionByArm = list(transition), dropout = list(rate = 0.3, time = 12), + accrual = list(param = "intensity", value = 7) + )[[1]]) + params <- c(1.2, 1.5, 1.6) + target <- getTarget(transition) + actual1 <- target(params, data) + expect_equal(actual1, 84.68301) +}) + +test_that("getTarget works as expected for Weibull", { + transition <- weibull_transition(h01 = 0.2, h02 = 0.5, h12 = 1.6, p01 = 1, p02 = 2.5, p12 = 3) + data <- prepareData(getClinicalTrials( + nRep = 1, nPat = 50, seed = 1234, datType = "1rowPatient", + transitionByArm = list(transition), dropout = list(rate = 0.3, time = 12), + accrual = list(param = "intensity", value = 7) + )[[1]]) + params <- c(1.2, 1.5, 1.6, 2, 1, 2) + target <- getTarget(transition) + actual2 <- target(params, data) + expect_equal(actual2, 103.6357444) +}) + +# getResults ---- + +test_that("getResults works as expected for Exponential", { + results <- c(1.2, 1.5, 1.6) + actual1 <- getResults(exponential_transition(), results) + expect_identical(actual1$hazards, list(h01 = 1.2, h02 = 1.5, h12 = 1.6)) +}) + +test_that("getResults works as expected for weibull", { + results <- c(1.2, 1.5, 1.6, 2, 1, 0.5) + actual2 <- getResults(weibull_transition(), results) + expect_identical(actual2$hazards, list(h01 = 1.2, h02 = 1.5, h12 = 1.6)) + expect_identical(actual2$weibull_rates, list(p01 = 2, p02 = 1, p12 = 0.5)) +}) + +# estimateParams ---- + +test_that("estimateParams estimates the true parameters correctly for Exponential", { + transition <- exponential_transition(2, 1.3, 0.8) + data <- getClinicalTrials( + nRep = 1, nPat = 100000, seed = 123, datType = "1rowPatient", + transitionByArm = list(transition), dropout = list(rate = 0.3, time = 1), + accrual = list(param = "intensity", value = 500) + )[[1]] + actual1 <- estimateParams(data, transition) + expect_equal(actual1$hazards, list(h01 = 2, h02 = 1.3, h12 = 0.8), tolerance = 1e-2) + expect_identical(actual1$weibull_rates, list(p01 = 1, p02 = 1, p12 = 1)) + expect_identical(class(actual1), c("ExponentialTransition", "TransitionParameters")) +}) + +test_that("estimateParams estimates the true parameters correctly for Weibull", { + transition <- weibull_transition(h01 = 0.4, h02 = 0.9, h12 = 1.6, p01 = 1, p02 = 0.5, p12 = 1.9) + data <- getClinicalTrials( + nRep = 1, nPat = 100000, seed = 123, datType = "1rowPatient", + transitionByArm = list(transition), dropout = list(rate = 0.3, time = 1), + accrual = list(param = "intensity", value = 500) + )[[1]] + actual2 <- estimateParams(data, transition) + expect_equal(actual2$hazards, list(h01 = 0.4, h02 = 0.9, h12 = 1.6), tolerance = 1e-2) + expect_equal(actual2$weibull_rates, list(p01 = 1, p02 = 0.5, p12 = 1.9), tolerance = 1e-2) + expect_identical(class(actual2), c("WeibullTransition", "TransitionParameters")) +})