From 66716b7125b50a4876578004b620104e7b3fd824 Mon Sep 17 00:00:00 2001 From: andybeet <22455149+andybeet@users.noreply.github.com> Date: Sat, 14 Sep 2024 09:41:38 -0400 Subject: [PATCH] reomved rd files for functions no longer exported --- R/assign_unknown.R | 186 +++++++++++++++++++++--------------------- R/calc_DK.R | 39 +++++---- R/calc_discards.R | 31 +++---- R/soeAreas.R | 15 ++++ man/assign_area.Rd | 27 ------ man/assign_unknown.Rd | 27 ------ man/calc_DK.Rd | 27 ------ man/calc_discards.Rd | 35 -------- 8 files changed, 137 insertions(+), 250 deletions(-) create mode 100644 R/soeAreas.R delete mode 100644 man/assign_area.Rd delete mode 100644 man/assign_unknown.Rd delete mode 100644 man/calc_DK.Rd delete mode 100644 man/calc_discards.Rd diff --git a/R/assign_unknown.R b/R/assign_unknown.R index f11042e..0dfb4fc 100644 --- a/R/assign_unknown.R +++ b/R/assign_unknown.R @@ -3,12 +3,12 @@ #' Impute unknown variables associated with landings. #' #' -# @inheritParams +# @inheritParams #' @param unkVar Vector. Catch variables to be imputed. Should be in the order #' you would like them to be solved. -#' +#' #' @param knStrata Vector. Catch variables to be used to impute \code{unkVar}. An -#' \code{unkVar} can be included in this list if it is used to solve a second +#' \code{unkVar} can be included in this list if it is used to solve a second #' \code{unkVar}. Should be in the order of most restrictive to least restrictive. #' #' @return Returns a \code{comlandData} data.table. @@ -18,52 +18,52 @@ #' #'@family comland #' -#' @export +#' @noRd -assign_unknown <- function (comData, unkVar, +assign_unknown <- function (comData, unkVar, knStrata = c('HY', 'QY', 'MONTH', 'NEGEAR', 'TONCL1', 'AREA')) { - + call <- c(comData$call, dbutils::capture_function_call()) - + #Pulling data message("Imputing unknown catch parameters ...") - + #pull out data sql <- comData$sql comdata <- data.table::copy(comData[[1]]) - + #Assign Quarter/Half Years comdata[MONTH == 0, QY := 0] comdata[MONTH %in% 1:3, QY := 1] comdata[MONTH %in% 4:6, QY := 2] comdata[MONTH %in% 7:9, QY := 3] comdata[MONTH %in% 10:12, QY := 4] - + comdata[QY == 0, HY := 0] comdata[QY %in% 1:2, HY := 1] comdata[QY %in% 3:4, HY := 2] - + #Assign size classes #comdata[TONCL1 %in% 1:3, SIZE := 1] #Small #comdata[TONCL1 > 3, SIZE := 2] #Large - + for(ivar in 1:length(unkVar)){ if(unkVar[ivar] %in% knStrata){ - strata <- knStrata[which(knStrata != unkVar[ivar])] + strata <- knStrata[which(knStrata != unkVar[ivar])] } else { strata <- knStrata } - + #Change names of strata strata.code <- paste0('STR', 1:length(strata)) data.table::setnames(comdata, c(strata, unkVar[ivar]), c(strata.code, 'VAR')) - + #Set unknown Var to NA comdata[VAR == 0, VAR := NA] comdata[VAR == 999, VAR := NA] - + #Set all unknowns to NA for(ist in 1:length(strata.code)){ data.table::setnames(comdata, strata.code[ist], 'ST') @@ -71,87 +71,87 @@ assign_unknown <- function (comData, unkVar, comdata[ST == 999, ST := NA] data.table::setnames(comdata, 'ST', strata.code[ist]) } - + #Identify records with known and unknown variable known <- comdata[!is.na(VAR), ] unknown <- comdata[ is.na(VAR), ] - + #Need record ID to calculate proportions correctly unknown[, ID := 1:nrow(unknown)] - + #set output to known records only comdata.out <- data.table::copy(known) - + #Create combinations of strata variables to match combos <- c() for(inum in length(strata.code):1){ #combinations of strata codes - num.combos <- data.table::setDT(list(gtools::combinations(length(strata.code), + num.combos <- data.table::setDT(list(gtools::combinations(length(strata.code), inum, strata.code))) combos <- data.table::rbindlist(list(combos, num.combos), fill = T) } - - + + if(nrow(unknown) > 0){ cat(paste('Total', unkVar[ivar], 'unknown records', nrow(unknown), '\n')) - - + + for(icom in 1:nrow(combos)){ if(nrow(unknown) > 0){ stra.combo <- combos[icom, ] num.stra.var <- stra.combo[, which(!is.na(stra.combo))] stra.combo <- unlist(stra.combo[, ..num.stra.var]) - + #Identify columns that are not part of the stratification - ext.col <- names(comdata)[which(!names(comdata) + ext.col <- names(comdata)[which(!names(comdata) %in% c('NESPP3', 'YEAR', stra.combo, 'VAR', 'SPPLIVMT'))] - + #Remove extra columns from known known.simple <- data.table::copy(known) known.simple <- known.simple[, c(names(known)[which(names(known) %in% ext.col)]) := NULL] - + #Need to only match with known variables known.all <- known.simple[complete.cases(known.simple), ] - + #Sum landings per stratification - known.sum <- known.all[, .(VARMT = sum(SPPLIVMT)), + known.sum <- known.all[, .(VARMT = sum(SPPLIVMT)), by = c('NESPP3', 'YEAR', stra.combo, 'VAR')] - + #Match records but keep unmatched records to carry forward match <- merge(known.sum, unknown, by = c('NESPP3', 'YEAR', stra.combo), all.y = T, allow.cartesian = T) - + #Remove unmatched for next round unknown <- match[is.na(VAR.x), ] unknown[, c('VAR.x', 'VARMT') := NULL] data.table::setnames(unknown, 'VAR.y', 'VAR') - + #Remove unmatched records from merge match <- match[!is.na(VAR.x), ] - + #Determine proportion of known catch per variable match[, totlivmt := sum(VARMT), by = c(stra.combo, 'ID')] #Catch zeros that lead to NaN match[totlivmt == 0, totlivmt := 1] - + match[, prop := VARMT / totlivmt] - + #Proportion catch from unknown variable to known variable match[, newlivmt := SPPLIVMT * prop] match[, newvalue := SPPVALUE * prop] - + #Drop extra columns - match <- match[, c('VAR.y', 'VARMT', 'totlivmt', 'prop', 'SPPLIVMT', + match <- match[, c('VAR.y', 'VARMT', 'totlivmt', 'prop', 'SPPLIVMT', 'SPPVALUE', 'ID') := NULL] - data.table::setnames(match, c('VAR.x', 'newlivmt', 'newvalue'), + data.table::setnames(match, c('VAR.x', 'newlivmt', 'newvalue'), c('VAR', 'SPPLIVMT', 'SPPVALUE')) - + #Append new entries to output - comdata.out <- data.table::rbindlist(list(comdata.out, match), + comdata.out <- data.table::rbindlist(list(comdata.out, match), use.names = T) - cat(paste('After using', length(stra.combo), + cat(paste('After using', length(stra.combo), 'variables: Unknown records remaining', nrow(unknown), '\n')) } } @@ -160,100 +160,100 @@ assign_unknown <- function (comData, unkVar, #Remove extra columns from known known.all <- data.table::copy(known) known.all <- known.all[, list(YEAR, NESPP3, VAR, SPPLIVMT)] - + #3 year window years <- unique(unknown[, YEAR]) known.sum <- c() for(iyr in 1:length(years)){ known.3 <- known.all[YEAR %in% (years[iyr] - 1):(years[iyr] + 1), ] - + #Sum landings per stratification sum.3 <- known.3[, .(VARMT = sum(SPPLIVMT)), by = c('NESPP3', 'VAR')] sum.3[, YEAR := years[iyr]] known.sum <- data.table::rbindlist(list(known.sum, sum.3)) } - + #Match unknown records for the year - match <- merge(known.sum, unknown, by = c('YEAR', 'NESPP3'), all.y = T, + match <- merge(known.sum, unknown, by = c('YEAR', 'NESPP3'), all.y = T, allow.cartesian = T) - + #Remove unmatched for next round unknown <- match[is.na(VAR.x), ] unknown[, c('VAR.x', 'VARMT') := NULL] data.table::setnames(unknown, 'VAR.y', 'VAR') - + #Remove unmatched records from merge match <- match[!is.na(VAR.x), ] - + #Determine proportion of known catch per variable match[, totlivmt := sum(VARMT), by = c(stra.combo, 'ID')] #Catch zeros that lead to NaN match[totlivmt == 0, totlivmt := 1] - + match[, prop := VARMT / totlivmt] - + #Proportion catch from unknown variable to known variable match[, newlivmt := SPPLIVMT * prop] match[, newvalue := SPPVALUE * prop] - + #Drop extra columns - match <- match[, c('VAR.y', 'VARMT', 'totlivmt', 'prop', 'SPPLIVMT', + match <- match[, c('VAR.y', 'VARMT', 'totlivmt', 'prop', 'SPPLIVMT', 'SPPVALUE', 'ID') := NULL] - data.table::setnames(match, c('VAR.x', 'newlivmt', 'newvalue'), + data.table::setnames(match, c('VAR.x', 'newlivmt', 'newvalue'), c('VAR', 'SPPLIVMT', 'SPPVALUE')) - + #Append new entries to output - comdata.out <- data.table::rbindlist(list(comdata.out, match), + comdata.out <- data.table::rbindlist(list(comdata.out, match), use.names = T) cat(paste('After using 3 year window: Unknown records remaining', nrow(unknown), '\n')) - + if(nrow(unknown) > 0){ #5 Year window years <- unique(unknown[, YEAR]) known.sum <- c() for(iyr in 1:length(years)){ known.5 <- known.all[YEAR %in% (years[iyr] - 2):(years[iyr] + 2), ] - + #Sum landings per stratification sum.5 <- known.5[, .(VARMT = sum(SPPLIVMT)), by = c('NESPP3', 'VAR')] sum.5[, YEAR := years[iyr]] known.sum <- data.table::rbindlist(list(known.sum, sum.5)) } - + #Match unknown records for the year - match <- merge(known.sum, unknown, by = c('YEAR', 'NESPP3'), all.y = T, + match <- merge(known.sum, unknown, by = c('YEAR', 'NESPP3'), all.y = T, allow.cartesian = T) - + #Remove unmatched for next round unknown <- match[is.na(VAR.x), ] unknown[, c('VAR.x', 'VARMT') := NULL] data.table::setnames(unknown, 'VAR.y', 'VAR') - + #Remove unmatched records from merge match <- match[!is.na(VAR.x), ] - + #Determine proportion of known catch per variable match[, totlivmt := sum(VARMT), by = c(stra.combo, 'ID')] #Catch zeros that lead to NaN match[totlivmt == 0, totlivmt := 1] - + match[, prop := VARMT / totlivmt] - + #Proportion catch from unknown variable to known variable match[, newlivmt := SPPLIVMT * prop] match[, newvalue := SPPVALUE * prop] - + #Drop extra columns - match <- match[, c('VAR.y', 'VARMT', 'totlivmt', 'prop', 'SPPLIVMT', + match <- match[, c('VAR.y', 'VARMT', 'totlivmt', 'prop', 'SPPLIVMT', 'SPPVALUE', 'ID') := NULL] - data.table::setnames(match, c('VAR.x', 'newlivmt', 'newvalue'), + data.table::setnames(match, c('VAR.x', 'newlivmt', 'newvalue'), c('VAR', 'SPPLIVMT', 'SPPVALUE')) - + #Append new entries to output - comdata.out <- data.table::rbindlist(list(comdata.out, match), + comdata.out <- data.table::rbindlist(list(comdata.out, match), use.names = T) - cat(paste('After using 5 year window: Unknown records remaining', + cat(paste('After using 5 year window: Unknown records remaining', nrow(unknown), '\n')) } } @@ -262,64 +262,64 @@ assign_unknown <- function (comData, unkVar, #Remove extra columns from known known.all <- data.table::copy(known) known.all <- known.all[, list(NESPP3, VAR, SPPLIVMT)] - + #Sum landings per stratification known.sum <- known.all[, .(VARMT = sum(SPPLIVMT)), by = c('NESPP3', 'VAR')] - + #Match unknown records for the year - match <- merge(known.sum, unknown, by = 'NESPP3', all.y = T, + match <- merge(known.sum, unknown, by = 'NESPP3', all.y = T, allow.cartesian = T) - + #Remove unmatched for next round unknown <- match[is.na(VAR.x), ] unknown[, c('VAR.x', 'VARMT') := NULL] data.table::setnames(unknown, 'VAR.y', 'VAR') - + #Remove unmatched records from merge match <- match[!is.na(VAR.x), ] - + #Determine proportion of known catch per variable match[, totlivmt := sum(VARMT), by = c(stra.combo, 'ID')] #Catch zeros that lead to NaN match[totlivmt == 0, totlivmt := 1] - + match[, prop := VARMT / totlivmt] - + #Proportion catch from unknown variable to known variable match[, newlivmt := SPPLIVMT * prop] match[, newvalue := SPPVALUE * prop] - + #Drop extra columns - match <- match[, c('VAR.y', 'VARMT', 'totlivmt', 'prop', 'SPPLIVMT', + match <- match[, c('VAR.y', 'VARMT', 'totlivmt', 'prop', 'SPPLIVMT', 'SPPVALUE', 'ID') := NULL] - data.table::setnames(match, c('VAR.x', 'newlivmt', 'newvalue'), + data.table::setnames(match, c('VAR.x', 'newlivmt', 'newvalue'), c('VAR', 'SPPLIVMT', 'SPPVALUE')) - + #Append new entries to output - comdata.out <- data.table::rbindlist(list(comdata.out, match), + comdata.out <- data.table::rbindlist(list(comdata.out, match), use.names = T) - - cat(paste('After using only species: Unknown records remaining', + + cat(paste('After using only species: Unknown records remaining', nrow(unknown), '\n')) } } #Append any remaining unknown records - comdata.out <- data.table::rbindlist(list(comdata.out, unknown[, ID := NULL]), + comdata.out <- data.table::rbindlist(list(comdata.out, unknown[, ID := NULL]), use.names = T) - + #Revert names for subsequent runs and the output data.table::setnames(comdata.out, c(strata.code, 'VAR'), c(strata, unkVar[ivar])) - + #Update comdata set for next variable to solve comdata <- comdata.out } - + #Drop QY and HY comdata[, c('QY', 'HY') := NULL] - + #Add changes back into comdata comData[[1]] <- comdata[] - + return(comData[]) } diff --git a/R/calc_DK.R b/R/calc_DK.R index ba76b2c..79ec8e4 100644 --- a/R/calc_DK.R +++ b/R/calc_DK.R @@ -1,11 +1,9 @@ #' Calculate discard to kept ratio #' #' Use observer data to calculate the ratio of discards to kept by species. -#' #' -# @inheritParams strat_prep -#' @param na.keep Boolean. Logical value to indicate whether original strata names -#' should be retained. +#' @inheritParams get_comland_data +#' @param comData data frame. calculated from inside \code{get_comdisc_data} #' #' @return Returns a \code{comdiscData} data.table with one additional column labeled #' with the value of \code{areaDescription} @@ -15,49 +13,50 @@ #' #' @importFrom magrittr "%>%" #' -#'@family comdisc +#' @family comdisc #' -#' @export +#' Internal function +#' @noRd + calc_DK <- function(comData, areaDescription, fleetDescription){ - + comdata <- data.table::copy(comData[[1]]) - + #Standardize column names - comdata <- data.table::setnames(comdata, c(areaDescription, fleetDescription), + comdata <- data.table::setnames(comdata, c(areaDescription, fleetDescription), c('area', 'fleet')) - + #sum catch by species/disposition/area/fleet ob.sums <- comdata[, sum(SPPLIVMT), by = c('YEAR', 'area', 'fleet', 'NESPP3', 'CATDISP')] #identify discards ob.discard <- ob.sums[CATDISP == 0, ] - + setnames(ob.discard, "V1", "DISCARD") ob.discard[, CATDISP := NULL] - + #Sum kept by area/fleet ob.kept <- ob.sums[CATDISP == 1, sum(V1), by = c('YEAR', 'area', 'fleet')] - + setnames(ob.kept, "V1", "KEPT.ALL") - + #Merge discards and kept dk <- merge(ob.kept, ob.discard, by = c('YEAR', 'area', 'fleet')) - + #Calculate ratio dk[, DK := DISCARD / KEPT.ALL] #NAs result if divide by 0 so set DK to 1 (all discards) dk[is.na(DK), DK := 1.0] - + #Remove extra columns dk[, c('KEPT.ALL', 'DISCARD') := NULL] - + #Replace standard column names #Standardize column names - data.table::setnames(dk, c('area', 'fleet'), + data.table::setnames(dk, c('area', 'fleet'), c(areaDescription, fleetDescription)) - + return(dk[]) } - \ No newline at end of file diff --git a/R/calc_discards.R b/R/calc_discards.R index f8192c0..c45c18e 100644 --- a/R/calc_discards.R +++ b/R/calc_discards.R @@ -1,34 +1,23 @@ -#' Calculate stratified mean +#' Calculates total discard by species #' -#' Calculates the stratified mean. Details of method found here ... +#' Applies discard ratio to landings to obtain total discards by species #' -#' @inheritParams strat_prep -#' @inheritParams strat_mean -#' @param tidy Boolean. Return output in long format (Default = F). -#' @param returnPrepData Boolean. Return both \code{stratmeanData} and \code{prepData} -#' as a list object. The default (F) returns only the \code{stratmeanData} as a -#' \code{data.table}. +#' @inheritParams get_comland_data +#' @param comland Data frame. Internally calculated by \code{get_comdisc_data} +#' @param dk dk. Need to find out #' -#' @return #' -#'@family survdat +#' @return dk +#' +#'@family comdisc #' #' @examples #' \dontrun{ -#' # Pull data and apply conversion corrections -#' data <- get_survdat_data(channel) -#' # Calculate stratified mean for specific survey strata for the SPRING season -#' calc_stratified_mean(surveyData=data$survdat, filterByArea=c(1220, 1240, 1260:1290,1360:1400),filterBySeason = "SPRING") -#' -#' # Calculate stratified mean for area defined by EPU regions, for all seasons ("SPRING", "FALL") -#' # Read in EPU shapefile (loaded as part of the package) -#' area <- sf::st_read(dsn = system.file("extdata","EPU.shp",package="survdat"),quiet=T) -#' calc_stratified_mean(surveyData=data$survdat, areaPolygon=area, areaDescription="EPU", filterByArea="all",filterBySeason = "all") -#' #' } #' #' -#' @export +#' Internal function +#' @noRd calc_discards <- function(comland, dk, areaDescription, fleetDescription) { diff --git a/R/soeAreas.R b/R/soeAreas.R new file mode 100644 index 0000000..82b2910 --- /dev/null +++ b/R/soeAreas.R @@ -0,0 +1,15 @@ +#' soeAreas: Area Species,EPU designations +#' +#' Option to pass to \code{get_comland_data} if the user wishes define EPUs exclusively +#' by Stat areas and not to proportion the landings in these Statistical areas to EPUs +#' +#' @format A Data frame +#' \describe{ +#' \item{AREA}{Statistical Area} +#' \item{NESPP3}{Gulf of Maine EPU} +#' \item{MeanProp}{Proportion of Statistical area to attribute to EPU} +#' \item{EPU}{Ecological Production Unit} +#'} +#' +#' +"soeAreas" diff --git a/man/assign_area.Rd b/man/assign_area.Rd deleted file mode 100644 index bbb4302..0000000 --- a/man/assign_area.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/assign_area.R -\name{assign_area} -\alias{assign_area} -\title{Assigns points to polygon} -\usage{ -assign_area(comdiscData, areaPolygon, areaDescription, na.keep = F) -} -\arguments{ -\item{na.keep}{Boolean. Logical value to indicate whether original strata names -should be retained.} -} -\value{ -Returns a \code{comdiscData} data.table with one additional column labeled - with the value of \code{areaDescription} - -\item{areaDescription}{The name of the region (found in \code{areaPolygon}) - that a record in \code{surveyData} is assigned to} -} -\description{ -Assign observer data (points, lat and lon) to designated regions (polygons) from a shape file. -} -\seealso{ -Other comdisc: -\code{\link{calc_DK}()} -} -\concept{comdisc} diff --git a/man/assign_unknown.Rd b/man/assign_unknown.Rd deleted file mode 100644 index d6f2ccd..0000000 --- a/man/assign_unknown.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/assign_unknown.R -\name{assign_unknown} -\alias{assign_unknown} -\title{Assigns unknown catch variables} -\usage{ -assign_unknown( - comData, - unkVar, - knStrata = c("HY", "QY", "MONTH", "NEGEAR", "TONCL1", "AREA") -) -} -\arguments{ -\item{unkVar}{Vector. Catch variables to be imputed. Should be in the order -you would like them to be solved.} - -\item{knStrata}{Vector. Catch variables to be used to impute \code{unkVar}. An -\code{unkVar} can be included in this list if it is used to solve a second -\code{unkVar}. Should be in the order of most restrictive to least restrictive.} -} -\value{ -Returns a \code{comlandData} data.table. -} -\description{ -Impute unknown variables associated with landings. -} -\concept{comland} diff --git a/man/calc_DK.Rd b/man/calc_DK.Rd deleted file mode 100644 index dc9f22b..0000000 --- a/man/calc_DK.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_DK.R -\name{calc_DK} -\alias{calc_DK} -\title{Calculate discard to kept ratio} -\usage{ -calc_DK(comData, areaDescription, fleetDescription) -} -\arguments{ -\item{na.keep}{Boolean. Logical value to indicate whether original strata names -should be retained.} -} -\value{ -Returns a \code{comdiscData} data.table with one additional column labeled - with the value of \code{areaDescription} - -\item{areaDescription}{The name of the region (found in \code{areaPolygon}) - that a record in \code{surveyData} is assigned to} -} -\description{ -Use observer data to calculate the ratio of discards to kept by species. -} -\seealso{ -Other comdisc: -\code{\link{assign_area}()} -} -\concept{comdisc} diff --git a/man/calc_discards.Rd b/man/calc_discards.Rd deleted file mode 100644 index bc52ed7..0000000 --- a/man/calc_discards.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calc_discards.R -\name{calc_discards} -\alias{calc_discards} -\title{Calculate stratified mean} -\usage{ -calc_discards(comland, dk, areaDescription, fleetDescription) -} -\arguments{ -\item{tidy}{Boolean. Return output in long format (Default = F).} - -\item{returnPrepData}{Boolean. Return both \code{stratmeanData} and \code{prepData} -as a list object. The default (F) returns only the \code{stratmeanData} as a -\code{data.table}.} -} -\description{ -Calculates the stratified mean. Details of method found here ... -} -\examples{ -\dontrun{ -# Pull data and apply conversion corrections -data <- get_survdat_data(channel) -# Calculate stratified mean for specific survey strata for the SPRING season -calc_stratified_mean(surveyData=data$survdat, filterByArea=c(1220, 1240, 1260:1290,1360:1400),filterBySeason = "SPRING") - -# Calculate stratified mean for area defined by EPU regions, for all seasons ("SPRING", "FALL") -# Read in EPU shapefile (loaded as part of the package) -area <- sf::st_read(dsn = system.file("extdata","EPU.shp",package="survdat"),quiet=T) -calc_stratified_mean(surveyData=data$survdat, areaPolygon=area, areaDescription="EPU", filterByArea="all",filterBySeason = "all") - -} - - -} -\concept{survdat}