diff --git a/DESCRIPTION b/DESCRIPTION index 492fd72..02847a1 100644 --- a/DESCRIPTION +++ b/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", diff --git a/NEWS.md b/NEWS.md index 8d70217..805baac 100644 --- a/NEWS.md +++ b/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 diff --git a/R/calc_swept_area.R b/R/calc_swept_area.R index b449b54..dbca4d0 100644 --- a/R/calc_swept_area.R +++ b/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) } - - - - - - diff --git a/R/swept_area.R b/R/swept_area.R index 30b5461..877b01a 100644 --- a/R/swept_area.R +++ b/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()