plot_subhr_linear_egfrdisc <- function(time_var, status_var, extra_adj = NULL,
outcome_label) {
base_adj <- c("age", "sex", "ecog_score", "ici", "cockcroft")
keep <- c("egfr_discrepancy", time_var, status_var, base_adj, extra_adj)
d <- dat %>% dplyr::select(all_of(keep)) %>% tidyr::drop_na()
adj_df <- d[, c(base_adj, extra_adj), drop = FALSE]
X_adj <- model.matrix(~ ., data = adj_df)[, -1, drop = FALSE]
X <- cbind(egfr_discrepancy = d$egfr_discrepancy, X_adj)
stat_num <- suppressWarnings(as.integer(as.character(d[[status_var]])))
time_num <- as.numeric(d[[time_var]])
fit <- tryCatch(
cmprsk::crr(ftime = time_num, fstatus = stat_num,
cov1 = X, failcode = 1),
error = function(e) NULL
)
if (is.null(fit)) return(.plot_failed(outcome_label))
beta <- fit$coef[1]
V_beta <- fit$var[1, 1]
se_b <- sqrt(V_beta)
q1 <- as.numeric(quantile(d$egfr_discrepancy, 0.25, na.rm = TRUE))
q3 <- as.numeric(quantile(d$egfr_discrepancy, 0.75, na.rm = TRUE))
iqr_w <- q3 - q1
hr1 <- exp(beta); hr1_l <- exp(beta - 1.96 * se_b); hr1_u <- exp(beta + 1.96 * se_b)
hri <- exp(beta * iqr_w); hri_l <- exp(beta * iqr_w - 1.96 * abs(iqr_w) * se_b); hri_u <- exp(beta * iqr_w + 1.96 * abs(iqr_w) * se_b)
pval <- 2 * (1 - pnorm(abs(beta / se_b)))
p_str <- ifelse(pval < 0.001, "<0.001", sprintf("%.3f", pval))
subtitle_str <- sprintf(
"subHR per 1 mL/min: %.2f (%.2f-%.2f), p = %s | per IQR (Δ = %.1f): %.2f (%.2f-%.2f) | IQR: [%.1f, %.1f]",
hr1, hr1_l, hr1_u, p_str, iqr_w, hri, hri_l, hri_u, q1, q3)
ref_x <- median(d$egfr_discrepancy, na.rm = TRUE)
grid_x <- seq(quantile(d$egfr_discrepancy, 0.025, na.rm = TRUE),
quantile(d$egfr_discrepancy, 0.975, na.rm = TRUE),
length.out = 100)
log_hr <- beta * (grid_x - ref_x)
se <- sqrt((grid_x - ref_x)^2 * V_beta)
df_plot <- tibble(
x = grid_x,
subhr = exp(log_hr),
lcl = exp(log_hr - 1.96 * se),
ucl = exp(log_hr + 1.96 * se)
)
ggplot(df_plot, aes(x = x, y = subhr)) +
geom_ribbon(aes(ymin = lcl, ymax = ucl), alpha = 0.2, fill = "darkorange") +
geom_line(color = "darkorange", linewidth = 1) +
geom_hline(yintercept = 1, linetype = "dashed", color = "grey50") +
geom_vline(xintercept = ref_x, linetype = "dotted", color = "grey40") +
geom_vline(xintercept = c(q1, q3), linetype = "dashed",
color = "steelblue", alpha = 0.7) +
labs(x = "eGFR Discrepancy (mL/min)",
y = "subHR (95% CI)",
title = outcome_label,
subtitle = subtitle_str) +
coord_cartesian(ylim = c(0, 4)) +
theme_minimal(base_size = 14) +
theme(plot.subtitle = element_text(size = 12, color = "grey25")) -> p
.save_plot_pptx(p)
p
}
plot_cox_linear_egfrdisc <- function(time_var, status_var, extra_adj = NULL,
outcome_label) {
base_adj <- c("age", "sex", "ecog_score", "ici", "cockcroft")
keep <- c("egfr_discrepancy", time_var, status_var, base_adj, extra_adj)
d <- dat %>% dplyr::select(all_of(keep)) %>% tidyr::drop_na()
fmla <- as.formula(paste0(
"Surv(", time_var, ", ", status_var, ") ~ egfr_discrepancy + ",
paste(c(base_adj, extra_adj), collapse = " + ")
))
fit <- tryCatch(survival::coxph(fmla, data = d), error = function(e) NULL)
if (is.null(fit)) return(.plot_failed(outcome_label))
beta <- coef(fit)["egfr_discrepancy"]
V_beta <- vcov(fit)["egfr_discrepancy", "egfr_discrepancy"]
se_b <- sqrt(V_beta)
q1 <- as.numeric(quantile(d$egfr_discrepancy, 0.25, na.rm = TRUE))
q3 <- as.numeric(quantile(d$egfr_discrepancy, 0.75, na.rm = TRUE))
iqr_w <- q3 - q1
hr1 <- exp(beta); hr1_l <- exp(beta - 1.96 * se_b); hr1_u <- exp(beta + 1.96 * se_b)
hri <- exp(beta * iqr_w); hri_l <- exp(beta * iqr_w - 1.96 * abs(iqr_w) * se_b); hri_u <- exp(beta * iqr_w + 1.96 * abs(iqr_w) * se_b)
pval <- 2 * (1 - pnorm(abs(beta / se_b)))
p_str <- ifelse(pval < 0.001, "<0.001", sprintf("%.3f", pval))
subtitle_str <- sprintf(
"HR per 1 mL/min: %.2f (%.2f-%.2f), p = %s | per IQR (Δ = %.1f): %.2f (%.2f-%.2f) | IQR: [%.1f, %.1f]",
hr1, hr1_l, hr1_u, p_str, iqr_w, hri, hri_l, hri_u, q1, q3)
ref_x <- median(d$egfr_discrepancy, na.rm = TRUE)
grid_x <- seq(quantile(d$egfr_discrepancy, 0.025, na.rm = TRUE),
quantile(d$egfr_discrepancy, 0.975, na.rm = TRUE),
length.out = 100)
log_hr <- beta * (grid_x - ref_x)
se <- sqrt((grid_x - ref_x)^2 * V_beta)
df_plot <- tibble(
x = grid_x,
hr = exp(log_hr),
lcl = exp(log_hr - 1.96 * se),
ucl = exp(log_hr + 1.96 * se)
)
ggplot(df_plot, aes(x = x, y = hr)) +
geom_ribbon(aes(ymin = lcl, ymax = ucl), alpha = 0.2, fill = "darkorange") +
geom_line(color = "darkorange", linewidth = 1) +
geom_hline(yintercept = 1, linetype = "dashed", color = "grey50") +
geom_vline(xintercept = ref_x, linetype = "dotted", color = "grey40") +
geom_vline(xintercept = c(q1, q3), linetype = "dashed",
color = "steelblue", alpha = 0.7) +
labs(x = "eGFR Discrepancy (mL/min)",
y = "HR (95% CI)",
title = outcome_label,
subtitle = subtitle_str) +
coord_cartesian(ylim = c(0, 4)) +
theme_minimal(base_size = 14) +
theme(plot.subtitle = element_text(size = 12, color = "grey25")) -> p
.save_plot_pptx(p)
p
}
