#' Re-used documentation for Brier Score components

#'

#' @typed t: numeric

#'   timepoints to calculate the desired quantity at.

#' @typed times: numeric

#'   observed times.

#' @typed events: numeric

#'   event indicator for `times`. Either 1 for an event or 0 for censor.

#' @typed event_offset: logical

#'   If `TRUE` then \eqn{G(T_i)} is evaluated at \eqn{G(T_i-)}.

#'   Setting this as `TRUE` mirrors the implementation of the `{pec}` package.

#' @typed maintain_cen_order: logical

#'   If `TRUE` then, in the case of ties,

#'   censor times are always considered

#'   to have occurred after the event times when calculating the "reverse Kaplan-Meier" for the

#'   IPCW estimates. Setting this to `TRUE` mirrors the implementation of the `{prodlim}`

#'   package.

#' @param ... not used.

#'

#' @name Brier-Score-Shared

#' @keywords internal

NULL

#' Reverse Kaplan-Meier

#'

#' @inheritParams Brier-Score-Shared

#' @description

#' Calculates the survival estimates of the censoring distribution

#' using the Kaplan-Meier estimate.

#' This is primarily used in the calculation of the IPCW estimates.

#'

#' @details

#' With regards to ties between censor and event times; the standard

#' approach is to regard events as occurring before censors. However,

#' when modelling the censoring distribution we are regarding the

#' censors as "events" so which should come first in the case of ties?

#'

#' The `reverse_km_event_first()` function maintains the rule

#' that events always come first even if we are regarding the censors

#' as "events". This matches the implementation of

#' `prodlim::prodlim(..., reverse = TRUE)`.

#'

#' The `reverse_km_cen_first()` function provides the alternative

#' implementation assuming that in the case of ties the censor "events"

#' come before the event "censors". This is essentially a thin wrapper

#' around `survival::survfit(Surv(time, 1 - event), ...)`

#'

#' @name reverse_km

#' @keywords internal

#'

#' @returns The reverse Kaplan-Meier estimate at each requested time.

reverse_km_event_first <- function(t, times, events) {

    )

    )

}

#' @rdname reverse_km

reverse_km_cen_first <- function(t, times, events) {

    )

    )

    )

    )

    )

}

#' Match Order

#'

#' @typed x: numeric

#'   a vector for which we want to generate an index so other

#'   vectors can be put into the same sort order

#'

#'   Assuming we have a vector that is sorted then this function

#'   will return the index vector to convert that sorted vector

#'   into the same sort order as the input vector `x`.

#'   For example let `x = 8, 7, 9 , 7`. If sorted we would get

#'   `x_sort = 7, 7, 8, 9`. So in order to convert `x_sort`

#'   back into `x` we'd need an index vector of `3, 1, 4, 2`.

#'   This function is used to determine that corresponding

#'   index vector for an arbitrarily sorted vector `x`.

#'

#'   There is no specific handling of ties. It is assuming that in the case

#'   of ties for `x` that the vector you are re-indexing also has tied values

#'   thus the specific tied element selection does not matter.

#' @keywords internal

#'

#' @returns An integer vector giving the order that groups identical values.

match_order <- function(x) {

}

#' Brier Score

#'

#' @inheritParams Brier-Score-Shared

#'

#' @description

#' Implements the Brier Score as detailed in \insertCite{blanche2015}{jmpost}

#'

#' @details

#' - `bs_get_squared_dist()` - implements the squared distance part

#' of the formula.

#' - `bs_get_weights()` - implements the IPCW weighting

#'

#' @references

#' \insertAllCited{}

#'

#' @keywords internal

#'

#' @returns A numeric vector or matrix of Brier-score components.

brier_score <- function(

    t,

    times,

    events,

    pred_mat,

    maintain_cen_order = TRUE,

    event_offset = TRUE

) {

    )

    )

    # the following is a computational shortcut for diag(A %*% B)

    # as we don't want to compute the off-diagonal entries of the

    # matrix multiplication

}

