In pbs-assess/gfsynopsis: Data Synopsis Reports for PBS Groundfish

RELATIONS ENTRE LA DENSITÉ ET LA PROFONDEUR SELON LES RELEVÉS DES POISSONS {#app:depth-curves}

surveys <- c("SYN QCS", "SYN HS", "SYN WCHG", "SYN WCVI")
fi <- list.files(here::here("report/map-cache/synoptic"), full.names = FALSE)
out <- purrr::map_df(fi, function(i) {
  mm <- readRDS(here::here(paste0("report/map-cache/synoptic/", i)))
  out <- purrr::map_df(1:4, function(ii) {
    if (length(mm$models[[ii]]$models) > 1L) {
      rd <- dplyr::filter(mm$raw_dat, survey == surveys[ii])
      if (!'depth_mean' %in% names(rd))
        stop('Scaling mean and SD are missing.')
      range_d <- -1 * exp(rd$depth_mean[1] +
          range(rd$depth_scaled, na.rm = TRUE) * rd$depth_sd[1])
      x <- seq(-3, 4, length.out = 300)
      x2 <- x^2
      B <- mm$models[[ii]]$models$model$par
      if (B[[3]] <= 0) { # quadratic must be :-( shaped
        y <- B[[1]] + x * B[[2]] + x2 * B[[3]]
      } else {
        y <- NA
      }
      out <- data.frame(
        depth = -1*exp(x * rd$depth_sd[1] + rd$depth_mean[1]),
        y = exp(y) * 1000, # convert to kg/km^2 (was scaled by 1000 already)
        survey = surveys[ii],
        species = gsub("-", " ", gsub(".rds", "", i)),
        stringsAsFactors = FALSE)
      out <- mutate(out,
        extrapolated = depth < min(range_d) * 1 |
          depth > max(range_d) * 1)
      out
    }
  })
  out
})

surveys <- c('HBLL OUT N', 'HBLL OUT S')
fi <- list.files(here::here("report/map-cache/hbll"), full.names = FALSE)
out_hbll <- purrr::map_df(fi, function(i) {
  mm <- readRDS(here::here(paste0("report/map-cache/hbll/", i)))
  out <- purrr::map_df(1:length(surveys), function(ii) {
    if (length(mm$models[[ii]]$models) > 1L) {
      rd <- dplyr::filter(mm$raw_dat, survey == surveys[ii])
      if (!'depth_mean' %in% names(rd))
        stop('Scaling mean and SD are missing.')
      range_d <- -1 * exp(rd$depth_mean[1] +
          range(rd$depth_scaled, na.rm = TRUE) * rd$depth_sd[1])
      x <- seq(-3, 4, length.out = 300)
      x2 <- x^2
      B <- mm$models[[ii]]$models$model$par
      if (B[[3]] <= 0) { # quadratic must be :-( shaped
        y <- B[[1]] + x * B[[2]] + x2 * B[[3]]
      } else {
        y <- NA
      }
      y <- B[[1]] + x * B[[2]] + x2 * B[[3]]
      out <- data.frame(
        depth = -1*exp(x * rd$depth_sd[1] + rd$depth_mean[1]),
        y = exp(y) / 100, # convert to 100 fish/km^2
        survey = surveys[ii],
        species = gsub("-", " ", gsub(".rds", "", i)),
        stringsAsFactors = FALSE)
      out <- mutate(out,
        extrapolated = depth < min(range_d) * 1 |
          depth > max(range_d) * 1)
      out
    }
  })
  out
})
out <- bind_rows(out, out_hbll)
dd <- out %>% group_by(species, survey) %>%
  # mutate(y = y / max(y))
  mutate(max_y = max(y[!extrapolated])) %>%
  mutate(y = ifelse(y < max_y * 1.15, y, NA)) %>%
  mutate(mode_depth = depth[y == max(y)[1]]) %>%
  group_by(species) %>%
  mutate(mean_mode_depth = mean(mode_depth)) %>%
  filter(depth >= -800)

if(french){
  dd$species <- en2fr(gfsynopsis:::first_cap(dd$species), french)
}

make_depth_plot <- function(.data, 
  ylab = if (french){
    expression(Densité~de~la~biomasse~du~relevé~(kg/km^2))
  }
  else{
    expression(Survey~biomass~density~(kg/km^2))
  }
  ,
  xlim = c(-800, 0)) {

  if (french) {
    .data$species <- purrr::map_chr(.data$species, gfsynopsis:::cap) 
  } else {
    .data$species <- gfsynopsis:::first_cap(.data$species)
  }
  ggplot(.data, aes_string('depth', 'y', colour = 'survey')) +
    geom_line(lty = 2) +
    coord_cartesian(xlim = xlim) +
    labs(x = paste(en2fr('Depth', french), ' (m)'),
      y = ylab, colour = en2fr('Survey', french)) +
    # facet_wrap(~forcats::fct_reorder(species,
    #   mean_mode_depth),
    facet_wrap(~gfsynopsis:::first_cap(species), scales = "free_y", ncol = 4) +
    geom_line(data = dplyr::filter(.data, !extrapolated), lwd = 0.9) +
    scale_color_brewer(palette = "Dark2")
}

(ref:depth-relationship1) Relations prévues entre la profondeur et la densité de la biomasse pour toutes les espèces dans les quatre relevés synoptiques (Partie 1 de 2). Les lignes pleines indiquent les relations prévues dans la plage de profondeurs du relevé, et les lignes tiretées indiquent les relations extrapolées au-delà de la profondeur observée. Ces relations sont dérivées des coefficients de profondeur dans les modèles spatiaux qui génèrent les graphiques cartographiques (p. ex., figure \@ref(fig:survey-maps)). Ces graphiques fournissent une indication visuelle des relevés qui englobent la totalité de la répartition de la profondeur pour des espèces données. Voir l’annexe \@ref(app:spatial-modeling) pour davantage de détails sur les modèles qui sous-tendent ces prévisions.

.sp <- filter(dd, grepl('SYN', survey)) %>% 
  pull(species) %>% unique()
synoptic_data <- filter(dd, grepl('SYN', survey)) %>% 
  mutate(survey = as.factor(as.character(survey)))
filter(synoptic_data, species %in% .sp[1:36]) %>%
  make_depth_plot()

\clearpage

(ref:depth-relationship2) Partie 2 de la figure \@ref(fig:sdmTMB-depth-all-plots1). En dehors de cela, la légende est la même.

filter(synoptic_data, species %in% .sp[37:length(.sp)]) %>%
  make_depth_plot()

\clearpage

(ref:depth-relationship-hbll) Comme pour la figure \@ref(fig:sdmTMB-depth-all-plots1), mais pour les relevés menés à la palangre à l’extérieur du fond dur. En dehors de cela, la légende est la même. Il est à noter que ces panneaux ne s’étendent pas sur des profondeurs supérieures à celles illustrées sur les figures \@ref(fig:sdmTMB-depth-all-plots1) et \@ref(fig:sdmTMB-depth-all-plots2).

.sp <- filter(dd, grepl('HBLL', survey)) %>% 
  pull(species) %>% unique()
hbll_data <- filter(dd, grepl('HBLL', survey)) %>% 
  mutate(survey = as.factor(as.character(survey)))
filter(hbll_data, species %in% .sp) %>%
  make_depth_plot(
    ylab = if(french){
    expression(Densité~du~relevé~(100~poissons/km^2))
  }
  else{
    expression(Survey~density~(100~fish/km^2))
  }
  ,
    xlim = c(-250, 0)
  )