#' Fitting an MMRM with Single Optimizer

#'

#' @description `r lifecycle::badge("stable")`

#'

#' This function helps to fit an MMRM using `TMB` with a single optimizer,

#' while capturing messages and warnings.

#'

#' @inheritParams mmrm

#' @param control (`mmrm_control`)\cr object.

#' @param tmb_data (`mmrm_tmb_data`)\cr object.

#' @param formula_parts (`mmrm_tmb_formula_parts`)\cr object.

#' @param ... Additional arguments to pass to [mmrm_control()].

#'

#' @details

#' `fit_single_optimizer` will fit the `mmrm` model using the `control` provided.

#' If there are multiple optimizers provided in `control`, only the first optimizer

#' will be used.

#' If `tmb_data` and `formula_parts` are both provided, `formula`, `data`, `weights`,

#' `reml`, and `covariance` are ignored.

#'

#' @return The `mmrm_fit` object, with additional attributes containing warnings,

#'   messages, optimizer used and convergence status in addition to the

#'   `mmrm_tmb` contents.

#' @export

#'

#' @examples

#' mod_fit <- fit_single_optimizer(

#'   formula = FEV1 ~ RACE + SEX + ARMCD * AVISIT + us(AVISIT | USUBJID),

#'   data = fev_data,

#'   weights = rep(1, nrow(fev_data)),

#'   optimizer = "nlminb"

#' )

#' attr(mod_fit, "converged")

fit_single_optimizer <- function(formula,

                                 data,

                                 weights,

                                 reml = TRUE,

                                 covariance = NULL,

                                 tmb_data,

                                 formula_parts,

                                 ...,

                                 control = mmrm_control(...)) {

    # Transient visit to invalid parameters.

  )

    )

  )

      ),

    )

  } else {

      ),

    )

  }

  }

  )

}

#' Summarizing List of Fits

#'

#' @param all_fits (`list` of `mmrm_fit` or `try-error`)\cr list of fits.

#'

#' @return List with `warnings`, `messages`, `log_liks` and `converged` results.

#' @keywords internal

h_summarize_all_fits <- function(all_fits) {

  )

}

#' Refitting MMRM with Multiple Optimizers

#'

#' @description `r lifecycle::badge("stable")`

#'

#' @param fit (`mmrm_fit`)\cr original model fit from [fit_single_optimizer()].

#' @param ... Additional arguments passed to [mmrm_control()].

#' @param control (`mmrm_control`)\cr object.

#'

#' @return The best (in terms of log likelihood) fit which converged.

#'

#' @note For Windows, no parallel computations are currently implemented.

#' @export

#'

#' @examples

#' fit <- fit_single_optimizer(

#'   formula = FEV1 ~ RACE + SEX + ARMCD * AVISIT + us(AVISIT | USUBJID),

#'   data = fev_data,

#'   weights = rep(1, nrow(fev_data)),

#'   optimizer = "nlminb"

#' )

#' best_fit <- refit_multiple_optimizers(fit)

refit_multiple_optimizers <- function(fit,

                                      ...,

                                      control = mmrm_control(...)) {

    )

  )

  )

  # Take the results from old fit as starting values for new fits.

    ),

  ))

  # Find the results that are ok and return best in terms of log-likelihood.

    )

  }

}

#' Control Parameters for Fitting an MMRM

#'

#' @description `r lifecycle::badge("stable")`

#' Fine-grained specification of the MMRM fit details is possible using this

#' control function.

#'

#' @param n_cores (`count`)\cr number of cores to be used.

#' @param method (`string`)\cr adjustment method for degrees of freedom.

#' @param vcov (`string`)\cr coefficients covariance matrix adjustment method.

#' @param start (`NULL`, `numeric` or `function`)\cr optional start values for variance

#'   parameters. See details for more information.

#' @param accept_singular (`flag`)\cr whether singular design matrices are reduced

#'   to full rank automatically and additional coefficient estimates will be missing.

#' @param optimizers (`list`)\cr optimizer specification, created with [h_get_optimizers()].

#' @param drop_visit_levels (`flag`)\cr whether to drop levels for visit variable,