#' @rdname brier_score

bs_get_squared_dist <- function(t, times, events, pred_mat) {

    )

    )

    )

    )

    )

    ) |>

    )

}

#' @rdname brier_score

bs_get_weights <- function(

    t,

    times,

    events,

    event_offset = TRUE,

    maintain_cen_order = TRUE

) {

    )

    )

    )

    } else {

    }

        )

        )

    ) |>

    ) |>

    )

}

#' @include generics.R

#' @include StanModule.R

NULL

#' `Prior` Function Arguments

#'

#' The documentation lists all the conventional arguments for [`Prior`]

#' constructors.

#'

#' @typed centre: number

#'   the central point of distribution to shrink sampled values towards

#'   (for most distributions this is the mean or median if the mean is undefined)

#' @typed x: Prior

#'   a prior Distribution

#' @typed object: Prior

#'   a prior Distribution

#' @typed name: character

#'   the name of the parameter the prior distribution is for

#' @typed size: "`numeric` or `character`"

#'   the parameter size.

#' @typed transform: PriorTransform | NULL

#'   optional package-defined transformation from the model parameter to the

#'   prior density scale. See [prior_transform()] for support, Jacobians and

#'   examples. `NULL` keeps the prior on the model parameter scale.

#' @param ... Not Used.

#'

#' @name Prior-Shared

#' @keywords internal

NULL

# Prior-class ----

#' Prior Object and Constructor Function

#'

#' Specifies the prior distribution in a Stan Model

#'

#' @slot parameters (`list`)\cr See arguments.

#' @slot repr_model (`string`)\cr See arguments.

#' @slot repr_data (`string`)\cr See arguments.

#' @slot repr_parameters (`string`)\cr See arguments.

#' @slot repr_transformed_parameters (`string`)\cr See arguments.

#' @slot repr_generated_quantities (`string`)\cr See arguments.

#' @slot repr_multiplier (`function`)\cr See arguments.

#' @slot auxiliary_initial_values (`function`)\cr See arguments.

#' @slot auxiliary_size (`function`)\cr See arguments.

#' @slot centre (`numeric`)\cr See arguments.

#' @slot validation (`list`)\cr See arguments.

#' @slot display (`string`)\cr See arguments.

#' @slot sample (`function`)\cr See arguments.

#' @slot limits (`numeric`)\cr See arguments.

#' @slot .omit_zero_lower_truncation (`logical`)\cr See arguments.

#' @slot .allow_vectors (`logical`)\cr See arguments.

#' @slot .is_const (`logical`)\cr See arguments.

#'

#' @family Prior-internal

#' @export Prior

#' @exportClass Prior

.Prior <- setClass(

    Class = "Prior",

    slots = c(

        "parameters" = "list",

        "display" = "character",

        "repr_model" = "character",

        "repr_data" = "character",

        "repr_parameters" = "character",

        "repr_transformed_parameters" = "character",

        "repr_generated_quantities" = "character",

        "repr_multiplier" = "function",

        "auxiliary_initial_values" = "function",

        "auxiliary_size" = "function",

        "centre" = "numeric",

        "validation" = "list",

        "sample" = "function",

        "limits" = "numeric",

        ".omit_zero_lower_truncation" = "logical",

        ".allow_vectors" = "logical",

        ".is_const" = "logical"

    )

)

#' @typed parameters: list

#'   the prior distribution parameters.

#' @inheritParams Prior-Shared

#' @typed repr_model: string

#'   the Stan code representation for the model block.

#' @typed repr_data: string

#'   the Stan code representation for the data block.

#' @typed repr_parameters: string

#'   the Stan code representation for the parameters block.

#' @typed repr_transformed_parameters: string

#'   the Stan code representation for the transformed parameters block.

#' @typed repr_generated_quantities: string

