add tests

NAMESPACE

@@ -4,6 +4,7 @@ S3method(pcens_cdf,default)
 S3method(pcens_cdf,pcens_pgamma_dunif)
 S3method(pcens_cdf,pcens_plnorm_dunif)
 S3method(pcens_cdf,pcens_pweibull_dunif)
+S3method(pcens_quantile,default)
 export(add_name_attribute)
 export(check_dprimary)
 export(check_pdist)
@@ -22,9 +23,12 @@ export(pcd_stan_files)
 export(pcd_stan_functions)
 export(pcd_stan_path)
 export(pcens_cdf)
+export(pcens_quantile)
 export(pexpgrowth)
 export(ppcens)
 export(pprimarycensored)
+export(qpcens)
+export(qprimarycensored)
 export(rexpgrowth)
 export(rpcens)
 export(rprimarycensored)

R/expgrowth.R

@@ -4,14 +4,20 @@
 #' growth distribution.
 #'
 #' @param x,q Vector of quantiles.
+#'
 #' @param n Number of observations. If `length(n) > 1`, the length is taken to
-#' be the number required.
+#'  be the number required.
+#'
 #' @param min Minimum value of the distribution range. Default is 0.
+#'
 #' @param max Maximum value of the distribution range. Default is 1.
+#'
 #' @param r Rate parameter for the exponential growth.
+#'
 #' @param log,log.p Logical; if TRUE, probabilities p are given as log(p).
+#'
 #' @param lower.tail Logical; if TRUE (default), probabilities are P\[X <= x\],
-#' otherwise, P\[X > x\].
+#'  otherwise, P\[X > x\].
 #'
 #' @return `dexpgrowth` gives the density, `pexpgrowth` gives the distribution
 #' function, and `rexpgrowth` generates random deviates.

R/fitdistdoublecens.R

@@ -10,9 +10,9 @@
 #' their global environment.
 #'
 #' @param censdata A data frame with columns 'left' and 'right' representing
-#' the lower and upper bounds of the censored observations. Unlike
-#' [fitdistrplus::fitdistcens()] `NA` is not supported for either the
-#' upper or lower bounds.
+#'  the lower and upper bounds of the censored observations. Unlike
+#'  [fitdistrplus::fitdistcens()] `NA` is not supported for either the
+#'  upper or lower bounds.
 #'
 #' @param distr A character string naming the distribution to be fitted.
 #'

R/pcd-stan-tools.R