#'   if visit variable is a factor, see details.

#' @param ... additional arguments passed to [h_get_optimizers()].

#'

#' @details

#  - The `drop_visit_levels` flag will decide whether unobserved visits will be kept for analysis.

#'   For example, if the data only has observations at visits `VIS1`, `VIS3` and `VIS4`, by default

#'   they are treated to be equally spaced, the distance from `VIS1` to `VIS3`, and from `VIS3` to `VIS4`,

#'   are identical. However, you can manually convert this visit into a factor, with

#'   `levels = c("VIS1", "VIS2", "VIS3", "VIS4")`, and also use `drop_visits_levels = FALSE`,

#'   then the distance from `VIS1` to `VIS3` will be double, as `VIS2` is a valid visit.

#'   However, please be cautious because this can lead to convergence failure

#'   when using an unstructured covariance matrix and there are no observations

#'   at the missing visits.

#' - The `method` and `vcov` arguments specify the degrees of freedom and coefficients

#'   covariance matrix adjustment methods, respectively.

#'   - Allowed `vcov` includes: "Asymptotic", "Kenward-Roger", "Kenward-Roger-Linear", "Empirical" (CR0),

#'     "Empirical-Jackknife" (CR3), and "Empirical-Bias-Reduced" (CR2).

#'   - Allowed `method` includes: "Satterthwaite", "Kenward-Roger", "Between-Within" and "Residual".

#'   - If `method` is "Kenward-Roger" then only "Kenward-Roger" or "Kenward-Roger-Linear" are allowed for `vcov`.

#' - The `vcov` argument can be `NULL` to use the default covariance method depending on the `method`

#'   used for degrees of freedom, see the following table:

#'

#'    | `method`  |  Default `vcov`|

#'    |-----------|----------|

#'    |Satterthwaite| Asymptotic|

#'    |Kenward-Roger| Kenward-Roger|

#'    |Residual| Empirical|

#'    |Between-Within| Asymptotic|

#'

#' - Please note that "Kenward-Roger" for "Unstructured" covariance gives different results

#'   compared to SAS; Use "Kenward-Roger-Linear" for `vcov` instead for better matching

#'   of the SAS results.

#'

#' - The argument `start` is used to facilitate the choice of initial values for fitting the model.

#'   If `function` is provided, make sure its parameter is a valid element of `mmrm_tmb_data`

#'   or `mmrm_tmb_formula_parts` and it returns a numeric vector.

#'   By default or if `NULL` is provided, `std_start` will be used.

#'   Other implemented methods include `emp_start`.

#'

#' @return List of class `mmrm_control` with the control parameters.

#' @export

#'

#' @examples

#' mmrm_control(

#'   optimizer_fun = stats::optim,

#'   optimizer_args = list(method = "L-BFGS-B")

#' )

mmrm_control <- function(n_cores = 1L,

                         method = c("Satterthwaite", "Kenward-Roger", "Residual", "Between-Within"),

                         vcov = NULL,

                         start = std_start,

                         accept_singular = TRUE,

                         drop_visit_levels = TRUE,

                         ...,

                         optimizers = h_get_optimizers(...)) {

  }

  )

  }

    )

  )

    ))

  }

    ),

  )

}

#' Fit an MMRM

#'

#' @description `r lifecycle::badge("stable")`

#'

#' This is the main function fitting the MMRM.

#'

#' @param formula (`formula`)\cr the model formula, see details.

#' @param data (`data`)\cr the data to be used for the model.

#' @param weights (`vector`)\cr an optional vector of weights to be used in

#'   the fitting process. Should be `NULL` or a numeric vector.

#' @param reml (`flag`)\cr whether restricted maximum likelihood (REML)

#'   estimation is used, otherwise maximum likelihood (ML) is used.

#' @param covariance (`cov_struct`)\cr a covariance structure type definition

#'   as produced with [cov_struct()], or value that can be coerced to a

#'   covariance structure using [as.cov_struct()]. If no value is provided,

#'   a structure is derived from the provided formula.

