Steve, I think your KCOR method has merit.
I think it would be worth using the "log ratio of LOESS trendlines" to capture the ratio of differences in baseline: (V/Vbase)/(U/Ubase)
Here's a model with random variation between the groups in the first 50 weeks then a steady rise to a 10% increase in mortality over the next 50 weeks. LOESS smooths the variability so is more dynamic than a fixed linear baseline.
R Code below.
uvr <- rnorm(100, 200, 10)
vxr <- rnorm(100, 250, 10) * c(rnorm(50,1,0.02), seq(1, 1.1, length.out = 50))
weeks <- 1:100
# --- plot base series ---
uvr.mean<-mean(uvr[1:12])
vxr.mean<-mean(vxr[1:12])
plot(weeks, vxr/vxr.mean, pch = 21, col = "blue",
xlab = "Week", ylab = "Mortality rate ratio")
lines(weeks, vxr/vxr.mean, lwd = 1, col = "blue")
points(weeks, uvr/uvr.mean, pch = 21, col = "brown")
lines(weeks, uvr/uvr.mean, lwd = 1, col = "brown")
scan()
# 1) baselines and normalization to "ratio-to-baseline"
base_uvr <- mean(uvr[1:12], na.rm = TRUE)
base_vxr <- mean(vxr[1:12], na.rm = TRUE)
uvr_n <- uvr / base_uvr
vxr_n <- vxr / base_vxr
# 2) fit LOESS on the normalized series
span <- 0.25 # tweak as desired (0.2–0.4 is a nice range)
lo_uvr <- loess(uvr_n ~ weeks, span = span, degree = 1, family = "gaussian")
lo_vxr <- loess(vxr_n ~ weeks, span = span, degree = 1, family = "gaussian")
pred_grid <- data.frame(weeks = weeks)
uvr_lo <- predict(lo_uvr, newdata = pred_grid)
vxr_lo <- predict(lo_vxr, newdata = pred_grid)
# 3) ratio of LOESS curves (VXR ÷ UVR). >1 means VXR higher than UVR.
ratio_lo <- vxr_lo / uvr_lo
op <- par(mfrow = c(1, 2), mar = c(4, 4, 2, 1))
## ---- Plot 1: normalized series LOESS for both cohorts ----
plot(weeks, uvr_n, type = "n", ylim = range(c(uvr_n, vxr_n), na.rm = TRUE),
xlab = "Week", ylab = "Rate / Baseline (weeks 1–12)", main = "Normalized rates LOESS")
# shade first 12 weeks
rect(0.5, par("usr")[3], 12.5, par("usr")[4], col = adjustcolor("grey80", 0.25), border = NA)
abline(h = 1, col = "grey50", lty = 3)
# raw points/lines
points(weeks, uvr_n, pch = 21, col = "brown")
lines(weeks, uvr_n, col = "brown")
points(weeks, vxr_n, pch = 21, col = "blue")
lines(weeks, vxr_n, col = "blue")
# LOESS trendlines
lines(weeks, uvr_lo, lwd = 3, col = adjustcolor("brown", 0.9), lty = 1)
lines(weeks, vxr_lo, lwd = 3, col = adjustcolor("blue", 0.9), lty = 1)
legend("topleft",
legend = c("UVR (norm.)", "VXR (norm.)", "UVR LOESS", "VXR LOESS"),
col = c("brown", "blue", "brown", "blue"),
lty = c(1, 1, 1, 1), lwd = c(1, 1, 3, 3), bty = "n", cex = 0.9)
## ---- Plot 2: centered log ratio barplot ----
log_ratio_lo <- log(ratio_lo) # natural log
# symmetric axis limits around 0
ylim_range <- max(abs(log_ratio_lo), na.rm = TRUE)
bar_cols <- ifelse(weeks <= 12, adjustcolor("steelblue", 0.8), adjustcolor("grey60", 0.9))
bp <- barplot(log_ratio_lo, border = NA, col = bar_cols, space = 0.2,
xlab = "Week", ylab = "log(VXR LOESS / UVR LOESS)",
main = "Log ratio of LOESS trendlines",
ylim = c(-ylim_range, ylim_range))
abline(h = 0, col = "grey30", lty = 2) # 0 = equal
legend("topright",
legend = c("Weeks 1–12", "Weeks 13–100"),
fill = c(adjustcolor("steelblue", 0.8), adjustcolor("grey60", 0.9)),
border = NA, bty = "n", cex = 0.9)
par(op)
@canceledmouse @ManDownUnder76 @m_a_n_u______