## ----setup, include=FALSE-----------------------------------------------------
knitr::opts_chunk$set(collapse = TRUE, comment = "#>",
                      fig.width = 7, fig.height = 4)
library(prLogistic)

## ----lbw-data-----------------------------------------------------------------
data(LBW)
cat("n obs =", nrow(LBW), "| mothers =", length(unique(LBW$ID)), "\n")
cat("Prevalence of low birth weight:", round(mean(LBW$low == "Low"), 3), "\n\n")
table(LBW$low, LBW$smoke)

## ----lbw-glm------------------------------------------------------------------
LBW$low_bin   <- as.integer(LBW$low   == "Low")
LBW$smoke_bin <- as.integer(LBW$smoke == "Yes")
LBW$race_bin  <- as.integer(LBW$race  == "Non-white")

fit_lbw_glm <- glm(low_bin ~ smoke_bin + race_bin + age,
                   family = binomial, data = LBW)

cat("--- Conditional PR (GLM) ---\n")
prLogisticDelta(fit_lbw_glm, standardisation = "conditional")

## ----lbw-glm-marg-------------------------------------------------------------
cat("--- Marginal PR (GLM) ---\n")
prLogisticDelta(fit_lbw_glm, standardisation = "marginal")

## ----lbw-gee, eval=requireNamespace("geepack", quietly=TRUE)------------------
library(geepack)
fit_lbw_gee <- geeglm(low_bin ~ smoke_bin + race_bin + age,
                      family = binomial, id = ID,
                      corstr = "exchangeable", data = LBW)
cat("--- Marginal PR (GEE, exchangeable) ---\n")
prLogisticGEE(fit_lbw_gee)

## ----lbw-glmer, eval=requireNamespace("lme4", quietly=TRUE)-------------------
library(lme4)
fit_lbw_ml <- glmer(low_bin ~ smoke_bin + race_bin + age + (1 | ID),
                    family = binomial, data = LBW)
cat("--- Marginal PR (glmer) ---\n")
prLogisticDelta(fit_lbw_ml, standardisation = "marginal")

## ----thai-data----------------------------------------------------------------
data(Thailand)
cat("n =", nrow(Thailand), "| schools =", length(unique(Thailand$schoolid)), "\n")
cat("Prevalence of grade repetition:", round(mean(Thailand$rgi == "Yes"), 3), "\n\n")
table(Thailand$rgi, Thailand$sex)

## ----thai-glm-----------------------------------------------------------------
Thailand$rgi_bin  <- as.integer(Thailand$rgi  == "Yes")
Thailand$sex_bin  <- as.integer(Thailand$sex  == "Boy")
Thailand$pped_bin <- as.integer(Thailand$pped == "Yes")

fit_thai_glm <- glm(rgi_bin ~ sex_bin + pped_bin,
                    family = binomial, data = Thailand)

cat("--- Conditional PR (GLM) ---\n")
prLogisticDelta(fit_thai_glm, standardisation = "conditional")

## ----thai-glmer, eval=requireNamespace("lme4", quietly=TRUE)------------------
fit_thai_ml <- glmer(rgi_bin ~ sex_bin + pped_bin + (1 | schoolid),
                     family = binomial, data = Thailand)
cat("--- Marginal PR (glmer) ---\n")
prLogisticDelta(fit_thai_ml, standardisation = "marginal")

## ----toenail-data-------------------------------------------------------------
data(Toenail)
cat("n obs =", nrow(Toenail), "| patients =", length(unique(Toenail$ID)), "\n")
Toenail$resp_bin <- as.integer(Toenail$Response == "Moderate/severe")
Toenail$trt_bin  <- as.integer(Toenail$Treatment == "Terbinafine")
cat("Overall prevalence:", round(mean(Toenail$resp_bin), 3), "\n")

## ----toenail-gee, eval=requireNamespace("geepack", quietly=TRUE)--------------
fit_toe_gee <- geeglm(resp_bin ~ trt_bin + Month,
                      family = binomial, id = ID,
                      corstr = "exchangeable", data = Toenail)
cat("--- Marginal PR (GEE) ---\n")
prLogisticGEE(fit_toe_gee)

## ----uis-data-----------------------------------------------------------------
data(UIS)
cat("n =", nrow(UIS), "\n")
cat("Prevalence drug-free:", round(mean(UIS$drugFree == "Yes"), 3), "\n\n")
table(UIS$drugFree, UIS$trt)

## ----uis-glm------------------------------------------------------------------
UIS$drugFree_bin <- as.integer(UIS$drugFree == "Yes")