#' @param control (`mmrm_control`)\cr fine-grained fitting specifications list

#'   created with [mmrm_control()].

#' @param ... arguments passed to [mmrm_control()].

#'

#' @details

#' The `formula` typically looks like:

#' `FEV1 ~ RACE + SEX + ARMCD * AVISIT + us(AVISIT | USUBJID)`

#' so specifies response and covariates as usual, and exactly one special term

#' defines which covariance structure is used and what are the time point and

#' subject variables. The covariance structures in the formula can be

#' found in [`covariance_types`].

#'

#' The time points have to be unique for each subject. That is,

#' there cannot be time points with multiple observations for any subject.

#' The rationale is that these observations would need to be correlated, but it

#' is not possible within the currently implemented covariance structure framework

#' to do that correctly. Moreover, for non-spatial covariance structures, the time

#' variable must be a factor variable.

#'

#' When optimizer is not set, first the default optimizer

#' (`L-BFGS-B`) is used to fit the model. If that converges, this is returned.

#' If not, the other available optimizers from [h_get_optimizers()],

#' including `BFGS`, `CG` and `nlminb` are

#' tried (in parallel if `n_cores` is set and not on Windows).

#' If none of the optimizers converge, then the function fails. Otherwise

#' the best fit is returned.

#'

#' Note that fine-grained control specifications can either be passed directly

#' to the `mmrm` function, or via the `control` argument for bundling together

#' with the [mmrm_control()] function. Both cannot be used together, since

#' this would delete the arguments passed via `mmrm`.

#'

#' @return An `mmrm` object.

#'

#' @note The `mmrm` object is also an `mmrm_fit` and an `mmrm_tmb` object,

#' therefore corresponding methods also work (see [`mmrm_tmb_methods`]).

#'

#' Additional contents depend on the choice of the adjustment `method`:

#' - If Satterthwaite adjustment is used, the Jacobian information `jac_list`

#' is included.

#' - If Kenward-Roger adjustment is used, `kr_comp` contains necessary

#' components and `beta_vcov_adj` includes the adjusted coefficients covariance

#' matrix.

#'

#' Use of the package `emmeans` is supported, see [`emmeans_support`].

#'

#' NA values are always omitted regardless of `na.action` setting.

#'

#' When the number of visit levels is large, it usually requires large memory to create the

#' covariance matrix. By default, the maximum allowed visit levels is 100, and if there are more

#' visit levels, a confirmation is needed if run interactively.

#' You can use `options(mmrm.max_visits = <target>)` to increase the maximum allowed number of visit

#' levels. In non-interactive sessions the confirmation is not raised and will directly give you an error if

#' the number of visit levels exceeds the maximum.

#'

#' @export

#'

#' @examples

#' fit <- mmrm(

#'   formula = FEV1 ~ RACE + SEX + ARMCD * AVISIT + us(AVISIT | USUBJID),

#'   data = fev_data

#' )

#'

#' # Direct specification of control details:

#' fit <- mmrm(

#'   formula = FEV1 ~ RACE + SEX + ARMCD * AVISIT + us(AVISIT | USUBJID),

#'   data = fev_data,

#'   weights = fev_data$WEIGHTS,

#'   method = "Kenward-Roger"

#' )

#'

#' # Alternative specification via control argument (but you cannot mix the

#' # two approaches):

#' fit <- mmrm(

#'   formula = FEV1 ~ RACE + SEX + ARMCD * AVISIT + us(AVISIT | USUBJID),

#'   data = fev_data,

#'   control = mmrm_control(method = "Kenward-Roger")

#' )

mmrm <- function(formula,

                 data,

                 weights = NULL,

                 covariance = NULL,

                 reml = TRUE,

                 control = mmrm_control(...),

                 ...) {

  }

  } else {

    # na.action set to na.pass to allow data to be full; will be futher trimmed later

  }

  } else {

  }

  )

    )

      ))

    }

  }

      )

    } else {

      )

      ))

    }

  }

  }

    )

    )

    # Note that we only need the Jacobian list under Asymptotic covariance method,

    # cf. the Satterthwaite vignette.

    }

  } else {

  }

}

