R/aggregate_gear.R

In NOAA-EDAB/comlandr: Pulls and processes commercial fishing data from the Northeast US

#' Assign landing records to an aggregated gear fleet
#'
#' Takes the output from \code{get_comland_data} or \code{get_comdisc_data} and
#' further aggregates from NEGEAR2 codes to a user defined fleet.
#'
#'@param comdata Data set generated by \code{get_comland_data} or
#'               \code{get_comdisc_data}
#'@param userGears Data frame. Definitions to aggregate NEGEAR2 to user defined
#'                 gears
#'@param fleetDescription Character. Name of column in userGears that defines
#'                        the new gears.
#'
#'@noRd

aggregate_gear <- function(comData, userGears, fleetDescription){

  #Pulling data
  message("Aggregating Gears ...")

  #Grab just the data
  comdata <- data.table::copy(comData[[1]])

  call <- dbutils::capture_function_call()

  #Convert userGears to data.table
  gears <- data.table::as.data.table(userGears)
  gears <- data.table::setnames(gears, fleetDescription, 'fleet')

  #Assign gears to fleets
  #Generate NEGEAR2 codes from NEGEAR
  if(is.numeric(comdata$NEGEAR)){
    comdata[NEGEAR < 100, NEGEAR3 := paste0(0, NEGEAR)]
    comdata[NEGEAR >= 100, NEGEAR3 := NEGEAR]
    comdata[, NEGEAR2 := as.numeric(substr(NEGEAR3, 1, 2))]
    comdata[, NEGEAR3 := NULL]
  } else {
    comdata[, NEGEAR2 := as.numeric(substr(NEGEAR, 1, 2))]
  }

  fleets <- unique(gears$fleet)

  for(ifleet in 1:length(fleets)){
    fleet.gear <- gears[fleet == fleets[ifleet], NEGEAR2]
    fleet.mesh <- unique(gears[fleet == fleets[ifleet], MESHCAT])
    #Check if there is a mesh characteristic associated with this gear
    if(is.na(fleet.mesh)){
      comdata[NEGEAR2 %in% fleet.gear, fleet := fleets[ifleet]]
    } else {
      comdata[NEGEAR2 %in% fleet.gear & MESHCAT == fleet.mesh, fleet := fleets[ifleet]]
    }
  }

  comdata[, fleet := as.factor(fleet)]

  #Drop extra columns and rename
  comdata[, c('NEGEAR2', 'NEGEAR', 'MESHCAT') := NULL]
  data.table::setnames(comdata, 'fleet', fleetDescription)

  #Aggregate over new gears
  #Aggregate to new fleets
  catch.var <- names(comdata)[which(!names(comdata) %in% c('SPPLIVMT',
                                                           'SPPVALUE'))]
  #Discard data does not have value so need to ensure this runs on both
  if(length(which(names(comdata) == 'SPPVALUE')) > 0){
    comdata <- comdata[, .(SPPLIVMT = sum(SPPLIVMT), SPPVALUE = sum(SPPVALUE)),
                       by = catch.var]
  } else {
    comdata <- comdata[, .(SPPLIVMT = sum(SPPLIVMT)), by = catch.var]
  }


  #Add changes back into comdata
  comData[[1]] <- comdata[]
  comData$call <- c(comdata$call, call)
  comData$userGears <- userGears

  return(comData[])
}