R/fig_vulnerability.R

In EffetsCumulatifsNavigation/ceanav: Research compendium for project on the assessment cumulative effects of marine vessel activities in the St. Lawrence

#' Figure of vulnerability as heatmaps
#'
#' @keywords figure
#'
#' @export
#'


fig_vulnerability <- function(lang = "fr") {
  #=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=#
  # Metadata
  #=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=#
  st <- read.csv("data/data-metadata/metadata_stresseurs.csv")
  cv <- read.csv("data/data-metadata/metadata_composantes_valorisees.csv")
  folder <- "./figures/figures-vulnerability/"
  folder_en <- "./figures_en/figures-vulnerability/"

  #=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=#
  # Function
  #=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=#
  temp <- function(tab) {
    l <- list()
    l$dat <- as.matrix(tab[,2:ncol(tab)])
    if (lang == "fr") {
      l$columns <- data.frame(accronyme = colnames(l$dat)) %>%
                 left_join(cv, by = "accronyme") %>%
                 select(francais) %>%
                 as.matrix() %>%
                 as.vector()
      l$rows <- data.frame(accronyme = tab$X) %>%
              left_join(st, by = "accronyme") %>%
              select(francais) %>%
              as.matrix() %>%
              as.vector()      
      l$gr <- st[,c('stresseur','title')] %>%
                     group_by(stresseur, title) %>%
                     summarize(size = n()) %>%
                     ungroup() %>%
                     mutate(cumsize = cumsum(size))
    } else if (lang == "en") {
      l$columns <- data.frame(accronyme = colnames(l$dat)) %>%
                 left_join(cv, by = "accronyme") %>%
                 select(english) %>%
                 as.matrix() %>%
                 as.vector()
      l$rows <- data.frame(accronyme = tab$X) %>%
              left_join(st, by = "accronyme") %>%
              select(english) %>%
              as.matrix() %>%
              as.vector()
      l$gr <- st[,c('stresseur','title_en')] %>%
                     group_by(stresseur, title_en) %>%
                     rename(title = title_en) %>%
                     summarize(size = n()) %>%
                     ungroup() %>%
                     mutate(cumsize = cumsum(size))
    }
    return(l)
  }


  #=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=#
  # Data
  #=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=#
  berge <- read.csv("./data/data-vulnerability/vulnerability_berge.csv") %>% temp()
  hab <- read.csv("./data/data-vulnerability/vulnerability_habitat.csv") %>% temp()
  fau <- read.csv("./data/data-vulnerability/vulnerability_faune_flore.csv") %>% temp()
  mm <- read.csv("./data/data-vulnerability/vulnerability_mammiferes_marins.csv") %>% temp()

  #=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=#
  # Graph
  #=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=~-~=#
  if (lang == "fr") {
    fnc_heatmap(berge$dat, berge$columns, berge$rows, berge$gr, glue("{folder}berge.png"))
    fnc_heatmap(hab$dat, hab$columns, hab$rows, hab$gr, glue("{folder}habitat.png"))
    fnc_heatmap(fau$dat, fau$columns, fau$rows, fau$gr, glue("{folder}faune_flore.png"))
    fnc_heatmap(mm$dat, mm$columns, mm$rows, mm$gr, glue("{folder}mammiferes_marins.png"))
  } else if (lang == "en") {
    fnc_heatmap(berge$dat, berge$columns, berge$rows, berge$gr, glue("{folder_en}berge.png"))
    fnc_heatmap(hab$dat, hab$columns, hab$rows, hab$gr, glue("{folder_en}habitat.png"))
    fnc_heatmap(fau$dat, fau$columns, fau$rows, fau$gr, glue("{folder_en}faune_flore.png"))
    fnc_heatmap(mm$dat, mm$columns, mm$rows, mm$gr, glue("{folder_en}mammiferes_marins.png"))
  }
} # end function