Air

.Rbuildignore

@@ -12,3 +12,5 @@
 ^pkgdown$
 ^CRAN-SUBMISSION$
 ^man-roxygen$
+^[.]?air[.]toml$
+^\.vscode$

.vscode/extensions.json

@@ -0,0 +1,5 @@
+{
+    "recommendations": [
+        "Posit.air-vscode"
+    ]
+}

.vscode/settings.json

@@ -0,0 +1,10 @@
+{
+    "[r]": {
+        "editor.formatOnSave": true,
+        "editor.defaultFormatter": "Posit.air-vscode"
+    },
+    "[quarto]": {
+        "editor.formatOnSave": true,
+        "editor.defaultFormatter": "quarto.quarto"
+    }
+}

R/bound_prediction.R

@@ -15,13 +15,19 @@
 #'
 #' bound_prediction(solubility_test, lower_limit = -1)
 #' @export
-bound_prediction <- function(x, lower_limit = -Inf, upper_limit = Inf,
-                             call = rlang::current_env()) {
+bound_prediction <- function(
+  x,
+  lower_limit = -Inf,
+  upper_limit = Inf,
+  call = rlang::current_env()
+) {
   check_data_frame(x, call = call)
 
   if (!any(names(x) == ".pred")) {
-    cli::cli_abort("The argument {.arg x} should have a column named {.code .pred}.",
-                   call = call)
+    cli::cli_abort(
+      "The argument {.arg x} should have a column named {.code .pred}.",
+      call = call
+    )
   }
   if (!is.numeric(x$.pred)) {
     cli::cli_abort("Column {.code .pred} should be numeric.", call = call)
@@ -39,4 +45,3 @@ bound_prediction <- function(x, lower_limit = -Inf, upper_limit = Inf,
   }
   x
 }
-

R/cal-apply-binary.R

@@ -5,21 +5,25 @@ cal_apply_binary <- function(object, .data, pred_class) {
 }
 
 #' @export
-cal_apply_binary.cal_estimate_logistic <- function(object,
-                                                   .data,
-                                                   pred_class = NULL,
-                                                   ...) {
+cal_apply_binary.cal_estimate_logistic <- function(
+  object,
+  .data,
+  pred_class = NULL,
+  ...
+) {
   apply_model_predict(
     object = object,
     .data = .data
   )
 }
 
 #' @export
-cal_apply_binary.cal_estimate_logistic_spline <- function(object,
-                                                          .data,
-                                                          pred_class = NULL,
-                                                          ...) {
+cal_apply_binary.cal_estimate_logistic_spline <- function(
+  object,
+  .data,
+  pred_class = NULL,
+  ...
+) {
   apply_model_predict(
     object = object,
     .data = .data

R/cal-apply-impl.R

@@ -107,7 +107,10 @@ apply_beta_column <- function(.data, est_filter, estimates) {
   }
 
   ret <-
-    purrr::imap(estimates, ~ apply_beta_single(model = .x, df = df, est_name = .y))
+    purrr::imap(
+      estimates,
+      ~ apply_beta_single(model = .x, df = df, est_name = .y)
+    )
 
   names_ret <- names(ret)
   for (i in seq_along(names_ret)) {

R/cal-apply.R

@@ -31,22 +31,26 @@
 #'
 #' cal_apply(segment_logistic, w_calibration)
 #' @export
-cal_apply <- function(.data,
-                      object,
-                      pred_class = NULL,
-                      parameters = NULL,
-                      ...) {
+cal_apply <- function(
+  .data,
+  object,
+  pred_class = NULL,
+  parameters = NULL,
+  ...
+) {
   rlang::check_dots_empty()
   UseMethod("cal_apply")
 }
 
 #' @export
 #' @rdname cal_apply
-cal_apply.data.frame <- function(.data,
-                                 object,
-                                 pred_class = NULL,
-                                 parameters = NULL,
-                                 ...) {
+cal_apply.data.frame <- function(
+  .data,
+  object,
+  pred_class = NULL,
+  parameters = NULL,
+  ...
+) {
   cal_pkg_check(required_pkgs(object))
 
   stop_null_parameters(parameters)
@@ -60,11 +64,13 @@ cal_apply.data.frame <- function(.data,
 
 #' @export
 #' @rdname cal_apply
-cal_apply.tune_results <- function(.data,
-                                   object,
-                                   pred_class = NULL,
-                                   parameters = NULL,
-                                   ...) {
+cal_apply.tune_results <- function(
+  .data,
+  object,
+  pred_class = NULL,
+  parameters = NULL,
+  ...
+) {
   cal_pkg_check(required_pkgs(object))
 
   if (!(".predictions" %in% colnames(.data))) {
@@ -99,11 +105,13 @@ cal_apply.tune_results <- function(.data,
 
 #' @export
 #' @rdname cal_apply
-cal_apply.cal_object <- function(.data,
-                                 object,
-                                 pred_class = NULL,
-                                 parameters = NULL,
-                                 ...) {
+cal_apply.cal_object <- function(
+  .data,
+  object,
+  pred_class = NULL,
+  parameters = NULL,
+  ...
+) {
   if ("data.frame" %in% class(object)) {
     cli::cli_abort(
       c(
@@ -140,10 +148,12 @@ cal_adjust.cal_estimate_isotonic_boot <- function(object, .data, pred_class) {
 }
 
 #' @export
-cal_adjust.cal_estimate_beta <- function(object,
-                                         .data,
-                                         pred_class = NULL,
-                                         ...) {
+cal_adjust.cal_estimate_beta <- function(
+  object,
+  .data,
+  pred_class = NULL,
+  ...
+) {
   apply_beta_impl(
     object = object,
     .data = .data
@@ -182,11 +192,13 @@ cal_adjust.cal_estimate_none <- function(object, .data, pred_class) {
   .data
 }
 
-cal_adjust_update <- function(.data,
-                              object,
-                              pred_class = NULL,
-                              parameters = NULL,
-                              ...) {
+cal_adjust_update <- function(
+  .data,
+  object,
+  pred_class = NULL,
+  parameters = NULL,
+  ...
+) {
   if (object$type != "regression") {
     pred_class <- enquo(pred_class)
   } else {

R/cal-estimate-beta.R

@@ -22,28 +22,28 @@
 #' }
 #' @export
 cal_estimate_beta <- function(
-    .data,
-    truth = NULL,
-    shape_params = 2,
-    location_params = 1,
-    estimate = dplyr::starts_with(".pred_"),
-    parameters = NULL,
-    ...
+  .data,
+  truth = NULL,
+  shape_params = 2,
+  location_params = 1,
+  estimate = dplyr::starts_with(".pred_"),
+  parameters = NULL,
+  ...
 ) {
   UseMethod("cal_estimate_beta")
 }
 
 #' @export
 #' @rdname cal_estimate_beta
 cal_estimate_beta.data.frame <- function(
-    .data,
-    truth = NULL,
-    shape_params = 2,
-    location_params = 1,
-    estimate = dplyr::starts_with(".pred_"),
-    parameters = NULL,
-    ...,
-    .by = NULL
+  .data,
+  truth = NULL,
+  shape_params = 2,
+  location_params = 1,
+  estimate = dplyr::starts_with(".pred_"),
+  parameters = NULL,
+  ...,
+  .by = NULL
 ) {
   stop_null_parameters(parameters)
 
@@ -70,13 +70,13 @@ cal_estimate_beta.data.frame <- function(
 #' @export
 #' @rdname cal_estimate_beta
 cal_estimate_beta.tune_results <- function(
-    .data,
-    truth = NULL,
-    shape_params = 2,
-    location_params = 1,
-    estimate = dplyr::starts_with(".pred_"),
-    parameters = NULL,
-    ...
+  .data,
+  truth = NULL,
+  shape_params = 2,
+  location_params = 1,
+  estimate = dplyr::starts_with(".pred_"),
+  parameters = NULL,
+  ...
 ) {
   info <- get_tune_data(.data, parameters)
 
@@ -96,13 +96,13 @@ cal_estimate_beta.tune_results <- function(
 #' @export
 #' @rdname cal_estimate_beta
 cal_estimate_beta.grouped_df <- function(
-    .data,
-    truth = NULL,
-    shape_params = 2,
-    location_params = 1,
-    estimate = NULL,
-    parameters = NULL,
-    ...
+  .data,
+  truth = NULL,
+  shape_params = 2,
+  location_params = 1,
+  estimate = NULL,
+  parameters = NULL,
+  ...
 ) {
   abort_if_grouped_df()
 }
@@ -137,12 +137,12 @@ beta_fit_over_groups <- function(info, shape_params, location_params, ...) {
 
 
 fit_all_beta_models <- function(
-    .data,
-    truth = NULL,
-    shape = 2,
-    location = 1,
-    estimate = NULL,
-    ...
+  .data,
+  truth = NULL,
+  shape = 2,
+  location = 1,
+  estimate = NULL,
+  ...
 ) {
   lvls <- levels(.data[[truth]])
   num_lvls <- length(lvls)
@@ -176,12 +176,12 @@ fit_all_beta_models <- function(
 
 
 fit_beta_model <- function(
-    .data,
-    truth = NULL,
-    shape = 2,
-    location = 1,
-    estimate = NULL,
-    ...
+  .data,
+  truth = NULL,
+  shape = 2,
+  location = 1,
+  estimate = NULL,
+  ...
 ) {
   outcome_data <- .data[[truth]]
   lvls <- levels(outcome_data)
@@ -255,6 +255,8 @@ check_cal_groups <- function(group, .data, call = rlang::env_parent()) {
 
 #' @export
 print.betacal <- function(x, ...) {
-  cli::cli_inform("Beta calibration ({x$parameters}) using {x$model$df.null} samples")
+  cli::cli_inform(
+    "Beta calibration ({x$parameters}) using {x$model$df.null} samples"
+  )
   invisible(x)
 }