fit_uis <- glm(drugFree_bin ~ trt + Age + DrugUse + race + site,
               family = binomial, data = UIS)

cat("--- Conditional PR ---\n")
res_uis_cond <- prLogisticDelta(fit_uis, standardisation = "conditional")
print(res_uis_cond)

cat("\n--- Marginal PR ---\n")
res_uis_marg <- prLogisticDelta(fit_uis, standardisation = "marginal")
print(res_uis_marg)

## ----uis-or-pr----------------------------------------------------------------
OR <- exp(coef(fit_uis)[-1])
PR_cond <- coef(res_uis_cond)
PR_marg <- coef(res_uis_marg)

comp <- data.frame(
  OR        = round(OR, 3),
  PR_cond   = round(PR_cond, 3),
  PR_marg   = round(PR_marg, 3)
)
print(comp)

## ----uis-boot, cache=TRUE-----------------------------------------------------
set.seed(2024)
res_boot <- prLogisticBootCond(fit_uis, data = UIS, R = 499)
print(res_boot)

## ----downer-data--------------------------------------------------------------
data(downer)
cat("n =", nrow(downer), "\n")
cat("Survival prevalence:", round(mean(downer$Survival == "Survived"), 3), "\n\n")
table(downer$Survival, downer$Myopathy)

## ----downer-glm---------------------------------------------------------------
downer$surv_bin <- as.integer(downer$Survival == "Survived")

fit_downer <- glm(surv_bin ~ Myopathy + AST + CK + Calving,
                  family = binomial, data = downer)

cat("--- Conditional PR ---\n")
prLogisticDelta(fit_downer, standardisation = "conditional")

## ----titanic-data-------------------------------------------------------------
data(titanic)
cat("n =", nrow(titanic), "\n")
cat("Survival rate:", round(mean(titanic$survived == "Yes"), 3), "\n\n")
table(titanic$survived, titanic$sex)

## ----titanic-glm--------------------------------------------------------------
titanic$surv_bin <- as.integer(titanic$survived == "Yes")

fit_titanic <- glm(surv_bin ~ sex + pclass,
                   family = binomial, data = titanic)

# Odds Ratios (what logistic gives directly)
cat("--- Odds Ratios ---\n")
print(round(exp(cbind(OR = coef(fit_titanic), confint.default(fit_titanic))), 3))

cat("\n--- Conditional Prevalence Ratios ---\n")
res_tit <- prLogisticDelta(fit_titanic, standardisation = "conditional")
print(res_tit)

cat("\n--- Marginal Prevalence Ratios ---\n")
prLogisticDelta(fit_titanic, standardisation = "marginal")

## ----titanic-plot, fig.cap="Forest plot: conditional PR for Titanic survival"----
plot(res_tit, main = "Titanic: Conditional Prevalence Ratios (95% CI)")

## ----titanic-comparison-------------------------------------------------------
OR_sex <- exp(coef(fit_titanic)["sexMale"])
PR_sex <- coef(res_tit)["sexMale"]

cat(sprintf(
  "Being male:\n  OR = %.2f (%.0f%% overestimate over PR)\n  PR = %.2f\n",
  OR_sex,
  (OR_sex / PR_sex - 1) * 100,
  PR_sex
))

## ----summary-table------------------------------------------------------------
results <- data.frame(
  Dataset    = c("LBW (GLM)", "Thailand (GLM)", "UIS", "downer", "Titanic"),
  Prevalence = c(0.18, 0.16, 0.43, 0.50, 0.38),
  Predictor  = c("smoke", "sex (Boy)", "trt (Long)", "Myopathy (Yes)", "sex (Male)"),
  OR         = c(
    round(exp(coef(fit_lbw_glm)["smoke_bin"]), 2),
    round(exp(coef(fit_thai_glm)["sex_bin"]), 2),
    round(exp(coef(fit_uis)["trtLong"]), 2),
    round(exp(coef(fit_downer)["MyopathyYes"]), 2),
    round(exp(coef(fit_titanic)["sexMale"]), 2)
  ),
  PR_cond = c(
    round(coef(prLogisticDelta(fit_lbw_glm))["smoke_bin"], 2),
    round(coef(prLogisticDelta(fit_thai_glm))["sex_bin"], 2),
    round(coef(res_uis_cond)["trtLong"], 2),
    round(coef(prLogisticDelta(fit_downer))["MyopathyYes"], 2),
    round(coef(res_tit)["sexMale"], 2)
  )
)
results$OR_over_PR <- round(results$OR / results$PR_cond, 2)
print(results)

## ----session------------------------------------------------------------------
sessionInfo()

