In pratikunterwegs/patho-move-evol: Analysis code for the _pathomove_ model.

Plot eco-evolutionary change in the default scenario

library(data.table)

library(ggplot2)
library(patchwork)
library(colorspace)

Load evolutionary data

Load generation strategy data.

files <- list.files(
  "data/results/morph_data",
  pattern = "default",
  full.names = TRUE
)

data_all <- lapply(files, fread)
data_all <- rbindlist(data_all)

df_strat <- data_all[(costInfect == 0.25) & (regen_time == 50)]

# popsize
popsize <- 500
df_strat[, prop := N / popsize]

# get time since pathogen
sgen <- 3000
genmax <- 5000
df_strat[, gen_abs := gen - sgen]

# save for plotting and upload
fwrite(
  df_strat,
  file = "data/results/data_default_strategy_evo.csv"
)

# load saved data
df_strat <- fread("data/results/data_default_strategy_evo.csv")

Plot evolutionary change in default scenario

fig_evo_social_strategy <-
  ggplot() +
  geom_vline(
    xintercept = c(0, 100),
    lty = 2,
    linewidth = 0.3,
    col = c("red", "grey")
  ) +
  stat_summary(
    data = df_strat[social_strat != "non-handler tracking" &
      (gen %% 50 == 0), ],
    aes(
      gen_abs, prop,
      col = social_strat
    ),
    size = 0.2,
    geom = "line"
  ) +
  stat_summary(
    data = df_strat[social_strat != "non-handler tracking" &
      (gen %% 50 == 0), ],
    aes(
      gen_abs, prop,
      col = social_strat
    ),
    size = 0.2,
    position = position_dodge(width = 2)
  ) +
  scale_colour_discrete_sequential(
    palette = "Viridis",
    l2 = 80, # c2 = 20, c1 = 20,
    rev = FALSE,
    name = NULL,
    limits = c("agent avoiding", "agent tracking", "handler tracking"),
    labels = stringr::str_to_sentence,
    na.value = "lightgrey"
  ) +
  scale_fill_discrete_sequential(
    palette = "Viridis",
    l2 = 80,
    rev = FALSE,
    name = NULL,
    limits = c("agent avoiding", "agent tracking", "handler tracking"),
    labels = stringr::str_to_sentence,
    na.value = "lightgrey"
  ) +
  scale_x_continuous(
    trans = ggallin::ssqrt_trans,
    breaks = c(-500, 0, 100, 500, 2000),
    labels = scales::comma_format(
      accuracy = 1
    ),
    name = "Gens. after pathogen intro.",
    sec.axis = sec_axis(
      trans = function(x) x + sgen,
      breaks = c(sgen - 500, sgen, sgen + 500, sgen + 2000),
      labels = scales::comma_format(
        accuracy = 1
      ),
      name = "Generations"
    )
  ) +
  scale_y_continuous(
    breaks = c(0, 0.5, 1),
    labels = scales::percent,
    name = "% Individuals"
  ) +
  coord_cartesian(
    xlim = c(-500, 2000),
    ylim = c(0, 1)
  ) +
  theme_test(
    base_family = "Arial",
    base_size = 8
  ) +
  theme(
    legend.position = "top",
    legend.key.height = unit(1, "mm"),
    legend.key.width = unit(2, "mm"),
    axis.text.x = element_text(hjust = 0.5),
    axis.text.y = element_text(
      angle = 90, hjust = 0.5
    )
  )

Load social information importance

files <- list.files(
  "data/results/si_imp_data",
  pattern = "default",
  full.names = TRUE
)

data_all <- lapply(files, fread)
data_all <- rbindlist(data_all)

df_si <- data_all[(costInfect == 0.25) & (regen_time == 50)]

# popsize
popsize <- 500

df_si[, prop := N / popsize]

# group by 1% intervals
df_si <- df_si[, list(
  prop = sum(prop), N = sum(N)
), by = c("gen", "si_imp", "replicate")]

# get time since pathogen
sgen <- 3000
genmax <- 5000
df_si[, gen_abs := gen - sgen]

# save for plotting and upload
fwrite(
  df_si,
  file = "data/results/data_default_si_imp.csv"
)

# load saved data
df_si <- fread("data/results/data_default_si_imp.csv")

# get weighted mean and variance in social info importance
# replicate 2 is an anomaly with very high SI use, although strategies are
# similar across replicates
df_si_mean <- df_si[, list(
  mean = weighted.mean(si_imp, w = N),
  sd = Hmisc::wtd.var(si_imp, weights = N)
), by = "gen"]

df_si_mean[, c("y", "ymin", "ymax") := list(
  mean,
  mean - sd,
  mean + sd
)]
df_si_mean[, gen_abs := gen - sgen]

Plot social information importance

hmap_cols <- colorspace::sequential_hcl(
  5,
  palette = "sunset",
  rev = TRUE
)