#'   the Stan code representation for the generated quantities block.

#' @typed repr_multiplier: function

#'   a function of `name` and `size` returning a Stan affine multiplier

#'   expression for an unbounded parameter, or an empty string for no transform.

#' @typed auxiliary_initial_values: function

#'   a function that returns initial values for extra Stan parameters

#'   introduced by the prior.

#' @typed auxiliary_size: function

#'   a function that returns sizes for extra Stan parameters introduced

#'   by the prior.

#' @typed display: string

#'   the string to display when object is printed.

#' @typed centre: numeric

#'   the central point of distribution to shrink sampled values towards

#' @typed validation: list

#'   the prior distribution parameter validation functions. Must have

#'   the same names as the `paramaters` slot.

#' @typed sample: function

#'   a function to sample from the prior distribution.

#' @typed limits: numeric

#'   the lower and upper limits for a truncated distribution.

#' @typed .omit_zero_lower_truncation: flag

#'   whether to omit a lower-zero truncation adjustment.

#' @typed .allow_vectors: flag

#'   whether to allow vector parameters.

#' @typed .is_const: flag

#'   whether this prior fixes the parameter at a constant value.

#' @rdname Prior-class

#'

#' @returns A `Prior` object.

#'

#' @examples

#' # Prior objects are normally created with a distribution helper.

#' prior_normal(0, 1)

Prior <- function(

    parameters,

    display,

    repr_model,

    repr_data,

    centre,

    validation,

    sample,

    repr_parameters = "",

    repr_transformed_parameters = "",

    repr_generated_quantities = "",

    auxiliary_initial_values = \(name, size) list(),

    auxiliary_size = \(name, size) list(),

    limits = c(-Inf, Inf),

    .omit_zero_lower_truncation = FALSE,

    .allow_vectors = FALSE,

    .is_const = FALSE,

    repr_multiplier = \(name, size) "",

    transform = NULL

) {

    )

}

setValidity(

    Class = "Prior",

    method = function(object) {

        for (param in names(object@parameters)) {

            if (!param %in% names(object@validation)) {

                return(sprintf(

                    "Parameter `%s` does not have a validation method",

                    param

                ))

            }

            if (

                !object@.allow_vectors &&

                    length(object@parameters[[param]]) != 1

            ) {

                return(sprintf("Parameter `%s` must be a single value", param))

            }

            if (!object@validation[[param]](object@parameters[[param]])) {

                return_message <- sprintf(

                    "Invalid value of `%d` for parameter `%s`",

                    object@parameters[[param]],

                    param

                )

                return(return_message)

            }

        }

        if (object@.allow_vectors) {

            # Check that all parameters have either same length or are

            # length 1.

            all_lengths <- sapply(

                object@parameters,

                length

            )

            none_one_lengths <- setdiff(unique(all_lengths), 1)

            if (length(none_one_lengths) > 1) {

                return("All parameters must be the same length or length 1")

            }

        }

        if (length(object@limits) != 2) {

            return("Limits must be a vector of length 2")

        }

        if (object@limits[1] >= object@limits[2]) {

            return("Lower limit must be less than upper limit")

        }

        if (

            length(object@repr_model) != 1 || !is.character(object@repr_model)

        ) {

            return("Model representation must be length 1 string")

        }

        if (

            length(object@repr_parameters) < 1 ||

                !is.character(object@repr_parameters)

        ) {

            return("Parameters representation must be a character vector")

        }

        if (

            length(object@repr_transformed_parameters) < 1 ||

                !is.character(object@repr_transformed_parameters)

        ) {

            return(

                "Transformed parameters representation must be a character vector"

            )

        }

        return(TRUE)

    }

)

#' @rdname set_limits

#' @export

set_limits.Prior <- function(object, lower = -Inf, upper = Inf) {

}

#' `Prior` -> `Character`

#'

#' Converts a [`Prior`] object to a character vector

#' @inheritParams Prior-Shared

