knitr::opts_chunk$set(echo = FALSE,
                      message = FALSE,
                      warning = FALSE, 
                      fig.width = 10, 
                      fig.height = 5.2)
knitr::opts_knit$set(root.dir = "../..")
# xaringan::inf_mr()

library(SimSurvey)
library(plotly)
library(crosstalk)
library(raster)
library(lattice)
library(viridis)
library(data.table)
load("analysis/cod_sim_exports/2018-10-26_age_clust_test/test_output.RData")

boat_txt <- '<br>
<img src="graphics/teleost_twitter_crop.jpg" width="400"/>
<font size="1"> 
<br>
&nbsp; <a href="https://twitter.com/coastguardcan/status/879410397790515201">Canadian Coast Guard | Twitter</a>
</font>'

## wrapper for layout with some different defaults for this slideshow
tight_layout <- function(p, 
                         plot_bgcolor = "transparent",
                         paper_bgcolor = "transparent",
                         margin = list(l = 0, r = 0, t = 0, b = 0, pad = 0),
                         font = list(size = 14, family = "'Montserrat', sans-serif"), 
                         ..., data = NULL) {
  layout(p, plot_bgcolor = plot_bgcolor, paper_bgcolor = paper_bgcolor,
         margin = margin, font = font, ..., data = data)
}

N?

Fisheries-independent trawl surveys {.columns-2}

cat(boat_txt)

Fisheries-independent trawl surveys {.columns-2}

cat(boat_txt)

Multi-stage sampling

Surveys are generally designed to:

         1 |              2 |           3 :----: | :----: | :----: Conduct sets at multiple locations | Sub-sample catch for length measurements | Sub-sample length groups for age determination | |

Intra-haul correlation

Sampling clusters of fish that have similar characteristics (e.g. length)


Graphic from Tunstrøm et al (2013) PLoS Comput Biol 9(2): e1002915.

Fisheries-independent trawl surveys {.columns-2}

cat(boat_txt)

Reality is complicated {data-background=graphics/school_light.png data-background-size=cover}

Simulation steps {.smaller}

  1. Simulate abundance
    • Common cohort model
  2. Simulate spatial aggregation
    • Includes depth associations and noise correlated across space, years and ages
  3. Simulate surveys
    • Stratified random surveys with different sampling protocol
  4. Analyze

Simulate abundance

Simulate abundance {.tighter}

Trend in total abundance

plot_trend(sim) %>% 
  tight_layout(yaxis = list(rangemode = "tozero"),
               margin = list(l = 70, r = 0, t = 0, b = 40, pad = 0))

Simulate abundance {.tighter}

Trend in abundance at age

plot_surface(sim) %>% tight_layout(scene = list(xaxis = list(range = c(1, 10))))

Simulate spatial aggregation

Simulate spatial aggregation {.tighter}

Distribution for ages 1-6 in years 1-6

plot_distribution(sim, ages = 1:6, years = 1:6, type = "heatmap") %>% 
  tight_layout(margin = list(l = 0, r = 0, t = 40, b = 0, pad = 0))

Simulate survey

Simulate survey

Simulate survey {.tighter}

Catch in year 1 survey simulation 1

plot_survey(sim) %>% 
  tight_layout(margin = list(l = 0, r = 0, t = 0, b = 40, pad = 0))

Settings and analysis {.build}

| Parameter name | Symbol | Setting | |:----------------------- | :-------------- | :------------------------------------------------ | | Set density | $D_{sets}$ | 0.0005, 0.001, 0.002, 0.005, 0.01 sets / km^2^ | | Length sampling effort | $M_{lengths}$ | 5, 10, 20, 50, 100, 500, 1000 lengths / set | | Age sampling effort | $M_{ages}$ | 2, 5, 10, 20, 50 ages / length group / division |

Settings and analysis

Assumptions

  • Population is uniformly distributed within a cell
  • The survey is an instantaneous snapshot of the population
  • Fish are aged at random throughout the division within length bins
  • Ages are estimated without error
  • Trawl dimensions are perfectly standard

Truth vs. estimate

Total abundance

plot_total_strat_fan(sim, surveys = 1:5, 
                     plot_bgcolor = "transparent", paper_bgcolor = "transparent",
                     font = list(size = 14, family = "'Montserrat', sans-serif"))

Truth vs. estimate

Abundance at age

surveys <- sim$surveys[set_den %in% c(0.0005, 0.001, 0.002, 0.01) &
                         lengths_cap %in% c(10, 100, 500, 1000) &
                         ages_cap %in% c(5, 10, 50), ]
plot_age_strat_fan(sim, surveys = surveys$survey, 
                   years = 1:5, ages = sim$ages, select_by = "year",
                   plot_bgcolor = "transparent", paper_bgcolor = "transparent",
                   font = list(size = 14, family = "'Montserrat', sans-serif"))

Truth vs. estimate

Abundance at age

plot_age_strat_fan(sim, surveys = surveys$survey, 
                   ages = 2:6, years = sim$years, select_by = "age",
                   plot_bgcolor = "transparent", paper_bgcolor = "transparent",
                   font = list(size = 14, family = "'Montserrat', sans-serif"))

Truth vs. estimate {.tighter}

RMSE ~ sampling protocol

slide_font <- list(size = 14, color = rgb(121, 121, 121, maxColorValue = 255))
surface_font <- list(titlefont = slide_font, 
                     tickfont = slide_font)
surface_scene <- list(
  xaxis = surface_font,
  yaxis = surface_font,
  zaxis = surface_font
)
plot_error_surface(sim, plot_by = "rule") %>% 
  tight_layout(scene = surface_scene,
               margin = list(l = 0, r = 0, t = 40, b = 0, pad = 0))

Truth vs. estimate {.tighter}

RMSE ~ sample size

plot_error_surface(sim, plot_by = "samples") %>% 
  tight_layout(scene = surface_scene,
               margin = list(l = 0, r = 0, t = 40, b = 0, pad = 0))

Truth vs. estimate {.smaller}

Recap

Check bias

Turned off age-specific clustering

main_sim <- sim
load("analysis/cod_sim_exports/2018-09-07_test/test_output.RData")
plot_age_strat_fan(sim, surveys = surveys$survey,
                   ages = 2:6, years = sim$years, select_by = "age",
                   plot_bgcolor = "transparent", paper_bgcolor = "transparent",
                   font = list(size = 14, family = "'Montserrat', sans-serif"))

Check bias {.tighter}

Turned off age-specific clustering

plot_error_surface(sim, plot_by = "samples") %>% 
  tight_layout(scene = surface_scene,
               margin = list(l = 0, r = 0, t = 40, b = 0, pad = 0))

Check bias

Turned off age-specific clustering

Check bias

Why is there bias in the main scenario? Why is extra sub-sampling sometimes useful / sometimes detrimental?

Conclusions

Results suggest that

Conclusions

Caution: this simple simulation is far from perfect, focuses on one case study, and lacks a cost component

Potential future directions

Acknowledgements

  • Feedback and advice: Alejandro Buren, Dave Cote, Karen Dwyer, Geoff Evans, Brian Healey, Paul Higdon, Danny Ings, Mariano Koen-Alonso, Joanne Morgan, Derek Osborne, Dwayne Pittman, Don Power, Martha Robertson, Mark Simpson, Brad Squires, Don Stansbury, Peter Upward, ...
  • Support: Fisheries and Oceans Canada and NSERC

References {.smaller}



PaulRegular/SimSurvey documentation built on Sept. 21, 2023, 7:42 p.m.