fig_evo_si_importance <-
  ggplot() +
  geom_tile(
    data = df_si[replicate == 4],
    aes(
      gen_abs, si_imp,
      fill = N / popsize
    ),
    width = 5
  ) +
  geom_vline(
    xintercept = c(0, 100),
    lty = 2,
    size = 0.3,
    col = c("red", "grey")
  ) +
  geom_hline(
    yintercept = 0.5,
    col = "grey",
    lty = 2,
    size = 0.2
  ) +
  geom_pointrange(
    data = df_si_mean[(gen %% 100 == 0), ],
    aes(
      gen_abs, y,
      ymin = ymin,
      ymax = ymax
    ),
    shape = 16, size = 0.2,
    colour = "grey40"
  ) +
  scale_fill_gradientn(
    colours = c(
      "grey99",
      hmap_cols
    ),
    na.value = hmap_cols[5],
    limits = c(0.0, 0.3),
    breaks = c(0.01, 0.3, 0.5),
    labels = function(x) {
      a <- scales::percent(x)
      a[x == 0.3] <- ">30%"
      a
    },
    name = "% Indiv."
  ) +
  scale_x_continuous(
    breaks = c(-500, 0, 500, 2000),
    labels = scales::comma_format(
      accuracy = 1
    ),
    name = "Gens. after pathogen intro.",
    sec.axis = sec_axis(
      trans = function(x) x + sgen,
      breaks = c(sgen - 500, sgen, sgen + 500, sgen + 2000),
      labels = scales::comma_format(
        accuracy = 1
      ),
      name = "Generations"
    )
  ) +
  scale_y_continuous(
    labels = scales::percent,
    name = "% Contribution of\nsocial information"
  ) +
  coord_cartesian(
    xlim = c(-500, 2000),
    ylim = c(0, 0.5)
  ) +
  theme_test(
    base_family = "Arial",
    base_size = 8
  ) +
  theme(
    legend.position = "top",
    legend.key.height = unit(1, "mm"),
    legend.key.width = unit(2.5, "mm"),
    legend.title = element_text(
      vjust = 1.5
    ),
    legend.text = element_text(
      size = 6
    ),
    axis.text.y = element_text(
      angle = 90, hjust = 0.5
    )
  )

Plot intermediate figure

# prepare intermediate figure
fig_evo_intermediate <- wrap_plots(
  fig_evo_social_strategy,
  fig_evo_si_importance,
  guides = "collect"
) &
  plot_annotation(
    tag_levels = "A"
  ) &
  theme(
    plot.tag = element_text(
      face = "bold"
    ),
    legend.position = "bottom",
    legend.justification = "centre",
    legend.text = element_text(
      size = 8
    ),
    legend.title = element_text(
      size = 8
    )
  )

# save intermediate figure
ggsave(
  plot = fig_evo_intermediate,
  filename = "figures/fig_evo_intermediate.png",
  width = 120,
  height = 75,
  units = "mm"
)

Load ecological outcomes

Load generation data.

# list files, read, and filter for default model options
files <- list.files(
  "data/results/gen_data",
  pattern = "default",
  full.names = TRUE
)

data_all <- lapply(files, fread)
data_all <- rbindlist(data_all)

df_eco <- data_all[(costInfect == 0.25) & (regen_time == 50)]

# popsize
popsize <- 500

# get time since pathogen
sgen <- 3000
genmax <- 5000
df_eco[, gen_abs := gen - sgen]

# save for plotting and upload
fwrite(
  df_eco,
  file = "data/results/data_default_eco.csv"
)

# load saved data
df_eco <- fread("data/results/data_default_eco.csv")

Prepare data for plotting

df_eco <- df_eco[, c(
  "gen_abs", "intake.mean", "gen",
  "energy.mean",
  "moved.mean", "assoc.mean", "replicate"
)]
df_eco <- melt(
  df_eco,
  id.vars = c("gen_abs", "gen", "replicate")
)

## colours for background
cols <- colorspace::diverging_hcl(3, palette = "Tofino", l = 50, c = 80)

Plot change in movement

plot_movement <-
  ggplot(df_eco[variable %in% c("moved.mean") &
    gen %% 100 == 0]) +
  geom_vline(
    xintercept = c(0, 100),
    lty = 2,
    size = 0.3,
    col = c("red", "grey")
  ) +
  stat_summary(
    aes(
      gen_abs, value
    ),
    geom = "line",
    col = cols[1],
    size = 0.2,
    show.legend = F
  ) +
  stat_summary(
    aes(
      gen_abs, value
    ),
    col = cols[1],
    size = 0.1,
    show.legend = F
  ) +
  scale_x_continuous(
    breaks = c(-500, 0, 500, 2000),
    labels = scales::comma_format(
      accuracy = 1
    ),
    name = "Gens. after pathogen intro.",
    sec.axis = sec_axis(
      trans = function(x) x + sgen,
      breaks = c(sgen, genmax),
      labels = scales::comma_format(
        accuracy = 1
      ),
      name = "Generations"
    )
  ) +
  coord_cartesian(
    xlim = c(-500, 2000),
    ylim = c(50, NA)
  ) +
  theme_test(
    base_family = "Arial",
    base_size = 8
  ) +
  theme(
    legend.key = element_blank(),
    legend.background = element_blank(),
    strip.background = element_blank(),
    strip.text = element_text(
      face = "italic"
    ),
    plot.background = element_blank(),
    strip.placement = "outside"
  ) +
  labs(
    x = NULL,
    y = "Distance moved",
    colour = NULL,
    shape = NULL
  )

