diff --git a/R/get_marginal_effect.R b/R/get_marginal_effect.R index e2f7dbf..28fb014 100644 --- a/R/get_marginal_effect.R +++ b/R/get_marginal_effect.R @@ -60,6 +60,10 @@ #' marginal_se \tab Standard error estimate of the marginal treatment effect estimate. \cr #' marginal_results \tab Analysis results data (ARD) containing a summary of the analysis for subsequent reporting. \cr #' } +#' Note, the returned object is also appended with a `beeca` object class. This enables additional +#' functions to support extracting the marginal effect estimates from the object without +#' interacting with generic functions associated with the glm object. +#' #' @importFrom utils packageVersion #' @export #' @examples diff --git a/R/tidy_beeca.R b/R/tidy_beeca.R index 84ac4b3..b4efeef 100644 --- a/R/tidy_beeca.R +++ b/R/tidy_beeca.R @@ -1,8 +1,8 @@ -#' Tidy a beeca object +#' Tidy a beeca/glm object #' #' The broom package exports a tidier for `"glm"` objects. #' This function adds on top of that and returns more information -#' that is stored from gcomputation. +#' that is stored from g-computation. #' #' The function also utilizes additional information stored when the #' glm object is created with `get_marginal_effect()`. diff --git a/tests/testthat/test-tidy_beeca.R b/tests/testthat/test-tidy_beeca.R index 8849056..d4b442b 100644 --- a/tests/testthat/test-tidy_beeca.R +++ b/tests/testthat/test-tidy_beeca.R @@ -1,3 +1,49 @@ -test_that("multiplication works", { - expect_equal(2 * 2, 4) +# set up example ---------------------------------------------------------- +data <- trial01 +data$trtp <- factor(data$trtp) +data_complete <- na.omit(data) + +## Fit a logistic regression working model and pass it to beeca +fit <- glm(aval ~ trtp + bl_cov, family = binomial(link = "logit"), data = data_complete) |> + get_marginal_effect(trt="trtp", method="Ye", contrast="diff", reference = "0") + + +test_that("tidy_beeca stops if input is not a 'beeca' object", { + non_beeca_object <- lm(mpg ~ wt, data = mtcars) + expect_error(tidy_beeca(non_beeca_object), "x must be a 'beeca' object") }) + + +test_that("tidy_beeca returns a tibble", { + result <- tidy_beeca(fit) + expect_true(tibble::is_tibble(result)) +}) + +test_that("tidy_beeca returns correct columns without confidence intervals", { + result <- tidy_beeca(fit, conf.int = FALSE) + expect_named(result, c("term", "contrast", "estimate", "std.error", "statistic", "p.value")) +}) + +test_that("tidy_beeca returns correct columns with confidence intervals", { + result <- tidy_beeca(fit, conf.int = TRUE) + expect_named(result, c("term", "contrast", "estimate", "std.error", "statistic", "p.value", "conf.low", "conf.high")) +}) + +test_that("tidy_beeca computes confidence intervals correctly", { + result <- tidy_beeca(fit, conf.int = TRUE, conf.level = 0.95) + conf.low <- result$estimate - qnorm(1 - 0.95 / 2) * result$std.error + conf.high <- result$estimate + qnorm(1 - 0.95 / 2) * result$std.error + expect_equal(result$conf.low, conf.low, tolerance = 1e-8) + expect_equal(result$conf.high, conf.high, tolerance = 1e-8) +}) + + +test_that("tidy_beeca returns correct values", { + result <- tidy_beeca(fit, conf.int = FALSE) + expect_equal(result$term, "trtp") + expect_equal(result$estimate, fit$marginal_results$STATVAL[fit$marginal_results$STAT == "diff"]) + expect_equal(result$std.error, fit$marginal_results$STATVAL[fit$marginal_results$STAT == "diff_se"]) + expect_equal(result$statistic, NA) + expect_equal(result$p.value, NA) +}) +