R/viz.R

In matthewkling/stranger: Demographic species range modeling with dispersal

#' Convert spatiotemporal population array to tibble
#'
#' @param x Population array generated by \code{simulate}.
#' @return A data frame.
#' @export
frame <- function(x){
  x %>% as.data.frame.table() %>% as_tibble() %>%
    setNames(c("y", "x", "t", "N")) %>%
    mutate(x = as.integer(x),
           y = as.integer(y),
           t = as.integer(t),
           N = as.numeric(N)) %>%
    ungroup() %>%
    mutate(t = t - 1)
}


#' Plot population time series in random grid cells
#'
#' @param d Population array generated by \code{simulate}.
#' @param n_cells Number of grid cells to plot.
#' @return A ggplot.
#' @export
plot_lines <- function(d, n_cells = 10){
  d %>%
    frame() %>%
    filter(between(x, 5, max(x) - 4),
           between(y, 5, max(y) - 4)) %>%
    mutate(cell = paste(x, y)) %>%
    filter(cell %in% sample(unique(cell), n_cells)) %>%
    ggplot(aes(t, N, color = cell)) +
    geom_line() +
    theme_minimal() +
    theme(legend.position = "none") +
    labs(x = "time step", y = "N adults in cell")
}


#' Plot population maps for a series of time steps.
#'
#' @param d Population array generated by \code{simulate}.
#' @param n_frames Number of evenly spaced time steps to plot.
#' @param n_rows Number of rows for \code{facet_wrap}.
#' @return A ggplot.
#' @export
plot_heatmaps <- function(d, n_frames = 10, n_rows = 2){
  d %>%
    frame() %>%
    filter(t %in% round(seq(min(t), max(t), length.out = n_frames))) %>%
    mutate(N = ifelse(N == 0, NA, N)) %>%
    ggplot(aes(x, y, fill = N)) +
    facet_wrap(~ t, nrow = n_rows, labeller = label_both) +
    geom_raster() +
    theme_void() +
    theme(legend.position = "bottom") +
    coord_fixed() +
    scale_fill_gradientn(colors = c("khaki", "orange", "darkred", "black")) +
    labs(fill = "N adults")
}