From aa4e0e183729535ab7e9458ab3a247d7a1f697b6 Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Tue, 23 Dec 2025 12:48:44 +0000 Subject: [PATCH 1/4] Initial plan From 7b28821e6603e4218351e59e9f08988cea8a15e2 Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Tue, 23 Dec 2025 12:57:02 +0000 Subject: [PATCH 2/4] Add col_binomial_vec wrapper function with tests Co-authored-by: g-hyo <14864611+g-hyo@users.noreply.github.com> --- NAMESPACE | 1 + R/col_binomial.R | 72 +++++++++++++++++++++++++++++++ tests/testthat/test-col.R | 90 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 163 insertions(+) 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..ad1eb06 100644 --- a/R/col_binomial.R +++ b/R/col_binomial.R @@ -180,3 +180,75 @@ 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) + } + x_filtered <- ifelse(x >= range[1] & x <= range[2], x, 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..3c4ee6e 100644 --- a/tests/testthat/test-col.R +++ b/tests/testthat/test-col.R @@ -267,6 +267,96 @@ testthat::test_that("col_binomial can handle NAs", { 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 3 times out of 7 non-NA values + testthat::expect_identical(projected$n, 3L) + 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", { From 0d0aca88d8ee83ec337e6dd804dbd8f474699fdc Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Tue, 23 Dec 2025 12:59:03 +0000 Subject: [PATCH 3/4] Fix NA handling in range filter and correct test expectations Co-authored-by: g-hyo <14864611+g-hyo@users.noreply.github.com> --- R/col_binomial.R | 2 +- tests/testthat/test-col.R | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/col_binomial.R b/R/col_binomial.R index ad1eb06..08fd067 100644 --- a/R/col_binomial.R +++ b/R/col_binomial.R @@ -231,7 +231,7 @@ col_binomial_vec <- function(x, if (length(range) != 2) { stop("`range` must be a vector of length 2 or NULL", call. = FALSE) } - x_filtered <- ifelse(x >= range[1] & x <= range[2], x, NA) + x_filtered <- ifelse(!is.na(x) & x >= range[1] & x <= range[2], x, NA) } else { x_filtered <- x } diff --git a/tests/testthat/test-col.R b/tests/testthat/test-col.R index 3c4ee6e..95a12db 100644 --- a/tests/testthat/test-col.R +++ b/tests/testthat/test-col.R @@ -313,8 +313,8 @@ testthat::test_that("col_binomial_vec: multiple success values", { 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 3 times out of 7 non-NA values - testthat::expect_identical(projected$n, 3L) + # 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) }) From 608e63911a82b5e7885ec4d37242c85000ab9b5a Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Tue, 23 Dec 2025 13:02:24 +0000 Subject: [PATCH 4/4] Improve range filtering logic and use TRUE instead of T Co-authored-by: g-hyo <14864611+g-hyo@users.noreply.github.com> --- R/col_binomial.R | 5 ++++- tests/testthat/test-col.R | 2 +- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/R/col_binomial.R b/R/col_binomial.R index 08fd067..85be5ef 100644 --- a/R/col_binomial.R +++ b/R/col_binomial.R @@ -231,7 +231,10 @@ col_binomial_vec <- function(x, if (length(range) != 2) { stop("`range` must be a vector of length 2 or NULL", call. = FALSE) } - x_filtered <- ifelse(!is.na(x) & x >= range[1] & x <= range[2], x, NA) + # 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 } diff --git a/tests/testthat/test-col.R b/tests/testthat/test-col.R index 95a12db..d010d15 100644 --- a/tests/testthat/test-col.R +++ b/tests/testthat/test-col.R @@ -262,7 +262,7 @@ 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) })