Add col_binomial_vec wrapper function to handle vectors with missing data

NAMESPACE

@@ -41,6 +41,7 @@ S3method(vec_ptype_full,projectable_col)
 S3method(vec_ptype_full,projectable_col_row)
 export("col_shadow<-")
 export(col_binomial)
+export(col_binomial_vec)
 export(col_freq)
 export(col_row)
 export(col_shadow)

R/col_binomial.R

@@ -180,3 +180,78 @@ vec_ptype2.projectable_col_binomial.projectable_col_binomial <- function(x, y, .
 vec_proxy_compare.projectable_col_binomial <- function(x, ...) {
   vec_proxy_compare.projectable_col(x, ...)
 }
+
+# Wrapper function for vector input --------------------------------------------
+
+#' Calculate binomial proportions from a vector
+#'
+#' A wrapper function for `col_binomial()` that takes a single vector and
+#' automatically calculates the number of successes and trials. This is
+#' particularly useful when working with data that contains missing values.
+#'
+#' @param x A numeric or integer vector containing the data. Can include NA values.
+#' @param success_value The value(s) that count as "success". Can be a single value
+#'   or a vector of values. Default is 1.
+#' @param range The range of values to include in the calculation. Values outside
+#'   this range are excluded (treated as NA). Default is c(0, 1). Set to NULL to
+#'   include all non-NA values.
+#' @param ci_error A numeric vector, the error to be used for calculating
+#'   confidence intervals. Default is 0.05.
+#' @param population A numeric vector, the number of individuals in the
+#'   population to be used for calculating confidence intervals. Default is Inf.
+#' @param method The name of a method to be passed through to `asbio::ci.p()` for
+#'   parameter estimation. The default is "agresti.coull", but other options
+#'   include "asymptotic", "score", "LR" and "exact". See `asbio::ci.p()` for details.
+#'
+#' @return An S3 vector of class `projectable_col_binomial`
+#' @export
+#'
+#' @examples
+#' # Calculate proportion of 1s in a 0-1 vector with missing data
+#' x <- c(0, 1, 1, 0, NA, 1, 0, 1)
+#' col_binomial_vec(x)
+#'
+#' # Calculate proportion of 2s in a 1-2 vector
+#' y <- c(1, 2, 2, 1, NA, 2, 1, 2)
+#' col_binomial_vec(y, success_value = 2, range = c(1, 2))
+#'
+#' # Calculate proportion with multiple success values
+#' z <- c(1, 2, 3, 4, 5, NA, 2, 3)
+#' col_binomial_vec(z, success_value = c(2, 3), range = c(1, 5))
+#'
+col_binomial_vec <- function(x,
+                              success_value = 1,
+                              range = c(0, 1),
+                              ci_error = 0.05,
+                              population = Inf,
+                              method = "agresti.coull") {
+
+  # Filter to specified range if provided
+  if (!is.null(range)) {
+    if (length(range) != 2) {
+      stop("`range` must be a vector of length 2 or NULL", call. = FALSE)
+    }
+    # Create a filtered vector where values outside range become NA
+    x_filtered <- x
+    outside_range <- !is.na(x) & (x < range[1] | x > range[2])
+    x_filtered[outside_range] <- NA
+  } else {
+    x_filtered <- x
+  }
+
+  # Calculate trials (non-NA values in the filtered range)
+  N <- sum(!is.na(x_filtered))
+
+  # Calculate successes (values matching success_value)
+  n <- sum(x_filtered %in% success_value, na.rm = TRUE)
+
+  # Call col_binomial with summarised data
+  col_binomial(
+    n = n,
+    N = N,
+    ci_error = ci_error,
+    population = population,
+    method = method,
+    summarised = TRUE
+  )
+}

tests/testthat/test-col.R

@@ -262,11 +262,101 @@ testthat::test_that("col_binomial: summarised/unsummarised equivalence", {
 })
 
 testthat::test_that("col_binomial can handle NAs", {
-  x <- prj_project_col(col_binomial(NA_real_, 10, summarised = T))
+  x <- prj_project_col(col_binomial(NA_real_, 10, summarised = TRUE))
   expect_identical(x$n, NA_integer_)
   expect_identical(x$N, 10L)
 })
 
+# col_binomial_vec --------------------------------------------------------
+
+testthat::test_that("col_binomial_vec: basic usage", {
+  # Test with 0-1 vector with missing data
+  x <- c(0, 1, 1, 0, NA, 1, 0, 1)
+  result <- col_binomial_vec(x)
+
+  # Check class
+  testthat::expect_s3_class(result, "projectable_col_binomial")
+  testthat::expect_s3_class(result, "projectable_col")
+
+  # Check calculations: 4 successes out of 7 non-NA values
+  projected <- prj_project_col(result)
+  testthat::expect_identical(projected$n, 4L)
+  testthat::expect_identical(projected$N, 7L)
+  testthat::expect_equal(projected$p, 4/7, tolerance = 0.01)
+})
+
+testthat::test_that("col_binomial_vec: custom range", {
+  # Test with 1-2 range
+  y <- c(1, 2, 2, 1, NA, 2, 1, 2)
+  result <- col_binomial_vec(y, success_value = 2, range = c(1, 2))
+
+  projected <- prj_project_col(result)
+  # 4 successes (2s) out of 7 non-NA values
+  testthat::expect_identical(projected$n, 4L)
+  testthat::expect_identical(projected$N, 7L)
+})
+
+testthat::test_that("col_binomial_vec: values outside range excluded", {
+  # Test that values outside range are excluded
+  z <- c(0, 1, 1, 2, 3, 1, 0, 1)
+  result <- col_binomial_vec(z, success_value = 1, range = c(0, 1))
+
+  projected <- prj_project_col(result)
+  # Only 0s and 1s in range: 0,1,1,1,0,1 = 4 successes out of 6 values
+  testthat::expect_identical(projected$n, 4L)
+  testthat::expect_identical(projected$N, 6L)
+})
+
+testthat::test_that("col_binomial_vec: multiple success values", {
+  # Test with multiple success values
+  z <- c(1, 2, 3, 4, 5, NA, 2, 3)
+  result <- col_binomial_vec(z, success_value = c(2, 3), range = c(1, 5))
+
+  projected <- prj_project_col(result)
+  # Success values 2 and 3 appear 4 times out of 7 non-NA values
+  testthat::expect_identical(projected$n, 4L)
+  testthat::expect_identical(projected$N, 7L)
+})
+
+testthat::test_that("col_binomial_vec: NULL range includes all", {
+  # Test with NULL range (include all non-NA values)
+  w <- c(1, 5, 10, NA, 5, 1, 5)
+  result <- col_binomial_vec(w, success_value = 5, range = NULL)
+
+  projected <- prj_project_col(result)
+  # 3 successes (5s) out of 6 non-NA values
+  testthat::expect_identical(projected$n, 3L)
+  testthat::expect_identical(projected$N, 6L)
+})
+
+testthat::test_that("col_binomial_vec: all NA handling", {
+  # Test with all NA values
+  all_na <- c(NA, NA, NA)
+  result <- col_binomial_vec(all_na)
+
+  projected <- prj_project_col(result)
+  testthat::expect_identical(projected$n, 0L)
+  testthat::expect_identical(projected$N, 0L)
+})
+
+testthat::test_that("col_binomial_vec: error on invalid range", {
+  # Test that invalid range produces error
+  x <- c(0, 1, 1, 0)
+  testthat::expect_error(
+    col_binomial_vec(x, range = c(0, 1, 2)),
+    "`range` must be a vector of length 2 or NULL"
+  )
+})
+
+testthat::test_that("col_binomial_vec: parameters passed through", {
+  # Test that ci_error and other parameters are passed through
+  x <- c(0, 1, 1, 0, 1, 1, 0, 1)
+  result <- col_binomial_vec(x, ci_error = 0.01)
+
+  projected <- prj_project_col(result)
+  testthat::expect_identical(projected$ci_error, 0.01)
+})
+
 
 # prj_project_col ---------------------------------------------------------
 testthat::test_that("prj_project_col", {