#' @family Prior-internal

#' @export

#'

#' @returns A character vector.

as.character.Prior <- function(x, ...) {

    )

    if (

    ) {

    }

}

#' Creates Stan Syntax for Truncated distributions

#' @description

#' This function creates the Stan syntax for truncated distributions

#' @typed object: Prior | numeric

#'   prior or lower and upper limits for a truncated distribution.

#' @keywords internal

#' @typedreturn character

#'   the Stan syntax for truncated distributions

#'

#' @returns A character vector containing the Stan truncation syntax.

render_stan_limits <- function(object) {

}

#' @describeIn render_stan_limits method for [Prior] objects.

#' @exportS3Method NULL

render_stan_limits.Prior <- function(object) {

    if (

    ) {

    }

}

#' @describeIn render_stan_limits method for numeric vectors.

#' @exportS3Method NULL

render_stan_limits.numeric <- function(object) {

        )

    }

}

#' @rdname show-object

#' @export

setMethod(

    f = "show",

    signature = "Prior",

    definition = function(object) {

    }

)

#' `Prior` -> `StanModule`

#'

#' Converts a [`Prior`] object to a [`StanModule`] object

#'

#' @inheritParams Prior-Shared

#'

#' @family Prior-internal

#' @family as.StanModule

#' @export

#'

#' @returns A `StanModule` object.

as.StanModule.Prior <- function(object, name, size = 1, ...) {

    )

    }

        }

    }

    } else {

        ""

    }

        "}}",

        "}}",

        "}}",

        "}}",

        "}}",

    )

}

#' `Prior` -> `list`

#'

#' Converts a Prior object to a list of parameter data values

#' for a Stan model.

#'

#' @inheritParams Prior-Shared

#'

#' @family as_stan_list

#' @family Prior-internal

#' @export

#'

#' @returns A named `list` suitable for use as Stan data.

as_stan_list.Prior <- function(object, name, ...) {

    }

    }

}

#' Prior Getter Functions

#' @description

#' Getter functions for the slots of a [`Prior`] object

#' @inheritParams Prior-Shared

#' @family Prior-internal

#' @name Prior-Getter-Methods

NULL

# initialValues-Prior ----

#' @describeIn Prior-Getter-Methods The prior's initial value

#' @export

#'

#' @returns The requested prior initial values or auxiliary-parameter information.

initialValues.Prior <- function(object, ...) {

        )

        ]

        )

        }

    } else {

            )

        )

            ) +

            }),

            ,

        ]

        )

        } else {

        }

    }

}

#' @describeIn Prior-Getter-Methods The prior's auxiliary initial values

#' @export

auxiliaryInitialValues.Prior <- function(object, name, size, ...) {

}

#' @describeIn Prior-Getter-Methods The prior's auxiliary parameter sizes

#' @export

auxiliarySize.Prior <- function(object, name, size, ...) {

}

# Prior-constructors ----

#' Normal Prior Distribution

#'

#' @typed mu: number

#'   mean.

#' @typed sigma: number

#'   standard deviation.

#' @family Prior

#' @export

#'

#' @inheritParams Prior-Shared

#' @returns A `Prior` object.

#'

#' @examples

#' prior_normal(0, 1)

prior_normal <- function(mu, sigma, transform = NULL) {

        ),

        )

    )

}

#' Normal Prior for a Vector Distribution

#'

#' @typed mus: numeric

#'   means.

#' @typed sigmas: numeric

#'   standard deviations.

#' @family Prior

#' @export

#'

#' @returns A `Prior` object.

#'

#' @examples

#' prior_normal_vector(c(0, 1), c(1, 2))

prior_normal_vector <- function(mus, sigmas) {

        ),

        ),

        ),

    )

}

#' Regularized Horseshoe Prior for a Vector Distribution

#'

#' Unbounded coefficients use a non-centred parameterization through Stan's

