Format with air

.Rbuildignore

@@ -15,3 +15,5 @@
 ^vignettes/articles$
 ^CRAN-SUBMISSION$
 ^revdep$
+^[.]?air[.]toml$
+^\.vscode$

.github/workflows/format-check.yaml

@@ -0,0 +1,23 @@
+# Workflow derived from https://github.com/posit-dev/setup-air/tree/main/examples
+
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+
+name: format-check.yaml
+
+permissions: read-all
+
+jobs:
+  format-check:
+    name: format-check
+    runs-on: ubuntu-latest
+    steps:
+      - uses: actions/checkout@v4
+
+      - name: Install
+        uses: posit-dev/setup-air@v1
+
+      - name: Check
+        run: air format . --check

.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/autoplot.R

@@ -64,10 +64,11 @@ autoplot.spatial_rset <- function(object, ..., alpha = 0.6) {
     mapping = ggplot2::aes(color = .fold., fill = .fold.)
   )
   p <- p + ggplot2::geom_sf(..., alpha = alpha)
-  p <- p + ggplot2::guides(
-    colour = ggplot2::guide_legend("Fold"),
-    fill = ggplot2::guide_legend("Fold")
-  )
+  p <- p +
+    ggplot2::guides(
+      colour = ggplot2::guide_legend("Fold"),
+      fill = ggplot2::guide_legend("Fold")
+    )
 
   if (sum(bool_id_columns) == 2) {
     p <- p + ggplot2::facet_wrap(ggplot2::vars(.facet.))
@@ -97,10 +98,11 @@ autoplot.spatial_rsplit <- function(object, ..., alpha = 0.6) {
     data = object,
     mapping = ggplot2::aes(color = .class., fill = .class.)
   )
-  p <- p + ggplot2::guides(
-    colour = ggplot2::guide_legend("Class"),
-    fill = ggplot2::guide_legend("Class")
-  )
+  p <- p +
+    ggplot2::guides(
+      colour = ggplot2::guide_legend("Class"),
+      fill = ggplot2::guide_legend("Class")
+    )
   p <- p + ggplot2::geom_sf(..., alpha = alpha)
   p + ggplot2::coord_sf()
 }
