consistent air format

Author: danielinteractive

.Rbuildignore

@@ -20,3 +20,4 @@ simulations
 ^Meta$
 ^data-raw$
 ^cache$
+^[.]?air[.]toml$

.lintr

@@ -1,5 +1,6 @@
 linters:
   linters_with_defaults(
     line_length_linter = line_length_linter(120),
-    object_usage_linter = NULL
+    object_usage_linter = NULL,
+    indentation_linter = indentation_linter(2)
   )

R/between-within.R

@@ -80,7 +80,10 @@ h_df_bw_calc <- function(object) {
 #' @keywords internal
 h_df_min_bw <- function(bw_calc, is_coef_involved) {
   assert_list(bw_calc)
-  assert_names(names(bw_calc), identical.to = c("coefs_between_within", "ddf_between", "ddf_within"))
+  assert_names(
+    names(bw_calc),
+    identical.to = c("coefs_between_within", "ddf_between", "ddf_within")
+  )
   assert_logical(is_coef_involved, len = length(bw_calc$coefs_between_within))
   assert_true(sum(is_coef_involved) > 0)
 
@@ -122,7 +125,12 @@ h_df_1d_bw <- function(object, contrast) {
 #' @keywords internal
 h_df_md_bw <- function(object, contrast) {
   assert_class(object, "mmrm")
-  assert_matrix(contrast, mode = "numeric", any.missing = FALSE, ncols = length(component(object, "beta_est")))
+  assert_matrix(
+    contrast,
+    mode = "numeric",
+    any.missing = FALSE,
+    ncols = length(component(object, "beta_est"))
+  )
 
   bw_calc <- h_df_bw_calc(object)
   is_coef_involved <- apply(X = contrast != 0, MARGIN = 2L, FUN = any)

R/cov_struct.R

@@ -26,7 +26,8 @@
 #' }
 #'
 #' @keywords internal
-COV_TYPES <- local({ # nolint
+COV_TYPES <- local({
+  # nolint
   type <- function(name, abbr, habbr, heterogeneous, spatial) {
     args <- as.list(match.call()[-1])
     do.call(data.frame, args)
@@ -160,8 +161,9 @@ COV_TYPES <- local({ # nolint
 #' @name covariance_types
 #' @export
 cov_types <- function(
-    form = c("name", "abbr", "habbr"),
-    filter = c("heterogeneous", "spatial")) {
+  form = c("name", "abbr", "habbr"),
+  filter = c("heterogeneous", "spatial")
+) {
   form <- match.arg(form, several.ok = TRUE)
   filter <- if (missing(filter)) c() else match.arg(filter, several.ok = TRUE)
   df <- COV_TYPES[form][rowSums(!COV_TYPES[filter]) == 0, ]
@@ -231,11 +233,16 @@ tmb_cov_type <- function(cov) {
 #' @family covariance types
 #' @export
 cov_struct <- function(
-    type = cov_types(), visits, subject, group = character(),
-    heterogeneous = FALSE) {
+  type = cov_types(),
+  visits,
+  subject,
+  group = character(),
+  heterogeneous = FALSE
+) {
   # if heterogeneous isn't provided, derive from provided type
   if (missing(heterogeneous)) {
-    heterogeneous <- switch(type,
+    heterogeneous <- switch(
+      type,
       toeph = ,
       ar1h = ,
       adh = ,
@@ -398,7 +405,8 @@ print.cov_struct <- function(x, ...) {
 #'
 #' @family covariance types
 #' @export
-as.cov_struct <- function(x, ...) { # nolint
+as.cov_struct <- function(x, ...) {
+  # nolint
   UseMethod("as.cov_struct")
 }
 

R/interop-emmeans.R

@@ -26,7 +26,8 @@ NULL
 #' @seealso See [emmeans::recover_data()] for background.
 #' @keywords internal
 #' @noRd
-recover_data.mmrm <- function(object, ...) { # nolint
+recover_data.mmrm <- function(object, ...) {
+  # nolint
   fun_call <- stats::getCall(object)
   # subject_var is excluded because it should not contain fixed effect.
   # visit_var is not excluded because emmeans can provide marginal mean
@@ -35,7 +36,8 @@ recover_data.mmrm <- function(object, ...) { # nolint
     object,
     include = c(
       if (!object$formula_parts$is_spatial) "visit_var" else NULL,
-      "response_var", "group_var"
+      "response_var",
+      "group_var"
     )
   )
   model_terms <- stats::delete.response(stats::terms(model_frame))
@@ -53,12 +55,19 @@ recover_data.mmrm <- function(object, ...) { # nolint
 #' @seealso See [emmeans::emm_basis()] for background.
 #' @keywords internal
 #' @noRd
-emm_basis.mmrm <- function(object, # nolint
-                           trms,
-                           xlev,
-                           grid,
-                           ...) {
-  model_frame <- stats::model.frame(trms, grid, na.action = stats::na.pass, xlev = xlev)
+emm_basis.mmrm <- function(
+  object, # nolint
+  trms,
+  xlev,
+  grid,
+  ...
+) {
+  model_frame <- stats::model.frame(
+    trms,
+    grid,
+    na.action = stats::na.pass,
+    xlev = xlev
+  )
   contrasts <- component(object, "contrasts")
   model_mat <- stats::model.matrix(trms, model_frame, contrasts.arg = contrasts)
   beta_hat <- component(object, "beta_est")
@@ -72,7 +81,8 @@ emm_basis.mmrm <- function(object, # nolint
         object,
         include = c(
           if (!object$formula_parts$is_spatial) "visit_var" else NULL,
-          "response_var", "group_var"
+          "response_var",
+          "group_var"
         )
       ),
       contrasts.arg = contrasts

R/kenwardroger.R

@@ -36,7 +36,12 @@ h_get_kr_comp <- function(tmb_data, theta) {
 #' @keywords internal
 h_df_md_kr <- function(object, contrast) {
   assert_class(object, "mmrm")
-  assert_matrix(contrast, mode = "numeric", any.missing = FALSE, ncols = length(component(object, "beta_est")))
+  assert_matrix(
+    contrast,
+    mode = "numeric",
+    any.missing = FALSE,
+    ncols = length(component(object, "beta_est"))
+  )
   if (component(object, "reml") != 1) {
     stop("Kenward-Roger is only for REML")
   }
@@ -159,8 +164,16 @@ h_var_adj <- function(v, w, p, q, r, linear = FALSE) {
   theta_per_group <- nrow(q) / nrow(p)
   n_groups <- n_theta / theta_per_group
   assert_matrix(p, nrows = n_theta * n_visits)
-  assert_matrix(q, nrows = theta_per_group^2 * n_groups * n_visits, ncols = n_visits)
-  assert_matrix(r, nrows = theta_per_group^2 * n_groups * n_visits, ncols = n_visits)
+  assert_matrix(
+    q,
+    nrows = theta_per_group^2 * n_groups * n_visits,
+    ncols = n_visits
+  )
+  assert_matrix(
+    r,
+    nrows = theta_per_group^2 * n_groups * n_visits,
+    ncols = n_visits
+  )
   if (linear) {
     r <- matrix(0, nrow = nrow(r), ncol = ncol(r))
   }
@@ -175,15 +188,30 @@ h_var_adj <- function(v, w, p, q, r, linear = FALSE) {
       jid <- (j - 1) * n_beta + 1
       ii <- i - (gi - 1) * theta_per_group
       jj <- j - (gi - 1) * theta_per_group
-      ijid <- ((ii - 1) * theta_per_group + jj - 1) * n_beta + (gi - 1) * n_beta * theta_per_group^2 + 1
+      ijid <- ((ii - 1) * theta_per_group + jj - 1) *
+        n_beta +
+        (gi - 1) * n_beta * theta_per_group^2 +
+        1
       if (gi != gj) {
-        ret <- ret + 2 * w[i, j] * v %*% (-p[iid:(iid + n_beta - 1), ] %*% v %*% p[jid:(jid + n_beta - 1), ]) %*% v
+        ret <- ret +
+          2 *
+            w[i, j] *
+            v %*%
+              (-p[iid:(iid + n_beta - 1), ] %*%
+                v %*%
+                p[jid:(jid + n_beta - 1), ]) %*%
+              v
       } else {
-        ret <- ret + 2 * w[i, j] * v %*% (
-          q[ijid:(ijid + n_beta - 1), ] -
-            p[iid:(iid + n_beta - 1), ] %*% v %*% p[jid:(jid + n_beta - 1), ] -
-            1 / 4 * r[ijid:(ijid + n_beta - 1), ]
-        ) %*% v
+        ret <- ret +
+          2 *
+            w[i, j] *
+            v %*%
+              (q[ijid:(ijid + n_beta - 1), ] -
+                p[iid:(iid + n_beta - 1), ] %*%
+                  v %*%
+                  p[jid:(jid + n_beta - 1), ] -
+                1 / 4 * r[ijid:(ijid + n_beta - 1), ]) %*%
+              v
       }
     }
   }

R/mmrm-methods.R

@@ -58,7 +58,13 @@ h_coef_table <- function(object) {
     colnames(coef_table),
     identical.to = c("est", "se", "df", "t_stat", "p_val")
   )
-  colnames(coef_table) <- c("Estimate", "Std. Error", "df", "t value", "Pr(>|t|)")
+  colnames(coef_table) <- c(
+    "Estimate",
+    "Std. Error",
+    "df",
+    "t value",
+    "Pr(>|t|)"
+  )
 
   coef_aliased <- component(object, "beta_aliased")
   if (any(coef_aliased)) {
@@ -89,11 +95,20 @@ summary.mmrm <- function(object, ...) {
   )
   coefficients <- h_coef_table(object)
   call <- stats::getCall(object)
-  components <- component(object, c(
-    "cov_type", "reml", "n_groups", "n_theta",
-    "n_subjects", "n_timepoints", "n_obs",
-    "beta_vcov", "varcor"
-  ))
+  components <- component(
+    object,
+    c(
+      "cov_type",
+      "reml",
+      "n_groups",
+      "n_theta",
+      "n_subjects",
+      "n_timepoints",
+      "n_obs",
+      "beta_vcov",
+      "varcor"
+    )
+  )
   components$method <- object$method
   components$vcov <- object$vcov
   structure(
@@ -129,8 +144,15 @@ h_print_call <- function(call, n_obs, n_subjects, n_timepoints) {
   }
   if (!is.null(call$data)) {
     cat(
-      "Data:       ", deparse(call$data), "(used", n_obs, "observations from",
-      n_subjects, "subjects with maximum", n_timepoints, "timepoints)",
+      "Data:       ",
+      deparse(call$data),
+      "(used",
+      n_obs,
+      "observations from",
+      n_subjects,
+      "subjects with maximum",
+      n_timepoints,
+      "timepoints)",
       fill = TRUE
     )
   }
@@ -152,7 +174,8 @@ h_print_cov <- function(cov_type, n_theta, n_groups) {
   assert_string(cov_type)
   assert_count(n_theta, positive = TRUE)
   assert_count(n_groups, positive = TRUE)
-  cov_definition <- switch(cov_type,
+  cov_definition <- switch(
+    cov_type,
     us = "unstructured",
     toep = "Toeplitz",
     toeph = "heterogeneous Toeplitz",
@@ -182,8 +205,7 @@ h_print_cov <- function(cov_type, n_theta, n_groups) {
 #' @param digits (`number`)\cr number of decimal places used with [round()].
 #'
 #' @keywords internal
-h_print_aic_list <- function(aic_list,
-                             digits = 1) {
+h_print_aic_list <- function(aic_list, digits = 1) {
   diag_vals <- round(unlist(aic_list), digits)
   diag_vals <- format(diag_vals)
   print(diag_vals, quote = FALSE)
@@ -192,10 +214,12 @@ h_print_aic_list <- function(aic_list,
 #' @describeIn mmrm_methods prints the MMRM fit summary.
 #' @exportS3Method
 #' @keywords internal
-print.summary.mmrm <- function(x,
-                               digits = max(3, getOption("digits") - 3),
-                               signif.stars = getOption("show.signif.stars"), # nolint
-                               ...) {
+print.summary.mmrm <- function(
+  x,
+  digits = max(3, getOption("digits") - 3),
+  signif.stars = getOption("show.signif.stars"), # nolint
+  ...
+) {
   cat("mmrm fit\n\n")
   h_print_call(x$call, x$n_obs, x$n_subjects, x$n_timepoints)
   h_print_cov(x$cov_type, x$n_theta, x$n_groups)
@@ -209,7 +233,12 @@ print.summary.mmrm <- function(x,
   cat("\n")
   cat("Coefficients: ")
   if (x$n_singular_coefs > 0) {
-    cat("(", x$n_singular_coefs, " not defined because of singularities)", sep = "")
+    cat(
+      "(",
+      x$n_singular_coefs,
+      " not defined because of singularities)",
+      sep = ""
+    )
   }
   cat("\n")
   stats::printCoefmat(
@@ -248,10 +277,15 @@ confint.mmrm <- function(object, parm, level = 0.95, ...) {
     check_subset(parm, pnames),
     check_integerish(parm, lower = 1L, upper = length(cf))
   )
-  if (is.numeric(parm)) parm <- pnames[parm]
+  if (is.numeric(parm)) {
+    parm <- pnames[parm]
+  }
   assert_number(level, lower = 0, upper = 1)
   a <- (1 - level) / 2
-  pct <- paste(format(100 * c(a, 1 - a), trim = TRUE, scientific = FALSE, digits = 3), "%")
+  pct <- paste(
+    format(100 * c(a, 1 - a), trim = TRUE, scientific = FALSE, digits = 3),
+    "%"
+  )
   coef_table <- h_coef_table(object)
   df <- coef_table[parm, "df"]
   ses <- coef_table[parm, "Std. Error"]
@@ -263,7 +297,6 @@ confint.mmrm <- function(object, parm, level = 0.95, ...) {
 }
 
 
-
 #' Analysis of Variance for `mmrm` Fits
 #'
 #' If supplied only one model fit, the function will calculate and return the
@@ -443,16 +476,13 @@ confint.mmrm <- function(object, parm, level = 0.95, ...) {
 #' # If a model was created with a different data set, refit = TRUE is needed.
 #' anova(fit_sex_ar1, fit_sex_race_toeph_sub, fit_interaction_us, refit = TRUE)
 anova.mmrm <- function(object, ..., test = TRUE, refit = FALSE) {
-
   assert_class(object, "mmrm")
 
   fits <- list(object, ...)
 
   if (length(fits) == 1L) {
     out <- h_anova_single_mmrm_model(object)
-
   } else {
-
     # Ensure all objects in ... are mmrm fits.
     lapply(fits[-1L], assert_class, classes = "mmrm", .var.name = "...")
 
@@ -498,7 +528,6 @@ anova.mmrm <- function(object, ..., test = TRUE, refit = FALSE) {
       )
 
     if (test) {
-
       h_assert_lrt_suitability(fits, refit, dfs = out$df, is_reml = out$REML)
 
       model_indices_except_last <- out$Model[-length(fits)]
@@ -508,7 +537,8 @@ anova.mmrm <- function(object, ..., test = TRUE, refit = FALSE) {
       # first element to be NA because a pair of models is the previous row's
       # model plus the current row's model.
       out$test <-
-        c(NA_character_,
+        c(
+          NA_character_,
           paste(model_indices_except_last, "vs", model_indices_except_first)
         )
 
@@ -524,7 +554,6 @@ anova.mmrm <- function(object, ..., test = TRUE, refit = FALSE) {
 
     fit_calls <- lapply(fits, component, "call")
     out$call <- vapply(fit_calls, deparse1, FUN.VALUE = character(1L))
-
   }
 
   class(out) <- union("anova.mmrm", class(out))