In karinorman/biodivTS: What the Package Does (One Line, Title Case)

knitr::opts_chunk$set(echo = TRUE)

library(ggplot2)
library(dplyr)

Plot a normal curve

ggplot(data.frame(x = c(-5, 5)), aes(x)) + 
  stat_function(fun = dnorm, args = list(mean = 0, sd = .9), col='red', xlim = c(-3, 3)) +
  stat_function(fun = dnorm, args = list(mean = 1, sd = .5), col='blue', xlim = c(-2, 4)) +
  xlim(c(-5, 5)) +
  ylim(c(0,1)) +
  theme_classic() +
  theme(axis.text.x=element_blank(),
        #axis.ticks.x=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank())

Richness plots

get_xlim <- function(center, edge){
  return(list(center - edge, center + edge))
}

low_rich <- 
  ggplot(data.frame(x = c(-5, 5)), aes(x)) + 
  stat_function(fun = dnorm, args = list(mean = -3, sd = .9), xlim = c(-5, -1)) +
  stat_function(fun = dnorm, args = list(mean = 3, sd = .9), xlim = c(1, 5)) +
  xlim(c(-5, 5)) +
  #ylim(c(0,1)) +
  scale_y_continuous(expand = expansion(mult = c(0, .1)), limits = c(.05, 1)) +
  theme_classic() +
  ylab("S") +
  theme(axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.title.y=element_text(angle = 0, vjust = 0.5, face = "bold"),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank(),
        plot.title = element_text(hjust = 0.5, face = "bold")) +
  ggtitle("Low")

low_rich_fin <- low_rich + ylab(NULL)

high_rich <- 
  ggplot(data.frame(x = c(-5, 5)), aes(x)) + 
  #stat_function(fun = dnorm, args = list(mean = -3, sd = .9), xlim = c(-5, -1)) +
  #stat_function(fun = dnorm, args = list(mean = 3, sd = .9), xlim = c(1, 5)) +
  pmap(tibble(mean = c(-3, -2, -1.5, 0, 1.25, 3), 
  sd = rep(0.9, 6)) %>%
    rowwise %>%
    mutate(xlim = list(get_xlim(mean, 2))),
  function(mean, sd, xlim) stat_function(fun = dnorm, args = list(mean = mean, sd = sd), xlim = unlist(xlim))
  )  +
  xlim(c(-5, 5)) +
  #ylim(c(0,1)) +
  scale_y_continuous(expand = expansion(mult = c(0, .1)), limits = c(.05, 1)) +
  theme_classic() +
  theme(axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank(),
        plot.title = element_text(hjust = 0.5, face = "bold")) +
  ggtitle("High")

Functional Richness

low_fric <- 
  ggplot(data.frame(x = c(-5, 5)), aes(x)) + 
  #stat_function(fun = dnorm, args = list(mean = -3, sd = .9), xlim = c(-5, -1)) +
  #stat_function(fun = dnorm, args = list(mean = 3, sd = .9), xlim = c(1, 5)) +
  pmap(tibble(mean = c(-.5, 0,.25), 
  sd = rep(0.9, 3)) %>%
    rowwise %>%
    mutate(xlim = list(get_xlim(mean, 2))),
  function(mean, sd, xlim) stat_function(fun = dnorm, args = list(mean = mean, sd = sd), xlim = unlist(xlim))
  )  +
  xlim(c(-5, 5)) +
  #ylim(c(0,1)) +
  scale_y_continuous(expand = expansion(mult = c(0, .1)), limits = c(.05, 1)) +
  theme_classic() +
  ylab("FRic") +
  theme(axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.title.y=element_text(angle = 0, vjust = 0.5, face = "bold"),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank())

low_fric_fin <- low_fric + ylab(NULL)

high_fric <- 
  ggplot(data.frame(x = c(-5, 5)), aes(x)) + 
  #stat_function(fun = dnorm, args = list(mean = -3, sd = .9), xlim = c(-5, -1)) +
  #stat_function(fun = dnorm, args = list(mean = 3, sd = .9), xlim = c(1, 5)) +
  pmap(tibble(mean = c(-3, -1.5, 1, 3), 
  sd = rep(0.9, 4)) %>%
    rowwise %>%
    mutate(xlim = list(get_xlim(mean, 2))),
  function(mean, sd, xlim) stat_function(fun = dnorm, args = list(mean = mean, sd = sd), xlim = unlist(xlim))
  )  +
  xlim(c(-5, 5)) +
  #ylim(c(0,1)) +
  scale_y_continuous(expand = expansion(mult = c(0, .1)), limits = c(.05, 1)) +
  theme_classic() +
  theme(axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank())

high_fric

Evenness

low_eve <- 
  ggplot(data.frame(x = c(-5, 5)), aes(x)) + 
  #stat_function(fun = dnorm, args = list(mean = -3, sd = .9), xlim = c(-5, -1)) +
  #stat_function(fun = dnorm, args = list(mean = 3, sd = .9), xlim = c(1, 5)) +
  pmap(tibble(mean = c(-3, -2, -1.5, 0, 1.25, 3), 
  sd = c(1.25, 0.5, 1.25, 1.25, 0.65, 1.25),
  plot_range = c(2.5, 2, 2.5, 2.5, 2, 2.5)) %>%
    rowwise %>%
    mutate(xlim = list(get_xlim(mean, plot_range))) %>%
    select(-plot_range),
  function(mean, sd, xlim) stat_function(fun = dnorm, args = list(mean = mean, sd = sd), xlim = unlist(xlim))
  )  +
  xlim(c(-5.25, 5.25)) +
  #ylim(c(0,1)) +
  scale_y_continuous(expand = expansion(mult = c(0, .1)), limits = c(.05, 1)) +
  theme_classic() +
  ylab("FEve") +
  theme(axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.title.y=element_text(angle = 0, vjust = 0.5, face = "bold"),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank())

low_eve_fin <- low_eve + ylab(NULL)

high_eve <- ggplot(data.frame(x = c(-5, 5)), aes(x)) + 
  #stat_function(fun = dnorm, args = list(mean = -3, sd = .9), xlim = c(-5, -1)) +
  #stat_function(fun = dnorm, args = list(mean = 3, sd = .9), xlim = c(1, 5)) +
  pmap(tibble(mean = c(-3, -2, -1.5, 0, 1.25, 3), 
  sd = rep(0.9, 6)) %>%
    rowwise %>%
    mutate(xlim = list(get_xlim(mean, 2))),
  function(mean, sd, xlim) stat_function(fun = dnorm, args = list(mean = mean, sd = sd), xlim = unlist(xlim))
  )  +
  xlim(c(-5, 5)) +
  #ylim(c(0,1)) +
  scale_y_continuous(expand = expansion(mult = c(0, .1)), limits = c(.05, 1)) +
  theme_classic() +
  theme(axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank())

Divergence

low_div <-  
ggplot(data.frame(x = c(-5, 5)), aes(x)) + 
  #stat_function(fun = dnorm, args = list(mean = -3, sd = .9), xlim = c(-5, -1)) +
  #stat_function(fun = dnorm, args = list(mean = 3, sd = .9), xlim = c(1, 5)) +
  pmap(tibble(mean = c(-3, -2, -1.5, 0, 1.25, 3), 
  sd = c(0.9, 0.9, 0.55, 0.5, 0.9, 0.9)) %>%
    rowwise %>%
    mutate(xlim = list(get_xlim(mean, 2))),
  function(mean, sd, xlim) stat_function(fun = dnorm, args = list(mean = mean, sd = sd), xlim = unlist(xlim))
  )  +
  xlim(c(-5, 5)) +
  #ylim(c(0,1)) +
  scale_y_continuous(expand = expansion(mult = c(0, .1)), limits = c(.05, 1)) +
  theme_classic() +
  ylab("FDiv") +
  theme(axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.title.y=element_text(angle = 0, vjust = 0.5, face = "bold"),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank())

low_div_fin <- low_div + ylab(NULL)

high_div <- 
ggplot(data.frame(x = c(-5, 5)), aes(x)) + 
  #stat_function(fun = dnorm, args = list(mean = -3, sd = .9), xlim = c(-5, -1)) +
  #stat_function(fun = dnorm, args = list(mean = 3, sd = .9), xlim = c(1, 5)) +
  pmap(tibble(mean = c(-3, -.5, -0.15, 0,.25, 3), 
  sd = c(0.55, 0.9, 0.9, 0.9, 0.9, 0.5)) %>%
    rowwise %>%
    mutate(xlim = list(get_xlim(mean, 2))),
  function(mean, sd, xlim) stat_function(fun = dnorm, args = list(mean = mean, sd = sd), xlim = unlist(xlim))
  )  +
  xlim(c(-5, 5)) +
  #ylim(c(0,1)) +
  scale_y_continuous(expand = expansion(mult = c(0, .1)), limits = c(.05, 1)) +
  theme_classic() +
  theme(axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank())

high_div

library(cowplot)
library(grid)
library(gridExtra)

plot_join <- plot_grid(get_plot_component(low_rich, "ylab-l"), low_rich_fin, high_rich, 
                       get_plot_component(low_fric, "ylab-l"), low_fric_fin, high_fric, 
                       get_plot_component(low_eve, "ylab-l"), low_eve_fin, high_eve, 
                       get_plot_component(low_div, "ylab-l"), low_div_fin, high_div, 
                       nrow = 4, align = 'vh',
                       hjust = -1, axis = "l", scale = 0.9, 
                       #label_x = "Trait Axis", label_y = "Abundance",
                       rel_widths = c(.5, 1, 1))

plot_join

y.grob <- textGrob("Abundance",  
            gp = gpar(fontsize = 12),
            vjust = 11, hjust = 0.25, rot=90)

x.grob <- textGrob("Trait Axis", gp = gpar(fontsize = 12), hjust = -0.5)

final <- grid.arrange(arrangeGrob(plot_join, left = y.grob, bottom = x.grob))

ggsave(here::here("figures/conceptual_fig.jpeg"), final, height = 6, width = 7)

patchwork

# library(patchwork)
# low_rich + high_rich + low_fric + high_fric + 
#                        low_eve + high_eve + low_div + high_div + plot_layout(ncol = 2) %>%
#   add_global_label(Ylab="Abundance", Ygap=0.05)

karinorman/biodivTS documentation built on Dec. 23, 2024, 10 p.m.