In pratikunterwegs/klepto-move-evol: R code for the Kleptomove Simulation

Landscape depletion and the evolution of social information use

# to handle data and plot
library(data.table)
library(glue)

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

# load local functions
devtools::load_all()

Prepare handler preference

data_pref = fread("data/results/data_handler_tracking_by_strategy.csv")

data_pref = data_pref[handler_pref == T, list(
  handler_pref = mean(prop_handler_pref)
), by = c("sim_type", "rep", "comp_strat", "gen")]

ggplot(data_pref)+
  geom_point(
    aes(
      gen, handler_pref,
      col = comp_strat
    )
  )

Read p clueless

# focus r
focus_r <- c(0.01)

# read clueless data
data <- fread("data/results/data_p_clueless.csv")
data <- data[regrowth %in% focus_r, ]
data[, sim_type := ifelse(sim_type == "forager", "foragers", sim_type)]

# remove random
data <- data[sim_type != "random"]

# 1 - p_clueless
data$p_clueless <- 1 - data$p_clueless

# set factor order
data$sim_type <- factor(data$sim_type,
  levels = c("foragers", "obligate", "facultative")
)
setnames(data, "rep", "replicate", skip_absent = TRUE)

# split data
data <- split(data, by = "sim_type")
# set order
data = data[c("foragers", "obligate", "facultative")]

# split preference data
data_pref = split(data_pref, by = "sim_type")
data_pref = data_pref[c("foragers", "obligate", "facultative")]

# this green
this_green <- "forestgreen"

# make subplots
subplots <- 
Map(
  data_pref, data, names(data),
  f = function(df_wt, df_land, n) {

  # colour values
  col_vals = c(
    land = this_green,
    consumer = "steelblue",
    klept = "indianred",
    forager = "navy"
  )
  # label values
  label_vals = c(
    land = "Different prey density\nin neighbourhood",
    consumer = "% Handler preffering",
    klept = "% Klepts.\npreffering handlers",
    forager = "% Foragers.\npreffering handlers"
  )
  # remove as req
  if(n != "obligate") {
    col_vals = col_vals[!names(col_vals) %in% c("forager", "klept")]
    label_vals = label_vals[!names(label_vals) %in% c("forager", "klept")]
    break_vals = c("land", "consumer")
  } else {
    col_vals = col_vals[!names(col_vals) %in% c("consumer")]
    label_vals = label_vals[!names(label_vals) %in% c("consumer", "land")]
    break_vals = c("klept", "forager")
  }

  ggplot() +
    geom_vline(
      xintercept = c(1, 10, 950),
      colour = "grey",
      lty = 2,
      size = 0.3
    )+
    geom_line(
      data = df_land[gen > 0,],
      aes(
        gen, p_clueless,
        colour = "land",
        group = replicate
      )
    )+
    geom_path(
      data = df_wt,
      aes(
        gen, handler_pref,
        col = comp_strat,
        group = interaction(rep, comp_strat)
      )
    )+
    scale_colour_manual(
      values = col_vals,
      labels = label_vals,
      breaks = break_vals
    ) +
    scale_x_continuous(
      trans = "sqrt",
      limits = c(1, 1000),
      breaks = c(1, 10, 100, 500, 1000)
    )+
    scale_y_continuous(
      limits = c(0, 1.0),
      labels = scales::percent
    ) +
    coord_cartesian(
      ylim = c(0., 1.05),
      expand = T
    ) +
    theme_test(
      base_size = 8,
      base_family = "Arial"
    )+
    theme(
      legend.position = "bottom",
      axis.text.y = element_text(
        angle = 90,
        hjust = 0.5
      ),
      legend.margin = margin(rep(0, 4)),
      legend.box.margin = margin(rep(0, 4))
    ) +
    labs(
      x = "Generation",
      y = "% Individuals or land.",
      colour = NULL,
      shape = NULL
    ) +
    guides(
      colour = guide_legend(nrow = 2, ncol = 2)
    )
})

# arrange order
subplots = subplots[c("foragers", "obligate", "facultative")]
wrap_plots(subplots, ncol = 1, guides = "collect") &
  theme(legend.position = "bottom")

Show landscape for each sim type

