test_that("c() with psw objects of different estimands warns and returns correct numeric values", { x <- psw(c(0.5, 0.7), estimand = "ate") y <- psw(c(0.3, 0.8), estimand = "att") # Test c() function specifically expect_propensity_warning( result <- c(x, y) ) expect_type(result, "double") expect_equal(result, c(0.5, 0.7, 0.3, 0.8)) expect_equal(length(result), 4) # Test with more values - note: when mixing with double, different warning z <- psw(c(0.1, 0.2, 0.9), estimand = "ato") expect_propensity_warning( expect_propensity_warning( result2 <- c(x, y, z) ) ) expect_equal(result2, c(0.5, 0.7, 0.3, 0.8, 0.1, 0.2, 0.9)) expect_equal(length(result2), 7) }) test_that("c() with psw objects of same estimand combines without warning", { x <- psw(c(0.5, 0.7), estimand = "ate") y <- psw(c(0.3, 0.8), estimand = "ate") z <- psw(c(0.1, 0.9), estimand = "ate") expect_silent(result <- c(x, y, z)) expect_s3_class(result, "psw") expect_equal(estimand(result), "ate") expect_equal(as.numeric(result), c(0.5, 0.7, 0.3, 0.8, 0.1, 0.9)) expect_equal(length(result), 6) }) test_that("c() with psw and numeric values warns and returns numeric", { x <- psw(c(0.5, 0.7), estimand = "ate") # psw with single numeric expect_propensity_warning( result <- c(x, 0.9) ) expect_type(result, "double") expect_equal(result, c(0.5, 0.7, 0.9)) # numeric first - no warning because numeric method is called result2 <- c(0.1, x) expect_type(result2, "double") expect_equal(result2, c(0.1, 0.5, 0.7)) # psw with multiple numerics expect_propensity_warning( result3 <- c(x, c(0.2, 0.3)) ) expect_equal(result3, c(0.5, 0.7, 0.2, 0.3)) # Mixed order - numeric first means no warning result4 <- c(0.1, x, 0.9, c(0.2, 0.3)) expect_type(result4, "double") expect_equal(result4, c(0.1, 0.5, 0.7, 0.9, 0.2, 0.3)) }) test_that("c() with ps_trim objects of different parameters warns and returns numeric", { x <- ps_trim(c(0.1, 0.5, 0.9), lower = 0.1, upper = 0.9) y <- ps_trim(c(0.2, 0.6, 0.8), lower = 0.2, upper = 0.8) expect_propensity_warning( result <- c(x, y) ) expect_type(result, "double") # ps_trim might have NAs for trimmed values expect_equal(length(result), 6) expect_true(all(result[!is.na(result)] >= 0 & result[!is.na(result)] <= 1)) }) test_that("c() with ps_trim objects of same parameters combines correctly", { x <- ps_trim(c(0.2, 0.5, 0.8), method = "ps", lower = 0.1, upper = 0.9) y <- ps_trim(c(0.3, 0.6, 0.7), method = "ps", lower = 0.1, upper = 0.9) expect_silent(result <- c(x, y)) expect_s3_class(result, "ps_trim") expect_equal(length(result), 6) # Values should be preserved (no NAs since all are within bounds) expect_equal( as.numeric(result[!is.na(result)]), c(0.2, 0.5, 0.8, 0.3, 0.6, 0.7)[!is.na(c(x, y))] ) }) test_that("c() with ps_trunc objects behaves correctly", { # Different parameters x <- ps_trunc(c(0.1, 0.5, 0.9), lower = 0.2, upper = 0.8) y <- ps_trunc(c(0.15, 0.6, 0.85), lower = 0.3, upper = 0.7) expect_propensity_warning( result <- c(x, y) ) expect_type(result, "double") expect_equal(result, c(0.2, 0.5, 0.8, 0.3, 0.6, 0.7)) # truncated values # Same parameters x2 <- ps_trunc(c(0.1, 0.5, 0.9), lower = 0.2, upper = 0.8) y2 <- ps_trunc(c(0.15, 0.6, 0.85), lower = 0.2, upper = 0.8) expect_silent(result2 <- c(x2, y2)) expect_s3_class(result2, "ps_trunc") expect_equal(as.numeric(result2), c(0.2, 0.5, 0.8, 0.2, 0.6, 0.8)) }) test_that("c() with mixed propensity classes warns and returns numeric", { psw_obj <- psw(c(0.5, 0.7), estimand = "ate") trim_obj <- ps_trim(c(0.3, 0.8), lower = 0.1, upper = 0.9) trunc_obj <- ps_trunc(c(0.4, 0.6), lower = 0.1, upper = 0.9) # psw + ps_trim expect_propensity_warning( result1 <- c(psw_obj, trim_obj) ) expect_type(result1, "double") expect_equal(length(result1), 4) # psw + ps_trunc expect_propensity_warning( result2 <- c(psw_obj, trunc_obj) ) expect_type(result2, "double") expect_equal(result2, c(0.5, 0.7, 0.4, 0.6)) # ps_trim + ps_trunc expect_propensity_warning( result3 <- c(trim_obj, trunc_obj) ) expect_type(result3, "double") expect_equal(length(result3), 4) # All three - gets multiple warnings expect_propensity_warning( expect_propensity_warning( result4 <- c(psw_obj, trim_obj, trunc_obj) ) ) expect_type(result4, "double") expect_equal(length(result4), 6) }) test_that("c() with empty vectors works correctly", { x <- psw(c(0.5, 0.7), estimand = "ate") empty_psw <- psw(double(), estimand = "ate") empty_numeric <- double() # psw with empty psw result1 <- c(x, empty_psw) expect_s3_class(result1, "psw") expect_equal(as.numeric(result1), c(0.5, 0.7)) # psw with empty numeric - warns in current implementation expect_propensity_warning( result2 <- c(x, empty_numeric) ) expect_type(result2, "double") expect_equal(result2, c(0.5, 0.7)) # empty psw with numeric expect_propensity_warning( result3 <- c(empty_psw, 0.5) ) expect_equal(result3, 0.5) }) test_that("c() with single values works correctly", { x <- psw(0.5, estimand = "ate") y <- psw(0.7, estimand = "att") expect_propensity_warning( result <- c(x, y) ) expect_equal(result, c(0.5, 0.7)) # Single with vector z <- psw(c(0.1, 0.2), estimand = "ato") expect_propensity_warning( result2 <- c(x, z) ) expect_equal(result2, c(0.5, 0.1, 0.2)) }) test_that("c() preserves attributes when metadata matches", { x <- new_psw(c(0.5, 0.7), estimand = "ate", stabilized = TRUE) y <- new_psw(c(0.3, 0.8), estimand = "ate", stabilized = TRUE) result <- c(x, y) expect_s3_class(result, "psw") expect_equal(estimand(result), "ate") expect_true(is_stabilized(result)) expect_equal(as.numeric(result), c(0.5, 0.7, 0.3, 0.8)) }) test_that("c() with different stabilization status warns", { x <- new_psw(c(0.5, 0.7), estimand = "ate", stabilized = TRUE) y <- new_psw(c(0.3, 0.8), estimand = "ate", stabilized = FALSE) expect_propensity_warning( result <- c(x, y) ) expect_type(result, "double") expect_equal(result, c(0.5, 0.7, 0.3, 0.8)) }) test_that("subsetting operations work correctly", { x <- psw(c(0.1, 0.5, 0.7, 0.9), estimand = "ate") y <- psw(c(0.2, 0.6), estimand = "att") # Subset then combine expect_propensity_warning( result <- c(x[1:2], y) ) expect_equal(result, c(0.1, 0.5, 0.2, 0.6)) # Combine subsets expect_propensity_warning( result2 <- c(x[c(1, 3)], y[2]) ) expect_equal(result2, c(0.1, 0.7, 0.6)) }) test_that("append() works like c()", { x <- psw(c(0.5, 0.7), estimand = "ate") y <- psw(c(0.3, 0.8), estimand = "att") expect_propensity_warning( result <- append(x, y) ) expect_type(result, "double") expect_equal(result, c(0.5, 0.7, 0.3, 0.8)) # With after argument - more complex due to subsetting # append() triggers warnings but we'll suppress and check result result2 <- suppressWarnings(append(x, y, after = 1)) expect_equal(result2, c(0.5, 0.3, 0.8, 0.7)) }) test_that("unlist() works correctly", { x <- psw(c(0.5, 0.7), estimand = "ate") y <- psw(c(0.3, 0.8), estimand = "att") lst <- list(a = x, b = y) # unlist doesn't go through vctrs so no warning result <- unlist(lst) expect_type(result, "double") expect_equal(as.numeric(result), c(0.5, 0.7, 0.3, 0.8)) expect_equal(names(result), c("a1", "a2", "b1", "b2")) }) test_that("data.frame operations work as expected", { df1 <- data.frame( id = 1:3, wt = psw(c(0.5, 0.7, 0.3), estimand = "ate") ) df2 <- data.frame( id = 4:6, wt = psw(c(0.8, 0.2, 0.6), estimand = "att") ) # rbind maintains psw class when estimands match for first data frame # but converts to numeric when they don't match result1 <- rbind(df1, df2) expect_equal(nrow(result1), 6) # rbind preserves the first object's class expect_s3_class(result1$wt, "psw") expect_equal(as.numeric(result1$wt), c(0.5, 0.7, 0.3, 0.8, 0.2, 0.6)) # But vec_rbind does trigger the warning expect_propensity_warning( result2 <- vctrs::vec_rbind(df1, df2) ) expect_equal(nrow(result2), 6) expect_type(result2$wt, "double") expect_equal(result2$wt, c(0.5, 0.7, 0.3, 0.8, 0.2, 0.6)) }) test_that("vctrs vec_ptype2 returns appropriate prototypes", { x <- psw(c(0.5, 0.7), estimand = "ate") y <- psw(c(0.3, 0.8), estimand = "att") # This is what vctrs uses internally - verify it returns empty double expect_propensity_warning( proto <- vec_ptype2(x, y) ) expect_identical(proto, double()) expect_equal(length(proto), 0) # Compatible objects return psw prototype z <- psw(c(0.1, 0.2), estimand = "ate") expect_silent(proto2 <- vec_ptype2(x, z)) expect_s3_class(proto2, "psw") expect_equal(length(proto2), 0) }) test_that("arithmetic operations with different metadata work correctly", { x <- psw(c(0.5, 0.7), estimand = "ate") y <- psw(c(0.3, 0.8), estimand = "att") # These should create psw objects but with combined estimand info result <- x + y expect_s3_class(result, "psw") expect_equal(estimand(result), "ate, att") expect_equal(as.numeric(result), c(0.8, 1.5)) result2 <- x * y expect_s3_class(result2, "psw") expect_equal(as.numeric(result2), c(0.15, 0.56)) }) test_that("comparison operations warn about class downgrade", { x <- psw(c(0.5, 0.7), estimand = "ate") expect_propensity_warning( result <- x > 0.6 ) expect_equal(result, c(FALSE, TRUE)) expect_propensity_warning( result2 <- x == 0.5 ) expect_equal(result2, c(TRUE, FALSE)) }) test_that("interaction with base R functions work correctly", { x <- psw(c(0.5, 0.7, 0.3), estimand = "ate") # sum, mean, etc should return numeric expect_equal(sum(x), 1.5) expect_equal(mean(x), 0.5) expect_equal(min(x), 0.3) expect_equal(max(x), 0.7) # These return numeric as expected expect_type(sum(x), "double") expect_type(mean(x), "double") }) test_that("c() ordering matters for warnings", { x <- psw(c(0.5, 0.7), estimand = "ate") num <- c(0.3, 0.4) # psw first triggers warning expect_propensity_warning( result1 <- c(x, num) ) expect_equal(result1, c(0.5, 0.7, 0.3, 0.4)) # numeric first doesn't trigger our warning (uses base c()) result2 <- c(num, x) expect_type(result2, "double") expect_equal(result2, c(0.3, 0.4, 0.5, 0.7)) })