swept area bug fix

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: survdat
 Type: Package
 Title: Tools for working with NEFSC survey data
-Version: 1.1.0
+Version: 1.1.1
 Authors@R: c(person(given = "Sean",
                     family = "Lucey",
                     email = "Sean.Lucey@NOAA.gov",

NEWS.md

@@ -1,3 +1,10 @@
+# survdat 1.1.1
+
+## Bug fixes
+
+* `calc_swept_area` function can now use a user supplied value of `a` (average swept area of trawl, km^-2)
+* `swep_area` function can now utilize a user supplied scalar for `q` (catchability) across all groups
+
 # survdat 1.1.0
 
 * Added `get_species_stock_area` function to retrieve species stock area (Bottom Trawl survey STRATA) data from STOCKEFF

R/calc_swept_area.R

@@ -30,57 +30,73 @@
 #'
 #' @export
 
-calc_swept_area <- function(surveyData, areaPolygon = 'NEFSC strata',
-                            areaDescription = 'STRATA', filterByArea = "all",
-                            filterBySeason, groupDescription = "SVSPP",
-                            filterByGroup = "all", mergesexFlag = T,
-                            tidy = F, q = NULL, a = 0.0384) {
+calc_swept_area <- function(
+  surveyData,
+  areaPolygon = 'NEFSC strata',
+  areaDescription = 'STRATA',
+  filterByArea = "all",
+  filterBySeason,
+  groupDescription = "SVSPP",
+  filterByGroup = "all",
+  mergesexFlag = T,
+  tidy = F,
+  q = NULL,
+  a = 0.0384
+) {
+  #Run stratified mean
+  stratmeanData <- calc_stratified_mean(
+    surveyData,
+    areaPolygon,
+    areaDescription,
+    filterByArea,
+    filterBySeason,
+    groupDescription,
+    filterByGroup,
+    mergesexFlag,
+    returnPrepData = T
+  )
 
-    #Run stratified mean
-    stratmeanData <- calc_stratified_mean(surveyData, areaPolygon, areaDescription,
-                                          filterByArea, filterBySeason,
-                                          groupDescription, filterByGroup,
-                                          mergesexFlag, returnPrepData = T)
+  #Calculate total biomass/abundance estimates
+  message("Calculating Swept Area Estimate  ...")
+  sweptareaData <- survdat:::swept_area(
+    prepData = stratmeanData$prepData,
+    stratmeanData = stratmeanData$stratmeanData,
+    q = q,
+    areaDescription = areaDescription,
+    a = a,
+    groupDescription = groupDescription
+  )
 
-    #Calculate total biomass/abundance estimates
-    message("Calculating Swept Area Estimate  ...")
-    sweptareaData <- survdat:::swept_area(prepData = stratmeanData$prepData,
-                                         stratmeanData = stratmeanData$stratmeanData,
-                                         q = q, areaDescription = areaDescription,
-                                         groupDescription = groupDescription)
+  #create tidy data set
+  if (tidy) {
+    message("Tidying data  ...")
+    tidyData <- data.table::melt.data.table(
+      sweptareaData,
+      id.vars = c('YEAR', groupDescription),
+      measure.vars = c(
+        'strat.biomass',
+        'biomass.var',
+        'strat.abund',
+        'abund.var',
+        'tot.biomass',
+        'tot.bio.var',
+        'tot.abundance',
+        'tot.abund.var'
+      )
+    )
+    tidyData[variable == 'strat.biomass', units := 'kg tow^-1']
+    tidyData[variable == 'biomass.var', units := '(kg tow^-1)^2']
+    tidyData[variable == 'strat.abund', units := 'number']
+    tidyData[variable == 'abund.var', units := 'numbers^2']
+    tidyData[variable == 'tot.biomass', units := 'kg']
+    tidyData[variable == 'tot.bio.var', units := 'kg^2']
+    tidyData[variable == 'tot.abundance', units := 'number']
+    tidyData[variable == 'tot.abund.var', units := 'numbers^2']
 
-    #create tidy data set
-    if(tidy){
-        message("Tidying data  ...")
-        tidyData <- data.table::melt.data.table(sweptareaData, id.vars = c('YEAR',
-                                                                           groupDescription),
-                                                measure.vars = c('strat.biomass',
-                                                                 'biomass.var',
-                                                                 'strat.abund',
-                                                                 'abund.var',
-                                                                 'tot.biomass',
-                                                                 'tot.bio.var',
-                                                                 'tot.abundance',
-                                                                 'tot.abund.var'))
-        tidyData[variable == 'strat.biomass', units := 'kg tow^-1']
-        tidyData[variable == 'biomass.var',   units := '(kg tow^-1)^2']
-        tidyData[variable == 'strat.abund',   units := 'number']
-        tidyData[variable == 'abund.var',     units := 'numbers^2']
-        tidyData[variable == 'tot.biomass',   units := 'kg']
-        tidyData[variable == 'tot.bio.var',   units := 'kg^2']
-        tidyData[variable == 'tot.abundance', units := 'number']
-        tidyData[variable == 'tot.abund.var', units := 'numbers^2']
+    sweptareaData <- tidyData
+  }
 
-        sweptareaData <- tidyData
-    }
+  sweptareaData[]
 
-    sweptareaData[]
-
-    return(sweptareaData)
+  return(sweptareaData)
 }
-
-
-
-
-
-

R/swept_area.R

@@ -31,16 +31,24 @@
 #'
 #'@noRd
 
-
-swept_area <- function (prepData, stratmeanData, q = NULL, a = 0.0384,
-                        areaDescription, groupDescription = 'SVSPP') {
+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)
+  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::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))
@@ -51,34 +59,67 @@ swept_area <- function (prepData, stratmeanData, q = NULL, a = 0.0384,
   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)
+  if (is.null(q)) {
+    q <- data.table::data.table(
+      groups = unique(swept.area[, get(groupDescription)]),
+      q = 1
+    )
+    message("Assuming a value of q = ", q, " for all groups")
+  } else if (length(q) == 1) {
+    # apply q to all groups
+    message("Assuming a value of q = ", q, " for all groups")
+    q <- data.table::data.table(
+      groups = unique(swept.area[, get(groupDescription)]),
+      q = q
+    )
+  } else {
+    # Need a value of q for all groups
+  }
+
   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)]
+  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[, 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.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)]
+  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]
+  if (length(which(names(stratmeanData.x) == 'sex')) == 0) {
+    swept.area[, sex := NULL]
+  }
 
   swept.area <- swept.area %>% units::drop_units()