diff --git a/NAMESPACE b/NAMESPACE index 5fc1e30..400a054 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/col_binomial.R b/R/col_binomial.R index 8c54282..85be5ef 100644 --- a/R/col_binomial.R +++ b/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 + ) +} diff --git a/tests/testthat/test-col.R b/tests/testthat/test-col.R index b0ff9cc..d010d15 100644 --- a/tests/testthat/test-col.R +++ b/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", {