@@ -109,7 +111,12 @@ autoplot.spatial_rsplit <- function(object, ..., alpha = 0.6) {
 #' @param show_grid When plotting [spatial_block_cv] objects, should the grid
 #' itself be drawn on top of the data? Set to FALSE to remove the grid.
 #' @export
-autoplot.spatial_block_cv <- function(object, show_grid = TRUE, ..., alpha = 0.6) {
+autoplot.spatial_block_cv <- function(
+  object,
+  show_grid = TRUE,
+  ...,
+  alpha = 0.6
+) {
   p <- autoplot.spatial_rset(object, ..., alpha = alpha)
 
   if (!show_grid) {

R/buffer.R

@@ -10,7 +10,13 @@
 #' or assessment set. If `NULL`, no buffer is applied.
 #'
 #' @keywords internal
-buffer_indices <- function(data, indices, radius, buffer, call = rlang::caller_env()) {
+buffer_indices <- function(
+  data,
+  indices,
+  radius,
+  buffer,
+  call = rlang::caller_env()
+) {
   standard_checks(data, "Buffering", call)
 
   n <- nrow(data)
@@ -30,15 +36,21 @@ buffer_indices <- function(data, indices, radius, buffer, call = rlang::caller_e
   run_radius <- !is.null(radius)
   if (run_radius && units::set_units(radius, NULL) > 0) {
     # In case `radius` has no units, assume it's in the same units as `data`
-    if (!identical(sf::st_crs(data), sf::NA_crs_)) units(radius) <- units(distmat)
+    if (!identical(sf::st_crs(data), sf::NA_crs_)) {
+      units(radius) <- units(distmat)
+    }
     indices <- row_ids_within_dist(distmat, indices, radius)
   }
 
   # `buffer_indices` are _always_ needed
   # so re-code a NULL buffer as a 0, which will buffer nothing
-  if (is.null(buffer)) buffer <- 0L
+  if (is.null(buffer)) {
+    buffer <- 0L
+  }
   # In case `buffer` has no units, assume it's in the same units as `data`
-  if (!identical(sf::st_crs(data), sf::NA_crs_)) units(buffer) <- units(distmat)
+  if (!identical(sf::st_crs(data), sf::NA_crs_)) {
+    units(buffer) <- units(distmat)
+  }
   buffer_indices <- row_ids_within_dist(distmat, indices, buffer)
 
   purrr::map2(indices, buffer_indices, buffered_complement, n = n)

R/checks.R

@@ -14,7 +14,9 @@ check_s2 <- function(data, calling_function, call = rlang::caller_env()) {
   if (is_longlat(data) && !sf::sf_use_s2()) {
     rlang::abort(
       c(
-        glue::glue("{calling_function} can only process geographic coordinates when using the s2 geometry library."),
+        glue::glue(
+          "{calling_function} can only process geographic coordinates when using the s2 geometry library."
+        ),
         "i" = "Reproject your data into a projected coordinate reference system using `sf::st_transform()`.",
         "i" = "Or install the `s2` package and enable it using `sf::sf_use_s2(TRUE)`."
       ),
@@ -27,16 +29,24 @@ check_na_crs <- function(data, calling_function, call = rlang::caller_env()) {
   if (sf::st_crs(data) == sf::NA_crs_) {
     rlang::warn(
       c(
-        glue::glue("{calling_function} expects your data to have an appropriate coordinate reference system (CRS)."),
+        glue::glue(
+          "{calling_function} expects your data to have an appropriate coordinate reference system (CRS)."
+        ),
         i = "If possible, try setting a CRS using `sf::st_set_crs()`.",
-        i = glue::glue("Otherwise, {tolower(calling_function)} will assume your data is in projected coordinates.")
+        i = glue::glue(
+          "Otherwise, {tolower(calling_function)} will assume your data is in projected coordinates."
+        )
       ),
       call = call
     )
   }
 }
 
-standard_checks <- function(data, calling_function, call = rlang::caller_env()) {
+standard_checks <- function(
+  data,
+  calling_function,
+  call = rlang::caller_env()
+) {
   check_sf(data, calling_function, call)
   check_na_crs(data, calling_function, call)
   check_s2(data, calling_function, call)
@@ -47,12 +57,16 @@ standard_checks <- function(data, calling_function, call = rlang::caller_env())
 #' @param v The number of partitions for the resampling. Set to `NULL` or `Inf`
 #' for the maximum sensible value (for leave-one-X-out cross-validation).
 #' @keywords internal
-check_v <- function(v,
-                    max_v,
-                    objects,
-                    allow_max_v = TRUE,
-                    call = rlang::caller_env()) {
-  if (is.null(v)) v <- Inf
+check_v <- function(
+  v,
+  max_v,
+  objects,
+  allow_max_v = TRUE,
+  call = rlang::caller_env()
+) {
+  if (is.null(v)) {
+    v <- Inf
+  }
 
   if (!rlang::is_integerish(v) || length(v) != 1 || v < 1) {
     rlang::abort("`v` must be a single positive integer.", call = call)

R/compat-vctrs-helpers.R

@@ -14,11 +14,21 @@ delayedAssign("rset_subclasses", {
     withr::with_seed(
       123,
       list(
-        spatial_block_cv              = spatial_block_cv(test_data()),
-        spatial_clustering_cv         = spatial_clustering_cv(test_data()),
-        spatial_buffer_vfold_cv       = spatial_buffer_vfold_cv(test_data(), radius = 1, buffer = 1),
-        spatial_leave_location_out_cv = spatial_leave_location_out_cv(test_data(), idx),
-        spatial_nndm_cv               = spatial_nndm_cv(test_data()[1:500, ], test_data()[501:682, ])
+        spatial_block_cv = spatial_block_cv(test_data()),
+        spatial_clustering_cv = spatial_clustering_cv(test_data()),
+        spatial_buffer_vfold_cv = spatial_buffer_vfold_cv(
+          test_data(),
+          radius = 1,
+          buffer = 1
+        ),
+        spatial_leave_location_out_cv = spatial_leave_location_out_cv(
+          test_data(),
+          idx
+        ),
+        spatial_nndm_cv = spatial_nndm_cv(
+          test_data()[1:500, ],
+          test_data()[501:682, ]
+        )
       )
     )
   } else {

R/compat-vctrs.R

@@ -5,7 +5,13 @@
 
 stop_incompatible_cast_rset <- function(x, to, ..., x_arg, to_arg) {
   details <- "Can't cast to an rset because attributes are likely incompatible."
-  vctrs::stop_incompatible_cast(x, to, x_arg = x_arg, to_arg = to_arg, details = details)
+  vctrs::stop_incompatible_cast(
+    x,
+    to,
+    x_arg = x_arg,
+    to_arg = to_arg,
+    details = details
+  )
 }
 
 stop_never_called <- function(fn) {

R/labels.R

@@ -8,11 +8,14 @@ pretty.spatial_clustering_cv <- function(x, ...) {
 #' @export
 print.spatial_clustering_cv <- function(x, ...) {
   cat("# ", pretty(x), "\n")
-  class(x) <- class(x)[!(class(x) %in% c(
-    "spatial_clustering_cv",
-    "spatial_rset",
-    "rset"
-  ))]
+  class(x) <- class(x)[
+    !(class(x) %in%
+      c(
+        "spatial_clustering_cv",
+        "spatial_rset",
+        "rset"
+      ))
+  ]
   print(x, ...)
 }
 
@@ -26,11 +29,14 @@ pretty.spatial_block_cv <- function(x, ...) {
 #' @export
 print.spatial_block_cv <- function(x, ...) {
   cat("# ", pretty(x), "\n")
-  class(x) <- class(x)[!(class(x) %in% c(
-    "spatial_block_cv",
-    "spatial_rset",
-    "rset"
-  ))]
+  class(x) <- class(x)[
+    !(class(x) %in%
+      c(
+        "spatial_block_cv",
+        "spatial_rset",
+        "rset"
+      ))
+  ]
   print(x, ...)
 }
 
@@ -44,11 +50,14 @@ pretty.spatial_leave_location_out_cv <- function(x, ...) {
 #' @export
 print.spatial_leave_location_out_cv <- function(x, ...) {
   cat("# ", pretty(x), "\n")
-  class(x) <- class(x)[!(class(x) %in% c(
-    "spatial_leave_location_out_cv",
-    "spatial_rset",
-    "rset"
-  ))]
+  class(x) <- class(x)[
+    !(class(x) %in%
+      c(
+        "spatial_leave_location_out_cv",
+        "spatial_rset",
+        "rset"
+      ))
+  ]
   print(x, ...)
 }
 
@@ -62,10 +71,13 @@ pretty.spatial_buffer_vfold_cv <- function(x, ...) {
 #' @export
 print.spatial_buffer_vfold_cv <- function(x, ...) {
   cat("# ", pretty(x), "\n")
-  class(x) <- class(x)[!(class(x) %in% c(
-    "spatial_buffer_vfold_cv",
-    "spatial_rset",
-    "rset"
-  ))]
+  class(x) <- class(x)[
+    !(class(x) %in%
+      c(
+        "spatial_buffer_vfold_cv",
+        "spatial_rset",
+        "rset"
+      ))
+  ]
   print(x, ...)
 }

R/misc.R

@@ -27,7 +27,9 @@ split_unnamed <- function(x, f) {
 
 ## This will remove the assessment indices from an rsplit object
 rm_out <- function(x, buffer = NULL) {
-  if (is.null(buffer)) x$out_id <- NA
+  if (is.null(buffer)) {
+    x$out_id <- NA
+  }
   x
 }