#' Capture all Output

#'

#' This function silences all warnings, errors & messages and instead returns a list

#' containing the results (if it didn't error), as well as the warnings, errors

#' and messages and divergence signals as character vectors.

#'

#' @param expr (`expression`)\cr to be executed.

#' @param remove (`list`)\cr optional list with elements `warnings`, `errors`,

#'   `messages` which can be character vectors, which will be removed from the

#'   results if specified.

#' @param divergence (`list`)\cr optional list similar as `remove`, but these

#'   character vectors will be moved to the `divergence` result and signal

#'   that the fit did not converge.

#'

#' @return

#' A list containing

#'

#' - `result`: The object returned by `expr` or `list()` if an error was thrown.

#' - `warnings`: `NULL` or a character vector if warnings were thrown.

#' - `errors`: `NULL` or a string if an error was thrown.

#' - `messages`: `NULL` or a character vector if messages were produced.

#' - `divergence`: `NULL` or a character vector if divergence messages were caught.

#'

#' @keywords internal

h_record_all_output <- function(expr,

                                remove = list(),

                                divergence = list()) {

  # Note: We don't need to and cannot assert `expr` here.

    ),

    },

    },

    }

  )

    )

  )

}

#' Trace of a Matrix

#'

#' @description Obtain the trace of a matrix if the matrix is diagonal, otherwise raise an error.

#'

#' @param x (`matrix`)\cr square matrix input.

#'

#' @return The trace of the square matrix.

#'

#' @keywords internal

h_tr <- function(x) {

  }

}

#' Split Control List

#'

#' @description Split the [mmrm_control()] object according to its optimizers and use additional arguments

#' to replace the elements in the original object.

#'

#' @param control (`mmrm_control`)\cr object.

#' @param ... additional parameters to update the `control` object.

#'

#' @return A `list` of `mmrm_control` entries.

#' @keywords internal

h_split_control <- function(control, ...) {

  })

}

#' Obtain Optimizer according to Optimizer String Value

#'

#' @description This function creates optimizer functions with arguments.

#'

#' @param optimizer (`character`)\cr names of built-in optimizers to try, subset

#'   of "L-BFGS-B", "BFGS", "CG" and "nlminb".

#' @param optimizer_fun (`function` or `list` of `function`)\cr alternatively to `optimizer`,

#'   an optimizer function or a list of optimizer functions can be passed directly here.

#' @param optimizer_args (`list`)\cr additional arguments for `optimizer_fun`.

#' @param optimizer_control (`list`)\cr passed to argument `control` in `optimizer_fun`.

#'

#' @details

#' If you want to use only the built-in optimizers:

#' - `optimizer` is a shortcut to create a list of built-in optimizer functions

#'   passed to `optimizer_fun`.

#' - Allowed are "L-BFGS-B", "BFGS", "CG" (using [stats::optim()] with corresponding method)

#'   and "nlminb" (using [stats::nlminb()]).

#' - Other arguments should go into `optimizer_args`.

#'

#' If you want to use your own optimizer function:

#' - Make sure that there are three arguments: parameter (start value), objective function

#'   and gradient function are sequentially in the function arguments.

#' - If there are other named arguments in front of these, make sure they are correctly

#'   specified through `optimizer_args`.

#' - If the hessian can be used, please make sure its argument name is `hessian` and

#'   please add attribute `use_hessian = TRUE` to the function,

#'   using `attr(fun, "use_hessian) <- TRUE`.

#'

#' @return Named `list` of optimizers created by [h_partial_fun_args()].

#'

#' @keywords internal

h_get_optimizers <- function(optimizer = c("L-BFGS-B", "BFGS", "CG", "nlminb"),

                             optimizer_fun = h_optimizer_fun(optimizer),

                             optimizer_args = list(),

                             optimizer_control = list()) {

    )

  }

  )

  }

  })

}

#' Obtain Optimizer Function with Character

#' @description Obtain the optimizer function through the character provided.

#' @param optimizer (`character`)\cr vector of optimizers.

#'

