enable other start values

NAMESPACE

@@ -33,12 +33,14 @@ export(cov_struct)
 export(cov_types)
 export(df_1d)
 export(df_md)
+export(emp_start)
 export(fit_mmrm)
 export(fit_single_optimizer)
 export(glance)
 export(mmrm)
 export(mmrm_control)
 export(refit_multiple_optimizers)
+export(std_start)
 export(tidy)
 import(checkmate)
 importFrom(Matrix,.bdiag)

R/fit.R

@@ -201,7 +201,7 @@ refit_multiple_optimizers <- function(fit,
 #' @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`, `string` or `function`)\cr optional start values for variance
+#' @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.
@@ -241,13 +241,11 @@ refit_multiple_optimizers <- function(fit,
 #'   of the SAS results.
 #'
 #' - The argument `start` is used to facilitate the choice of initial values for fitting the model.
-#'   If `string` is provided, `mmrm_control` will try to find a function within the parent frame.
 #'   If `function` is provided, make sure its parameter is a valid element of `mmrm_tmb_data`
-#'   or `mmrm_tmb_formula_parts`.
-#'   If `NULL` is provided, `default_start` will be used.
-#'   By default, `default_start` will be used. Other implemented methods include `std_start` and
-#'   `emp_start`. `default_start` will use `emp_start` if covariance structure is unstructured and use
-#'   `std_start` otherwise.
+#'   or `mmrm_tmb_formula_parts` and it returns a numeric vector.
+#'   If `NULL` is provided, `std_start` will be used.
+#'   By default, `std_start` will be used. Other implemented methods include `std_start` and
+#'   `emp_start`.
 #'
 #' @return List of class `mmrm_control` with the control parameters.
 #' @export
@@ -260,24 +258,15 @@ refit_multiple_optimizers <- function(fit,
 mmrm_control <- function(n_cores = 1L,
                          method = c("Satterthwaite", "Kenward-Roger", "Residual", "Between-Within"),
                          vcov = NULL,
-                         start = "default_start",
+                         start = std_start,
                          accept_singular = TRUE,
                          drop_visit_levels = TRUE,
                          ...,
                          optimizers = h_get_optimizers(...)) {
   assert_count(n_cores, positive = TRUE)
   assert_character(method)
   if (is.null(start)) {
-    start <- "default_start"
-  }
-  if (test_string(start)) {
-    if (exists(start, envir = parent.frame(), mode = "function")) {
-      start <- get(start, envir = parent.frame(), mode = "function")
-    } else if (test_subset(start, names(start_funs))) {
-      start <- start_funs[[start]]
-    } else {
-      stop("Can not find function`", start, "` for mmrm_control()!")
-    }
+    start <- std_start
   }
   if (test_function(start)) {
     assert_function(start, args = "...")

R/tmb.R

@@ -258,15 +258,17 @@ h_mmrm_tmb_parameters <- function(formula_parts,
   assert_class(tmb_data, "mmrm_tmb_data")
 
   m <- tmb_data$n_visits
-  if (test_function(start)) {
-    start <- do.call(start, utils::modifyList(formula_parts, tmb_data))
+  start_value0 <- std_start(formula_parts$cov_type, m, n_groups)
+  theta_dim <- length(start_value0)
+  if (is.null(start)) {
+    start_value <- start_value0
+  } else if (test_function(start)) {
+    start_value <- do.call(start, utils::modifyList(formula_parts, tmb_data))
   } else {
-    start_value <- std_start(formula_parts$cov_type, m, n_groups)
-    theta_dim <- length(start_value)
-    if (is.null(start)) start <- start_value
-    assert_numeric(start, len = theta_dim, any.missing = FALSE, finite = TRUE)
+    start_value <- start
   }
-  list(theta = start)
+  assert_numeric(start_value, len = theta_dim, any.missing = FALSE, finite = TRUE)
+  list(theta = start_value)
 }
 
 #' Asserting Sane Start Values for `TMB` Fit

R/utils.R

@@ -348,36 +348,18 @@ h_valid_formula <- function(formula) {
   }
 }
 
-#' Default Starting Value
-#'
-#' @description Obtain default starting value based on covariance structure.
-#'
-#' @param cov_type (`string`)\cr name of the covariance structure.
-#' @param ... additional arguments passed to inner functions.
-#'
-#' @return A numeric vector of starting values.
-#'
-#' @keywords internal
-default_start <- function(cov_type, ...) {
-  if (identical(cov_type, "us")) {
-    emp_start(...)
-  } else {
-    std_start(cov_type = cov_type, ...)
-  }
-}
-
 #' Standard Starting Value
 #'
 #' @description Obtain standard start values.
 #'
-#' @inheritParams default_start
+#' @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.
 #'
 #' @return A numeric vector of starting values.
 #'
-#' @keywords internal
+#' @export
 std_start <- function(cov_type, n_visits, n_groups, ...) {
   assert_string(cov_type)
   assert_subset(cov_type, cov_types(c("abbr", "habbr")))
@@ -414,7 +396,7 @@ std_start <- function(cov_type, n_visits, n_groups, ...) {
 #'
 #' @return A numeric vector of starting values.
 #'
-#' @keywords internal
+#' @export
 emp_start <- function(full_frame, model_formula, visit_var, subject_var, n_visits, n_subjects, subject_groups, ...) {
   assert_formula(model_formula)
   assert_data_frame(full_frame)
@@ -463,17 +445,6 @@ h_get_theta_from_cov <- function(covariance) {
   unname(ret)
 }
 
-#' Starting Value Functions
-#'
-#' An internal constant of available start value functions.
-#'
-#' @keywords internal
-start_funs <- list(
-  default_start = default_start,
-  emp_start = emp_start,
-  std_start = std_start
-)
-
 #' Register S3 Method
 #' Register S3 method to a generic.
 #'

_pkgdown.yml

@@ -68,6 +68,10 @@ reference:
       - df_1d
       - df_md
       - component
+  - title: Start Values
+    contents:
+      - std_start
+      - emp_start
   - title: Methods
     contents:
       - mmrm_methods