Here we show a landscape with and without clues at 1, 10, and 40th generation for $r_{max}$ = 0.01.

Items landscape

# list folders
paths <- list.dirs("data/for_landscape/", recursive = F)

# select gens
gens_for_figure <- stringr::str_pad(c(1, 10, 950), width = 5, pad = "0")

# get paths for files
landscape_data <- CJ(
  gen = gens_for_figure,
  path = paths
)

# add sim_type
landscape_data[, sim_type := rep(c("facultative", "foragers", "obligate"), 3)]

# get paths
landscape_data$image <- glue_data(landscape_data, "{path}/{gen}.png")

# get data
landscape_data$data <- lapply(landscape_data$image,
  read_landscape,
  layer = 4,
  crop_dim = 60,
  type = "items"
)

# convert gen to numeric
landscape_data[, gen := as.numeric(gen)]

# unlst
landscape_items <- landscape_data[, unlist(data, recursive = F),
  by = c("sim_type", "gen")
]

Gradient landscape

# get data
landscape_data$data <- lapply(landscape_data$image,
  read_landscape,
  layer = 4,
  crop_dim = 60,
  type = "gradient"
)

# unlst
landscape_gradient <- landscape_data[, unlist(data, recursive = F),
  by = c("sim_type", "gen")
]

Merge landscapes

# landscape overall
landscape <- (landscape_gradient)

# melt
landscape <- melt(landscape, id.vars = c("sim_type", "gen", "x", "y"))

# split by sim_type
landscape <- split(landscape, by = c("sim_type"))

landscape = landscape[c("foragers", "obligate", "facultative")]

Plot landscape

subplot_land <- Map(function(df, n) {
  ggplot(df) +
    geom_tile(
      aes(x, y, 
          fill = value >= 0.7),
      show.legend = T
    ) +
    facet_grid(
      ~gen, 
      labeller = labeller(
        gen = function(x) glue::glue("Gen = {as.numeric(x)}")
      )
    ) +
    scale_fill_manual(
      values = c(
        "TRUE" = this_green,
        "FALSE" = "white"
      ),
      labels = c(
        "TRUE" = "Prey gradient",
        "FALSE" = "Neighbourhood has\nsame prey density"
      ),
      breaks = c("TRUE", "FALSE"),
      name = NULL
    ) +
    # coord_equal(expand = F) +
    coord_cartesian(expand = F)+
    kleptomoveMS::theme_custom(
      landscape = T, 
      base_size = 8,
      base_family = "Arial"
    ) +
    theme(
      legend.position = "top",
      legend.key = element_rect(
        fill = NA,
        colour = "grey"
      ),
      legend.key.height = unit(1, units = "mm"),
      title = element_text(face = "bold"),
      axis.text = element_blank(),
      axis.title = element_blank()
    )+
    labs(
      title = glue("Scenario {n}")
    )+
    guides(colour = guide_legend(nrow = 2, ncol = 1))
}, landscape, seq(3))

Figure 5

# make figure 5
# wrap cues per gen plots
plots_cues = wrap_plots(subplots, ncol = 1, guides = "collect") +
  plot_layout(tag_level = "new") &
  theme(
    legend.justification = "right",
    legend.position = "bottom",
    legend.key.width = unit(1, units = "mm"),
    # legend.direction = "vertical",
    legend.box.margin = margin(rep(0, 4))
  )

# wrap landscape plots
plots_land =
  wrap_plots(subplot_land, ncol = 1) +
  plot_layout(
    guides = "collect", 
    tag_level = "new"
  ) &
  theme(
    legend.key.width = unit(3, units = "mm"),
    legend.position = "bottom",
    legend.box.margin = margin(rep(0, 4))
  )

# make figure 5
figure_5 =
  wrap_plots(
    plots_land, plots_cues, 
    design = "AAAABBB",
    guides = "collect"
  ) &
  plot_annotation(tag_levels = c("A", "1")) &
  theme(
    legend.justification = "left",
    plot.tag = element_text(
      face = "bold",
      size = 8
    )
  )

ggsave(
  figure_5,
  height = 150,
  width = 160,
  units = "mm",
  filename = "figures/fig_05.png"
)