#' affine multiplier transform. By default, standard-normal coefficients are

#' multiplied by the regularized horseshoe scales. A finite `scale_noncentred`

#' instead uses partial non-centring, limiting the multiplier to that scale.

#' This can reduce dependence between strongly identified coefficients and

#' their prior scales. It changes the sampling coordinates, not the prior.

#' The coefficient names and initial-value interface are unchanged. Coefficients

#' with finite bounds retain a centred parameterization because Stan does not

#' allow bounds and affine multipliers on the same declaration.

#'

#' @typed df: number

#'   degrees of freedom of the half-Student-t prior for local shrinkage

#'   parameters.

#' @typed df_global: number

#'   degrees of freedom of the half-Student-t prior for the global shrinkage

#'   parameter.

#' @typed df_slab: number

#'   degrees of freedom of the Student-t slab.

#' @typed scale_global: number

#'   scale of the half-Student-t prior for the global shrinkage parameter.

#' @typed scale_slab: number

#'   scale of the Student-t slab.

#' @typed scale_noncentred: number

#'   positive computational scale for partial non-centring, in coefficient

#'   units. If the horseshoe standard deviation is `s`, the multiplier is

#'   `s / sqrt(1 + (s / scale_noncentred)^2)`. The default `Inf` gives full

#'   non-centring with multiplier `s`. This argument does not change the

#'   horseshoe hyperparameters or the prior distribution.

#' @family Prior

#' @export

#'

#' @returns A `Prior` object.

#'

#' @examples

#' prior_horseshoe(df = 1, df_global = 1, df_slab = 4, scale_global = 0.1, scale_slab = 2)

prior_horseshoe <- function(

    df = 1,

    df_global = 1,

    df_slab = 4,

    scale_global = 1,

    scale_slab = 2,

    scale_noncentred = Inf

) {

        ),

        ),

            # Important: T[0, ] for truncating to positive values!

        ),

        ),

        ),

            )

        ),

            )

        ),

            )

            }

                )

            }

        },

                ),

            )

        },

            )

        },

            )

        },

        )

    )

}

#' Standard Normal Prior Distribution

#'

#'

#' @family Prior

#' @export

#'

#' @inheritParams Prior-Shared

#' @returns A `Prior` object.

#'

#' @examples

#' prior_std_normal()

prior_std_normal <- function(transform = NULL) {

    )

}

#' Constant Prior Distribution

#'

#' @typed value: number

#'   the fixed parameter value.

#' @family Prior

#' @export

#'

#' @returns A `Prior` object.

#'

#' @examples

#' prior_const(0)

prior_const <- function(value) {

        ),

    )

}

#' Constant Prior Distribution for a Vector

#'

#' @typed values: numeric

#'   the fixed parameter values.

#' @family Prior

#' @export

#'

#' @returns A `Prior` object.

#'

#' @examples

#' prior_const_vector(c(0, 1))

prior_const_vector <- function(values) {

    )

            )

        },

        ),

    )

}

#' Cauchy Prior Distribution

#'

#' @typed mu: number

#'   mean.

#' @typed sigma: number

#'   scale.

#' @family Prior

#'

#' @export

#'

#' @inheritParams Prior-Shared

#' @returns A `Prior` object.

#'

#' @examples

#' prior_cauchy(0, 1)

prior_cauchy <- function(mu, sigma, transform = NULL) {

        ),

        ),

    )

}

#' Gamma Prior Distribution

#'

#' @typed alpha: number

#'   shape.

#' @typed beta: number

#'   inverse scale.

#' @family Prior

#'

#' @export

#'

#' @inheritParams Prior-Shared

#' @returns A `Prior` object.

#'

#' @examples

#' prior_gamma(2, 1)

prior_gamma <- function(alpha, beta, transform = NULL) {

        ),

        ),

    )

}

#' Log-Normal Prior Distribution

#'

#' @typed mu: number

#'   mean of the logarithm.