#' @return A (`list`)\cr of optimizer functions generated from [h_partial_fun_args()].

#' @keywords internal

h_optimizer_fun <- function(optimizer = c("L-BFGS-B", "BFGS", "CG", "nlminb")) {

    )

  })

}

#' Create Partial Functions

#' @description Creates partial functions with arguments.

#'

#' @param fun (`function`)\cr to be wrapped.

#' @param ... Additional arguments for `fun`.

#' @param additional_attr (`list`)\cr of additional attributes to apply to the result.

#'

#' @details This function add `args` attribute to the original function,

#' and add an extra class `partial` to the function.

#' `args` is the argument for the function, and elements in `...` will override the existing

#' arguments in attribute `args`. `additional_attr` will override the existing attributes.

#'

#' @return Object with S3 class `"partial"`, a `function` with `args` attribute (and possibly more

#' attributes from `additional_attr`).

#' @keywords internal

h_partial_fun_args <- function(fun, ..., additional_attr = list()) {

  }

      ),

    )

  )

}

#' Obtain Default Covariance Method

#'

#' @description Obtain the default covariance method depending on

#' the degrees of freedom method used.

#'

#' @param method (`string`)\cr degrees of freedom method.

#'

#' @details The default covariance method is different for different degrees of freedom method.

#' For "Satterthwaite" or "Between-Within", "Asymptotic" is returned.

#' For "Kenward-Roger" only, "Kenward-Roger" is returned.

#' For "Residual" only, "Empirical" is returned.

#'

#' @return String of the default covariance method.

#' @keywords internal

h_get_cov_default <- function(method = c("Satterthwaite", "Kenward-Roger", "Residual", "Between-Within")) {

  )

}

#' Complete `character` Vector Names From Values

#'

#' @param x (`character` or `list`)\cr value whose names should be completed

#'   from element values.

#'

#' @return A named vector or list.

#'

#' @keywords internal

fill_names <- function(x) {

}

#' Drop Items from an Indexible

#'

#' Drop elements from an indexible object (`vector`, `list`, etc.).

#'

#' @param x Any object that can be consumed by [seq_along()] and indexed by a

#'   logical vector of the same length.

#' @param n (`integer`)\cr the number of terms to drop.

#'

#' @return A subset of `x`.

#'

#' @keywords internal

drop_elements <- function(x, n) {

}

#' Ask for Confirmation on Large Visit Levels

#'

#' @description Ask the user for confirmation if there are too many visit levels

#' for non-spatial covariance structure in interactive sessions.

#'

#' @param x (`numeric`)\cr number of visit levels.

#'

#' @return Logical value `TRUE`.

#' @keywords internal

h_confirm_large_levels <- function(x) {

  }

  }

    )

  )

  }

}

#' Default Value on NULL

#' Return default value when first argument is NULL.

#'

#' @param x Object.

#' @param y Object.

#'

#' @details If `x` is NULL, returns `y`. Otherwise return `x`.

#'

#' @keywords internal

h_default_value <- function(x, y) {

  } else {

  }

}

#' Warn on na.action

#' @keywords internal

h_warn_na_action <- function() {

  }

}

#' Obtain `na.action` as Function

#' @keywords internal

h_get_na_action <- function(na_action) {

  }

  }

}

#' Validate mmrm Formula

#' @param formula (`formula`)\cr to check.

#'

#' @details In mmrm models, `.` is not allowed as it introduces ambiguity of covariates

#' to be used, so it is not allowed to be in formula.

#'

#' @keywords internal

h_valid_formula <- function(formula) {

  }

}

#' Standard Starting Value

#'

#' @description Obtain standard start values.

#'

#' @param cov_type (`string`)\cr name of the covariance structure.

#' @param n_visits (`int`)\cr number of visits.

#' @param n_groups (`int`)\cr number of groups.

#' @param ... not used.

#'

#' @details

#' `std_start` will try to provide variance parameter from identity matrix.

#' However, for `ar1` and `ar1h` the corresponding values are not ideal because the

#' \eqn{\rho} is usually a positive number thus using 0 as starting value can lead to

