R/swept_area.R

#'Calculate the estimate of total biomass and abundance
#'
#'Calculates the estimate of total biomass and abundance using the swept area.
#'Variance of the estimate is also calculated.  Requires the outputs from both
#'the stratprep and stratmean functions.
#'
#'
#'@param survdat NEFSC survey data generated by Survdat.R and modified by stratprep().
#'@param stratmean Output from strat_mean().
#'@param q Table of survey catchability with a column of group names and a column of
#'catchabilities.  If not provided, assumes a q of 1 for each group (Minimum swept area
#'estimates).
#'@param a The average swept area of the trawl.  Default value is the swept area of a
#'standard NOAA Ship Albatross IV tow.
#'@param areaDescription Column of survdat containing strata designations.
#'@param groupDescription Column of survdat upon which the totals are based (i.e. SVSPP).
#'
#'@return Returns a table with the estimates of total biomass and abundance as well as
#'the stratified mean biomass and abundance for each group indicated by the groupDescription
#'parameter.  In addition, the variance of the totals and variance and standard error
#'for both means are provided.
#'
#'@importFrom data.table "key"
#'
#'@family survdat
#'
#'@examples
#'\dontrun{
#'# Called internally
#'}
#'
#'@export


swept_area <- function (prepData, stratmeanData, q = NULL, a = 0.0384,
                        areaDescription, groupDescription = 'SVSPP') {
  #This is necessary to break the link with the original data table
  prepData.x  <- data.table::copy(prepData)
  stratmeanData.x  <- data.table::copy(stratmeanData)

  #Calculate A (Total area)
  data.table::setnames(prepData.x, c(areaDescription, "Area"),
           c('STRAT', 'S.AREA'))

  data.table::setkey(prepData.x, YEAR, STRAT)
  stratum <- unique(prepData.x, by = key(prepData.x))
  stratum <- stratum[, sum(S.AREA, na.rm = T), by = 'YEAR']
  data.table::setnames(stratum, "V1", "A")

  #Merge A
  swept.area <- base::merge(stratmeanData.x, stratum, by = 'YEAR')

  #Merge q
  if(is.null(q)) q <- data.table::data.table(groups = unique(swept.area[, get(groupDescription)]), q = 1)
  data.table::setnames(q, names(q), c(groupDescription, 'q'))
  swept.area <- base::merge(swept.area, q, by = groupDescription, all.x = T)
  swept.area[is.na(q), q := 1]

  #Calculate swept area biomass
  swept.area[, tot.biomass   :=       (strat.biomass * A/a)/q]
  swept.area[, tot.abundance := round((strat.abund   * A/a)/q)]

  #Calculate variance
  swept.area[, var.constant := (A/a)/q]
  swept.area[, tot.bio.var   := var.constant^2 * biomass.var]
  swept.area[, tot.abund.var := var.constant^2 * abund.var]

  #Calculate standard error
  swept.area[, tot.bio.SE   := sqrt(tot.bio.var)]
  swept.area[, tot.abund.SE := sqrt(tot.abund.var)]

  #remove extra columns - need to add sex column if stratmean object does not have one
  #then remove before output
  if(length(which(names(stratmeanData.x) == 'sex')) == 0) swept.area[, sex := 0]
  swept.area <- swept.area[, list(YEAR, get(groupDescription), sex, N,
                                  strat.biomass, biomass.var,   biomass.SE,
                                  strat.abund,   abund.var,     abund.SE,
                                  tot.biomass,   tot.bio.var,   tot.bio.SE,
                                  tot.abundance, tot.abund.var, tot.abund.SE)]
  data.table::setnames(swept.area, 'V2', groupDescription)
  if(length(which(names(stratmeanData.x) == 'sex')) == 0) swept.area[, sex := NULL]

  swept.area <- swept.area %>% units::drop_units()

  return(swept.area)
}
andybeet/survdat documentation built on Nov. 9, 2023, 10:11 a.m.