#' @typed sigma: number

#'   standard deviation of the logarithm.

#' @family Prior

#'

#' @export

#'

#' @inheritParams Prior-Shared

#' @returns A `Prior` object.

#'

#' @examples

#' prior_lognormal(0, 1)

prior_lognormal <- function(mu, sigma, transform = NULL) {

        ),

        ),

    )

}

#' Beta Prior Distribution

#'

#' @typed a: number

#'   first parameter.

#' @typed b: number

#'   second parameter

#' @family Prior

#'

#' @export

#'

#' @inheritParams Prior-Shared

#' @returns A `Prior` object.

#'

#' @examples

#' prior_beta(2, 3)

prior_beta <- function(a, b, transform = NULL) {

        ),

        )

    )

}

#' Initial Values Specification

#'

#' @typed dist: Prior

#'   a prior Distribution

#' @family Prior

#' @description

#' This function is used to specify only the initial values for a parameter.

#' This is primarily used for hierarchical parameters whose distributions

#' are fixed within the model and cannot be altered by the user.

#'

#' @export

#'

#' @returns A `Prior` object.

#'

#' @examples

#' prior_init_only(prior_normal(0, 1))

prior_init_only <- function(dist) {

        },

    )

}

#' Flat Prior

#'

#' Specifies a constant density on the declared model parameter scale, for a

#' scalar or each component of a vector. No prior density term or auxiliary

#' parameters are added to the Stan model. Model-imposed parameter bounds still

#' apply. An unbounded flat prior is improper; a proper posterior is not

#' guaranteed.

#'

#' @typed init: Prior

#'   distribution used only to generate initial values, including the usual

#'   `jmpost.prior_shrinkage` towards its centre. Its density and limits do not

#'   constrain the model parameter. Choose initial values compatible with any

#'   model-imposed bounds.

#' @family Prior

#' @seealso [prior_init_only()]

#' @export

#'

#' @returns A `Prior` object.

#'

#' @examples

#' prior_flat()

#' prior_flat(init = prior_normal(0, 2))

#' SurvivalWeibullPH(beta = prior_flat())

prior_flat <- function(init = prior_normal(0, 1)) {

    )

}

#' Uniform Prior Distribution

#'

#' @typed alpha: number

#'   minimum value parameter.

#' @typed beta: number

#'   maximum value parameter.

#' @family Prior

#'

#' @export

#'

#' @inheritParams Prior-Shared

#' @returns A `Prior` object.

#'

#' @examples

#' prior_uniform(0, 1)

prior_uniform <- function(alpha, beta, transform = NULL) {

    )

        ),

        )

    )

}

#' Student-t Prior Distribution

#'

#' @typed nu: number

#'   Degrees of freedom parameter.

#' @typed mu: number

#'   Location parameter.

#' @typed sigma: number

#'   Scale parameter.

#' @family Prior

#'

#' @export

#'

#' @inheritParams Prior-Shared

#' @returns A `Prior` object.

#'

#' @examples

#' prior_student_t(4, 0, 1)

prior_student_t <- function(nu, mu, sigma, transform = NULL) {

        ),

        ),

        )

    )

}

#' Logistic Prior Distribution

#'

#' @typed mu: number

#'   Location parameter.

#' @typed sigma: number

#'   Scale parameter.

#' @family Prior

#'

#' @export

#'

#' @inheritParams Prior-Shared

#' @returns A `Prior` object.

#'

#' @examples

#' prior_logistic(0, 1)

prior_logistic <- function(mu, sigma, transform = NULL) {

        ),

        ),

        )

    )

}

#' Log-Logistic Prior Distribution

#'

#' @typed alpha: number

#'   Scale parameter.

#' @typed beta: number

#'   Shape parameter.

#' @family Prior

#'

#' @export

#'

#' @inheritParams Prior-Shared

#' @returns A `Prior` object.

#'

#' @examples