#' incorrect optimization result, and we use 0.5 as the initial value of \eqn{\rho}.

#'

#' @return A numeric vector of starting values.

#'

#' @export

std_start <- function(cov_type, n_visits, n_groups, ...) {

  )

}

#' Empirical Starting Value

#'

#' @description Obtain empirical start value for unstructured covariance

#'

#' @param data (`data.frame`)\cr data used for model fitting.

#' @param model_formula (`formula`)\cr the formula in mmrm model without covariance structure part.

#' @param visit_var (`string`)\cr visit variable.

#' @param subject_var (`string`)\cr subject id variable.

#' @param subject_groups (`factor`)\cr subject group assignment.

#' @param ... not used.

#'

#' @details

#' This `emp_start` only works for unstructured covariance structure.

#' It uses linear regression to first obtain the coefficients and use the residuals

#' to obtain the empirical variance-covariance, and it is then used to obtain the

#' starting values.

#'

#' @note `data` is used instead of `full_frame` because `full_frame` is already

#' transformed if model contains transformations, e.g. `log(FEV1) ~ exp(FEV1_BL)` will

#' drop `FEV1` and `FEV1_BL` but add `log(FEV1)` and `exp(FEV1_BL)` in `full_frame`.

#'

#' @return A numeric vector of starting values.

#'

#' @export

emp_start <- function(data, model_formula, visit_var, subject_var, subject_groups, ...) {

    }

  )

}

#' Obtain Theta from Covariance Matrix

#'

#' @description Obtain unstructured theta from covariance matrix.

#'

#' @param covariance (`matrix`) of covariance matrix values.

#'

#' @details

#' If the covariance matrix has `NA` in some of the elements, they will be replaced by

#' 0 (non-diagonal) and 1 (diagonal). This ensures that the matrix is positive definite.

#'

#' @return Numeric vector of the theta values.

#' @keywords internal

h_get_theta_from_cov <- function(covariance) {

  # empirical is not always positive definite in some special cases of numeric singularity.

  }

}

#' Register S3 Method

#' Register S3 method to a generic.

#'

#' @param pkg (`string`) name of the package name.

#' @param generic (`string`) name of the generic.

#' @param class (`string`) class name the function want to dispatch.

#' @param envir (`environment`) the location the method is defined.

#'

#' @details This function is adapted from `emmeans:::register_s3_method()`.

#'

#' @keywords internal

h_register_s3 <- function(pkg, generic, class, envir = parent.frame()) {

  }

  })

}

#' Check if a Factor Should Drop Levels

#'

#' @param x (`vector`) vector to check.

#'

#' @keywords internal

h_extra_levels <- function(x) {

}

#' Drop Levels from Dataset

#' @param data (`data.frame`) data to drop levels.

#' @param subject_var (`character`) subject variable.

#' @param visit_var (`character`) visit variable.

#' @param except (`character`) variables to exclude from dropping.

#' @keywords internal

h_drop_levels <- function(data, subject_var, visit_var, except) {

  )

  # only drop levels for those not defined in excep and not in visit_var.

  # subject var are always dropped and no message given.

    )

  }

}

#' Warn if TMB is Configured to Use Non-Deterministic Hash for Tape Optimizer

#'

#' This function checks the TMB configuration for the `tmbad_deterministic_hash` setting

#' If it is set to `FALSE`, a warning is issued indicating that this may lead to

#' unreproducible results.

#'

#' @return No return value, called for side effects.

#' @keywords internal

h_tmb_warn_non_deterministic <- function() {

  }

    )

  }

}

#' Extract Formula Terms used for Covariance Structure Definition

#'

#' @param f (`formula`)\cr a formula from which covariance terms should be

#'   extracted.

#'

#' @return A list of covariance structure expressions found in `f`.

#'

#' @importFrom stats terms

#' @keywords internal

h_extract_covariance_terms <- function(f) {

}

#' Drop Formula Terms used for Covariance Structure Definition

#'

#' @param f (`formula`)\cr a formula from which covariance terms should be

#'   dropped.

#'

#' @return The formula without accepted covariance terms.

#'

