add air support

.Rbuildignore

@@ -14,3 +14,5 @@
 ^scratch$
 ^\.claude$
 CLAUDE.md
+^[.]?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: air
+
+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/plot_ess.R

@@ -71,7 +71,7 @@
 #' # Using pre-computed ESS data
 #' ess_data <- check_ess(nhefs_weights, .wts = c(w_ate, w_att))
 #' plot_ess(ess_data)
-#' 
+#'
 #' # Show ESS on original scale instead of percentage
 #' plot_ess(nhefs_weights, .wts = c(w_ate, w_att), percent_scale = FALSE)
 #'
@@ -108,7 +108,7 @@ plot_ess <- function(
 
   # Determine if we have groups
   has_groups <- "group" %in% names(.data)
-  
+
   # Choose which variable to plot
   y_var <- if (percent_scale) "ess_pct" else "ess"
 
@@ -191,12 +191,14 @@ plot_ess <- function(
   p <- p +
     ggplot2::labs(
       x = "method",
-      y = if (percent_scale) "effective sample size (%)" else "effective sample size"
+      y = if (percent_scale) "effective sample size (%)" else
+        "effective sample size"
     ) +
     ggplot2::scale_y_continuous(
       limits = c(0, y_upper),
       expand = c(0, 0),
-      labels = if (percent_scale) \(x) scales::percent(x / 100) else scales::number
+      labels = if (percent_scale) \(x) scales::percent(x / 100) else
+        scales::number
     )
 
   p

tests/testthat/test-check_ess.R

@@ -1,6 +1,6 @@
 test_that("check_ess works with no weights", {
   result <- check_ess(nhefs_weights)
-  
+
   expect_s3_class(result, "tbl_df")
   expect_equal(nrow(result), 1)
   expect_equal(result$method, "observed")
@@ -10,7 +10,7 @@ test_that("check_ess works with no weights", {
 
 test_that("check_ess works with single weight", {
   result <- check_ess(nhefs_weights, .wts = w_ate)
-  
+
   expect_s3_class(result, "tbl_df")
   expect_equal(nrow(result), 2)
   expect_equal(result$method, c("observed", "w_ate"))
@@ -20,7 +20,7 @@ test_that("check_ess works with single weight", {
 
 test_that("check_ess works with multiple weights", {
   result <- check_ess(nhefs_weights, .wts = c(w_ate, w_att, w_atm))
-  
+
   expect_s3_class(result, "tbl_df")
   expect_equal(nrow(result), 4)
   # Methods may be returned in different order due to tidyselect
@@ -29,14 +29,14 @@ test_that("check_ess works with multiple weights", {
 
 test_that("check_ess works without observed", {
   result <- check_ess(nhefs_weights, .wts = w_ate, include_observed = FALSE)
-  
+
   expect_equal(nrow(result), 1)
   expect_equal(result$method, "w_ate")
 })
 
 test_that("check_ess works with binary groups", {
   result <- check_ess(nhefs_weights, .wts = w_ate, .group = qsmk)
-  
+
   expect_s3_class(result, "tbl_df")
   expect_true("group" %in% names(result))
   expect_equal(length(unique(result$group)), 2)
@@ -45,15 +45,15 @@ test_that("check_ess works with binary groups", {
 
 test_that("check_ess works with categorical groups", {
   result <- check_ess(nhefs_weights, .wts = w_cat_ate, .group = alcoholfreq_cat)
-  
+
   expect_s3_class(result, "tbl_df")
   expect_true("group" %in% names(result))
   expect_true(length(unique(result$group)) > 2)
 })
 
 test_that("check_ess works with continuous groups", {
   result <- check_ess(nhefs_weights, .wts = w_ate, .group = age, n_tiles = 4)
-  
+
   expect_s3_class(result, "tbl_df")
   expect_true("group" %in% names(result))
   expect_equal(length(unique(result$group)), 4)
@@ -62,16 +62,24 @@ test_that("check_ess works with continuous groups", {
 
 test_that("check_ess works with custom tile labels", {
   labels <- c("Young", "Middle", "Older")
-  result <- check_ess(nhefs_weights, .wts = w_ate, .group = age, 
-                      n_tiles = 3, tile_labels = labels)
-
+  result <- check_ess(
+    nhefs_weights,
+    .wts = w_ate,
+    .group = age,
+    n_tiles = 3,
+    tile_labels = labels
+  )
+
   expect_setequal(as.character(unique(result$group)), labels)
 })
 
 test_that("check_ess handles tidyselect syntax", {
   result1 <- check_ess(nhefs_weights, .wts = starts_with("w_a"))
-  result2 <- check_ess(nhefs_weights, .wts = c(w_ate, w_att, w_atc, w_atm, w_ato))
-
+  result2 <- check_ess(
+    nhefs_weights,
+    .wts = c(w_ate, w_att, w_atc, w_atm, w_ato)
+  )
+
   # Should have same number of methods (plus observed)
   expect_equal(nrow(result1), nrow(result2))
 })
@@ -80,7 +88,7 @@ test_that("check_ess handles psw weight objects", {
   # Assuming psw weights are numeric vectors with special class
   # The extract_weight_data function should handle conversion
   result <- check_ess(nhefs_weights, .wts = w_ate)
-  
+
   expect_true(is.numeric(result$ess))
   expect_true(all(result$ess > 0))
 })
@@ -90,28 +98,33 @@ test_that("check_ess validates inputs", {
     check_ess("not a data frame"),
     "halfmoon_type_error"
   )
-  
+
   expect_halfmoon_error(
     check_ess(nhefs_weights, .group = "not_a_column"),
     "halfmoon_column_error"
   )
-  
+
   expect_halfmoon_error(
-    check_ess(nhefs_weights, .wts = w_ate, .group = age,
-              n_tiles = 3, tile_labels = c("Too", "Few")),
+    check_ess(
+      nhefs_weights,
+      .wts = w_ate,
+      .group = age,
+      n_tiles = 3,
+      tile_labels = c("Too", "Few")
+    ),
     "halfmoon_length_error"
   )
 })
 
 test_that("ESS calculation is correct", {
   # Create simple test case with known ESS
   test_df <- data.frame(
-    wts = c(1, 1, 1, 1),  # Equal weights -> ESS = n
-    wts2 = c(4, 0, 0, 0)  # All weight on one obs -> ESS = 1
+    wts = c(1, 1, 1, 1), # Equal weights -> ESS = n
+    wts2 = c(4, 0, 0, 0) # All weight on one obs -> ESS = 1
   )
-  
+
   result <- check_ess(test_df, .wts = c(wts, wts2), include_observed = FALSE)
-  
+
   expect_equal(result$ess[result$method == "wts"], 4)
   expect_equal(result$ess[result$method == "wts2"], 1)
   expect_equal(result$ess_pct[result$method == "wts"], 100)
@@ -122,10 +135,10 @@ test_that("check_ess handles NA values", {
   # Create data with NAs
   test_df <- nhefs_weights
   test_df$w_ate[1:10] <- NA
-  
+
   result <- check_ess(test_df, .wts = w_ate)
-  
+
   # Should still compute ESS on non-NA values
   expect_true(all(!is.na(result$ess)))
   expect_true(all(result$ess > 0))
-})
+})

tests/testthat/test-ess.R

@@ -29,7 +29,7 @@ test_that("ess gives `NaN` if all weights are 0", {
 test_that("ess handles NA values", {
   # With na.rm = FALSE (default), should return NA
   expect_true(is.na(ess(c(1, 2, NA, 3))))
-  
+
   # With na.rm = TRUE, should calculate ESS on non-NA values
   expect_equal(ess(c(1, 1, NA, 1), na.rm = TRUE), 3)
   expect_true(ess(c(0.5, 2, NA, 0.1), na.rm = TRUE) < 3)