@@ -29,11 +29,13 @@ pcd_stan_path <- function() {
 #' @param content Character vector containing Stan code
 #'
 #' @param names_only Logical, if TRUE extract function names, otherwise
-#' extract function content.
+#'  extract function content.
 #'
 #' @param functions Optional, character vector of function names to extract
-#' content for.
+#'   content for.
+#'
 #' @return Character vector of function names or content
+#'
 #' @keywords internal
 .extract_stan_functions <- function(
     content,
@@ -90,11 +92,11 @@ pcd_stan_path <- function() {
 #' the names of all functions defined in those files.
 #'
 #' @param stan_path Character string specifying the path to the directory
-#' containing Stan files. Defaults to the Stan path of the primarycensored
-#' package.
+#'  containing Stan files. Defaults to the Stan path of the primarycensored
+#'  package.
 #'
 #' @return A character vector containing unique names of all functions found in
-#' the Stan files.
+#'  the Stan files.
 #'
 #' @export
 #'

R/pcens.R

@@ -3,10 +3,10 @@
 #' @inheritParams pprimarycensored
 #'
 #' @return An object of class `pcens_{pdist_name}_{dprimary_name}`. This
-#' contains the primary event distribution, the delay distribution, the
-#' delay distribution arguments, and any additional arguments. It can be
-#' used with the `pcens_cdf()` function to compute the primary event censored
-#' cdf.
+#'  contains the primary event distribution, the delay distribution, the
+#'  delay distribution arguments, and any additional arguments. It can be
+#'  used with the `pcens_cdf()` function to compute the primary event censored
+#'  cdf.
 #'
 #' @family pcens
 #'

R/pcens_cdf.R

@@ -45,25 +45,28 @@ pcens_cdf <- function(
 #' applies numerical integration instead of analytical solutions.
 #'
 #' @seealso [pprimarycensored()] for the mathematical details of the
-#' primary event censored CDF computation.
+#'  primary event censored CDF computation.
 #'
 #' @family pcens
 #'
 #' @inherit pcens_cdf return
 #'
 #' @export
 #' @examples
-#' pcens_cdf(
-#'   new_pcens(
-#'     pdist = pgamma,
-#'     dprimary = dunif,
-#'     dprimary_args = list(min = 0, max = 1),
-#'     shape = 3,
-#'     scale = 2
-#'   ),
-#'   q = 2,
-#'   pwindow = 1
+#' # Create a primarycensored object with gamma delay and uniform primary
+#' pcens_obj <- new_pcens(
+#'   pdist = pgamma,
+#'   dprimary = dunif,
+#'   dprimary_args = list(min = 0, max = 1),
+#'   shape = 3,
+#'   scale = 2
 #' )
+#'
+#' # Compute CDF for a single value
+#' pcens_cdf(pcens_obj, q = 9, pwindow = 1)
+#'
+#' # Compute CDF for multiple values
+#' pcens_cdf(pcens_obj, q = c(4, 6, 8), pwindow = 1)
 pcens_cdf.default <- function(
     object,
     q,

R/pcens_quantile.R

@@ -33,6 +33,11 @@ pcens_quantile <- function(object, p, pwindow, use_numeric = FALSE, ...) {
 #' delay such that the CDF computed by [pcens_cdf()] approximates the target
 #' probability.
 #'
+#' @param init Initial guess for the delay. By default, 5.
+#'
+#' @param upper Upper bound for the delay. By default, 100 times the initial
+#'   guess.
+#'
 #' @param tol Numeric tolerance for the convergence criterion in the
 #'   optimisation routine.
 #'
@@ -52,23 +57,27 @@ pcens_quantile <- function(object, p, pwindow, use_numeric = FALSE, ...) {
 #'
 #' @export
 #' @examples
-#' @examples
-#' pcens_quantile(
-#'   new_pcens(
-#'     pdist = pgamma,
-#'     dprimary = dunif,
-#'     dprimary_args = list(min = 0, max = 1),
-#'     shape = 3,
-#'     scale = 2
-#'   ),
-#'   p = 0.8,
-#'   pwindow = 1
+#' # Create a primarycensored object with gamma delay and uniform primary
+#' pcens_obj <- new_pcens(
+#'   pdist = pgamma,
+#'   dprimary = dunif,
+#'   dprimary_args = list(min = 0, max = 1),
+#'   shape = 3,
+#'   scale = 2
 #' )
+#'
+#' # Compute quantile for a single probability
+#' pcens_quantile(pcens_obj, p = 0.8, pwindow = 1)
+#'
+#' # Compute quantiles for multiple probabilities
+#' pcens_quantile(pcens_obj, p = c(0.25, 0.5, 0.75), pwindow = 1)
 pcens_quantile.default <- function(
     object,
     p,
     pwindow,
     use_numeric = FALSE,
+    init = 5,
+    upper = init * 100,
     tol = 1e-8,
     max_iter = 10000,
     ...) {
@@ -88,18 +97,16 @@ pcens_quantile.default <- function(
     }
 
     lower_bound <- 0
-    upper_bound <- 100
 
-    init_guess <- (lower_bound + upper_bound) / 2
     opt_result <- optim(
-      par = init_guess,
+      par = init,
       fn = objective,
       method = "L-BFGS-B",
       lower = lower_bound,
-      upper = upper_bound,
+      upper = upper,
       control = list(fnscale = 1, maxit = max_iter, factr = tol)
     )
 
-    opt_result$value
+    opt_result$par
   })
 }

R/pprimarycensored.R

@@ -9,43 +9,43 @@
 #' @param q Vector of quantiles
 #'
 #' @param pdist Distribution function (CDF). The package can identify base R
-#' distributions for potential analytical solutions. For non-base R functions,
-#' users can apply [add_name_attribute()] to yield properly tagged
-#' functions if they wish to leverage the analytical solutions.
+#'  distributions for potential analytical solutions. For non-base R functions,
+#'  users can apply [add_name_attribute()] to yield properly tagged
+#'  functions if they wish to leverage the analytical solutions.
 #'
 #' @param pwindow Primary event window
 #'
 #' @param D Maximum delay (truncation point). If finite, the distribution is
-#' truncated at D. If set to Inf, no truncation is applied. Defaults to Inf.
+#'  truncated at D. If set to Inf, no truncation is applied. Defaults to Inf.
 #'
 #' @param dprimary Function to generate the probability density function
-#' (PDF) of primary event times. This function should take a value `x` and a
-#' `pwindow` parameter, and return a probability density. It should be
-#' normalized to integrate to 1 over \[0, pwindow\]. Defaults to a uniform
-#' distribution over \[0, pwindow\]. Users can provide custom functions or use
-#' helper functions like `dexpgrowth` for an exponential growth distribution.
-#' See `primary_dists.R` for examples. The package can identify base R
-#' distributions for potential analytical solutions. For non-base R functions,
-#' users can apply [add_name_attribute()] to yield properly tagged
-#' functions if they wish to leverage analytical solutions.
+#'  (PDF) of primary event times. This function should take a value `x` and a
+#'  `pwindow` parameter, and return a probability density. It should be
+#'  normalized to integrate to 1 over \[0, pwindow\]. Defaults to a uniform
+#'  distribution over \[0, pwindow\]. Users can provide custom functions or use
+#'  helper functions like `dexpgrowth` for an exponential growth distribution.
+#'  See [pcd_primary_distributions()] for examples. The package can identify
+#'  base R distributions for potential analytical solutions. For non-base R
+#'  functions, users can apply [add_name_attribute()] to yield properly tagged
+#'  functions if they wish to leverage analytical solutions.
 #'
 #' @param dprimary_args List of additional arguments to be passed to
-#' dprimary. For example, when using `dexpgrowth`, you would
-#' pass `list(min = 0, max = pwindow, r = 0.2)` to set the minimum, maximum,
-#' and rate parameters
+#'  dprimary. For example, when using `dexpgrowth`, you would
+#'  pass `list(min = 0, max = pwindow, r = 0.2)` to set the minimum, maximum,
+#'  and rate parameters
 #'
 #' @param pdist_name `r lifecycle::badge("deprecated")` this argument will be
-#' ignored in future versions; use [add_name_attribute()] on `pdist`
-#' instead
+#'  ignored in future versions; use [add_name_attribute()] on `pdist`
+#'  instead
 #'
 #' @param dprimary_name `r lifecycle::badge("deprecated")` this argument will be
-#' ignored in future versions; use [add_name_attribute()] on `dprimary`
-#' instead
+#'  ignored in future versions; use [add_name_attribute()] on `dprimary`
+#'  instead
 #'
 #' @param ... Additional arguments to be passed to pdist
 #'
 #' @return Vector of primary event censored CDFs, normalized by D if finite
-#' (truncation adjustment)
+#'  (truncation adjustment)
 #'
 #' @aliases ppcens
 #'

R/qprimarycensored.R

@@ -0,0 +1,79 @@
+#' Compute quantiles corresponding to target probabilities for primary event
+#' censored delays
+#'
+#' This function computes the quantiles (delay values) that correspond to
+#' specified probabilities in the primary event censored distribution. For a
+#' given probability p, it computes the delay value q such that P(X ≤ q) = p,
+#' where X follows the primary event censored distribution. The distribution
+#' accounts for both the delay distribution and the primary event timing
+#' distribution.
+#'
+#' @param p Vector of probabilities between 0 and 1 for which to compute
+#'  corresponding quantiles
+#'
+#' @inheritParams pprimarycensored
+#'
+#' @return Vector of delay values (quantiles) corresponding to the input
+#'  probabilities
+#'
+#' @aliases qpcens
+#'
+#' @importFrom stats dunif
+#'
+#' @export
+#'
+#' @details
+#' For each probability p, the function computes the delay value q such that
+#' P(X ≤ q) = p, where X follows the primary event censored distribution.
+#' This is done by inverting the primary event censored CDF.
+#'
+#' The function creates a `primarycensored` object using [new_pcens()] and then
+#' computes the quantiles using [pcens_quantile()]. This approach allows for
+#' analytical solutions when available, falling back to numerical methods when
+#' necessary.
+#'
+#' For example, if p = 0.5, the function returns the median delay - the value
+#' where 50% of censored events occur by this time and 50% occur after.
+#'
+#' See `methods(pcens_quantile)` for which combinations have analytical
+#' solutions implemented.
+#'
+#' @family primarycensored
+#' @seealso [new_pcens()] and [pcens_quantile()]
+#'
+#' @examples
+#' # Compute delays where 25%, 50%, and 75% of events occur by (quartiles)
+#' # Using lognormal delays with uniform primary events
+#' qprimarycensored(c(0.25, 0.5, 0.75), plnorm, meanlog = 0, sdlog = 1)
+#'
+#' # Same quartiles but with exponential growth in primary events
+#' qprimarycensored(
+#'   c(0.25, 0.5, 0.75), plnorm,
+#'   dprimary = dexpgrowth,
+#'   dprimary_args = list(r = 0.2), meanlog = 0, sdlog = 1
+#' )
+qprimarycensored <- function(
+    p,
+    pdist,
+    pwindow = 1,
+    dprimary = stats::dunif,
+    dprimary_args = list(),
+    ...) {
+  check_pdist(pdist, Inf, ...)
+  check_dprimary(dprimary, pwindow, dprimary_args)
+
+  # Create a new primarycensored object
+  pcens_obj <- new_pcens(
+    pdist,
+    dprimary,
+    dprimary_args,
+    ...
+  )
+
+  # Compute the quantiles using the S3 method
+  pcens_quantile(pcens_obj, p, pwindow)
+}
+
+#' @rdname qprimarycensored
+#' @export
+qpcens <- qprimarycensored

R/rprimarycensored.R

@@ -9,25 +9,25 @@
 #' @inheritParams dprimarycensored
 #'
 #' @param rdist Function to generate random samples from the delay distribution
-#' for example [stats::rlnorm()] for lognormal distribution.
+#'  for example [stats::rlnorm()] for lognormal distribution.
 #'
 #' @param swindow Integer specifying the window size for rounding the delay
-#' (default is 1). If `swindow = 0` then no rounding is applied.
+#'  (default is 1). If `swindow = 0` then no rounding is applied.
 #'
 #' @param n Number of random samples to generate.
 #'
 #' @param rprimary Function to generate random samples from the primary
-#' distribution (default is [stats::runif()]).
+#'  distribution (default is [stats::runif()]).
 #'
 #' @param rprimary_args List of additional arguments to be passed to rprimary.
 #'
 #' @param oversampling_factor Factor by which to oversample the number of
-#' samples to account for truncation (default is 1.2).
+#'  samples to account for truncation (default is 1.2).
 #'
 #' @param ... Additional arguments to be passed to the distribution function.
 #'
 #' @return Vector of random samples from the primary event censored
-#' distribution censored by the secondary event window.
+#'  distribution censored by the secondary event window.
 #'
 #' @aliases rpcens
 #'