#' @details `terms` is used and it will preserve the environment attribute.

#' This ensures the returned formula and the input formula have the same environment.

#' @importFrom stats terms drop.terms

#' @keywords internal

h_drop_covariance_terms <- function(f) {

  # if no covariance terms were found, return original formula

  }

  } else {

  }

  )

}

#' Add Individual Covariance Variables As Terms to Formula

#'

#' @param f (`formula`)\cr a formula to which covariance structure terms should

#'   be added.

#' @param covariance (`cov_struct`)\cr a covariance structure object from which

#'   additional variables should be sourced.

#'

#' @return A new formula with included covariance terms.

#'

#' @details [stats::update()] is used to append the covariance structure and the environment

#' attribute will not be changed. This ensures the returned formula and the input formula

#' have the same environment.

#'

#' @keywords internal

h_add_covariance_terms <- function(f, covariance) {

}

#' Add Formula Terms with Character

#'

#' Add formula terms from the original formula with character representation.

#'

#' @param f (`formula`)\cr a formula to be updated.

#' @param adds (`character`)\cr representation of elements to be added.

#' @param drop_response (`flag`)\cr whether response should be dropped.

#'

#' @details Elements in `adds` will be added from the formula, while the environment

#' of the formula is unchanged. If `adds` is `NULL` or `character(0)`, the formula is

#' unchanged.

#' @return A new formula with elements in `drops` removed.

#'

#' @keywords internal

h_add_terms <- function(f, adds, drop_response = FALSE) {

  }

  }

}

#' Methods for `mmrm_tmb` Objects

#'

#' @description `r lifecycle::badge("stable")`

#'

#' @param object (`mmrm_tmb`)\cr the fitted MMRM object.

#' @param x (`mmrm_tmb`)\cr same as `object`.

#' @param formula (`mmrm_tmb`)\cr same as `object`.

#' @param complete (`flag`)\cr whether to include potential non-estimable

#'   coefficients.

#' @param ... mostly not used;

#'   Exception is `model.matrix()` passing `...` to the default method.

#' @return Depends on the method, see Functions.

#'

#' @name mmrm_tmb_methods

#'

#' @seealso [`mmrm_methods`], [`mmrm_tidiers`] for additional methods.

#'

#' @examples

#' formula <- FEV1 ~ RACE + SEX + ARMCD * AVISIT + us(AVISIT | USUBJID)

#' object <- fit_mmrm(formula, fev_data, weights = rep(1, nrow(fev_data)))

NULL

#' @describeIn mmrm_tmb_methods obtains the estimated coefficients.

#' @importFrom stats coef

#' @exportS3Method

#' @examples

#' # Estimated coefficients:

#' coef(object)

coef.mmrm_tmb <- function(object, complete = TRUE, ...) {

}

#' @describeIn mmrm_tmb_methods obtains the fitted values.

#' @importFrom stats fitted

#' @exportS3Method

#' @examples

#' # Fitted values:

#' fitted(object)

fitted.mmrm_tmb <- function(object, ...) {

}

#' @describeIn mmrm_tmb_methods predict conditional means for new data;

#'  optionally with standard errors and confidence or prediction intervals.

#'  Returns a vector of predictions if `se.fit == FALSE` and

#'  `interval == "none"`; otherwise it returns a data.frame with multiple

#'  columns and one row per input data row.

#'

#' @param newdata (`data.frame`)\cr optional new data, otherwise data from `object` is used.

#' @param se.fit (`flag`)\cr indicator if standard errors are required.

#' @param interval (`string`)\cr type of interval calculation. Can be abbreviated.

#' @param level (`number`)\cr tolerance/confidence level.

#' @param nsim (`count`)\cr number of simulations to use.

#' @param conditional (`flag`)\cr indicator if the prediction is conditional on the observation or not.

#'

#' @importFrom stats predict

#' @exportS3Method

#'

#' @examples

#' predict(object, newdata = fev_data)

