Skip to content

Commit

Permalink
add print method for prop_ci and or_ci classes
Browse files Browse the repository at this point in the history
  • Loading branch information
kaigu1990 committed Feb 2, 2024
1 parent e0ce538 commit 8128dfb
Show file tree
Hide file tree
Showing 6 changed files with 99 additions and 22 deletions.
2 changes: 2 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
# Generated by roxygen2: do not edit by hand

S3method(print,or_ci)
S3method(print,prop_ci)
S3method(print,s_lsmeans)
export("%>%")
export(h_prep_prop)
Expand Down
41 changes: 41 additions & 0 deletions R/pkg-methods.R
Original file line number Diff line number Diff line change
Expand Up @@ -33,3 +33,44 @@ print.s_lsmeans <- function(x, ...) {

invisible(x)
}

#' @describeIn prop_odds_ratio prints proportion and confidence interval.
#' @exportS3Method
#' @keywords internal
print.prop_ci <- function(x, ...) {
cat(sprintf("Proportion and %s confidence interval:", x$params$method))
cat("\n")
print(x$prop_est)

if (!is.null(x$params$by.level)) {
cat(sprintf("\nProportion Difference and %s confidence interval:", x$params$diff.method))
cat("\n")
print(x$prop_diff)
}

invisible(x)
}

#' @describeIn prop_odds_ratio prints odds ratio and confidence interval.
#' @exportS3Method
#' @keywords internal
print.or_ci <- function(x, ...) {
comp <- paste0(rev(x$params$by.level), collapse = "/")
cat(sprintf("Common Odds Ratio (%s) and %s confidence interval:", comp, x$params$or.method))
cat("\n")
print(x$or)

if (!is.null(x$params$strata)) {
cat(sprintf(
"\nStratified Odds Ratio (%s) using %s", comp,
ifelse(x$params$strata.method == "CMH",
"Cochran-Mantel-Haenszel Chi-Squared Test:",
"Conditional logistic regression:"
)
))
cat("\n")
print(x$strata_or)
}

invisible(x)
}
19 changes: 13 additions & 6 deletions R/proportion.R
Original file line number Diff line number Diff line change
Expand Up @@ -264,7 +264,9 @@ s_odds_ratio <- function(data,
# follow the preferred 2x2 table structure
DescTools::OddsRatio(method = or.method, conf.level = conf.level)
}
or_res <- setNames(or_res, c("or.est", "lwr.ci", "upr.ci"))
or_res <- tibble::tibble(
!!!setNames(or_res, c("or.est", "lwr.ci", "upr.ci"))
)

stra_or_res <- if (!is.null(strata)) {
if (strata.method == "CMH") {
Expand All @@ -279,12 +281,15 @@ s_odds_ratio <- function(data,
purrr::map_int(nrow)
tb <- as.table(array(c(tab), dim = c(2, 2, prod(grpn))))
mod <- stats::mantelhaen.test(
tb, conf.level = conf.level,
tb,
conf.level = conf.level,
correct = correct, exact = exact
)
setNames(
c(mod$estimate, mod$conf.int, mod$p.value),
c("or.est", "lwr.ci", "upr.ci", "pval")
tibble::tibble(
!!!setNames(
c(mod$estimate, mod$conf.int, mod$p.value),
c("or.est", "lwr.ci", "upr.ci", "pval")
)
)
} else {
mod <- survival::clogit(
Expand All @@ -305,7 +310,8 @@ s_odds_ratio <- function(data,
row.names = gsub(pattern = paste0("^", by), x = .x, "")
)
) %>%
purrr::list_rbind()
purrr::list_rbind() %>%
tibble::tibble()
}
} else {
NULL
Expand All @@ -320,6 +326,7 @@ s_odds_ratio <- function(data,
by = by,
by.level = object$by.level,
event = object$event,
strata = strata,
conf.level = conf.level,
or.method = ifelse(or.glm, "logit", or.method),
strata.method = ifelse(
Expand Down
17 changes: 14 additions & 3 deletions man/prop_odds_ratio.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

9 changes: 6 additions & 3 deletions tests/spelling.R
Original file line number Diff line number Diff line change
@@ -1,3 +1,6 @@
if(requireNamespace('spelling', quietly = TRUE))
spelling::spell_check_test(vignettes = TRUE, error = FALSE,
skip_on_cran = TRUE)
if (requireNamespace("spelling", quietly = TRUE)) {
spelling::spell_check_test(
vignettes = TRUE, error = FALSE,
skip_on_cran = TRUE
)
}
33 changes: 23 additions & 10 deletions tests/testthat/test-proportion.R
Original file line number Diff line number Diff line change
Expand Up @@ -119,7 +119,11 @@ test_that("s_odds_ratio works as expected with default arguments, no stratificat
expect_null(res$strata_or)
expect_equal(
res$or,
setNames(c(0.8484848, 0.3831831, 1.8788054), c("or.est", "lwr.ci", "upr.ci")),
tibble::tibble(
or.est = 0.8484848,
lwr.ci = 0.3831831,
upr.ci = 1.8788054
),
tolerance = 0.0001
)
expect_equal(
Expand All @@ -129,6 +133,7 @@ test_that("s_odds_ratio works as expected with default arguments, no stratificat
by = "trtp",
by.level = c("PBO", "TRT"),
event = 1,
strata = NULL,
conf.level = 0.95,
or.method = "wald",
strata.method = NA
Expand All @@ -153,9 +158,11 @@ test_that("s_odds_ratio works as expected with stratification", {
)
expect_equal(
res$strata_or,
setNames(
c(0.7499121, 0.3248143, 1.7313529, 0.5089342),
c("or.est", "lwr.ci", "upr.ci", "pval")
tibble::tibble(
or.est = 0.7499121,
lwr.ci = 0.3248143,
upr.ci = 1.7313529,
pval = 0.5089342
),
tolerance = 0.0001
)
Expand All @@ -181,16 +188,22 @@ test_that("s_odds_ratio works as expected using or.glm and clogit", {
)
expect_equal(
res$or,
setNames(c(0.8484848, 0.3811997, 1.8797355), c("or.est", "lwr.ci", "upr.ci")),
tibble::tibble(
or.est = 0.8484848,
lwr.ci = 0.3811997,
upr.ci = 1.8797355
),
tolerance = 0.0001
)
expect_equal(
res$strata_or,
data.frame(
or.est = 0.7592608,
lwr.ci = 0.335024,
upr.ci = 1.720704,
row.names = "TRT"
tibble::tibble(
data.frame(
or.est = 0.7592608,
lwr.ci = 0.335024,
upr.ci = 1.720704,
row.names = "TRT"
)
),
tolerance = 0.0001
)
Expand Down

0 comments on commit 8128dfb

Please sign in to comment.