diff --git a/NEWS.md b/NEWS.md index 8b804e559..15f528ee0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # rbmi (development version) +## New Features +* `pool()` now returns `df` and in the `data.frame` returned by `as.data.frame.pool()`. + ## Bug Fixes * Added en-GB spell-check and a corresponding test to the package * Fixed numerous spelling errors and standardised nomenclature for missing not diff --git a/R/pool.R b/R/pool.R index b18cc493d..58950cd34 100644 --- a/R/pool.R +++ b/R/pool.R @@ -158,6 +158,7 @@ pool_internal.jackknife <- function(results, conf.level, alternative, type, D) { N_jack <- length(ests_jack) se_jack <- sqrt(((N_jack - 1) / N_jack) * sum((ests_jack - mean_jack)^2)) ret <- parametric_ci(est_point, se_jack, alpha, alternative, qnorm, pnorm) + ret$df <- NA_real_ return(ret) } @@ -179,6 +180,7 @@ pool_internal.bootstrap <- function( ) ret <- bootfun(results$est, conf.level, alternative) + ret$df <- NA_real_ return(ret) } @@ -207,6 +209,7 @@ pool_internal.bmlmi <- function( pfun = pt, df = pooled_est$df ) + ret$df <- pooled_est$df return(ret) } @@ -302,6 +305,7 @@ pool_internal.rubin <- function(results, conf.level, alternative, type, D) { pfun = pt, df = res_rubin$df ) + ret$df <- res_rubin$df return(ret) } @@ -391,8 +395,8 @@ rubin_rules <- function(ests, ses, v_com) { return( list( est_point = est_point, - var_t = NA, - df = NA + var_t = NA_real_, + df = NA_real_ ) ) } @@ -676,10 +680,15 @@ as_data_frame_internal <- function(x) { msg = "`x` must be a pool or mcse object" ) + df_col <- vapply(x$pars, function(p) { + if (is.null(p$df)) NA_real_ else p$df + }, numeric(1)) + data.frame( parameter = names(x$pars), est = vapply(x$pars, function(x) x$est, numeric(1)), se = vapply(x$pars, function(x) x$se, numeric(1)), + df = df_col, lci = vapply(x$pars, function(x) x$ci[[1]], numeric(1)), uci = vapply(x$pars, function(x) x$ci[[2]], numeric(1)), pval = vapply(x$pars, function(x) x$pvalue, numeric(1)), diff --git a/tests/testthat/_snaps/pool.md b/tests/testthat/_snaps/pool.md index 7557ddb71..eeae00d43 100644 --- a/tests/testthat/_snaps/pool.md +++ b/tests/testthat/_snaps/pool.md @@ -10,18 +10,18 @@ Results: - ========================================================= - parameter est se lci uci pval - --------------------------------------------------------- - trt_visit_1 0.078 0.024 0.058 0.12 0.07057 - lsm_ref_visit_1 0.031 0.005 0.031 0.034 < 0.000001 - lsm_alt_visit_1 0.071 0.025 0.081 0.101 < 0.000001 - trt_visit_2 0.104 0.025 0.14 0.088 0.00057 - lsm_ref_visit_2 0.064 0.016 0.052 0.088 < 0.000001 - lsm_alt_visit_2 0.068 0.009 0.073 0.068 < 0.000001 - trt_visit_3 0.107 0.023 0.094 0.136 0.00093 - lsm_ref_visit_3 0.096 0.021 0.097 0.115 < 0.000001 - lsm_alt_visit_3 0.087 0.021 0.074 0.117 < 0.000001 - --------------------------------------------------------- + ================================================================= + parameter est se df lci uci pval + ----------------------------------------------------------------- + trt_visit_1 0.078 0.024 12.486 0.058 0.12 0.07057 + lsm_ref_visit_1 0.031 0.005 2.876 0.031 0.034 < 0.000001 + lsm_alt_visit_1 0.071 0.025 13.915 0.081 0.101 < 0.000001 + trt_visit_2 0.104 0.025 8.182 0.14 0.088 0.00057 + lsm_ref_visit_2 0.064 0.016 7.349 0.052 0.088 < 0.000001 + lsm_alt_visit_2 0.068 0.009 4.328 0.073 0.068 < 0.000001 + trt_visit_3 0.107 0.023 5.265 0.094 0.136 0.00093 + lsm_ref_visit_3 0.096 0.021 6.922 0.097 0.115 < 0.000001 + lsm_alt_visit_3 0.087 0.021 7.575 0.074 0.117 < 0.000001 + ----------------------------------------------------------------- diff --git a/tests/testthat/_snaps/print.md b/tests/testthat/_snaps/print.md index 96c3e676f..0f0c9bbda 100644 --- a/tests/testthat/_snaps/print.md +++ b/tests/testthat/_snaps/print.md @@ -13,16 +13,16 @@ Results: - ======================================================== - parameter est se lci uci pval - -------------------------------------------------------- - trt_visit_1 7.253 0.781 5.665 8.842 <0.001 - lsm_ref_visit_1 7.254 0.566 6.102 8.406 <0.001 - lsm_alt_visit_1 14.507 0.479 13.533 15.481 <0.001 - trt_visit_3 7.984 0.258 7.448 8.52 <0.001 - lsm_ref_visit_3 7.005 0.205 6.575 7.436 <0.001 - lsm_alt_visit_3 14.989 0.167 14.641 15.338 <0.001 - -------------------------------------------------------- + ============================================================== + parameter est se df lci uci pval + -------------------------------------------------------------- + trt_visit_1 7.253 0.781 5.665 8.842 <0.001 + lsm_ref_visit_1 7.254 0.566 6.102 8.406 <0.001 + lsm_alt_visit_1 14.507 0.479 13.533 15.481 <0.001 + trt_visit_3 7.984 0.258 7.448 8.52 <0.001 + lsm_ref_visit_3 7.005 0.205 6.575 7.436 <0.001 + lsm_alt_visit_3 14.989 0.167 14.641 15.338 <0.001 + -------------------------------------------------------------- --- @@ -40,19 +40,19 @@ Results: - =================================================== - parameter est se lci uci pval - --------------------------------------------------- - trt_visit_1 7.253 0.781 6.232 Inf 1 - lsm_ref_visit_1 7.254 0.566 6.513 Inf 1 - lsm_alt_visit_1 14.507 0.479 13.881 Inf 1 - trt_visit_2 7.406 0.388 6.898 Inf 1 - lsm_ref_visit_2 7.011 0.282 6.643 Inf 1 - lsm_alt_visit_2 14.417 0.238 14.106 Inf 1 - trt_visit_3 5.359 1.092 3.929 Inf 1 - lsm_ref_visit_3 6.723 0.835 5.624 Inf 1 - lsm_alt_visit_3 12.082 0.658 11.222 Inf 1 - --------------------------------------------------- + ========================================================= + parameter est se df lci uci pval + --------------------------------------------------------- + trt_visit_1 7.253 0.781 6.232 Inf 1 + lsm_ref_visit_1 7.254 0.566 6.513 Inf 1 + lsm_alt_visit_1 14.507 0.479 13.881 Inf 1 + trt_visit_2 7.406 0.388 6.898 Inf 1 + lsm_ref_visit_2 7.011 0.282 6.643 Inf 1 + lsm_alt_visit_2 14.417 0.238 14.106 Inf 1 + trt_visit_3 5.359 1.092 3.929 Inf 1 + lsm_ref_visit_3 6.723 0.835 5.624 Inf 1 + lsm_alt_visit_3 12.082 0.658 11.222 Inf 1 + --------------------------------------------------------- --- @@ -70,19 +70,19 @@ Results: - ===================================================== - parameter est se lci uci pval - ----------------------------------------------------- - trt_visit_1 6.643 -Inf 7.383 <0.001 - lsm_ref_visit_1 7.605 -Inf 8.126 <0.001 - lsm_alt_visit_1 14.248 -Inf 15.088 <0.001 - trt_visit_2 6.906 -Inf 7.944 <0.001 - lsm_ref_visit_2 7.299 -Inf 7.666 <0.001 - lsm_alt_visit_2 14.205 -Inf 14.977 <0.001 - trt_visit_3 4.118 -Inf 4.257 <0.001 - lsm_ref_visit_3 7.514 -Inf 8.083 <0.001 - lsm_alt_visit_3 11.632 -Inf 11.837 <0.001 - ----------------------------------------------------- + =========================================================== + parameter est se df lci uci pval + ----------------------------------------------------------- + trt_visit_1 6.643 -Inf 7.383 <0.001 + lsm_ref_visit_1 7.605 -Inf 8.126 <0.001 + lsm_alt_visit_1 14.248 -Inf 15.088 <0.001 + trt_visit_2 6.906 -Inf 7.944 <0.001 + lsm_ref_visit_2 7.299 -Inf 7.666 <0.001 + lsm_alt_visit_2 14.205 -Inf 14.977 <0.001 + trt_visit_3 4.118 -Inf 4.257 <0.001 + lsm_ref_visit_3 7.514 -Inf 8.083 <0.001 + lsm_alt_visit_3 11.632 -Inf 11.837 <0.001 + ----------------------------------------------------------- --- @@ -100,19 +100,19 @@ Results: - ====================================================== - parameter est se lci uci pval - ------------------------------------------------------ - trt_visit_1 6.643 0.561 -Inf 7.565 <0.001 - lsm_ref_visit_1 7.605 1.057 -Inf 9.343 <0.001 - lsm_alt_visit_1 14.248 1.163 -Inf 16.161 <0.001 - trt_visit_2 6.906 0.852 -Inf 8.308 <0.001 - lsm_ref_visit_2 7.299 1.114 -Inf 9.13 <0.001 - lsm_alt_visit_2 14.205 0.984 -Inf 15.823 <0.001 - trt_visit_3 4.118 0.663 -Inf 5.208 <0.001 - lsm_ref_visit_3 7.514 1.003 -Inf 9.165 <0.001 - lsm_alt_visit_3 11.632 1.339 -Inf 13.834 <0.001 - ------------------------------------------------------ + ============================================================ + parameter est se df lci uci pval + ------------------------------------------------------------ + trt_visit_1 6.643 0.561 -Inf 7.565 <0.001 + lsm_ref_visit_1 7.605 1.057 -Inf 9.343 <0.001 + lsm_alt_visit_1 14.248 1.163 -Inf 16.161 <0.001 + trt_visit_2 6.906 0.852 -Inf 8.308 <0.001 + lsm_ref_visit_2 7.299 1.114 -Inf 9.13 <0.001 + lsm_alt_visit_2 14.205 0.984 -Inf 15.823 <0.001 + trt_visit_3 4.118 0.663 -Inf 5.208 <0.001 + lsm_ref_visit_3 7.514 1.003 -Inf 9.165 <0.001 + lsm_alt_visit_3 11.632 1.339 -Inf 13.834 <0.001 + ------------------------------------------------------------ --- @@ -130,19 +130,19 @@ Results: - ======================================================== - parameter est se lci uci pval - -------------------------------------------------------- - trt_visit_1 7.296 0.784 6.006 8.587 <0.001 - lsm_ref_visit_1 7.051 0.766 5.792 8.311 <0.001 - lsm_alt_visit_1 14.348 0.74 13.131 15.564 <0.001 - trt_visit_2 7.363 0.373 6.749 7.977 <0.001 - lsm_ref_visit_2 7.085 0.555 6.173 7.997 <0.001 - lsm_alt_visit_2 14.448 0.599 13.463 15.433 <0.001 - trt_visit_3 4.593 1.063 2.844 6.342 <0.001 - lsm_ref_visit_3 6.469 0.815 5.129 7.809 <0.001 - lsm_alt_visit_3 11.062 0.929 9.534 12.59 <0.001 - -------------------------------------------------------- + ============================================================== + parameter est se df lci uci pval + -------------------------------------------------------------- + trt_visit_1 7.296 0.784 6.006 8.587 <0.001 + lsm_ref_visit_1 7.051 0.766 5.792 8.311 <0.001 + lsm_alt_visit_1 14.348 0.74 13.131 15.564 <0.001 + trt_visit_2 7.363 0.373 6.749 7.977 <0.001 + lsm_ref_visit_2 7.085 0.555 6.173 7.997 <0.001 + lsm_alt_visit_2 14.448 0.599 13.463 15.433 <0.001 + trt_visit_3 4.593 1.063 2.844 6.342 <0.001 + lsm_ref_visit_3 6.469 0.815 5.129 7.809 <0.001 + lsm_alt_visit_3 11.062 0.929 9.534 12.59 <0.001 + -------------------------------------------------------------- --- @@ -160,19 +160,19 @@ Results: - ======================================================== - parameter est se lci uci pval - -------------------------------------------------------- - trt_visit_1 7.039 0.5 6.032 8.047 <0.001 - lsm_ref_visit_1 6.993 1.38 4.212 9.773 0.004 - lsm_alt_visit_1 14.032 1.178 11.658 16.406 <0.001 - trt_visit_2 7.494 0.403 6.681 8.306 <0.001 - lsm_ref_visit_2 6.694 1.278 4.119 9.27 0.003 - lsm_alt_visit_2 14.188 1.013 12.146 16.23 <0.001 - trt_visit_3 4.737 1.142 2.43 7.044 0.009 - lsm_ref_visit_3 6.53 1.097 4.318 8.742 0.002 - lsm_alt_visit_3 11.267 1.753 7.734 14.8 0.001 - -------------------------------------------------------- + ============================================================== + parameter est se df lci uci pval + -------------------------------------------------------------- + trt_visit_1 7.039 0.5 6.032 8.047 <0.001 + lsm_ref_visit_1 6.993 1.38 4.212 9.773 0.004 + lsm_alt_visit_1 14.032 1.178 11.658 16.406 <0.001 + trt_visit_2 7.494 0.403 6.681 8.306 <0.001 + lsm_ref_visit_2 6.694 1.278 4.119 9.27 0.003 + lsm_alt_visit_2 14.188 1.013 12.146 16.23 <0.001 + trt_visit_3 4.737 1.142 2.43 7.044 0.009 + lsm_ref_visit_3 6.53 1.097 4.318 8.742 0.002 + lsm_alt_visit_3 11.267 1.753 7.734 14.8 0.001 + -------------------------------------------------------------- # print - approx bayes diff --git a/tests/testthat/test-pool.R b/tests/testthat/test-pool.R index 4d644fe01..0d691f790 100644 --- a/tests/testthat/test-pool.R +++ b/tests/testthat/test-pool.R @@ -45,8 +45,8 @@ test_that("Rubin's rules", { rubin_rules(ests, ses, v_com), list( est_point = mean(ests), - var_t = NA, - df = NA + var_t = NA_real_, + df = NA_real_ ) ) }) @@ -252,7 +252,8 @@ test_that("Pool (Rubin) works as expected when se = NA in analysis model", { est = real_mu, ci = as.numeric(c(NA, NA)), se = as.numeric(NA), - pvalue = as.numeric(NA) + pvalue = as.numeric(NA), + df = as.numeric(NA) ), tolerance = 1e-2 ) @@ -263,7 +264,8 @@ test_that("Pool (Rubin) works as expected when se = NA in analysis model", { est = real_mu, ci = as.numeric(c(NA, NA)), se = as.numeric(NA), - pvalue = as.numeric(NA) + pvalue = as.numeric(NA), + df = as.numeric(NA) ), tolerance = 1e-2 ) @@ -274,7 +276,8 @@ test_that("Pool (Rubin) works as expected when se = NA in analysis model", { est = real_mu, ci = as.numeric(c(NA, NA)), se = as.numeric(NA), - pvalue = as.numeric(NA) + pvalue = as.numeric(NA), + df = as.numeric(NA) ), tolerance = 1e-2 ) @@ -300,7 +303,8 @@ test_that("Pool (Rubin) works as expected when se = NA in analysis model", { est = real_mu, ci = as.numeric(c(NA, NA)), se = as.numeric(NA), - pvalue = as.numeric(NA) + pvalue = as.numeric(NA), + df = as.numeric(NA) ), tolerance = 1e-2 ) @@ -311,7 +315,8 @@ test_that("Pool (Rubin) works as expected when se = NA in analysis model", { est = real_mu, ci = as.numeric(c(NA, NA)), se = as.numeric(NA), - pvalue = as.numeric(NA) + pvalue = as.numeric(NA), + df = as.numeric(NA) ), tolerance = 1e-2 ) @@ -322,7 +327,8 @@ test_that("Pool (Rubin) works as expected when se = NA in analysis model", { est = real_mu, ci = as.numeric(c(NA, NA)), se = as.numeric(NA), - pvalue = as.numeric(NA) + pvalue = as.numeric(NA), + df = as.numeric(NA) ), tolerance = 1e-2 ) @@ -470,7 +476,8 @@ test_that("Can recover known jackknife with H0 < 0 & H0 > 0", { est = 7, ci = 7 + c(-1, Inf) * qnorm(0.9) * jest_se, se = jest_se, - pvalue = pnorm(7, sd = jest_se, lower.tail = TRUE) + pvalue = pnorm(7, sd = jest_se, lower.tail = TRUE), + df = NA_real_ ) observed <- pool_internal.jackknife( list(est = jest), @@ -488,7 +495,8 @@ test_that("Can recover known jackknife with H0 < 0 & H0 > 0", { est = 7, ci = 7 + c(-Inf, 1) * qnorm(0.9) * jest_se, se = jest_se, - pvalue = pnorm(7, sd = jest_se, lower.tail = FALSE) + pvalue = pnorm(7, sd = jest_se, lower.tail = FALSE), + df = NA_real_ ) expect_equal(observed, expected) @@ -501,7 +509,8 @@ test_that("Can recover known jackknife with H0 < 0 & H0 > 0", { est = 7, ci = 7 + c(-1, 1) * qnorm(0.95) * jest_se, se = jest_se, - pvalue = pnorm(7, sd = jest_se, lower.tail = FALSE) * 2 + pvalue = pnorm(7, sd = jest_se, lower.tail = FALSE) * 2, + df = NA_real_ ) expect_equal(observed, expected) }) @@ -517,7 +526,8 @@ test_that("Can recover known values using bootstrap percentiles", { est = best[1], ci = c(-Inf, x), se = NA, - pvalue = pval + pvalue = pval, + df = NA_real_ ) observed <- pool_internal.bootstrap( list(est = best), @@ -534,7 +544,8 @@ test_that("Can recover known values using bootstrap percentiles", { est = best[1], ci = c(x, Inf), se = NA, - pvalue = pval + pvalue = pval, + df = NA_real_ ) observed <- pool_internal.bootstrap( list(est = best), @@ -552,7 +563,8 @@ test_that("Can recover known values using bootstrap percentiles", { est = best[1], ci = c(x1, x2), se = NA, - pvalue = min(pval) * 2 + pvalue = min(pval) * 2, + df = NA_real_ ) observed <- pool_internal.bootstrap( list(est = best), @@ -570,7 +582,8 @@ test_that("Results of bootstrap percentiles when n_samples = 0 or 1", { est = best[1], ci = c(NA, NA), se = NA, - pvalue = NA + pvalue = NA, + df = NA_real_ ) observed <- pool_internal.bootstrap( list(est = best), @@ -601,7 +614,8 @@ test_that("Results of bootstrap percentiles when n_samples = 0 or 1", { est = best[1], ci = c(-Inf, 3), se = NA, - pvalue = 0 + pvalue = 0, + df = NA_real_ ) observed <- pool_internal.bootstrap( list(est = best), @@ -615,7 +629,8 @@ test_that("Results of bootstrap percentiles when n_samples = 0 or 1", { est = best[1], ci = c(3, Inf), se = NA, - pvalue = 1 + pvalue = 1, + df = NA_real_ ) observed <- pool_internal.bootstrap( list(est = best), @@ -629,7 +644,8 @@ test_that("Results of bootstrap percentiles when n_samples = 0 or 1", { est = best[1], ci = c(3, 3), se = NA, - pvalue = 0 + pvalue = 0, + df = NA_real_ ) observed <- pool_internal.bootstrap( list(est = best), @@ -649,7 +665,8 @@ test_that("Bootstrap percentile does not return two-sided p-value larger than 1 est = best[1], ci = c(x1, x2), se = NA, - pvalue = 1 + pvalue = 1, + df = NA_real_ ) observed <- pool_internal.bootstrap( list(est = best), @@ -669,7 +686,8 @@ test_that("Can recover known values using bootstrap Normal", { est = best[1], ci = best[1] + c(-1, 1) * qnorm(0.96) * se, se = se, - pvalue = pnorm(best[1], sd = se, lower.tail = FALSE) * 2 + pvalue = pnorm(best[1], sd = se, lower.tail = FALSE) * 2, + df = NA_real_ ) observed <- pool_internal.bootstrap( list(est = best), @@ -683,7 +701,8 @@ test_that("Can recover known values using bootstrap Normal", { est = best[1], ci = best[1] + c(-1, Inf) * qnorm(0.92) * se, se = se, - pvalue = pnorm(best[1], sd = se, lower.tail = TRUE) + pvalue = pnorm(best[1], sd = se, lower.tail = TRUE), + df = NA_real_ ) observed <- pool_internal.bootstrap( list(est = best), @@ -697,7 +716,8 @@ test_that("Can recover known values using bootstrap Normal", { est = best[1], ci = best[1] + c(-Inf, 1) * qnorm(0.92) * se, se = se, - pvalue = pnorm(best[1], sd = se, lower.tail = FALSE) + pvalue = pnorm(best[1], sd = se, lower.tail = FALSE), + df = NA_real_ ) observed <- pool_internal.bootstrap( list(est = best), @@ -715,7 +735,8 @@ test_that("Results of bootstrap Normal when n_samples = 0 or 1", { est = best[1], ci = as.numeric(c(NA, NA)), se = as.numeric(NA), - pvalue = as.numeric(NA) + pvalue = as.numeric(NA), + df = as.numeric(NA) ) observed <- pool_internal.bootstrap( list(est = best),