predict.mmrm_tmb <- function(object,

                             newdata,

                             se.fit = FALSE, # nolint

                             interval = c("none", "confidence", "prediction"),

                             level = 0.95,

                             nsim = 1000L,

                             conditional = FALSE,

                             ...) {

  }

    )

  }

    # model.matrix always return a complete matrix (no NA allowed)

    )

    }

      # can be NA if there are aliased cols

    )

    )

    }

    )

  }

  )

  )

    )

    )

    }

  }

  # Use original names.

  }

}

#' Get Prediction

#'

#' @description Get predictions with given `data`, `theta`, `beta`, `beta_vcov`.

#'

#' @details See `predict` function in `predict.cpp` which is called internally.

#'

#' @param tmb_data (`mmrm_tmb_data`)\cr object.

#' @param theta (`numeric`)\cr theta value.

#' @param beta (`numeric`)\cr beta value.

#' @param beta_vcov (`matrix`)\cr beta_vcov matrix.

#'

#' @return List with:

#' - `prediction`: Matrix with columns `fit`, `conf_var`, and `var`.

#' - `covariance`: List with subject specific covariance matrices.

#' - `index`: List of zero-based subject indices.

#'

#' @keywords internal

h_get_prediction <- function(tmb_data, theta, beta, beta_vcov) {

}

#' Get Prediction Variance

#'

#' @description Get prediction variance with given fit, `tmb_data` with the Monte Carlo sampling method.

#'

#' @param object (`mmrm_tmb`)\cr the fitted MMRM.

#' @param nsim (`count`)\cr number of samples.

#' @param tmb_data (`mmrm_tmb_data`)\cr object.

#'

#' @keywords internal

h_get_prediction_variance <- function(object, nsim, tmb_data) {

  })

}

#' @describeIn mmrm_tmb_methods obtains the model frame.

#' @param data (`data.frame`)\cr object in which to construct the frame.

#' @param include (`character`)\cr names of variable types to include.

#'   Must be `NULL` or one or more of `c("subject_var", "visit_var", "group_var", "response_var")`.

#' @param full (`flag`)\cr indicator whether to return full model frame (deprecated).

#' @param na.action (`string`)\cr na action.

#' @importFrom stats model.frame

#' @exportS3Method

#'

#' @details

#' `include` argument controls the variables the returned model frame will include.

#' Possible options are "response_var", "subject_var", "visit_var" and "group_var", representing the

#' response variable, subject variable, visit variable or group variable.

#' `character` values in new data will always be factorized according to the data in the fit

#' to avoid mismatched in levels or issues in `model.matrix`.

#'

#' @examples

#' # Model frame:

#' model.frame(object)

#' model.frame(object, include = "subject_var")

model.frame.mmrm_tmb <- function(formula, data, include = c("subject_var", "visit_var", "group_var", "response_var"),

                                 full, na.action = "na.omit", ...) { # nolint

  # Construct updated formula and data arguments.

    )

  # Only if include is default (full) and also data is missing, and also na.action is na.omit we will

  # use the model frame from the tmb_data.

    # Remove weights column.

  } else {

    # Construct data frame to return to users.

      )

  }

}

#' Construction of Model Frame Formula and Data Inputs

#'

#' @description

#' Input formulas are converted from mmrm-style to a style compatible

#' with default [stats::model.frame()] and [stats::model.matrix()] methods.

#'

#' The full formula is returned so we can construct, for example, the

#' `model.frame()` including all columns as well as the requested subset.

#' The full set is used to identify rows to include in the reduced model frame.

#'

#' @param formula (`mmrm`)\cr mmrm fit object.

#' @param data optional data frame that will be

#'   passed to `model.frame()` or `model.matrix()`

#' @param include (`character`)\cr names of variable to include

#' @param full (`flag`)\cr indicator whether to return full model frame (deprecated).

#'

#' @return named list with four elements:

#' - `"formula"`: the formula including the columns requested in the `include=` argument.

#' - `"data"`: a data frame including all columns needed in the formula.

#'   full formula are identical

#' @keywords internal

h_construct_model_frame_inputs <- function(formula,

                                           data,

                                           include,

                                           include_choice = c("subject_var", "visit_var", "group_var", "response_var"),

                                           full) {

  }

  }