---
title: "Mojave desert hydric physiology"
subtitle: "Technical supplement"
author: "Trevor Ruiz and Alvaro Ramos"
author-title: "AUTHORS"
date: today
published-title: "UPDATED"
format:
html:
code-fold: false
code-tools: true
callout-appearance: simple
math: mathjax
toc: false
execute:
warning: false
message: false
echo: false
cache: true
---
```{r}
library(tidyverse)
library(magrittr)
library(ggridges)
library(patchwork)
library(ape)
library(geiger)
library(phytools)
library(nlme)
library(lme4)
library(brms)
library(emmeans)
library(pander)
library(broom)
library(sf)
library(bayesplot)
library(ggtree)
# read in data
data_dir <- 'data/processed/'
here::here(data_dir, 'mojave.RData') |> load()
# color palettes
cb_pal <- c(BG = "#FF00B2", DI = "#ECC901", CW = "#696969", LB = "#0072B2",
SB = "#56B4E9", TW = "#D52C00", ZT = "#009E73", MF = "#E67E00",
LN = "#5600B9")
mh_pal <- c(Floor = "orange", Road = "gray", Rock = "saddlebrown",
Sand = "wheat2", Veg = "forestgreen")
```
This is the analysis notebook for the working paper *Phylogeny vs. physiology: how a guild of desert lizards maintain water balance*. The project examines cutaneous evaporative water loss (CEWL) among a sample of lizards of 9 distinct species in the Mojave desert before and after acclimation to a controlled environment.
::: callout-note
Comments appear like this.
:::
::: {.callout-caution appearance="simple"}
To-do's and placeholders for missing content appear like this.
:::
# Executive summary
This supplement presents descriptive and inferential analyses of cutaneous evaporative water loss (CEWL) among eight lizard species in the Mojave desert. CEWL was measured at capture — reflecting physiology embedded in field conditions — and after laboratory acclimation, reflecting intrinsic physiology with hydric stress removed. The difference in log(CEWL) between states quantifies **physiological flexibility**. Three parallel Bayesian phylogenetic mixed models were fit, one per phenotypic state, each modeling log(CEWL) as a function of blood plasma osmolality, ambient temperature, and vapor pressure deficit (VPD), with species-level random effects and phylogenetic covariance.
**Key findings:**
- Temperature and VPD credibly predict log(CEWL) at capture (temp: +19% per °C; VPD: −46% per kPa unit) but neither is credible at acclimation, suggesting these environmental factors influence CEWL under field conditions but not intrinsically.
- Osmolality is not credibly associated with log(CEWL) at any phenotypic state.
- Species-level variation in log(CEWL) is substantially larger at acclimation ($\hat{\sigma}_s \approx 0.73$) than at capture ($\hat{\sigma}_s \approx 0.37$), consistent with field conditions compressing apparent species differences.
- Phylogenetic signal ($\lambda$) is highly uncertain across all three models; posteriors span nearly the full \[0, 1\] interval and the data do not strongly support or refute phylogenetic structuring of any CEWL trait.
- Among species, only Chuckwallas showed a clearly elevated mean log($\Delta$CEWL); flexibility estimates are otherwise imprecise and broadly consistent with zero change.
The supplement is organized as follows. The **Descriptive Analysis** section presents sampling information and exploratory summaries and graphics. The **Statistical Modeling** discusses model specification and presents summaries of fit and findings for each of the three phenotypic states: CEWL at capture, CEWL at acclimation, and physiological flexibility (log-scale change in CEWL from capture to acclimation). The **Synthesis** section compares estimates across all three models and examines phylogenetic signal.
# Descriptive analysis
Primary measurements taken both at capture and after acclimation (2 days after capture) are:
- `cewl`: mean cutaneous evaporative water loss (in $g/m^2h$) measured in technical replicates
- `osml`: mean blood plasma osmolality ($mmol/kg$), or the concentration of solutes in the blood (proxy for hydraton)
- `mass`: mass ($g$) at time of measurement
- `clo.temp`: cloacal temperature ($^\circ C$)
- `temp`: ambient temperature ($^\circ C$) at time of measurement
- `vpd`: ambient vapor pressure deficit ($kPa$) at time of measurement <!-- - `rh`: ambient relative humidity (%) at time of measurement --> <!-- - `hema.pct`: hematocrit (%) -->
Example rows are shown below.
```{r}
# example rows
raw |>
arrange(desc(id), date) |>
head() |>
select(-ends_with('.sd'), -hema.pct, -rh) |>
pander(caption = 'Table: example data rows')
```
For most species, about ten individuals were captured for the study, but sample sizes range from 2 to 24 individuals.
```{r}
# sample sizes
raw |>
distinct(id, species) |>
count(species) %>%
left_join(species, ., join_by(sp.abbrv == species)) |>
select(-activity, -diet) |>
pander(caption = 'Table: sample sizes by species')
```
## Capture sites
Individuals were captured from 9 locales in the Mojave desert.
```{r}
#| fig-width: 6
#| fig-height: 7
#| fig-cap: "Figure: Map of study sites (blue) and capture locations (inset)"
# read in shape files
shape_california_sf <- here::here("data/_raw/map_shapefiles/California_State_Boundary.geojson") |>
st_read(quiet = TRUE)
shape_capture_sf <- here::here("data/_raw/map_shapefiles/capture_sites.gpkg") |>
st_read(quiet = TRUE)
shape_rectangle_sf <- here::here("data/_raw/map_shapefiles/custom_moja_rectangle.shp") |>
st_read(quiet = TRUE)
st_crs(shape_california_sf) <- 4326
st_crs(shape_capture_sf) <- 4326
st_crs(shape_rectangle_sf) <- 4326
target_crs <- st_crs(shape_california_sf)
shape_capture_sf <- st_transform(shape_capture_sf, target_crs)
shape_rectangle_sf <- st_transform(shape_rectangle_sf, target_crs)
pts_sf <- st_as_sf(metadata, coords = c('lon', 'lat'), crs = 4326) |>
st_transform(target_crs)
# plot CA map
label_col <- 'id'
p1 <- ggplot() +
geom_sf(data = shape_california_sf, fill = "gray90", color = "gray60") +
geom_sf(data = shape_rectangle_sf, fill = NA, color = "darkblue", linewidth = 0.7) +
geom_sf(data = shape_capture_sf, color = "steelblue", size = 2, alpha = 0.8) +
theme_minimal(base_size = 12) +
coord_sf(expand = FALSE) +
labs(x = "Longitude", y = "Latitude") +
theme(panel.grid = element_blank())
# Get bounding box of the rectangle
bbox_rect <- st_bbox(shape_rectangle_sf)
xpad <- 0.02 * (bbox_rect["xmax"] - bbox_rect["xmin"])
ypad <- 0.02 * (bbox_rect["ymax"] - bbox_rect["ymin"])
xlim <- c(bbox_rect["xmin"] - xpad, bbox_rect["xmax"] + xpad)
ylim <- c(bbox_rect["ymin"] - ypad, bbox_rect["ymax"] + ypad)
label_col <- 'id'
p2 <- ggplot() +
geom_sf(data = shape_california_sf, fill = "gray95", color = "gray80") +
geom_sf(data = shape_rectangle_sf, fill = NA, color = "darkblue", linewidth = 0.8) +
geom_sf(data = shape_capture_sf, color = "steelblue", size = 15, alpha = 0.2) +
geom_sf(data = pts_sf, color = "darkred", size = 2, alpha = 0.7) +
theme_minimal(base_size = 12) +
coord_sf(xlim = xlim, ylim = ylim, expand = FALSE) +
labs(x = NULL,
y = NULL) +
ggrepel::geom_text_repel(data = shape_capture_sf,
aes(label = locale, geometry = geom),
stat = 'sf_coordinates',
size = 3) +
theme(panel.grid = element_blank())
p1 + inset_element(p2 + theme_void(),
left = 0.20, bottom = 0.40,
right = 0.98, top = 0.98,
align_to = 'panel')
ggsave(here::here("img/fig1-map.png"), width = 8, height = 6, dpi = 400, units = 'in')
```
Capture locations were classified by microhabitat type. The capture site for individual TW10 was not classified.
```{r}
metadata |>
count(locale, mh) |>
spread(mh, n) |>
pander(caption = 'Table: sample sizes by locale and microhabitat type',
missing = '-')
```
The microhabitat distribution of species sampled for the study is shown below. Most species were sampled from 1 or 2 primary microhabitats.
```{r}
#| fig-width: 6
#| fig-height: 4
#| fig-cap: "Figure: Microhabitat allocation of individuals sampled by species"
# microhabitat allocation
metadata |>
select(species, sp.common, mh) |>
mutate(species = toupper(species),
mh = str_to_title(mh)) |>
filter(is.na(mh) == FALSE) |>
group_by(mh, species) |>
summarize(count = n()) |>
group_by(species) |>
mutate(prop = count / sum(count)) |>
ggplot(aes(x = species,
y = prop,
fill = mh)) +
geom_bar(stat = "identity",
color = "black",
linewidth = 0.2,
alpha = 0.7) +
scale_fill_manual(values = mh_pal, labels = c("Floor", "Road", "Rock", "Sand", "Vegetation")) +
geom_text(aes(label = str_glue("{100*round(prop, 2)}% ({count})")),
position = position_stack(vjust = 0.5),
color = "black",
size = 2) +
labs(x = "Species",
y = "Microhabitat allocation",
fill = NULL) +
theme_minimal() +
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank())
ggsave(here::here('img/fig2-microhabitat.png'), dpi = 400, width = 6, height = 5, units = 'in')
```
Microhabitats are not considered in subsequent analysis because, although there are apparent marginal differences in CEWL and osmolality at capture when grouped by microhabitat, species is a confounding factor and after accounting for species the apparent marginal differences vanish, as shown in the figure below.
```{r}
#| fig-width: 6
#| fig-height: 7
#| fig-cap: "Figure: Distributions of CEWL and osmolality by microhabitat (top); Distributions of residual CEWL and osmolality by microhabitat after accounting for species (bottom)."
# capture data
capture <- raw |>
filter(day == "capture") |>
select(id, species, mass, osml, cewl, temp, vpd) |>
left_join(select(species, sp.abbrv, sp.common), join_by(species == sp.abbrv)) |>
rename(common.name = sp.common) |>
mutate(spp = toupper(species) |> fct_reorder(cewl, median),
name = str_to_title(common.name) |> fct_reorder(cewl, median))
# cewl by microhabitat
p1 <- capture |>
left_join(metadata, by = join_by(id)) |>
filter(is.na(mh) == FALSE) |>
mutate(mh = as.factor(str_to_title(mh))) |>
ggplot(aes(y = fct_reorder(mh, cewl, median), # order species based on median CEEWL
x = cewl,
fill = mh)) +
geom_density_ridges(scale = 1, alpha = 0.8, show.legend = F) +
geom_boxplot(width = 0.25, alpha = 0.8, show.legend = F) +
geom_vline(xintercept = median(capture$cewl),
linetype = 5,
alpha = 0.5) +
theme_bw() +
labs(y = "Microhabitat",
x = NULL,
title = "CEWL") +
geom_label(data = subset(capture |>
left_join(metadata, by = join_by(id)) |>
filter(is.na(mh) == FALSE) |>
mutate(mh = as.factor(str_to_sentence(mh))),
(cewl > 20 & mh == "Sand") |
(cewl > 15 & mh == "Floor")),
aes(label = id),
show.legend = FALSE,
vjust = -0.2,
size = 3,
alpha = 0.8) +
scale_fill_manual(values = mh_pal) +
theme(panel.grid.minor = element_blank())
# osml by microhabitat
p2 <- capture |>
left_join(metadata, by = join_by(id)) |>
filter(is.na(mh) == FALSE) |>
mutate(mh = as.factor(str_to_title(mh))) |>
ggplot(aes(y = fct_reorder(mh, cewl, median),
x = osml,
fill = mh)) +
geom_density_ridges(scale = 1, alpha = 0.8, show.legend = F) +
geom_boxplot(width = 0.25, alpha = 0.8, show.legend = F,
data = subset(capture |>
left_join(metadata, by = join_by(id)) |>
filter(is.na(mh) == FALSE) |>
mutate(mh = as.factor(str_to_sentence(mh))),
mh != "Road")) +
geom_point(data = subset(capture |>
left_join(metadata, by = join_by(id)) |>
filter(is.na(mh) == FALSE) |>
mutate(mh = as.factor(str_to_sentence(mh))),
mh == "Road"),
show.legend = FALSE) +
geom_vline(xintercept = median(capture$osml, na.rm = T),
linetype = 5,
alpha = 0.5) +
theme_bw() +
labs(y = NULL,
x = NULL,
title = "Osmolality") +
geom_label(data = subset(capture |>
left_join(metadata, by = join_by(id)) |>
filter(is.na(mh) == FALSE) |>
mutate(mh = as.factor(str_to_sentence(mh))),
(osml < 290 & mh == "Floor") |
(osml < 400 & mh == "Road")),
aes(label = id),
show.legend = FALSE,
vjust = -0.2,
size = 3,
alpha = 0.8) +
scale_fill_manual(values = mh_pal) +
theme(panel.grid.minor = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank())
# cewl residuals by mh -- add outlier annotations?
capture_cres <- capture %>%
modelr::add_residuals(., lm(cewl ~ species, data = .), var = 'cewl.res')
p3 <- capture_cres |>
left_join(metadata, by = join_by(id)) |>
filter(is.na(mh) == FALSE) |>
mutate(mh = as.factor(str_to_title(mh))) |>
ggplot(aes(y = mh,
x = cewl.res,
fill = mh)) +
geom_density_ridges(scale = 1, alpha = 0.8, show.legend = F) +
geom_boxplot(width = 0.25, alpha = 0.8, show.legend = F) +
geom_vline(xintercept = 0,
linetype = 5,
alpha = 0.5) +
theme_bw() +
labs(y = "Microhabitat",
x = NULL,
title = "Residual CEWL") +
scale_fill_manual(values = mh_pal) +
theme(panel.grid.minor = element_blank())
# osml residuals by mh -- add outlier annotations?
capture_ores <- capture %>%
drop_na(osml) %>%
modelr::add_residuals(., lm(osml ~ species, data = .), var = 'osml.res') %>%
modelr::add_residuals(., lm(cewl ~ species, data = .), var = 'cewl.res')
p4 <- capture_ores |>
left_join(metadata, by = join_by(id)) |>
filter(is.na(mh) == FALSE) |>
mutate(mh = as.factor(str_to_title(mh))) |>
ggplot(aes(y = mh,
x = osml.res,
fill = mh)) +
geom_density_ridges(scale = 1, alpha = 0.8, show.legend = F) +
geom_boxplot(width = 0.25, alpha = 0.8, show.legend = F,
data = subset(capture_ores |>
left_join(metadata, by = join_by(id)) |>
filter(is.na(mh) == FALSE) |>
mutate(mh = as.factor(str_to_sentence(mh))),
mh != "Road")) +
geom_point(data = subset(capture_ores |>
left_join(metadata, by = join_by(id)) |>
filter(is.na(mh) == FALSE) |>
mutate(mh = as.factor(str_to_sentence(mh))),
mh == "Road"),
show.legend = FALSE) +
geom_vline(xintercept = 0,
linetype = 5,
alpha = 0.5) +
theme_bw() +
labs(y = NULL,
x = NULL,
title = "Residual osmolality") +
scale_fill_manual(values = mh_pal) +
theme(panel.grid.minor = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank())
(p1 + p2)/(p3 + p4) + plot_layout(nrow = 2)
ggsave(here::here('img/fig3-ridges.png'), dpi = 400, width = 6, height = 6, units = 'in')
```
Indeed, microhabitat does not explain a significant amount of variation in CEWL after adjusting for species.
```{r}
lm(cewl ~ species*mh,
data = left_join(capture, metadata, by = join_by(id, species))) |>
anova() |>
pander(caption = "Table: ANOVA of CEWL by species and microhabitat.")
```
Moreover, there's no obvious strong relationship between microhabitat temperatures and CEWL or osmolality at capture.
```{r}
#| fig-width: 6
#| fig-height: 3
#| fig-cap: "Figure: Microhabitat ambient temperature at capture site and CEWL and osmolality values after capture"
# microhabitat temperature
left_join(capture, metadata, join_by(id, species)) |>
rename(CEWL = cewl,
Osmolality = osml) |>
pivot_longer(c(CEWL, Osmolality), names_to = 'yvar') |>
ggplot(aes(x = mh.temp, y = value)) +
facet_wrap(~yvar, scales = 'free_y') +
geom_point() +
theme_bw() +
labs(x = 'Microhabitat temperature', y = NULL, color = 'Species')
ggsave(here::here('img/fig4-mhtemp.png'), dpi = 400, width = 6, height = 3, units = 'in')
```
## Missing values
Several osmolality values are missing both at capture and after acclimation.
```{r}
# missing values
raw |>
pivot_longer(c(osml, cewl, mass, clo.temp, temp, vpd)) |>
group_by(day, name) |>
summarize(n.missing = sum(is.na(value))) |>
spread(day, n.missing) |>
pander(caption = 'Table: counts of missing values')
```
::: callout-note
The missing cloacal temperature value is from individual LB02. We'll ignore this value since it was agreed on 8/20/25 that we'd use ambient temperatures rather than cloacal temperatures in statistical models.
:::
The missing osmolality values are distributed across species as follows:
```{r}
raw |>
pivot_longer(c(osml, cewl, mass, clo.temp, temp, vpd)) |>
group_by(species, day, name) |>
summarize(n.missing = sum(is.na(value))) |>
spread(species, n.missing) |>
filter(name == 'osml') |>
rename(variable = name) |>
pander(caption = 'Table: counts of missing osmolality values by species')
```
Here is a list of the individuals with missing values:
- acclimation only: CW01, CW11, CW12, CW13, CW14, DI18, LB04
- capture only: CW02, SB01, SB02, SB08
- both: LB05, LB06, LB07, LB08, LB09, LB10, LB11, SB10, SB11, SB13, SB14, SB15, SB16, SB17, SB18
::: callout-note
Missing osmolality measurements may become available for Chuckwallas at a later date per discussion on 8/20/25.
:::
Sample sizes after removing missing values are rendered below.
```{r}
# tabulate missing osmolality
raw |>
select(id, day, species, osml) |>
spread(day, osml) |>
mutate(missing = case_when(
is.na(acclimation) | is.na(capture) ~ F, # either column missing
TRUE ~ T)) |>
group_by(na.osml = factor(missing,
levels = c(T, F),
labels = c('osml missing', 'osml recorded'))) |>
count(species) |>
spread(na.osml, n) |>
mutate(across(everything(), ~replace_na(.x, 0))) |>
mutate(n = `osml missing` + `osml recorded`) |>
select(species, n, starts_with('osml')) |>
janitor::adorn_totals() |>
pander(caption = 'Table: sample sizes by species after removing missing osmolality values')
```
::: callout-note
Cloacal and ambient temperatures are only moderately correlated (r ≈ 0.6 at capture, weaker after acclimation), and their ordering reverses between states: on average, cloacal temperature exceeds ambient at capture but falls below it after acclimation. Ambient temperature is used as the predictor in all models — it better captures the external hydric-thermal environment and avoids conflating the outcome physiology (thermoregulation affects cloacal temperature) with a predictor.
```{r}
#| include: false
# cloacal and ambient temperature correlations
p1 <- raw |>
drop_na(clo.temp) |>
group_by(day) |>
summarize(r = cor(temp, clo.temp)) %>%
left_join(raw, ., join_by(day)) |>
mutate(day = paste(str_to_title(day), ' (r = ', round(r, 3), ')', sep = '')) |>
ggplot(aes(x = temp, y = clo.temp)) +
facet_wrap(~fct_rev(day)) +
geom_point() +
geom_abline(slope = 1, intercept = 0, color = 'grey', alpha = 0.6) +
theme_bw() +
theme(panel.grid.minor = element_blank()) +
labs(x = 'Ambient temperature', y = 'Cloacal temperature')
# change after acclimation
p3 <- raw |>
select(id, day, clo.temp, temp) |>
drop_na(clo.temp) |>
pivot_wider(id_cols = id, names_from = day, values_from = c(clo.temp, temp)) |>
transmute(`Ambient temperature` = temp_acclimation - temp_capture,
`Cloacal temperature` = clo.temp_acclimation - clo.temp_capture) |>
pivot_longer(everything()) |>
ggplot(aes(x = value)) +
facet_wrap(~name, nrow = 1, scales = 'free_x') +
geom_vline(xintercept = 0, linetype = 2, color = "gray") +
geom_histogram(bins = 15, color = "black", fill = "white") +
theme_bw() +
labs(x = "Change in value (acclimation - capture)", y = 'Count') +
theme(panel.grid.minor = element_blank())
p1 + p3 + plot_layout(ncol = 1)
ggsave(here::here('img/fig5-cloacal.png'), dpi = 400, width = 6, height = 6, units = 'in')
```
:::
## Distributions of primary measurements
The marginal distributions of individual measurements by species at capture and flexibility (log-scale change in CEWL) after acclimation are shown below.
```{r}
#| fig-width: 8
#| fig-height: 3.5
#| fig-cap: "Figure: Distributions of CEWL, osmolality, and mass by species and ambient measurement conditions at capture (top); distributions of physiological flexibility (log-scale change in CEWL) after acclimation (bottom)."
# capitalize tip labels
tree$tip.label <- str_to_sentence(tree$tip.label)
# choose a consistent plotting order for the tree first
tree_plot_order <- tree |> ape::ladderize(right = TRUE)
tip_order <- tree_plot_order$tip.label
# boxplots
sci_to_col <- species |>
mutate(sp.sci = str_to_sentence(sp.sci)) |>
with(setNames(cb_pal[toupper(sp.abbrv)], sp.sci))
p_box <- raw |>
left_join(select(species, sp.abbrv, sp.sci), join_by(species == sp.abbrv)) |>
mutate(spp = factor(str_to_sentence(sp.sci), levels = tip_order)) |>
select(id, day, cewl, spp) |>
mutate(cewl = log(cewl)) |>
spread(day, cewl) |>
mutate(change = acclimation - capture) |>
pivot_longer(acclimation:change, names_to = 'state', values_to = 'cewl') |>
mutate(state = recode(str_to_sentence(state), "Change" = "Flexibility")) |>
ggplot(aes(x = cewl, y = spp, fill = spp)) +
facet_grid(~state, scale = 'free_x') +
geom_boxplot(outlier.size = 0.5) +
scale_fill_manual(values = sci_to_col, guide = "none") +
labs(y = NULL, x = 'log(CEWL)') +
theme_bw() +
theme(panel.grid.minor = element_blank())
# ultrametric tree
p_tree <-
ggtree(tree_plot_order) +
geom_text2(aes(subset = !isTip & round(branch.length, 2) != 0,
label = round(branch.length, 2)),
hjust = -0.1, vjust = -0.6, size = 2.5, color = "blue") +
theme_tree2() +
scale_x_reverse() +
theme(
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank()
)
p_box + p_tree + plot_layout(widths = c(4, 2))
ggsave(here::here('img/fig6-distributions.png'), width = 7, height = 3, dpi = 400, units = 'in')
```
At a glance, only Chuckwallas showed clearly elevated flexibility (increased CEWL after acclimation). Owing to the difference in scale of flexibility across species, CEWL is shown on the log scale.
# Statistical modeling
::: callout-note
**A note on interpreting cross-sectional models.** The capture and acclimation models describe cross-sectional patterns at each phenotypic state — they answer *what predicts log(CEWL) at that moment*, not *what changed between states*. Differences in estimates between these two models should be interpreted with care: they may reflect differences in measurement conditions and individual baseline variation rather than responses to acclimation per se. For inferences specifically about physiological flexibility (change in CEWL after acclimation), the flexibility model is the appropriate tool.
:::
The framework for analysis is:
$$
\log(\text{CEWL}) \longleftarrow \text{osml} + \text{temp} + \text{vpd} + \text{species}
$$
Individuals with missing osmolality measurements (discussed above) are removed from analysis, and covariates are centered for ease of interpretation when fitting models.
```{r}
# analysis-ready capture data
cdata <- raw |>
filter(day == "capture") |>
select(id, species, osml, cewl, temp, vpd) |>
drop_na(osml) |>
mutate(across(c(osml, temp, vpd), ~scale(.x, scale = F)),
log.cewl = log(cewl))
# analysis-ready acclimation data
adata <- raw |>
filter(day == "acclimation") |>
select(id, species, osml, cewl, temp, vpd) |>
drop_na(osml) |>
mutate(across(c(osml, temp, vpd), ~scale(.x, scale = F)),
log.cewl = log(cewl))
# analysis-ready change data
ddata <- change |>
drop_na(osml) |>
select(id, species, log.cewl, osml, temp, vpd) |>
mutate(across(c(osml, temp, vpd), ~scale(.x, scale = F)))
```
## Phylogenetic mixed model specification
Denote the vector of CEWL measurements (or change in CEWL measurements) by $Y$ and the covariate measurements (or change in covariate measurements) by:
$$
X = (1 \; \text{osml} \; \text{temp} \; \text{vpd})
$$
To enter species into the model, encode the species membership of each individual by the $n \times S$ matrix:
$$
Z_S = \text{diag}(\mathbf{1}_{n_1}, \mathbf{1}_{n_2}, \dots, \mathbf{1}_{n_S})
$$
Here $\mathbf{1}_{n_s}$ denotes a vector of ones of length $n_s$, where $n_s$ denotes the sample size for species $s = 1, \dots, S$ (note $\sum_s n_s = n$).
::: callout-note
Preliminary analysis using a model with uncorrelated random effects was used to test for species/osmolality interactions; no such interactions were significant at the 5% level, though there is suggestive evidence of an interaction for the acclimation and flexibility models. This interaction term is retained. Additional interactions were not identifiable and could not be tested.
```{r, include = T}
## ---- at capture ----
# fit model 1
fit1_cap <- lmer(log.cewl ~ osml + temp + vpd + (1 | species),
data = cdata)
# fit model 2
fit2_cap <- lmer(log.cewl ~ osml + temp + vpd +
(1 + osml | species),
data = cdata,
control = lmerControl(optimizer = 'bobyqa',
optCtrl = list(maxfun = 1e6)))
# test for interactions
anova(fit1_cap, fit2_cap, type = 'LRT')
## ---- after acclimation ----
# fit model 1
fit1_acc <- lmer(log.cewl ~ osml + temp + vpd + (1 | species),
data = adata)
# fit model 2
fit2_acc <- lmer(log.cewl ~ osml + temp + vpd +
(1 + osml | species),
data = adata,
control = lmerControl(optimizer = 'bobyqa',
optCtrl = list(maxfun = 1e6)))
# test for interactions
anova(fit1_acc, fit2_acc, type = 'LRT')
## ---- deltas ----
# fit model 1
fit1_chg <- lmer(log.cewl ~ osml + temp + vpd + (1 | species),
data = ddata)
# fit model 2
fit2_chg <- lmer(log.cewl ~ osml + temp + vpd +
(1 + osml | species),
data = ddata,
control = lmerControl(optimizer = 'bobyqa',
optCtrl = list(maxfun = 1e6)))
# test for interactions
anova(fit1_chg, fit2_chg, type = 'LRT')
```
:::
To include an osmolality-species interaction term (see remark below), define $Z_I = Z_S \circ \left(\mathbf{1}_S^\top \otimes x_1\right)$ and specify the linear mixed model:
$$
Y = X\beta + Z_S \gamma_S + Z_I \gamma_I + \epsilon
$$
This is a random slope and random intercept model by species where $\gamma_S$ captures species-specific differences in mean log(CEWL) and $\gamma_I$ captures species-specific differences in the log(CEWL)–osmolality relationship. We assume $\epsilon \sim N(0, \sigma^2 I_n)$ independent of the random effects, and allow correlated intercepts and slopes with within-species covariance:
$$
\Delta = \text{var}\left(\begin{array}{c}\gamma_{Sj} \\ \gamma_{Ij}\end{array}\right)
= \left(\begin{array}{cc} \sigma_S^2 &\rho\sigma_S\sigma_I \\ \rho\sigma_S\sigma_I &\sigma_I^2\end{array}\right)
$$
Phylogenetic relationships may induce trait dependence between species in proportion to the length of shared evolutionary history. *Coleonyx variegatus* (Western Banded Gecko) is excluded from all statistical models: its small body size makes blood draws impractical, so osmolality measurements are unavailable for this species. Under a Brownian motion model of evolutionary drift, the phylogeny induces the following expected correlations among an arbitrary continuous trait for the remaining eight species:
```{r, results='asis'}
# trait covariance under bm — display version with abbreviation labels
v_display <- tree |>
drop.tip('Coleonyx variegatus') |>
vcv(model = 'Brownian', corr = T)
# relabel rows/cols with uppercase two-letter abbreviations
abb_lkp <- with(species, setNames(toupper(sp.abbrv), str_to_sentence(sp.sci)))
rownames(v_display) <- colnames(v_display) <- abb_lkp[rownames(v_display)]
# Convert to LaTeX bmatrix format (from GPT)
latex_matrix_named <- function(M, digits = 3, fmt = "fg", na_label = "") {
stopifnot(is.matrix(M))
M <- round(M, digits)
rn <- rownames(M); cn <- colnames(M)
if (is.null(rn)) rn <- as.character(seq_len(nrow(M)))
if (is.null(cn)) cn <- as.character(seq_len(ncol(M)))
# Escape LaTeX special chars in labels
esc <- function(x) {
x <- gsub("\\\\", "\\\\textbackslash{}", x)
x <- gsub("([#%&_{}$])", "\\\\\\1", x, perl = TRUE)
x <- gsub("\\^", "\\\\textasciicircum{}", x)
x <- gsub("~", "\\\\textasciitilde{}", x)
x
}
rn <- esc(rn); cn <- esc(cn)
# Build header and body
header <- paste0("& ", paste(cn, collapse = " & "), " \\\\")
num2tex <- function(v) paste(formatC(v, format = fmt, digits = digits), collapse = " & ")
body <- paste(
mapply(function(lbl, row) paste0(lbl, " & ", num2tex(row)), rn, split(M, row(M))),
collapse = " \\\\ \n"
)
# Array spec: one left label col + n centered numeric cols
spec <- paste0("l|", paste(rep("c", ncol(M)), collapse = ""))
out <- paste0(
"$$\n",
"V = \\quad \\begin{array}{", spec, "}\n",
header, "\n\\hline\n",
body, "\n",
"\\end{array}\n",
"$$"
)
knitr::asis_output(out)
}
cat(latex_matrix_named(v_display, 3))
```
We incorporate a phylogenetic correlation structure for the random intercepts only, so that $\gamma_S \sim N(0, \sigma^2_S V_\lambda)$ and $\gamma_I \sim N(0, \sigma^2_I I_S)$, where $V_\lambda = (1 - \lambda)I_S + \lambda V$ and $\lambda \in (0, 1)$ captures the strength of phylogenetic signal in the trait after adjusting for covariates. Within-species slope–intercept correlation $\rho = \text{Corr}(\gamma_{Sj}, \gamma_{Ij})$ is retained. Together these assumptions give the marginal covariance structure:
$$
\Sigma = \text{var}Y = \sigma^2_S Z_S V_\lambda Z_S^T + \rho\sigma_S\sigma_I\left(Z_S Z_I^T + Z_I Z_S^T\right) + \sigma^2_I Z_I Z_I^T + \sigma^2 I_n
$$
The model is estimated in a Bayesian framework with normal priors for regression coefficients and half-normal priors for variance parameters. We used the one-to-one reparametrization $\tau_S^2 = \sigma_S^2(1-\lambda)$ and $\tau_P^2 = \sigma_S^2\lambda$, which expands the intercept covariance term and gives:
$$
\Sigma = \text{var}Y = \tau^2_S Z_S Z_S^T + \tau^2_P Z_S V Z_S^T + \rho\sigma_S\sigma_I\left(Z_S Z_I^T + Z_I Z_S^T\right) + \sigma^2_I Z_I Z_I^T + \sigma^2 I_n
$$
Half-normal priors (specified as $\text{Normal}(0, \sigma)$ with a lower bound of zero) were used for all variance parameters. Exponential priors were avoided because their sharp spike at zero creates a funnel-shaped posterior geometry when variance components are small, which produces divergent transitions and poor sampler efficiency. All three models share log(CEWL) as the outcome, so prior scales were calibrated to the log scale throughout. For the capture and acclimation models, the log(CEWL) outcome has mean $\approx 2.4$ and SD $\approx 0.5$–$0.8$, giving fixed-effect priors $\text{Normal}(0, 2)$ for the intercept and $\text{Normal}(0, 1)$ for slopes, and variance priors $\tau_S \sim \text{HN}(0, 1)$, $\tau_P \sim \text{HN}(0, 0.5)$, and $\sigma \sim \text{HN}(0, 1)$. The flexibility model outcome (log-scale CEWL change, i.e., log($\Delta$CEWL)) has mean $\approx 0$ and SD $\approx 0.6$, giving $\text{Normal}(0, 1)$ for the intercept, $\text{Normal}(0, 2)$ for slopes (to accommodate larger VPD effects), and $\text{HN}(0, 0.5)$ for both $\tau_S$ and $\tau_P$. Note that $\rho$ applies only to the iid intercept component $\tau_S$; the phylogenetic component $\tau_P$ is assumed independent of the slope.
```{r, eval = F}
# rebuild v_mx with species abbreviations to match grouping levels in data
# str_to_sentence() applied to tree$tip.label to match case of species lookup
tree_abb <- tree
tree_abb$tip.label <- with(species, setNames(sp.abbrv, str_to_sentence(sp.sci))) |>
(\(lkp) unname(lkp[str_to_sentence(tree$tip.label)]))()
v_mx <- tree_abb |> drop.tip('bg') |> vcv(model = 'Brownian', corr = T)
## ---- fit to capture data ----
# log.cewl mean ~2.37, SD ~0.48; half-normal priors calibrated to log scale
priors <- c(
prior(normal(0, 2), class = "Intercept"),
prior(normal(0, 1), class = "b"),
prior(normal(0, 1), class = "sd", group = "spp"),
prior(normal(0, 0.5), class = "sd", group = "phy"),
prior(normal(0, 1), class = "sigma")
)
fit_phy_cap <- cdata |>
mutate(spp = factor(species),
phy = factor(species)) %>%
brm(log.cewl ~ osml + temp + vpd +
(1 + osml | spp) +
(1 | gr(phy, cov = V)),
data = .,
data2 = list(V = v_mx),
prior = priors,
chains = 6,
iter = 4000,
warmup = 2000,
control = list(adapt_delta = 0.99,
max_treedepth = 15),
seed = 41826,
family = gaussian())
## ---- fit to acclimation data ----
# log.cewl mean ~2.42, SD ~0.77
priors <- c(
prior(normal(0, 2), class = "Intercept"),
prior(normal(0, 1), class = "b"),
prior(normal(0, 1), class = "sd", group = "spp"),
prior(normal(0, 0.5), class = "sd", group = "phy"),
prior(normal(0, 1), class = "sigma")
)
fit_phy_acc <- adata |>
mutate(spp = factor(species),
phy = factor(species)) %>%
brm(log.cewl ~ osml + temp + vpd +
(1 + osml | spp) +
(1 | gr(phy, cov = V)),
data = .,
data2 = list(V = v_mx),
prior = priors,
chains = 6,
iter = 4000,
warmup = 2000,
control = list(adapt_delta = 0.99,
max_treedepth = 15),
seed = 102625,
family = gaussian())
## ---- fit to change data ----
# priors rescaled to log-cewl outcome
priors <- c(
prior(normal(0, 1), class = "Intercept"),
prior(normal(0, 2), class = "b"),
prior(normal(0, 0.5), class = "sd", group = "spp"),
prior(normal(0, 0.5), class = "sd", group = "phy"),
prior(normal(0, 1), class = "sigma")
)
fit_phy_chg <- ddata |>
mutate(spp = factor(species),
phy = factor(species)) %>%
brm(log.cewl ~ osml + temp + vpd +
(1 + osml | spp) +
(1 | gr(phy, cov = V)),
data = .,
data2 = list(V = v_mx),
prior = priors,
chains = 6,
iter = 4000,
warmup = 2000,
control = list(adapt_delta = 0.99,
max_treedepth = 15),
seed = 102625,
family = gaussian())
```
```{r}
# fit models if not already done, then load results
rdata_path <- here::here('rslt/bpmm-fit.RData')
if (!file.exists(rdata_path)) source(here::here('scripts/model-fitting.R'))
load(rdata_path)
```
## Analysis of capture data
```{r}
glue::glue("Sample size: n = {nrow(cdata)} individuals across {n_distinct(cdata$species)} species (after removing missing osmolality values).")
```
### Model diagnostic checks
Diagnostic MCMC trace and density plots show good chain mixing and consistent posteriors, indicating successful convergence.
```{r}
#| fig-width: 12
#| fig-height: 4
#| fig-cap: "Figure: Trace (left) and posterior density (right) plots for each model parameter."
# label customization
labels <- c(
"b_Intercept" = "Intercept~(beta[0])",
"b_osml" = "Osmolality~(beta[osml])",
"b_temp" = "Temperature~(beta[temp])",
"b_vpd" = "VPD~(beta[vpd])",
"sd_spp__Intercept" = "Species~intercept~iid~(tau[S])",
"sd_spp__osml" = "Osmolality~slope~SD~(sigma[I])",
"cor_spp__Intercept__osml" = "Intercept-slope~corr.~(rho)",
"sd_phy__Intercept" = "Phylogenetic~intercept~(tau[P])",
"sigma" = "Residual~SD~(sigma[epsilon])"
)
plot_pars <- names(labels)
facet_labeller <- labeller(parameter = as_labeller(labels, default = label_parsed))
bayesplot::color_scheme_set("blue")
cols <- bayesplot::color_scheme_get() |> as_vector()
names(cols) <- 6:1
# mcmc trace plots
p_trace <- mcmc_plot(fit_phy_cap,
type = "trace",
variable = plot_pars,
facet_args = list(nrow = 3, ncol = 3)) +
guides(color = guide_none()) +
scale_colour_manual(values = cols, name = "Chain") +
facet_wrap(~ parameter, nrow = 3, ncol = 3, labeller = facet_labeller, scales = 'free_y') +
theme_minimal(base_family = "Helvetica", base_size = 11) +
theme(
panel.grid.minor = element_blank(),
axis.text.x = element_blank(),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA),
legend.position = 'none'
) +
labs(x = 'Iteration', y = 'Draw')
# per-chain posterior densities
df <- as_draws_df(fit_phy_cap) %>%
select(.chain, all_of(plot_pars)) %>%
pivot_longer(-.chain, names_to = "parameter", values_to = "value") %>%
mutate(
parameter = factor(parameter, levels = names(labels), labels = labels),
.chain = factor(.chain)
)
p_dens <- ggplot(df, aes(x = value, colour = .chain)) +
geom_line(stat = 'density', linewidth = 0.6, alpha = 0.7) +
scale_colour_manual(values = cols, name = "Chain") +
facet_wrap(~ parameter, labeller = label_parsed, nrow = 3, ncol = 3, scales = "free") +
theme_minimal(base_family = "Helvetica", base_size = 11) +
theme(
panel.grid = element_blank(),
axis.text.y = element_blank(),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA)
) +
labs(x = "Parameter value", y = "Density")
# panel layout
(p_trace | p_dens)
# export
ggsave(here::here("img/fig7-cap-traces.png"), width = 14, height = 6, dpi = 400, units = 'in')
```
```{r}
#| fig-width: 10
#| fig-height: 10
#| fig-cap: "Figure: Pairs plots for variance parameters."
# pairs plots for variance components
bayesplot::bayesplot_theme_set(theme_minimal(base_size = 11))
bayesplot::bayesplot_theme_update(
panel.background = element_rect(fill = "white", color = NA),
plot.background = element_rect(fill = "white", color = NA),
panel.grid.minor = element_blank()
)
p <- pairs(fit_phy_cap, variable = c("sd_spp__Intercept",
"sd_spp__osml",
"cor_spp__Intercept__osml",
"sd_phy__Intercept",
"sigma"))
p
ggsave(here::here("img/fig8-cap-pairs.png"), p, width = 7, height = 7, dpi = 400, units = 'in')
```
### Coefficient estimates
::: callout-note
**Guide to reading these results.** All estimates are on the log(CEWL) scale; to convert to a multiplicative effect on raw CEWL, exponentiate: a slope of $\beta$ means a 1-unit increase in the predictor is associated with an $e^\beta$-fold change in CEWL. For example, the capture model temperature slope of $\approx 0.175$ means each 1°C increase is associated with $e^{0.175} \approx 1.19$, or roughly a **19% increase** in CEWL. The 95% credible interval (CI) is the range of values that the posterior assigns 95% probability to — if the CI excludes zero, the association is considered credible. Key variance parameters:
- $\tau_S$ (species intercept iid SD): typical spread in baseline log(CEWL) across species, after removing phylogenetic structure
- $\tau_P$ (phylogenetic SD): how much of species-level variation is attributable to shared evolutionary history; feeds into $\lambda$ below
- $\lambda$ (phylogenetic signal): proportion of total species variation explained by phylogeny (0 = no phylogenetic structure; 1 = trait perfectly tracks the phylogenetic tree)
- $\sigma_I$ (slope SD): how much the osmolality–log(CEWL) slope varies across species
- $\rho$ (intercept–slope correlation): whether species with higher baseline log(CEWL) also tend to have stronger (or weaker) osmolality responses
- $\sigma_\epsilon$ (residual SD): unexplained individual-level variation after accounting for species and phylogeny
:::
The table below shows parameter estimates.
```{r}
# table for variance parameters
draws <- as_draws_df(fit_phy_cap)
sd_spp <- draws$`sd_spp__Intercept`
sd_phy <- draws$`sd_phy__Intercept`
sigma_S <- sqrt(sd_spp^2 + sd_phy^2)
lambda <- (sd_phy^2) / sigma_S^2
sigma_I <- draws$sd_spp__osml
rho <- draws$cor_spp__Intercept__osml
sigma <- draws$sigma
rand_tbl <- tibble(
term = c("lambda", "sigma_S", "sigma_I", "rho", "sigma_eps"),
estimate = c(mean(lambda), mean(sigma_S), mean(sigma_I), mean(rho), mean(sigma)),
lwr = c(quantile(lambda, 0.025), quantile(sigma_S, 0.025), quantile(sigma_I, 0.025), quantile(rho, 0.025), quantile(sigma, 0.025)),
upr = c(quantile(lambda, 0.975), quantile(sigma_S, 0.975), quantile(sigma_I, 0.975), quantile(rho, 0.975), quantile(sigma, 0.975))
)
# table for regression coefficients
fixed_tbl <- fixef(fit_phy_cap, probs = c(0.025, 0.975)) %>%
as.data.frame() %>%
rownames_to_column("term") %>%
rename(estimate = Estimate,
lwr = Q2.5,
upr = Q97.5) |>
select(-Est.Error)
# table of parameter estimates
coef_tbl_cap <- bind_rows(fixed_tbl, rand_tbl)
coef_tbl_cap |>
pander(caption = 'Table: parameter estimates and 95% credible intervals')
```
The figure below shows the posterior densities for each parameter from the MCMC draws, and two posterior predictive checks (PPCs): a scatter of individual predicted versus observed means, and a density overlay comparing replicated datasets from the posterior to the observed distribution. Together these check both mean-level accuracy and distributional shape.
```{r}
#| fig-width: 8
#| fig-height: 8
#| fig-cap: "Figure: Posterior densities (top); posterior predictive checks — predicted vs. observed means (bottom left) and posterior predictive density overlay (bottom right)."
## posterior densities
# ---- Extract and transform ----
draws <- as_draws_df(fit_phy_cap) %>%
mutate(
sigma_S = sqrt(sd_phy__Intercept^2 + sd_spp__Intercept^2),
lambda = sd_phy__Intercept^2 / (sd_phy__Intercept^2 + sd_spp__Intercept^2),
sigma_I = sd_spp__osml,
rho = cor_spp__Intercept__osml
)
# ---- Select parameters ----
keep <- c(
colnames(draws)[1:4],
c("sigma", "sigma_S", "lambda", "sigma_I", "rho")
)
long <- draws %>%
select(all_of(keep)) %>%
pivot_longer(everything(), names_to = "parameter", values_to = "value") %>%
mutate(parameter = factor(parameter, levels = c("b_Intercept", "b_osml", "b_temp", "b_vpd", "sigma_I", "sigma_S", "rho", "sigma", "lambda")))
# ---- Compute intervals ----
alpha_lo <- 0.05; alpha_hi <- 0.95
ints <- long %>%
group_by(parameter) %>%
summarise(
lo = quantile(value, alpha_lo),
hi = quantile(value, alpha_hi),
med = median(value),
.groups = "drop"
)
# ---- Create clean labels ----
labels <- c(
"b_Intercept" = "Intercept~(beta[0])",
"b_log.mass" = "log(Mass)~(beta[1])",
"b_osml" = "Osmolality~(beta[2])",
"b_temp" = "Temperature~(beta[3])",
"b_vpd" = "VPD~(beta[4])",
"sigma" = "Residual~SD~(sigma[epsilon])",
"sigma_S" = "Species~intercept~SD~(sigma[S])",
"lambda" = "Phylogenetic~signal~(lambda)",
"sigma_I" = "Osmolality~slope~SD~(sigma[I])",
"rho" = "Intercept-slope~correlation~(rho)"
)
facet_labeller <- labeller(parameter = as_labeller(labels, default = label_parsed))
# ---- Plot ----
p_dens_cap <- ggplot(long, aes(x = value)) +
geom_density(fill = "grey85", color = "grey30", linewidth = 0.4) +
geom_vline(data = ints, aes(xintercept = lo), linetype = 2, color = "firebrick") +
geom_vline(data = ints, aes(xintercept = hi), linetype = 2, color = "firebrick") +
geom_vline(data = ints, aes(xintercept = med), linetype = 2, color = "black") +
facet_wrap(~ parameter, scales = "free", labeller = facet_labeller, ncol = 3) +
labs(
x = "Parameter value",
y = "Posterior density"
) +
theme_minimal(base_size = 11) +
theme(
panel.background = element_rect(fill = "white", colour = NA),
strip.background = element_rect(fill = "white", colour = "white"),
panel.grid = element_blank(),
axis.text.y = element_blank(),
)
## posterior predictive checks
p_pp_cap <- pp_check(fit_phy_cap, ndraws = 100, type = 'scatter_avg') +
guides(color = guide_none()) +
labs(y = 'Observed log(CEWL)', x = 'Predicted log(CEWL)') +
theme_minimal(base_family = "Helvetica", base_size = 11) +
theme(
panel.grid.minor = element_blank(),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA)
)
p_ppc_dens_cap <- pp_check(fit_phy_cap, ndraws = 50, type = 'dens_overlay') +
guides(color = guide_none()) +
labs(x = 'log(CEWL)', y = 'Density') +
theme_minimal(base_family = "Helvetica", base_size = 11) +
theme(
panel.grid.minor = element_blank(),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA)
)
p_dens_cap / (p_pp_cap | p_ppc_dens_cap)
ggsave(here::here("img/fig9-cap-posteriors.png"), width = 6, height = 8, dpi = 400, units = 'in')
```
Owing to the random slopes and intercepts, each species has a distinct estimated baseline log(CEWL) when covariates are fixed at their means, and a distinct slope in osmolality. The table below shows the species-specific estimates.
```{r}
# coefficient estimates
coef(fit_phy_cap)$spp[, 1, 1:2] |>
pander(caption = 'Table: species-specific relationships after adjusting for phylogeny')
```
Displayed visually:
```{r}
#| fig-width: 10
#| fig-height: 4
#| fig-cap: "Figure: (Left) Species-specific intercepts and osmolality slopes (95% CI); dashed line shows population-average. (Right) Implied species-specific osmolality–log(CEWL) relationships at average temperature and VPD."
coef_arr <- coef(fit_phy_cap)$spp
common_to_col <- species |>
mutate(sp.common = str_to_title(sp.common)) |>
with(setNames(cb_pal[toupper(sp.abbrv)], sp.common))
p_coef <- bind_rows(
as.data.frame(coef_arr[,, "Intercept"]) |>
rownames_to_column("sp.abbrv") |>
mutate(param = "Intercept"),
as.data.frame(coef_arr[,, "osml"]) |>
rownames_to_column("sp.abbrv") |>
mutate(param = "Osmolality slope")
) |>
left_join(species |> select(sp.abbrv, sp.common), join_by(sp.abbrv)) |>
mutate(sp.common = str_to_title(sp.common)) |>
ggplot(aes(x = Estimate,
xmin = Q2.5, xmax = Q97.5,
y = fct_reorder(sp.common, Estimate),
color = sp.common)) +
geom_pointrange(linewidth = 0.4) +
scale_color_manual(values = common_to_col, guide = "none") +
geom_vline(
data = data.frame(
param = c("Intercept", "Osmolality slope"),
ref = c(fixef(fit_phy_cap)["Intercept", "Estimate"],
fixef(fit_phy_cap)["osml", "Estimate"])
),
aes(xintercept = ref), linetype = 2, color = "firebrick"
) +
facet_wrap(~ param, scales = "free_x") +
labs(x = "Estimate (95% CI)", y = NULL) +
theme_minimal(base_size = 11) +
theme(panel.grid.minor = element_blank(),
panel.background = element_rect(fill = "white", colour = NA),
axis.text.x = element_text(angle = 90))
mean_osml <- mean(capture$osml, na.rm = TRUE)
osml_seq <- seq(min(cdata$osml), max(cdata$osml), length.out = 100)
line_df <- as.data.frame(coef_arr[,, "Intercept"]) |>
rownames_to_column("sp.abbrv") |>
rename(int = Estimate) |>
bind_cols(as.data.frame(coef_arr[,, "osml"]) |> select(slope = Estimate)) |>
left_join(species |> select(sp.abbrv, sp.common), join_by(sp.abbrv)) |>
mutate(sp.common = str_to_title(sp.common)) |>
crossing(osml_c = osml_seq) |>
mutate(log.cewl = int + slope * osml_c, osml = osml_c + mean_osml)
p_lines <- capture |>
drop_na(osml) |>
left_join(species |> select(sp.abbrv, sp.common), by = c("species" = "sp.abbrv")) |>
mutate(sp.common = str_to_title(sp.common)) |>
ggplot(aes(x = osml, y = log(cewl), color = sp.common)) +
geom_point(alpha = 0.5, size = 1.5) +
geom_line(data = line_df, aes(y = log.cewl), linewidth = 0.8) +
scale_color_manual(values = common_to_col) +
labs(x = "Osmolality (mOsm/kg)", y = "log(CEWL) at capture", color = NULL) +
theme_minimal(base_size = 11) +
theme(panel.background = element_rect(fill = "white", colour = NA),
panel.grid.minor = element_blank(),
legend.position = "right")
p_coef + p_lines
ggsave(here::here("img/fig10-cap-coefficients.png"), width = 11, height = 4, dpi = 400, units = 'in')
```
### Summary of findings
- At mean conditions, mean log(CEWL) is estimated to be 2.36 (95% CI: 1.70, 2.93), corresponding to approximately 5.5–18.8 $g/m^2h$ on the raw scale
- There is no credible association between log(CEWL) and osmolality (95% CI: −0.002 to 0.007)
- Temperature is credibly and positively associated with log(CEWL): each 1°C increase is associated with $e^{0.175} \approx 1.19$-fold higher CEWL (95% CI on slope: 0.096 to 0.254)
- VPD is credibly and negatively associated with log(CEWL) (95% CI on slope: −1.045 to −0.161), consistent with higher ambient evaporative demand reducing CEWL
- Species-specific variation in log(CEWL) is estimated at $\hat{\sigma}_s$ = 0.37 (95% CI: 0.04, 0.80)
- Phylogenetic signal is highly uncertain ($\lambda$: median 0.36, 95% CI ≈ 0 to 1.0); the posterior spans nearly the full unit interval and the data do not meaningfully constrain $\lambda$
- The slope/intercept correlation is imprecisely estimated (95% CI: −0.965 to 0.709), with a weakly negative central tendency suggesting species with higher baseline log(CEWL) may exhibit a shallower osmolality response
## Analysis of acclimation data
```{r}
glue::glue("Sample size: n = {nrow(adata)} individuals across {n_distinct(adata$species)} species (after removing missing osmolality values).")
```
### Model diagnostic checks
Diagnostic MCMC trace and density plots show good chain mixing and consistent posteriors, indicating successful convergence.
```{r}
#| fig-width: 12
#| fig-height: 4
#| fig-cap: "Figure: Trace (left) and posterior density (right) plots for each model parameter."
# label customization
labels <- c(
"b_Intercept" = "Intercept~(beta[0])",
"b_osml" = "Osmolality~(beta[osml])",
"b_temp" = "Temperature~(beta[temp])",
"b_vpd" = "VPD~(beta[vpd])",
"sd_spp__Intercept" = "Species~intercept~iid~(tau[S])",
"sd_spp__osml" = "Osmolality~slope~SD~(sigma[I])",
"cor_spp__Intercept__osml" = "Intercept-slope~corr.~(rho)",
"sd_phy__Intercept" = "Phylogenetic~intercept~(tau[P])",
"sigma" = "Residual~SD~(sigma[epsilon])"
)
plot_pars <- names(labels)
facet_labeller <- labeller(parameter = as_labeller(labels, default = label_parsed))
bayesplot::color_scheme_set("blue")
cols <- bayesplot::color_scheme_get() |> as_vector()
names(cols) <- 6:1
# mcmc trace plots
p_trace <- mcmc_plot(fit_phy_acc,
type = "trace",
variable = plot_pars,
facet_args = list(nrow = 3, ncol = 3)) +
guides(color = guide_none()) +
scale_colour_manual(values = cols, name = "Chain") +
facet_wrap(~ parameter, nrow = 3, ncol = 3, labeller = facet_labeller, scales = 'free_y') +
theme_minimal(base_family = "Helvetica", base_size = 11) +
theme(
panel.grid.minor = element_blank(),
axis.text.x = element_blank(),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA),
legend.position = 'none'
) +
labs(x = 'Iteration', y = 'Draw')
# per-chain posterior densities
df <- as_draws_df(fit_phy_acc) %>%
select(.chain, all_of(plot_pars)) %>%
pivot_longer(-.chain, names_to = "parameter", values_to = "value") %>%
mutate(
parameter = factor(parameter, levels = names(labels), labels = labels),
.chain = factor(.chain)
)
p_dens <- ggplot(df, aes(x = value, colour = .chain)) +
geom_line(stat = 'density', linewidth = 0.6, alpha = 0.7) +
scale_colour_manual(values = cols, name = "Chain") +
facet_wrap(~ parameter, labeller = label_parsed, nrow = 3, ncol = 3, scales = "free") +
theme_minimal(base_family = "Helvetica", base_size = 11) +
theme(
panel.grid = element_blank(),
axis.text.y = element_blank(),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA)
) +
labs(x = "Parameter value", y = "Density")
# panel layout
(p_trace | p_dens)
# export
ggsave(here::here("img/fig11-acc-traces.png"), width = 14, height = 6, dpi = 400, units = 'in')
```
Pairs plots of the posterior draws for the variance parameters.
```{r}
#| fig-width: 10
#| fig-height: 10
#| fig-cap: "Figure: Pairs plots for variance parameters."
bayesplot::bayesplot_theme_set(theme_minimal(base_size = 11))
bayesplot::bayesplot_theme_update(
panel.background = element_rect(fill = "white", color = NA),
plot.background = element_rect(fill = "white", color = NA),
panel.grid.minor = element_blank()
)
p <- pairs(fit_phy_acc, variable = c("sd_spp__Intercept",
"sd_spp__osml",
"cor_spp__Intercept__osml",
"sd_phy__Intercept",
"sigma"))
p
ggsave(here::here("img/fig12-acc-pairs.png"), p, width = 7, height = 7, dpi = 400, units = 'in')
```
### Coefficient estimates
::: callout-note
Parameters are interpreted as in the capture section. The intercept here represents log(CEWL) in the absence of hydric stress and field ecological variation. A larger $\sigma_S$ relative to the capture model would indicate that acclimation reveals greater between-species heterogeneity than is visible under field conditions.
:::
The table below shows parameter estimates.
```{r}
# table for variance parameters
draws <- as_draws_df(fit_phy_acc)
sd_spp <- draws$`sd_spp__Intercept`
sd_phy <- draws$`sd_phy__Intercept`
sigma_S <- sqrt(sd_spp^2 + sd_phy^2)
lambda <- (sd_phy^2) / sigma_S^2
sigma_I <- draws$sd_spp__osml
rho <- draws$cor_spp__Intercept__osml
sigma <- draws$sigma
rand_tbl <- tibble(
term = c("lambda", "sigma_S", "sigma_I", "rho", "sigma_eps"),
estimate = c(mean(lambda), mean(sigma_S), mean(sigma_I), mean(rho), mean(sigma)),
lwr = c(quantile(lambda, 0.025), quantile(sigma_S, 0.025), quantile(sigma_I, 0.025), quantile(rho, 0.025), quantile(sigma, 0.025)),
upr = c(quantile(lambda, 0.975), quantile(sigma_S, 0.975), quantile(sigma_I, 0.975), quantile(rho, 0.975), quantile(sigma, 0.975))
)
# table for regression coefficients
fixed_tbl <- fixef(fit_phy_acc, probs = c(0.025, 0.975)) %>%
as.data.frame() %>%
rownames_to_column("term") %>%
rename(estimate = Estimate,
lwr = Q2.5,
upr = Q97.5) |>
select(-Est.Error)
# table of parameter estimates
coef_tbl_acc <- bind_rows(fixed_tbl, rand_tbl)
coef_tbl_acc |>
pander(caption = 'Table: parameter estimates and 95% credible intervals')
```
The figure below shows the posterior densities for each parameter and two posterior predictive checks.
```{r}
#| fig-width: 8
#| fig-height: 8
#| fig-cap: "Figure: Posterior densities (top); posterior predictive checks — predicted vs. observed means (bottom left) and posterior predictive density overlay (bottom right)."
# ---- Extract and transform ----
draws <- as_draws_df(fit_phy_acc) %>%
mutate(
sigma_S = sqrt(sd_phy__Intercept^2 + sd_spp__Intercept^2),
lambda = sd_phy__Intercept^2 / (sd_phy__Intercept^2 + sd_spp__Intercept^2),
sigma_I = sd_spp__osml,
rho = cor_spp__Intercept__osml
)
# ---- Select parameters ----
keep <- c(
colnames(draws)[1:4],
c("sigma", "sigma_S", "lambda", "sigma_I", "rho")
)
long <- draws %>%
select(all_of(keep)) %>%
pivot_longer(everything(), names_to = "parameter", values_to = "value") %>%
mutate(parameter = factor(parameter, levels = c("b_Intercept", "b_osml", "b_temp", "b_vpd", "sigma_I", "sigma_S", "rho", "sigma", "lambda")))
# ---- Compute intervals ----
alpha_lo <- 0.05; alpha_hi <- 0.95
ints <- long %>%
group_by(parameter) %>%
summarise(
lo = quantile(value, alpha_lo),
hi = quantile(value, alpha_hi),
med = median(value),
.groups = "drop"
)
# ---- Create clean labels ----
labels <- c(
"b_Intercept" = "Intercept~(beta[0])",
"b_osml" = "Osmolality~(beta[2])",
"b_temp" = "Temperature~(beta[3])",
"b_vpd" = "VPD~(beta[4])",
"sigma" = "Residual~SD~(sigma[epsilon])",
"sigma_S" = "Species~intercept~SD~(sigma[S])",
"lambda" = "Phylogenetic~signal~(lambda)",
"sigma_I" = "Osmolality~slope~SD~(sigma[I])",
"rho" = "Intercept-slope~correlation~(rho)"
)
facet_labeller <- labeller(parameter = as_labeller(labels, default = label_parsed))
# ---- Plot ----
p_dens_acc <- ggplot(long, aes(x = value)) +
geom_density(fill = "grey85", color = "grey30", linewidth = 0.4) +
geom_vline(data = ints, aes(xintercept = lo), linetype = 2, color = "firebrick") +
geom_vline(data = ints, aes(xintercept = hi), linetype = 2, color = "firebrick") +
geom_vline(data = ints, aes(xintercept = med), linetype = 2, color = "black") +
facet_wrap(~ parameter, scales = "free", labeller = facet_labeller, ncol = 3) +
labs(
x = "Parameter value",
y = "Posterior density"
) +
theme_minimal(base_size = 11) +
theme(
panel.background = element_rect(fill = "white", colour = NA),
strip.background = element_rect(fill = "white", colour = "white"),
panel.grid = element_blank(),
axis.text.y = element_blank(),
)
## posterior predictive checks
p_pp_acc <- pp_check(fit_phy_acc, ndraws = 100, type = 'scatter_avg') +
guides(color = guide_none()) +
labs(y = 'Observed log(CEWL) at acclimation', x = 'Predicted log(CEWL) at acclimation') +
theme_minimal(base_family = "Helvetica", base_size = 11) +
theme(
panel.grid.minor = element_blank(),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA)
)
p_ppc_dens_acc <- pp_check(fit_phy_acc, ndraws = 50, type = 'dens_overlay') +
guides(color = guide_none()) +
labs(x = 'log(CEWL) at acclimation', y = 'Density') +
theme_minimal(base_family = "Helvetica", base_size = 11) +
theme(
panel.grid.minor = element_blank(),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA)
)
p_dens_acc / (p_pp_acc | p_ppc_dens_acc)
ggsave(here::here("img/fig13-acc-posteriors.png"), width = 6, height = 8, dpi = 400, units = 'in')
```
Owing to the random slopes and intercepts, each species has a distinct estimated baseline log(CEWL) at acclimation and a distinct slope in osmolality. The table below shows the species-specific estimates.
```{r}
# coefficient estimates
coef(fit_phy_acc)$spp[, 1, 1:2] |>
pander(caption = 'Table: species-specific relationships after adjusting for phylogeny')
```
Displayed visually:
```{r}
#| fig-width: 10
#| fig-height: 4
#| fig-cap: "Figure: (Left) Species-specific intercepts and osmolality slopes (95% CI); dashed line shows population-average. (Right) Implied species-specific osmolality–log(CEWL) relationships at average temperature and VPD."
coef_arr <- coef(fit_phy_acc)$spp
common_to_col <- species |>
mutate(sp.common = str_to_title(sp.common)) |>
with(setNames(cb_pal[toupper(sp.abbrv)], sp.common))
p_coef <- bind_rows(
as.data.frame(coef_arr[,, "Intercept"]) |>
rownames_to_column("sp.abbrv") |>
mutate(param = "Intercept"),
as.data.frame(coef_arr[,, "osml"]) |>
rownames_to_column("sp.abbrv") |>
mutate(param = "Osmolality slope")
) |>
left_join(species |> select(sp.abbrv, sp.common), join_by(sp.abbrv)) |>
mutate(sp.common = str_to_title(sp.common)) |>
ggplot(aes(x = Estimate,
xmin = Q2.5, xmax = Q97.5,
y = fct_reorder(sp.common, Estimate),
color = sp.common)) +
geom_pointrange(linewidth = 0.4) +
scale_color_manual(values = common_to_col, guide = "none") +
geom_vline(
data = data.frame(
param = c("Intercept", "Osmolality slope"),
ref = c(fixef(fit_phy_acc)["Intercept", "Estimate"],
fixef(fit_phy_acc)["osml", "Estimate"])
),
aes(xintercept = ref), linetype = 2, color = "firebrick"
) +
facet_wrap(~ param, scales = "free_x") +
labs(x = "Estimate (95% CI)", y = NULL) +
theme_minimal(base_size = 11) +
theme(panel.grid.minor = element_blank(),
panel.background = element_rect(fill = "white", colour = NA),
axis.text.x = element_text(angle = 90))
mean_osml <- mean(raw$osml[raw$day == "acclimation"], na.rm = TRUE)
osml_seq <- seq(min(adata$osml), max(adata$osml), length.out = 100)
line_df <- as.data.frame(coef_arr[,, "Intercept"]) |>
rownames_to_column("sp.abbrv") |>
rename(int = Estimate) |>
bind_cols(as.data.frame(coef_arr[,, "osml"]) |> select(slope = Estimate)) |>
left_join(species |> select(sp.abbrv, sp.common), join_by(sp.abbrv)) |>
mutate(sp.common = str_to_title(sp.common)) |>
crossing(osml_c = osml_seq) |>
mutate(log.cewl = int + slope * osml_c, osml = osml_c + mean_osml)
p_lines <- raw |>
filter(day == "acclimation") |>
drop_na(osml) |>
left_join(species |> select(sp.abbrv, sp.common), by = c("species" = "sp.abbrv")) |>
mutate(sp.common = str_to_title(sp.common)) |>
ggplot(aes(x = osml, y = log(cewl), color = sp.common)) +
geom_point(alpha = 0.5, size = 1.5) +
geom_line(data = line_df, aes(y = log.cewl), linewidth = 0.8) +
scale_color_manual(values = common_to_col) +
labs(x = "Osmolality (mOsm/kg)", y = "log(CEWL) at acclimation", color = NULL) +
theme_minimal(base_size = 11) +
theme(panel.background = element_rect(fill = "white", colour = NA),
panel.grid.minor = element_blank(),
legend.position = "right")
p_coef + p_lines
ggsave(here::here("img/fig14-acc-coefficients.png"), width = 11, height = 4, dpi = 400, units = 'in')
```
### Summary of findings
- At mean conditions, mean log(CEWL) at acclimation is estimated to be 2.37 (95% CI: 1.42, 3.22)
- There is no credible association between log(CEWL) and osmolality (95% CI: −0.006 to 0.007)
- Neither temperature nor VPD is credibly associated with log(CEWL) at acclimation (temp 95% CI: −0.152 to 0.144; VPD 95% CI: −0.511 to 0.941) — in contrast to the capture model
- Species-specific variation in log(CEWL) is larger at acclimation ($\hat{\sigma}_s$ = 0.73, 95% CI: 0.14, 1.41) than at capture ($\hat{\sigma}_s$ = 0.37), suggesting field conditions partially compress apparent species differences
- Phylogenetic signal is highly uncertain ($\lambda$: median 0.21, 95% CI ≈ 0 to 0.98)
- The slope/intercept correlation is imprecisely estimated (95% CI: −0.962 to 0.593), with a weakly negative central tendency
## Analysis of flexibility
```{r}
glue::glue("Sample size: n = {nrow(ddata)} individuals across {n_distinct(ddata$species)} species with complete osmolality measurements at both time points (used to compute log-scale flexibility).")
```
### Model diagnostic checks
Diagnostic MCMC trace and density plots show good chain mixing and consistent posteriors, indicating successful convergence.
```{r}
#| fig-width: 12
#| fig-height: 4
#| fig-cap: "Figure: Trace (left) and posterior density (right) plots for each model parameter."
# label customization
labels <- c(
"b_Intercept" = "Intercept~(beta[0])",
"b_osml" = "Osmolality~(beta[osml])",
"b_temp" = "Temperature~(beta[temp])",
"b_vpd" = "VPD~(beta[vpd])",
"sd_spp__Intercept" = "Species~intercept~iid~(tau[S])",
"sd_spp__osml" = "Osmolality~slope~SD~(sigma[I])",
"cor_spp__Intercept__osml" = "Intercept-slope~corr.~(rho)",
"sd_phy__Intercept" = "Phylogenetic~intercept~(tau[P])",
"sigma" = "Residual~SD~(sigma[epsilon])"
)
plot_pars <- names(labels)
facet_labeller <- labeller(parameter = as_labeller(labels, default = label_parsed))
bayesplot::color_scheme_set("blue")
cols <- bayesplot::color_scheme_get() |> as_vector()
names(cols) <- 6:1
# mcmc trace plots
p_trace <- mcmc_plot(fit_phy_chg,
type = "trace",
variable = plot_pars,
facet_args = list(nrow = 3, ncol = 3)) +
guides(color = guide_none()) +
scale_colour_manual(values = cols, name = "Chain") +
facet_wrap(~ parameter, nrow = 3, ncol = 3, labeller = facet_labeller, scales = 'free_y') +
theme_minimal(base_family = "Helvetica", base_size = 11) +
theme(
panel.grid.minor = element_blank(),
axis.text.x = element_blank(),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA),
legend.position = 'none'
) +
labs(x = 'Iteration', y = 'Draw')
# per-chain posterior densities
df <- as_draws_df(fit_phy_chg) %>%
select(.chain, all_of(plot_pars)) %>%
pivot_longer(-.chain, names_to = "parameter", values_to = "value") %>%
mutate(
parameter = factor(parameter, levels = names(labels), labels = labels),
.chain = factor(.chain)
)
p_dens <- ggplot(df, aes(x = value, colour = .chain)) +
geom_line(stat = 'density', linewidth = 0.6, alpha = 0.7) +
scale_colour_manual(values = cols, name = "Chain") +
facet_wrap(~ parameter, labeller = label_parsed, nrow = 3, ncol = 3, scales = "free") +
theme_minimal(base_family = "Helvetica", base_size = 11) +
theme(
panel.grid = element_blank(),
axis.text.y = element_blank(),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA)
) +
labs(x = "Parameter value", y = "Density")
# panel layout
(p_trace | p_dens)
# export
ggsave(here::here("img/fig15-chg-traces.png"), width = 14, height = 6, dpi = 400, units = 'in')
```
Pairs plots of the posterior draws for the variance parameters.
```{r}
#| fig-width: 10
#| fig-height: 10
#| fig-cap: "Figure: Pairs plots for variance parameters."
bayesplot::bayesplot_theme_set(theme_minimal(base_size = 11))
bayesplot::bayesplot_theme_update(
panel.background = element_rect(fill = "white", color = NA),
plot.background = element_rect(fill = "white", color = NA),
panel.grid.minor = element_blank()
)
p <- pairs(fit_phy_chg, variable = c("sd_spp__Intercept",
"sd_spp__osml",
"cor_spp__Intercept__osml",
"sd_phy__Intercept",
"sigma"))
p
ggsave(here::here("img/fig16-chg-pairs.png"), p, width = 7, height = 7, dpi = 400, units = 'in')
```
### Coefficient estimates
::: callout-note
Here the outcome is log(ΔCEWL) — **physiological flexibility** — the log-scale change in CEWL from capture to acclimation. All three covariates are likewise computed as acclimation-minus-capture differences (Δosmolality, Δtemperature, ΔVPD), so slopes represent the association between a unit change in the covariate difference and log(ΔCEWL). A positive slope for a predictor means that individuals whose conditions changed more in that direction showed greater flexibility. The intercept represents expected mean flexibility at mean conditions. $\lambda$ here quantifies how phylogenetically structured flexibility is, not CEWL level; a high $\lambda$ would indicate closely related species tend to show similar magnitudes of flexibility.
:::
The table below shows parameter estimates.
```{r}
# table for variance parameters
draws <- as_draws_df(fit_phy_chg)
sd_spp <- draws$`sd_spp__Intercept`
sd_phy <- draws$`sd_phy__Intercept`
sigma_S <- sqrt(sd_spp^2 + sd_phy^2)
lambda <- (sd_phy^2) / sigma_S^2
sigma_I <- draws$sd_spp__osml
rho <- draws$cor_spp__Intercept__osml
sigma <- draws$sigma
rand_tbl <- tibble(
term = c("lambda", "sigma_S", "sigma_I", "rho", "sigma_eps"),
estimate = c(mean(lambda), mean(sigma_S), mean(sigma_I), mean(rho), mean(sigma)),
lwr = c(quantile(lambda, 0.025), quantile(sigma_S, 0.025), quantile(sigma_I, 0.025), quantile(rho, 0.025), quantile(sigma, 0.025)),
upr = c(quantile(lambda, 0.975), quantile(sigma_S, 0.975), quantile(sigma_I, 0.975), quantile(rho, 0.975), quantile(sigma, 0.975))
)
# table for regression coefficients
fixed_tbl <- fixef(fit_phy_chg, probs = c(0.025, 0.975)) %>%
as.data.frame() %>%
rownames_to_column("term") %>%
rename(estimate = Estimate,
lwr = Q2.5,
upr = Q97.5) |>
select(-Est.Error)
# table of parameter estimates
coef_tbl_chg <- bind_rows(fixed_tbl, rand_tbl)
coef_tbl_chg |>
pander(caption = 'Table: parameter estimates and 95% credible intervals')
```
The figure below shows the posterior densities for each parameter and two posterior predictive checks.
```{r}
#| fig-width: 8
#| fig-height: 8
#| fig-cap: "Figure: Posterior densities (top); posterior predictive checks — predicted vs. observed means (bottom left) and posterior predictive density overlay (bottom right)."
# ---- Extract and transform ----
draws <- as_draws_df(fit_phy_chg) %>%
mutate(
sigma_S = sqrt(sd_phy__Intercept^2 + sd_spp__Intercept^2),
lambda = sd_phy__Intercept^2 / (sd_phy__Intercept^2 + sd_spp__Intercept^2),
sigma_I = sd_spp__osml,
rho = cor_spp__Intercept__osml
)
# ---- Select parameters ----
keep <- c(
colnames(draws)[1:4],
c("sigma", "sigma_S", "lambda", "sigma_I", "rho")
)
long <- draws %>%
select(all_of(keep)) %>%
pivot_longer(everything(), names_to = "parameter", values_to = "value") %>%
mutate(parameter = factor(parameter, levels = c("b_Intercept", "b_osml", "b_temp", "b_vpd", "sigma_I", "sigma_S", "rho", "sigma", "lambda")))
# ---- Compute intervals ----
alpha_lo <- 0.05; alpha_hi <- 0.95
ints <- long %>%
group_by(parameter) %>%
summarise(
lo = quantile(value, alpha_lo),
hi = quantile(value, alpha_hi),
med = median(value),
.groups = "drop"
)
# ---- Create clean labels ----
labels <- c(
"b_Intercept" = "Intercept~(beta[0])",
"b_osml" = "Osmolality~(beta[2])",
"b_temp" = "Temperature~(beta[3])",
"b_vpd" = "VPD~(beta[4])",
"sigma" = "Residual~SD~(sigma[epsilon])",
"sigma_S" = "Species~intercept~SD~(sigma[S])",
"lambda" = "Phylogenetic~signal~(lambda)",
"sigma_I" = "Osmolality~slope~SD~(sigma[I])",
"rho" = "Intercept-slope~correlation~(rho)"
)
facet_labeller <- labeller(parameter = as_labeller(labels, default = label_parsed))
# ---- Plot ----
p_dens_chg <- ggplot(long, aes(x = value)) +
geom_density(fill = "grey85", color = "grey30", linewidth = 0.4) +
geom_vline(data = ints, aes(xintercept = lo), linetype = 2, color = "firebrick") +
geom_vline(data = ints, aes(xintercept = hi), linetype = 2, color = "firebrick") +
geom_vline(data = ints, aes(xintercept = med), linetype = 2, color = "black") +
facet_wrap(~ parameter, scales = "free", labeller = facet_labeller, ncol = 3) +
labs(
x = "Parameter value",
y = "Posterior density"
) +
theme_minimal(base_size = 11) +
theme(
panel.background = element_rect(fill = "white", colour = NA),
strip.background = element_rect(fill = "white", colour = "white"),
panel.grid = element_blank(),
axis.text.y = element_blank(),
)
## posterior predictive checks
p_pp_chg <- pp_check(fit_phy_chg, ndraws = 100, type = 'scatter_avg') +
guides(color = guide_none()) +
labs(y = 'Observed log(\u0394CEWL)', x = 'Predicted log(\u0394CEWL)') +
theme_minimal(base_family = "Helvetica", base_size = 11) +
theme(
panel.grid.minor = element_blank(),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA)
)
p_ppc_dens_chg <- pp_check(fit_phy_chg, ndraws = 50, type = 'dens_overlay') +
guides(color = guide_none()) +
labs(x = 'log(\u0394CEWL)', y = 'Density') +
theme_minimal(base_family = "Helvetica", base_size = 11) +
theme(
panel.grid.minor = element_blank(),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA)
)
p_dens_chg / (p_pp_chg | p_ppc_dens_chg)
ggsave(here::here("img/fig17-chg-posteriors.png"), width = 6, height = 8, dpi = 400, units = 'in')
```
Owing to the random slopes and intercepts, each species has a distinct estimated mean flexibility (log(ΔCEWL)) and a distinct slope in osmolality. The table below shows the species-specific estimates.
```{r}
# coefficient estimates
coef(fit_phy_chg)$spp[, 1, 1:2] |>
pander(caption = 'Table: species-specific relationships after adjusting for phylogeny')
```
Displayed visually:
```{r}
#| fig-width: 10
#| fig-height: 4
#| fig-cap: "Figure: (Left) Species-specific intercepts and osmolality slopes (95% CI); dashed line shows population-average. (Right) Implied species-specific osmolality-log(ΔCEWL) relationships at average temperature and VPD."
coef_arr <- coef(fit_phy_chg)$spp
common_to_col <- species |>
mutate(sp.common = str_to_title(sp.common)) |>
with(setNames(cb_pal[toupper(sp.abbrv)], sp.common))
p_coef <- bind_rows(
as.data.frame(coef_arr[,, "Intercept"]) |>
rownames_to_column("sp.abbrv") |>
mutate(param = "Intercept"),
as.data.frame(coef_arr[,, "osml"]) |>
rownames_to_column("sp.abbrv") |>
mutate(param = "Osmolality slope")
) |>
left_join(species |> select(sp.abbrv, sp.common), join_by(sp.abbrv)) |>
mutate(sp.common = str_to_title(sp.common)) |>
ggplot(aes(x = Estimate,
xmin = Q2.5, xmax = Q97.5,
y = fct_reorder(sp.common, Estimate),
color = sp.common)) +
geom_pointrange(linewidth = 0.4) +
scale_color_manual(values = common_to_col, guide = "none") +
geom_vline(
data = data.frame(
param = c("Intercept", "Osmolality slope"),
ref = c(fixef(fit_phy_chg)["Intercept", "Estimate"],
fixef(fit_phy_chg)["osml", "Estimate"])
),
aes(xintercept = ref), linetype = 2, color = "firebrick"
) +
facet_wrap(~ param, scales = "free_x") +
labs(x = "Estimate (95% CI)", y = NULL) +
theme_minimal(base_size = 11) +
theme(panel.grid.minor = element_blank(),
panel.background = element_rect(fill = "white", colour = NA),
axis.text.x = element_text(angle = 90))
mean_osml <- mean(change$osml, na.rm = TRUE)
osml_seq <- seq(min(ddata$osml), max(ddata$osml), length.out = 100)
line_df <- as.data.frame(coef_arr[,, "Intercept"]) |>
rownames_to_column("sp.abbrv") |>
rename(int = Estimate) |>
bind_cols(as.data.frame(coef_arr[,, "osml"]) |> select(slope = Estimate)) |>
left_join(species |> select(sp.abbrv, sp.common), join_by(sp.abbrv)) |>
mutate(sp.common = str_to_title(sp.common)) |>
crossing(osml_c = osml_seq) |>
mutate(log.cewl = int + slope * osml_c, osml = osml_c + mean_osml)
p_lines <- change |>
drop_na(osml) |>
left_join(species |> select(sp.abbrv, sp.common), by = c("species" = "sp.abbrv")) |>
mutate(sp.common = str_to_title(sp.common)) |>
ggplot(aes(x = osml, y = log.cewl, color = sp.common)) +
geom_point(alpha = 0.5, size = 1.5) +
geom_line(data = line_df, linewidth = 0.8) +
scale_color_manual(values = common_to_col) +
labs(x = "Osmolality (mOsm/kg)", y = "log(\u0394CEWL)", color = NULL) +
theme_minimal(base_size = 11) +
theme(panel.background = element_rect(fill = "white", colour = NA),
panel.grid.minor = element_blank(),
legend.position = "right")
p_coef + p_lines
ggsave(here::here("img/fig18-chg-coefficients.png"), width = 11, height = 4, dpi = 400, units = 'in')
```
The species-level intercepts from the flexibility model directly estimate mean log($\Delta$CEWL) for each species — i.e., which species tend to show greater or lesser flexibility after acclimation, after accounting for measurement conditions. The plot below ranks species by estimated flexibility.
```{r}
#| fig-width: 6
#| fig-height: 4
#| fig-cap: "Figure: Species-specific mean log(ΔCEWL) with 95% credible intervals, ranked by estimate. Dashed red line shows the population average; dashed black line at zero indicates no change."
common_to_col <- species |>
mutate(sp.common = str_to_title(sp.common)) |>
with(setNames(cb_pal[toupper(sp.abbrv)], sp.common))
coef(fit_phy_chg)$spp[, , "Intercept"] |>
as.data.frame() |>
rownames_to_column("sp.abbrv") |>
left_join(species |> select(sp.abbrv, sp.common), join_by(sp.abbrv)) |>
mutate(sp.common = str_to_title(sp.common)) |>
ggplot(aes(x = Estimate, xmin = Q2.5, xmax = Q97.5,
y = fct_reorder(sp.common, Estimate),
color = sp.common)) +
geom_pointrange(linewidth = 0.5) +
geom_vline(xintercept = 0,
linetype = 2, color = "black") +
geom_vline(xintercept = fixef(fit_phy_chg)["Intercept", "Estimate"],
linetype = 2, color = "firebrick") +
scale_color_manual(values = common_to_col, guide = "none") +
labs(x = "log(\u0394CEWL) (95% CI)", y = NULL) +
theme_minimal(base_size = 11) +
theme(panel.background = element_rect(fill = "white", colour = NA),
panel.grid.minor = element_blank())
ggsave(here::here("img/fig19-flexibility.png"), width = 6, height = 4, dpi = 400, units = 'in')
```
### Summary of findings
- At mean conditions, mean log($\Delta$CEWL) is estimated at 0.13 (95% CI: −0.51, 0.77); Chuckwallas are the clearest outlier with a species-level estimate of \~0.78
- There is no credible association between log($\Delta$CEWL) and osmolality (95% CI: −0.006 to 0.006)
- Temperature is credibly and positively associated with log($\Delta$CEWL): each 1°C increase is associated with $e^{0.261} \approx 1.30$-fold greater flexibility (95% CI on slope: 0.169 to 0.353)
- VPD is credibly and negatively associated with log($\Delta$CEWL) (95% CI: −1.871 to −0.668), suggesting higher evaporative demand at measurement suppresses the acclimation response
- Species-specific variation in flexibility is uncertain ($\hat{\sigma}_s$ = 0.40, 95% CI: 0.04, 0.79)
- Phylogenetic signal in flexibility is highly uncertain ($\lambda$: median 0.40, 95% CI ≈ 0 to 1.0); with only eight species the data cannot meaningfully constrain $\lambda$
- The slope/intercept correlation is imprecisely estimated (95% CI: −0.971 to 0.732)
# Synthesis
## Cross-model parameter comparison
The tables below compare estimates across phenotypic states. The first places capture and acclimation side by side (both on the log(CEWL) scale); the second shows the flexibility model estimates (log($\Delta$CEWL) scale). Cells show posterior mean and 95% credible interval.
```{r}
library(glue)
all_est <- bind_rows(
{
d <- as_draws_df(fit_phy_cap)
fx <- fixef(fit_phy_cap, probs = c(0.025, 0.975)) |>
as.data.frame() |> rownames_to_column("term") |>
select(term, Estimate, Q2.5, Q97.5)
sd_spp <- d$sd_spp__Intercept; sd_phy <- d$sd_phy__Intercept
sd_slp <- d$sd_spp__osml; rho <- d$cor_spp__Intercept__osml
sig <- d$sigma; lam <- sd_phy^2 / (sd_phy^2 + sd_spp^2)
rv <- tibble(term = c("sd_spp","sd_phy","sd_slope","rho","sigma","lambda"),
Estimate = c(mean(sd_spp),mean(sd_phy),mean(sd_slp),mean(rho),mean(sig),mean(lam)),
Q2.5 = c(quantile(sd_spp,.025),quantile(sd_phy,.025),quantile(sd_slp,.025),
quantile(rho,.025),quantile(sig,.025),quantile(lam,.025)),
Q97.5 = c(quantile(sd_spp,.975),quantile(sd_phy,.975),quantile(sd_slp,.975),
quantile(rho,.975),quantile(sig,.975),quantile(lam,.975)))
bind_rows(fx, rv) |> mutate(model = "capture")
},
{
d <- as_draws_df(fit_phy_acc)
fx <- fixef(fit_phy_acc, probs = c(0.025, 0.975)) |>
as.data.frame() |> rownames_to_column("term") |>
select(term, Estimate, Q2.5, Q97.5)
sd_spp <- d$sd_spp__Intercept; sd_phy <- d$sd_phy__Intercept
sd_slp <- d$sd_spp__osml; rho <- d$cor_spp__Intercept__osml
sig <- d$sigma; lam <- sd_phy^2 / (sd_phy^2 + sd_spp^2)
rv <- tibble(term = c("sd_spp","sd_phy","sd_slope","rho","sigma","lambda"),
Estimate = c(mean(sd_spp),mean(sd_phy),mean(sd_slp),mean(rho),mean(sig),mean(lam)),
Q2.5 = c(quantile(sd_spp,.025),quantile(sd_phy,.025),quantile(sd_slp,.025),
quantile(rho,.025),quantile(sig,.025),quantile(lam,.025)),
Q97.5 = c(quantile(sd_spp,.975),quantile(sd_phy,.975),quantile(sd_slp,.975),
quantile(rho,.975),quantile(sig,.975),quantile(lam,.975)))
bind_rows(fx, rv) |> mutate(model = "acclimation")
},
{
d <- as_draws_df(fit_phy_chg)
fx <- fixef(fit_phy_chg, probs = c(0.025, 0.975)) |>
as.data.frame() |> rownames_to_column("term") |>
select(term, Estimate, Q2.5, Q97.5)
sd_spp <- d$sd_spp__Intercept; sd_phy <- d$sd_phy__Intercept
sd_slp <- d$sd_spp__osml; rho <- d$cor_spp__Intercept__osml
sig <- d$sigma; lam <- sd_phy^2 / (sd_phy^2 + sd_spp^2)
rv <- tibble(term = c("sd_spp","sd_phy","sd_slope","rho","sigma","lambda"),
Estimate = c(mean(sd_spp),mean(sd_phy),mean(sd_slp),mean(rho),mean(sig),mean(lam)),
Q2.5 = c(quantile(sd_spp,.025),quantile(sd_phy,.025),quantile(sd_slp,.025),
quantile(rho,.025),quantile(sig,.025),quantile(lam,.025)),
Q97.5 = c(quantile(sd_spp,.975),quantile(sd_phy,.975),quantile(sd_slp,.975),
quantile(rho,.975),quantile(sig,.975),quantile(lam,.975)))
bind_rows(fx, rv) |> mutate(model = "change")
}
)
term_labels <- c(
Intercept = "Intercept",
osml = "Osmolality",
temp = "Temperature",
vpd = "VPD",
sd_spp = "Species SD",
sd_phy = "Phylogenetic SD",
sd_slope = "Slope SD",
rho = "Intercept-slope corr.",
sigma = "Residual SD",
lambda = "Phylogenetic signal"
)
library(kableExtra)
all_est |>
filter(model %in% c("capture", "acclimation")) |>
mutate(across(c(Estimate, Q2.5, Q97.5), ~round(., 3)),
cell = glue("{Estimate} ({Q2.5}, {Q97.5})"),
term = factor(term, levels = names(term_labels),
labels = term_labels)) |>
select(term, model, cell) |>
pivot_wider(names_from = model, values_from = cell) |>
select(term, capture, acclimation) |>
kbl(col.names = c("Parameter", "Capture", "Acclimation"),
caption = "Table: Posterior mean and 95% CI — capture and acclimation models (outcome: log(CEWL)).",
escape = FALSE) |>
kable_styling(full_width = FALSE) |>
column_spec(2:3, extra_css = "white-space: nowrap;")
all_est |>
filter(model == "change") |>
mutate(across(c(Estimate, Q2.5, Q97.5), ~round(., 3)),
cell = glue("{Estimate} ({Q2.5}, {Q97.5})"),
term = factor(term, levels = names(term_labels),
labels = term_labels)) |>
select(term, cell) |>
kbl(col.names = c("Parameter", "Flexibility (log(\u0394CEWL))"),
caption = "Table: Posterior mean and 95% CI — flexibility model (outcome: log(\u0394CEWL)).",
escape = FALSE) |>
kable_styling(full_width = FALSE) |>
column_spec(2, extra_css = "white-space: nowrap;")
```
## Phylogenetic signal across phenotypic states
The figure below shows the full posterior distribution of $\lambda$ from each model, making visible both the central tendency and the considerable uncertainty across all three phenotypic states.
```{r}
#| fig-width: 7
#| fig-height: 3.5
#| fig-cap: "Figure: Posterior distributions of phylogenetic signal (λ) for each phenotypic state. All three posteriors are broad, indicating the data are largely uninformative about the degree of phylogenetic structuring in any CEWL trait."
lambda_df <- bind_rows(
as_draws_df(fit_phy_cap) |>
mutate(lambda = sd_phy__Intercept^2 / (sd_phy__Intercept^2 + sd_spp__Intercept^2),
model = "Capture"),
as_draws_df(fit_phy_acc) |>
mutate(lambda = sd_phy__Intercept^2 / (sd_phy__Intercept^2 + sd_spp__Intercept^2),
model = "Acclimation"),
as_draws_df(fit_phy_chg) |>
mutate(lambda = sd_phy__Intercept^2 / (sd_phy__Intercept^2 + sd_spp__Intercept^2),
model = "Flexibility")
) |> select(lambda, model)
ggplot(lambda_df, aes(x = lambda, fill = model, color = model)) +
geom_density(alpha = 0.25, linewidth = 0.7) +
scale_x_continuous(limits = c(0, 1), breaks = seq(0, 1, 0.25),
labels = c("0", "0.25", "0.50", "0.75", "1")) +
labs(x = expression(lambda ~ "(phylogenetic signal)"),
y = "Posterior density",
fill = "Phenotypic state", color = "Phenotypic state") +
theme_minimal(base_size = 11) +
theme(panel.background = element_rect(fill = "white", colour = NA),
panel.grid.minor = element_blank(),
legend.position = "right")
ggsave(here::here("img/fig20-lambda.png"), width = 7, height = 3.5, dpi = 400, units = 'in')
```
## Summary
Temperature and VPD credibly predict log(CEWL) at capture — each 1°C increase is associated with a \~19% increase in CEWL, and higher VPD is associated with \~46% lower CEWL — but neither predictor is credible at acclimation or for flexibility. This pattern is consistent with field conditions driving CEWL variation at capture through behavioral thermoregulation and microclimate differences, while intrinsic CEWL (measured under controlled acclimation) varies primarily among species rather than tracking environmental conditions. Osmolality shows no credible association with CEWL at any state, suggesting hydration status (at the range observed here) may not be a strong proximal driver of cutaneous water loss.
Species-level variation in log(CEWL) is nearly twice as large at acclimation as at capture, pointing to field conditions obscuring inherent between-species differences — consistent with the interpretation that capture CEWL reflects both physiology and ecology, while acclimated CEWL is a cleaner physiological signal. Phylogenetic signal is highly uncertain across all three phenotypic states, with posteriors that are nearly flat across the full 0–1 interval; with only eight species, the data lack the resolution to reliably partition species-level variation into phylogenetic and non-phylogenetic components. Among species, Chuckwallas stand out with the highest estimated flexibility (mean log($\Delta$CEWL) ≈ 0.78), though even this estimate carries a credible interval that includes zero.