## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----setup-------------------------------------------------------------------- library(hypothesize) ## ----------------------------------------------------------------------------- # Setup: testing whether a Poisson rate equals 5 # Observed: 60 events in 10 time units # MLE: lambda_hat = 6, se = sqrt(6/10) # Wald: evaluate at the MLE w <- wald_test(estimate = 6, se = sqrt(6/10), null_value = 5) # Score: evaluate at the null # Score function at lambda0=5: n*xbar/lambda0 - n = 60/5 - 10 = 2 # Fisher info at lambda0=5: n/lambda0 = 10/5 = 2 s <- score_test(score = 2, fisher_info = 2) # LRT: evaluate at both # loglik(lambda) = sum(x)*log(lambda) - n*lambda ll_null <- 60 * log(5) - 10 * 5 ll_alt <- 60 * log(6) - 10 * 6 l <- lrt(null_loglik = ll_null, alt_loglik = ll_alt, dof = 1) # All three give similar (not identical) answers: data.frame( test = c("Wald", "Score", "LRT"), statistic = c(test_stat(w), test_stat(s), test_stat(l)), p_value = round(c(pval(w), pval(s), pval(l)), 4) ) ## ----------------------------------------------------------------------------- # A significant Wald test w <- wald_test(estimate = 3.0, se = 1.0) pval(w) # small — rejects H0 # Its complement cw <- complement_test(w) pval(cw) # large — fails to reject ## ----------------------------------------------------------------------------- pval(complement_test(complement_test(w))) pval(w) ## ----------------------------------------------------------------------------- class(cw) ## ----------------------------------------------------------------------------- # Both must be significant intersection_test(0.01, 0.03) # both < 0.05 is_significant_at(intersection_test(0.01, 0.03), 0.05) # One non-significant component blocks rejection intersection_test(0.01, 0.80) is_significant_at(intersection_test(0.01, 0.80), 0.05) ## ----------------------------------------------------------------------------- # Drug effect estimate: 1.05, with SE = 0.08 # Must show: effect > 0.8 AND effect < 1.25 t_lower <- wald_test(estimate = 1.05, se = 0.08, null_value = 0.8) t_upper <- wald_test(estimate = 1.05, se = 0.08, null_value = 1.25) bioequiv <- intersection_test(t_lower, t_upper) is_significant_at(bioequiv, 0.05) ## ----eval=FALSE--------------------------------------------------------------- # # This is (essentially) the actual source code of union_test: # union_test <- function(...) { # complement_test( # do.call(intersection_test, lapply(tests, complement_test)) # ) # } ## ----------------------------------------------------------------------------- # Three p-values p1 <- 0.03; p2 <- 0.15; p3 <- 0.07 # Direct union ut <- union_test(p1, p2, p3) # Manual De Morgan construction tests <- list( hypothesis_test(stat = 0, p.value = p1, dof = 1), hypothesis_test(stat = 0, p.value = p2, dof = 1), hypothesis_test(stat = 0, p.value = p3, dof = 1) ) dm <- complement_test( do.call(intersection_test, lapply(tests, complement_test)) ) # Identical c(union = pval(ut), de_morgan = pval(dm)) ## ----------------------------------------------------------------------------- # Compose: take the union, then combine with another test ut <- union_test(0.01, 0.05) combined <- fisher_combine(ut, wald_test(estimate = 2, se = 1)) pval(combined) ## ----------------------------------------------------------------------------- # Invert a Wald test into a confidence interval cs <- invert_test( test_fn = function(theta) wald_test(estimate = 2.5, se = 0.8, null_value = theta), grid = seq(0, 5, by = 0.01) ) cs ## ----------------------------------------------------------------------------- # Analytical CI from the Wald test confint(wald_test(estimate = 2.5, se = 0.8)) # Numerical CI from test inversion c(lower = lower(cs), upper = upper(cs)) ## ----------------------------------------------------------------------------- # A custom test: reject if |observation - theta| > 2 # (This has no analytical CI, but invert_test handles it) my_test <- function(theta) { obs <- 5.0 hypothesis_test( stat = (obs - theta)^2, p.value = if (abs(obs - theta) > 2) 0.01 else 0.5, dof = 1 ) } cs <- invert_test(my_test, grid = seq(0, 10, by = 0.1)) c(lower = lower(cs), upper = upper(cs)) ## ----------------------------------------------------------------------------- # Test two parameters jointly est <- c(2.0, 3.0) V <- matrix(c(1.0, 0.3, 0.3, 1.0), 2, 2) # correlated w_joint <- wald_test(estimate = est, vcov = V, null_value = c(0, 0)) w_joint ## ----------------------------------------------------------------------------- # Independent parameters: diagonal vcov se1 <- 0.8; se2 <- 1.2 V_diag <- diag(c(se1^2, se2^2)) w_multi <- wald_test(estimate = c(2.0, 3.0), vcov = V_diag) w1 <- wald_test(estimate = 2.0, se = se1) w2 <- wald_test(estimate = 3.0, se = se2) # The joint statistic equals the sum of individual statistics c(joint = test_stat(w_multi), sum = test_stat(w1) + test_stat(w2))