The panel: a Confidence Eye per taxon and group
Each row is drawn as an honest Confidence Eye – a pale, shallow
horizontal lens whose width is exactly the 95% confidence interval and
whose cosine taper is tallest at the estimate, with a hollow point
marking the estimate itself. The two facets carry independent x-axes
(CTmax in degrees Celsius; z in degrees
Celsius per tenfold change in exposure time), because the two parameters
live on different scales and, for CTmax, on different
reference exposures.
The geometry follows the freqTLS Confidence-Eye
contract: the shallow, wide lens reads as a confidence
interval, not a probability density, and a profile that did not
close would render as a hollow point with no lens. All
12 headline profiles here close (six groups for each of two parameters),
so every row carries a lens.
# Build the honest Confidence-Eye geometry by hand so all three fits share one
# cross-taxon panel: a cosine-tapered pale lens (width = confidence interval)
# plus a hollow point, faceted by parameter with free x-axes. This reuses the
# package lens shape (see ?plot_confidence_eye) but spans every fit in one figure.
stopifnot(requireNamespace("ggplot2", quietly = TRUE))
# Fixed top-to-bottom row order (shrimp, zebrafish stages, fly sexes).
row_order <- c(
"Shrimp",
"Zebrafish: young embryos", "Zebrafish: old embryos", "Zebrafish: larvae",
"D. suzukii: female", "D. suzukii: male"
)
panel$row <- match(panel$label, row_order)
panel$parameter <- factor(panel$parameter, levels = c("CTmax", "z"),
labels = c("CTmax (°C)", "z (°C / decade)"))
# One cosine-tapered lens polygon per row (tallest at the estimate, zero at each
# bound), built per facet so the free x-axes do not distort the taper.
lens_df <- do.call(rbind, lapply(seq_len(nrow(panel)), function(i) {
x <- seq(panel$conf.low[i], panel$conf.high[i], length.out = 80)
d_lo <- max(panel$estimate[i] - panel$conf.low[i], .Machine$double.eps)
d_hi <- max(panel$conf.high[i] - panel$estimate[i], .Machine$double.eps)
frac <- ifelse(x <= panel$estimate[i], (panel$estimate[i] - x) / d_lo,
(x - panel$estimate[i]) / d_hi)
w <- 0.32 * cos((pi / 2) * pmin(pmax(frac, 0), 1))
data.frame(id = i, parameter = panel$parameter[i], x = x,
ymin = panel$row[i] - w, ymax = panel$row[i] + w)
}))
# Reference-exposure annotation for the CTmax facet only.
tref_lab <- data.frame(
parameter = factor("CTmax (°C)",
levels = levels(panel$parameter)),
row = panel$row[panel$parameter == "CTmax (°C)"],
x = panel$conf.high[panel$parameter == "CTmax (°C)"],
lab = c("1 h", "1 h", "1 h", "1 h", "4 h", "4 h")
)
ggplot2::ggplot() +
ggplot2::geom_ribbon(
data = lens_df,
ggplot2::aes(x = x, ymin = ymin, ymax = ymax, group = id),
fill = "#1b7837", colour = NA, alpha = 0.30
) +
ggplot2::geom_point(
data = panel,
ggplot2::aes(x = estimate, y = row),
shape = 21, fill = "white", colour = "#1b7837", size = 3, stroke = 1
) +
ggplot2::geom_text(
data = tref_lab,
ggplot2::aes(x = x, y = row, label = lab),
hjust = -0.25, size = 2.7, colour = "grey35"
) +
ggplot2::scale_y_continuous(
breaks = seq_along(row_order), labels = row_order,
trans = "reverse", expand = ggplot2::expansion(add = 0.7)
) +
ggplot2::scale_x_continuous(
expand = ggplot2::expansion(mult = c(0.05, 0.20))
) +
ggplot2::facet_wrap(~ parameter, scales = "free_x") +
ggplot2::labs(
x = NULL, y = NULL,
title = "Thermal limits across three taxa: CTmax and z",
subtitle = "Confidence Eyes: pale lens = 95% confidence interval; hollow point = estimate.",
caption = paste(
"Profile-likelihood confidence intervals (freqTLS, no Stan).",
"CTmax reference exposure differs by study (annotated): not a common time scale."
)
) +
ggplot2::theme_minimal() +
ggplot2::theme(
panel.grid.major.y = ggplot2::element_blank(),
panel.grid.minor = ggplot2::element_blank(),
plot.caption = ggplot2::element_text(hjust = 0)
)