Plot change in associations

plot_assoc <-
  ggplot(df_eco[variable %in% c("assoc.mean") &
    gen %% 100 == 0]) +
  geom_vline(
    xintercept = c(0, 100),
    lty = 2,
    size = 0.3,
    col = c("red", "grey")
  ) +
  stat_summary(
    aes(
      gen_abs, value
    ),
    geom = "line",
    col = cols[2],
    size = 0.2,
    show.legend = F
  ) +
  stat_summary(
    aes(
      gen_abs, value
    ),
    col = cols[2],
    size = 0.1,
    show.legend = F
  ) +
  scale_x_continuous(
    breaks = c(-500, 0, 500, 2000),
    labels = scales::comma_format(
      accuracy = 1
    ),
    name = "Gens. after pathogen intro.",
    sec.axis = sec_axis(
      trans = function(x) x + sgen,
      breaks = c(sgen, genmax),
      labels = scales::comma_format(
        accuracy = 1
      ),
      name = "Generations"
    )
  ) +
  scale_y_continuous(
    trans = "log10",
    labels = scales::comma
  ) +
  coord_cartesian(
    xlim = c(-500, 2000)
  ) +
  theme_test(
    base_family = "Arial",
    base_size = 8
  ) +
  theme(
    legend.key = element_blank(),
    legend.background = element_blank(),
    strip.background = element_blank(),
    strip.text = element_text(
      face = "italic"
    ),
    plot.background = element_blank(),
    axis.text.y = element_text(
      angle = 90,
      hjust = 0.5
    ),
    strip.placement = "outside"
  ) +
  labs(
    x = NULL,
    y = "Associations",
    colour = NULL,
    shape = NULL
  )

Plot change in energy and intake

col_energy <- colorspace::sequential_hcl(5, palette = "Purples")[2]

plot_energy <-
  ggplot(df_eco[variable %in% c("energy.mean") &
    (gen %% 100 == 0)]) +
  geom_vline(
    xintercept = c(0, 100),
    lty = 2,
    size = 0.3,
    col = c("red", "grey")
  ) +
  geom_hline(
    yintercept = c(0),
    lty = 2,
    size = 0.3,
    col = c("red")
  ) +
  stat_summary(
    data = df_eco[variable %in% c("intake.mean") &
      (gen %% 100 == 0)],
    aes(gen_abs, value),
    col = cols[3],
    size = 0.1
  ) +
  stat_summary(
    aes(
      gen_abs, value
    ),
    geom = "line",
    col = col_energy,
    size = 0.2,
    show.legend = F
  ) +
  stat_summary(
    aes(
      gen_abs, value
    ),
    col = col_energy,
    size = 0.1,
    show.legend = TRUE
  ) +
  scale_x_continuous(
    breaks = c(-500, 0, 500, 2000),
    labels = scales::comma_format(
      accuracy = 1
    ),
    name = "Gens. after pathogen intro.",
    sec.axis = sec_axis(
      trans = function(x) x + sgen,
      breaks = c(sgen, genmax),
      labels = scales::comma_format(
        accuracy = 1
      ),
      name = "Generations"
    )
  ) +
  coord_cartesian(
    xlim = c(-500, 2000)
  ) +
  theme_test(
    base_family = "Arial",
    base_size = 8
  ) +
  theme(
    legend.key = element_blank(),
    legend.background = element_blank(),
    strip.background = element_blank(),
    strip.text = element_text(
      face = "italic"
    ),
    plot.background = element_blank(),
    strip.placement = "outside"
  ) +
  labs(
    x = NULL,
    y = "Net energy",
    colour = NULL,
    shape = NULL
  )

Save figure: Eco-evolutionary outcomes summary

# prepare and save figure
fig_eco_evo_general <-
  wrap_plots(
    fig_evo_intermediate,
    plot_movement,
    plot_energy,
    plot_assoc,
    design = "AAA\nAAA\nBCD",
    guides = "collect"
  ) &
    plot_annotation(
      tag_levels = c("A", 1)
    ) &
    theme(
      legend.justification = "center",
      plot.tag = element_text(
        face = "bold",
        size = 10
      ),
      axis.text.x = element_text(
        size = 7
      )
    )

ggsave(
  fig_eco_evo_general,
  filename = "figures/fig_eco_evo_general.png",
  height = 120, width = 120, units = "mm"
)

pratikunterwegs/patho-move-evol documentation built on April 15, 2023, 5:54 p.m.