diff --git a/.Rbuildignore b/.Rbuildignore index fe5c6bd..0b020dd 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,4 +1,3 @@ -^comland\.Rproj$ ^\.Rproj\.user$ ^data-raw$ ^_pkgdown\.yml$ @@ -7,3 +6,5 @@ ^\.github$ ^other$ ^output$ +comlandr.Rproj +^.*\.Rproj$ diff --git a/DESCRIPTION b/DESCRIPTION index 3235142..6a6b7a3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -9,7 +9,7 @@ Authors@R: c(person(given = "Sean", email = "andrew.beet@noaa.gov", role = c("cre","aut"), comment = c(ORCID = "0000-0001-8270-7090"))) -Description: Pulls and processes commercial fishing data (US and NAFO) +Description: Pulls and processes commercial fishing data (US and NAFO). URL: https://github.com/NOAA-EDAB/comlandr BugReports: https://github.com/NOAA-EDAB/comlandr/issues License: file LICENSE @@ -34,8 +34,10 @@ Imports: data.table, sf, DBI, - odbc, magrittr, + dplyr, + stringr, + tibble, ggplot2, gtools, dbutils, diff --git a/NAMESPACE b/NAMESPACE index cffd32b..6487be3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,7 +1,5 @@ # Generated by roxygen2: do not edit by hand -export(adjust_inflation) -export(disaggregate_skates_hakes) export(get_areas) export(get_comdisc_data) export(get_comdisc_raw_data) diff --git a/news.md b/NEWS.md similarity index 99% rename from news.md rename to NEWS.md index b18353f..e64f93d 100644 --- a/news.md +++ b/NEWS.md @@ -26,3 +26,4 @@ Added supporting `get` functions to pull information from supporting oracle tabl # comlandr 0.1.0 Initial release + diff --git a/R/adjust_inflation.R b/R/adjust_inflation.R index 1b67561..2bd486a 100644 --- a/R/adjust_inflation.R +++ b/R/adjust_inflation.R @@ -1,7 +1,6 @@ #' Adjust species value for inflation #' #'Reads in data from Bureau of Labor statistics website and adjusts species value -#' #'What data is fetched? #' #' @@ -12,22 +11,21 @@ #'@return comland data frame adjusted for inflation #' #'@noRd -#'@export adjust_inflation <- function(comland, refYear, refMonth){ - + call <- c(comland$call, dbutils::capture_function_call()) - + #Pulling data message("Adjusting for inflation ...") - + #pull out comland data sql <- comland$sql comland <- comland$comland - + #This isn't working right now - using downloaded file # temp <- tempfile() # download.file("http://download.bls.gov/pub/time.series/wp/wp.data.3.ProcessedFoods", temp) @@ -39,7 +37,7 @@ adjust_inflation <- function(comland, refYear, refMonth){ # deflate[, MONTH := as.numeric(substr(period, 2, 3))] # data.table::setnames(deflate, c('year', 'value'), c('YEAR', 'PPI')) # deflate <- deflate[, list(YEAR, MONTH, PPI)] - + #Set yearly deflator to 0 instead of 13 to match unknown month designation deflate <- comlandr::deflate deflate[MONTH == 13, MONTH := 0] @@ -50,8 +48,8 @@ adjust_inflation <- function(comland, refYear, refMonth){ #Remove extra column comland[, PPI := NULL] - - return(list(comland = comland[], + + return(list(comland = comland[], sql = sql, pullDate = date(), functionCall = call)) diff --git a/R/aggregate_area.R b/R/aggregate_area.R index fe30086..bf21c56 100644 --- a/R/aggregate_area.R +++ b/R/aggregate_area.R @@ -5,12 +5,10 @@ #' proportions to more than two user defined areas from one stat area #' #'@param comland Data set generated by \code{get_comland_data} -#'@param userAreas Data frame. Definitions to aggregate statistical areas to user defined -#' areas -#'@param areaDescription Character. Name of column in userAreas that defines the new -#' area. +#'@param userAreas Data frame. Definitions to aggregate statistical areas to user defined areas +#'@param areaDescription Character. Name of column in userAreas that defines the new area. #'@param propDescription Character. Name of column in userAreas that defines the -#' proportions of landings assigned to new area. +#'proportions of landings assigned to new area. #' #'@noRd diff --git a/R/calc_DK.R b/R/calc_DK.R index 79ec8e4..b4ff171 100644 --- a/R/calc_DK.R +++ b/R/calc_DK.R @@ -11,8 +11,6 @@ #' \item{areaDescription}{The name of the region (found in \code{areaPolygon}) #' that a record in \code{surveyData} is assigned to} #' -#' @importFrom magrittr "%>%" -#' #' @family comdisc #' #' Internal function diff --git a/R/calc_discards.R b/R/calc_discards.R index c45c18e..8d6fad2 100644 --- a/R/calc_discards.R +++ b/R/calc_discards.R @@ -11,10 +11,6 @@ #' #'@family comdisc #' -#' @examples -#' \dontrun{ -#' } -#' #' #' Internal function #' @noRd diff --git a/R/disaggregate_skates_hakes.R b/R/disaggregate_skates_hakes.R index 5c307a1..788bd27 100644 --- a/R/disaggregate_skates_hakes.R +++ b/R/disaggregate_skates_hakes.R @@ -3,15 +3,14 @@ #'Determine proportion of little/winter skates and silver hake in landings data 7/13 #'SML #' +#'@inheritParams get_comland_data #'@param comland Data frame. Master data frame containing species landings -#'@param skate.hake.us Data frame. Landings of skates and hakes in USA #' #'@return updated comland #' #'@importFrom data.table ":=" "key" #' #' @noRd -#' @export disaggregate_skates_hakes <- function(comland, channel, filterByYear, filterByArea) { diff --git a/R/get_areas.R b/R/get_areas.R index c604152..aec8948 100644 --- a/R/get_areas.R +++ b/R/get_areas.R @@ -3,8 +3,7 @@ #'Extract a list of statistical areas, region, NAFO codes, etc from the NEFSC "Area" supporting table #' #' -#' @param channel an Object inherited from \link[DBI]{DBIConnection-class}. This object is used to connect -#' to communicate with the database engine. (see \code{\link[dbutils]{connect_to_database}}) +#' @inheritParams get_comland_data #' @param areas a specific area code or set of codes. Either numeric or character vector. Defaults to "all" areas #' Numeric codes are converted to VARCHAR2(3 BYTE) when creating the sql statement. Character codes are short character strings to reference the AREANM field. #' diff --git a/R/get_comdisc_data.R b/R/get_comdisc_data.R index 1b93046..b7685ed 100644 --- a/R/get_comdisc_data.R +++ b/R/get_comdisc_data.R @@ -5,7 +5,7 @@ #' #'@inheritParams get_comland_data #'@param comland Data frame. Result of \code{get_comland_data} -#'@param extendsTS Boolean. Should the DK (Discard to kept) ratio be extended and applied +#'@param extendTS Boolean. Should the DK (Discard to kept) ratio be extended and applied #'to landings beyond observer coverage time period (Discards started in 1989). Default = T #' #' @@ -25,10 +25,6 @@ #'\item{SPPLIVLB}{live weight (landed = "n") or landed weight (landed="y") in lbs} #'\item{SPPVALUE}{The value of landed catch to the nearest dollar (U.S.), paid to fisherman by dealer, for a given species.} #' -#'@section File Creation: -#' -#'A file containing the data.table above will also be saved to the users machine in the directory provided -#' #' #'@importFrom data.table ":=" #'@importFrom magrittr "%>%" @@ -54,7 +50,7 @@ get_comdisc_data <- function(channel, comland, #Aggregate areas if(aggArea){ userAreas <- comland$userAreas - comdisc.raw <- comlandr::aggregate_area(comdisc.raw, userAreas, areaDescription, + comdisc.raw <- aggregate_area(comdisc.raw, userAreas, areaDescription, propDescription, useForeign = F, applyPropValue = F) } @@ -66,7 +62,7 @@ get_comdisc_data <- function(channel, comland, } #Calculate the discard to kept ratio - dk <- comlandr::calc_DK(comdisc.raw, areaDescription, fleetDescription) + dk <- calc_DK(comdisc.raw, areaDescription, fleetDescription) #Extend dk ratios beyond observer data if(extendTS){ @@ -94,7 +90,7 @@ get_comdisc_data <- function(channel, comland, } #Apply the discard to kept ratio - comdisc <- comlandr::calc_discards(comland, dk, areaDescription, fleetDescription) + comdisc <- calc_discards(comland, dk, areaDescription, fleetDescription) message("Some data may be CONFIDENTIAL ... DO NOT disseminate without proper Non-disclosure agreement.") diff --git a/R/get_comdisc_raw_data.R b/R/get_comdisc_raw_data.R index 11563db..c5d2cc2 100644 --- a/R/get_comdisc_raw_data.R +++ b/R/get_comdisc_raw_data.R @@ -18,10 +18,6 @@ #'\item{SPPLIVLB}{live weight (landed = "n") or landed weight (landed="y") in lbs} #'\item{SPPVALUE}{The value of landed catch to the nearest dollar (U.S.), paid to fisherman by dealer, for a given species.} #' -#'@section File Creation: -#' -#'A file containing the data.table above will also be saved to the users machine in the directory provided -#' #'@export get_comdisc_raw_data <- function(channel, filterByYear){ @@ -36,7 +32,7 @@ get_comdisc_raw_data <- function(channel, filterByYear){ if(is.na(filterByYear[1])){ years <- ">= 1989" }else{ - years <- paste0("in (", comlandr:::sqltext(filterByYear), ")") + years <- paste0("in (", sqltext(filterByYear), ")") } ob.qry <- paste0("select year, month, area, negear, nespp4, hailwt, catdisp, drflag, diff --git a/R/get_comland_data.R b/R/get_comland_data.R index 0f8ac58..8c7da04 100644 --- a/R/get_comland_data.R +++ b/R/get_comland_data.R @@ -1,36 +1,41 @@ -#' Extracts commercial data from Database +#' Extracts and processes commercial data from Database #' -#' Connects to cfdbs and pulls fields from WOLANDS, WODETS, CFDETS +#' Connects to Population dynamics Database STOCKEFF to pull US landings data. +#' Data is also pulled from NAFO (foreign landings) and the State of Maine (Herring). +#' These sources of data are then aggregated, species value is adjusted to a user defined reference year, +#' skate and hake landings (often reported as an unclassified category) are split based on bottom trawl survey, +#' and missing values are imputed. For more information regarding these methods +#' see \code{vignette("Overview", package = "comlandr")} #' -#'@param channel an Object inherited from \code{ROracle}. This object is used to connect +#'@param channel an Object inherited from \code{\link[ROracle]{Oracle}}. This object is used to connect #' to communicate with the database engine. (see \code{\link[dbutils]{connect_to_database}}) -#'@param filterByYear numeric vector -#'@param filterByArea numeric vector -#'@param useLanded boolean -#'@param removeParts boolean -#'@param useHerringMaine boolean -#'@param useForeign boolean -#'@param refYear numeric -#'@param refMonth numeric -#'@param disaggSkatesHakes boolean -#'@param aggArea boolean -#'@param userAreas data frame -#'@param areaDescription character string -#'@param propDescription character string -#'@param applyPropLand boolean -#'@param applyPropValue boolean -#'@param aggGear boolean -#'@param userGears data frame -#'@param fleetDescription character string -#'@param unkVar character vector -#'@param knStrata character vector +#'@param filterByYear numeric vector. Years to retrieve data for (Default = NA, pull all years) +#'@param filterByArea numeric vector. Statistical Areas to retrieve data for (Default = NA, pull all areas) +#'@param useLanded boolean. Default = T +#'@param removeParts boolean. Remove species parts (Heads, wings, etc), Default = T +#'@param useHerringMaine boolean. Pull data from Maine Herring database or use herring data in commercial landings database (Default = T) +#'@param useForeign boolean. Pull foreign data from NAFO. Default = T +#'@param refYear numeric. Reference year to use when adjusting species value +#'@param refMonth numeric. Reference month to use when adjusting species value +#'@param disagSkatesHakes boolean. Partition skates and hake unclassified landings into species (Default = T) +#'@param aggArea boolean. Aggregate Statistical Areas into larger spatial units (Default = F) +#'@param userAreas data frame. Spatial units in which Statistical areas should be aggregated (eg. \code{\link{mskeyAreas}}) +#'@param areaDescription character string. Field name in \code{userAreas} denoting spatial unit. (Default = "EPU") +#'@param propDescription character string. Field name in \code{userAreas} denoting the scaling factor. (Default = "MeanProp") +#'@param applyPropLand boolean. Apply the proportions in userAreas to the landings (Default = F) +#'@param applyPropValue boolean. Apply the proportions in userAreas to the value (Default = F) +#'@param aggGear boolean. Aggregate NEGEAR codes to larger "fleets" (Default = F) +#'@param userGears data frame. Fleet designations in which NEGEAR codes should be grouped (eg. \code{\link{mskeyGears}}) +#'@param fleetDescription character string. Field name in \code{userGears} denoting Fleet. (Default = "Fleet") +#'@param unkVar character vector. Variables in the data, with have missing values, that you wish to assign a value to +#'@param knStrata character vector. Variables in the data that you wish to use to use to assign values to \code{unkVar} #' #'@return Data frame (data.table) (n x 12) #'Each row of the data.table represents a species record for a given tow/trip #' #'\item{YEAR}{Year of trip/tow} #'\item{MONTH}{Month of trip/tow} -#'\item{NEGEAR}{Fishing gear used on trip/tow} +#'\item{NEGEAR/Fleet}{Fishing gear used on trip/tow or aggregated to Fleet} #'\item{TONCL2}{Tonnage class of the fishing vessel (2 digit value)} #'\item{NESPP3}{Species code (3 charachters)} #'\item{MARKET_CODE}{market code (2 characters)} @@ -38,14 +43,9 @@ #'\item{AREA/EPU}{Statistical area/ Ecological Production Unit in which species was reportly caught} #'\item{UTILCD}{Utilization code} #'\item{US}{Landing from the USA vessels or foreign vessels} -#'\item{SPPLIVLB}{live weight (landed = "n") or landed weight (landed="y") in lbs} +#'\item{SPPLIVMT}{Weight in metric tons.} #'\item{SPPVALUE}{The value of landed catch to the nearest dollar (U.S.), paid to fisherman by dealer, for a given species.} #' -#'@section File Creation: -#' -#'A file containing the data.table above will also be saved to the users machine in the directory provided -#' -#' #'@importFrom data.table ":=" #'@importFrom magrittr "%>%" #' @@ -105,10 +105,10 @@ get_comland_data <- function(channel, filterByYear = NA, #Apply correction for inflation - if(!is.na(refYear)) comland <- comlandr::adjust_inflation(comland, refYear, refMonth) + if(!is.na(refYear)) comland <- adjust_inflation(comland, refYear, refMonth) #Disaggregate skates and hakes - if(disagSkatesHakes) comland <- comlandr::disaggregate_skates_hakes(comland, + if(disagSkatesHakes) comland <- disaggregate_skates_hakes(comland, channel, filterByYear, filterByArea) diff --git a/R/get_comland_raw_data.R b/R/get_comland_raw_data.R index d0c1b9b..477eeea 100644 --- a/R/get_comland_raw_data.R +++ b/R/get_comland_raw_data.R @@ -1,6 +1,7 @@ #' Extracts commercial data from Database #' -#' Connects to cfdbs and pulls fields from WOLANDS, WODETS, CFDETS +#' Connects to Population dynamics Database STOCKEFF. This database contains the information +#' from from WOLANDS, WODETS, CFDETS and CAMS. #' #'@inheritParams get_comland_data #' @@ -10,18 +11,14 @@ #'\item{YEAR}{Year of trip/tow} #'\item{MONTH}{Month of trip/tow} #'\item{NEGEAR}{Fishing gear used on trip/tow} -#'\item{TONCL1}{Tonnage class of the fishing vessel} +#'\item{TONCL2}{Two digit Tonnage class code of the fishing vessel} #'\item{NESPP3}{Species code (3 charachters)} #'\item{NESPP4}{Species code and market code (4 characters)} #'\item{AREA}{Statistical area in which species was reportly caught} #'\item{UTILCD}{Utilization code} -#'\item{SPPLIVLB}{live weight (landed = "n") or landed weight (landed="y") in lbs} +#'\item{SPPLIVMT}{live weight (landed = "n") or landed weight (landed="y") in lbs} #'\item{SPPVALUE}{The value of landed catch to the nearest dollar (U.S.), paid to fisherman by dealer, for a given species.} #' -#'@section File Creation: -#' -#'A file containing the data.table above will also be saved to the users machine in the directory provided -#' #'@export get_comland_raw_data <- function(channel, filterByYear = NA, filterByArea = NA, diff --git a/R/get_foreign_data.R b/R/get_foreign_data.R index 6a6f99c..95333f8 100644 --- a/R/get_foreign_data.R +++ b/R/get_foreign_data.R @@ -1,6 +1,6 @@ #' Downloads all NAFO data #' -#'Downloads, imports, aggregates NAFO data +#' Downloads, imports, aggregates NAFO data from 21B data base #' #' @param filterByYear Numeric vector. Years for which data is required #' @param filterByArea Character vector. NAFO Areas for which data is required @@ -22,6 +22,9 @@ #' #'@importFrom data.table ":=" "key" "setcolorder" "as.data.table" #' +#'@seealso +#' NAFO 21B website: \url{https://www.nafo.int/Data/Catch-Statistics-STATLANT-21B} +#' #' @export get_foreign_data <- function(filterByYear=NA,filterByArea=NA,removeUSA = T, aggregateCountry = T){ diff --git a/R/get_gears.R b/R/get_gears.R index cb6a76e..84b9f95 100644 --- a/R/get_gears.R +++ b/R/get_gears.R @@ -3,8 +3,7 @@ #'Extract a list of gear types in the NEFSC "GEAR" supporting table #' #' -#' @param channel DBI Object. Inherited from \link[DBI]{DBIConnection-class}. This object is used to connect -#' to communicate with the database engine. (see \code{\link[dbutils]{connect_to_database}}) +#' @inheritParams get_comland_data #' @param gears specific gear code or set of codes. Either numeric or character vector. Defaults to "all" gears. #' Numeric codes are converted to VARCHAR2(2 BYTE) when creating the sql statement. Character codes are short character strings referencing GEARNM field. #' diff --git a/R/get_herring_data.R b/R/get_herring_data.R index 188084f..7eb189b 100644 --- a/R/get_herring_data.R +++ b/R/get_herring_data.R @@ -1,15 +1,15 @@ -#' Processes herring data +#' Pull Herring data #' -#'Herring Data comes from the state of Maine. +#' Herring Data comes from the state of Maine and replaces the herring data from StockEff (since +#' it is incomplete). Pulled from NEFSC_GARFO.maine_herring_catch #' -#'@param channel DBI object. connection object for database access +#' @inheritParams get_comland_data #'@param comland Data frame. master data frame containing species landings #' #'@return Processed Herring data added to comland #' #'@importFrom data.table ":=" "key" #' -#' @noRd #' @export get_herring_data <- function(channel, comland, filterByYear, filterByArea, diff --git a/R/get_locations.R b/R/get_locations.R index 1f391fe..5155010 100644 --- a/R/get_locations.R +++ b/R/get_locations.R @@ -4,8 +4,7 @@ #' #' #' -#' @param channel DBI Object. Inherited from \link[DBI]{DBIConnection-class}. This object is used to connect -#' to communicate with the database engine. (see \code{\link{connect_to_database}}) +#' @inheritParams get_comland_data #' @param sqlStatement Character string. An sql statement (optional). #' If no \code{sqlStatement} is provided the default sql statement "\code{select * from cfdbs.loc}" is used #' diff --git a/R/get_ports.R b/R/get_ports.R index 010e275..2129c21 100644 --- a/R/get_ports.R +++ b/R/get_ports.R @@ -2,9 +2,7 @@ #' #'Extract a list of port names, and location info for vessel landings from the NEFSC "Port" supporting table #' -#' -#' @param channel DBI Object. Inherited from \link[DBI]{DBIConnection-class}. This object is used to connect -#' to communicate with the database engine. (see \code{\link[dbutils]{connect_to_database}}) +#' @inheritParams get_comland_data #' @param ports a specific port code or set of codes. Either numeric or character vector. Defaults to "all" ports. #' Numeric codes are converted to VARCHAR2(6 BYTE) when creating the sql statement. Character codes are short character strings referencing PORTNM field. #' diff --git a/R/get_species.R b/R/get_species.R index 389bdfa..1cfb950 100644 --- a/R/get_species.R +++ b/R/get_species.R @@ -3,8 +3,7 @@ #'Extract a list of speices names, code, market category, etc from the NEFSC cfspp table #' #' -#' @param channel DBI Object. Inherited from \link[DBI]{DBIConnection-class}. This object is used to connect -#' to communicate with the database engine. (see \code{\link[dbutils]{connect_to_database}}) +#' @inheritParams get_comland_data #' @param species a specific species code or set of codes. Either numeric or character vector. (NESPP3 codes) #' Numeric codes are converted to VARCHAR2(3 BYTE) when creating the sql statement. #' A Species common name can also be supplied. The character string is used to pull from SPPNM field. Defaults to "all" species. diff --git a/R/get_species_itis.R b/R/get_species_itis.R index b11e4fa..80dad6b 100644 --- a/R/get_species_itis.R +++ b/R/get_species_itis.R @@ -3,8 +3,7 @@ #'Extract a list of species names, code, market category, etc from the NEFSC_GARFO CFDBS_SPECIES_ITIS_NE table #' #' -#' @param channel DBI Object. Inherited from \link[DBI]{DBIConnection-class}. This object is used to connect -#' to communicate with the database engine. (see \code{\link{connect_to_database}}) +#' @inheritParams get_comland_data #' @param species A specific species code or set of codes. Either numeric or character vector. Defaults to "all" species. #' Numeric codes (SPECIES_ITIS, NESPP4) are converted to VARCHAR2 (6 and 4 characters respectively) when creating the sql statement. #' @param nameType Character string. Upper or lower case. Either "common_name" (default), "scientific_name" or "nespp4". diff --git a/R/get_vessels.R b/R/get_vessels.R index 0c6bb75..5abb8fd 100644 --- a/R/get_vessels.R +++ b/R/get_vessels.R @@ -3,8 +3,7 @@ #'Extract a list of vessell ID's, tonnage, crew size, home port, etc from the NEFSC "Mstrvess" supporting table #' #' -#' @param channel DBI Object. Inherited from \link[DBI]{DBIConnection-class}. This object is used to connect -#' to communicate with the database engine. (see \code{\link[dbutils]{connect_to_database}}) +#' @inheritParams get_comland_data #' @param sqlStatement an sql statement (optional) #' @param where text string appending where clause to sql #' diff --git a/R/oldfunctions/Comland.r b/R/oldfunctions/Comland.r deleted file mode 100644 index a646afa..0000000 --- a/R/oldfunctions/Comland.r +++ /dev/null @@ -1,213 +0,0 @@ -#' Comland.r Version now controlled by git - originally part of comcatch.r -#' -#'Grab commercial landings data from US and Foreign countries (NAFO) -#'Need to fix menhaden data -#'SML -#' -#'@param channel an Object inherited from \link[DBI]{DBIConnection-class}. This object is used to connect -#' to communicate with the database engine. (see \code{\link[dbutils]{connect_to_database}}) -#'@param EPUS List. Designates the stat areas that comprise an EPU. Default = EPUs (lazily loaded data) -#'@param GEARS List. Designates the NEGEAR codes that comprise a fishing fleet. Default = GEARs (lazily loaded data) -#'@param use.existing String. Pull from database "n" or use existing pull "y" (saves time) . Default = "y" -#'@param landed Character String. Use landed weight for scallops and clams or live weight. Default = "y" (meatwt), "n" (livewt) -#'@param foreign Character String. Mark foreign landings and keep seperate. Default = "y" -#'@param adjust.ppi Character String. Adjust value for inflation. Default = "y" (deflated) vs "n" (notdeflated) -#'@param sum.by Character String. Variable to sum landings by either "EPU" (Default) or "stat.area" -#'@param endyear Numeric Scalar. Final year of query. Default = 2018 -#'@param reftime Numeric Vector. (Length 2). Specifies the year and month if adjusting for inflation. Default = c(2016,1) -#'@param out.dir Character string. Path to directory where final output will be saved or where data is to be read from -#'@param Stand.alone Boolean. Flag to determine whether to save Skate and hake data to file. defualt = F (Both a US catch file and a NAFO catch file will be saved) -#' -#' -#'@return An RDS file is created -#' -#' -#'A file will be written to your hard drive in the directory specified by \code{out.dir}. The name of the file will be named depending on user input. For example: -#' -#'Filename = 'comland_meatwt_deflated_stat_areas.RDS' -#' arises from user: landed = "y", adjust.ppi = "y", sum.by = "stat.area" -#' -#'@importFrom data.table ":=" "key" "setcolorder" "as.data.table" -#'@importFrom magrittr "%>%" -#' -#'@export -#' -#Make sure to define your fleets below! - -#Requires the following files: -# data.dir.2\\Comland_skates_hakes.R -# data.dir\\Menhaden.csv -# data.dir.3\\SS_NAFO_21A.csv -# data.dir.3\\species.txt -comland <- function(channel, - GEARS=comlandr::GEARs, - EPUS=comlandr::EPUs, - use.existing="y", - landed="y", - foreign="y", - adjust.ppi="y", - sum.by="EPU", - endyear=2018, - reftime = c(2016,1), - out.dir=here::here(), - Stand.alone=F) { - - if(!(isS4(channel))) { - message("Argument \"channel\", is not a valid DBI connection object. Please see dbutils::connect_to_database for details ...") - return() - } - - # informs user as to what he/she has requested since there a lot of options - #input_checks(use.existing,landed,foreign,adjust.ppi,sum.by,endyear,reftime,out.dir) - - #Output file - if(landed == 'n') file.landed <- '_livewt' else file.landed <- '_meatwt' - if(adjust.ppi == 'n') file.adjust <- '' else file.adjust <- '_deflated' - if(sum.by == 'EPU') file.by <- '_EPU' else file.by <- '_stat_areas' - file.name <- paste0('comland', file.landed, file.adjust, file.by) - - refyear <- reftime[1] - refmonth <- reftime[2] - - -# Pull data from databases or read existing ------------------------------ -if(use.existing == 'n'){ - # capture the call to the comland function. Added to output - call <- dbutils::capture_function_call() - pullDate <- date() - comland <- get_comland_data(channel,landed,endyear,out.dir) - -} else if(use.existing == 'y'){ # or read from directory - if(landed == 'n') { - comlandFile <- file.path(out.dir, "comland_raw_US_livewt.RDS") - } else if (landed == "y") { - comlandFile <- file.path(out.dir, "comland_raw_US_meatwt.RDS") - } else { - stop(paste0("landed = ",landed," is not a valid entry. Please see help for valid argument values")) - } - - if (!file.exists(comlandFile)) { - message(paste0("The file, ",comlandFile," doesnt exist. If this is the first time you are running comland.R then you will need to use the argument \"use.existing=\"n\" and pull an initial data set. Fishing data are not provided with this package. Otherwise check to make sure your out.dir path is correct ")) - return() - } else { - comland <- readRDS(comlandFile) - if (any(names(comland) == "pullDate")) { - pullDate = comland$pullDate - } else { - message("Data used is from an older pull where the date of the original data pull was not recorded") - pullDate <- NULL - } - - - } -} - comland$YEAR <- as.integer(comland$YEAR) - comland$MONTH <- as.integer(comland$MONTH) - comland$NEGEAR <- as.integer(comland$NEGEAR) - comland$TONCL1 <- as.integer(comland$TONCL1) - comland$NESPP3 <- as.integer(comland$NESPP3) - comland$NESPP4 <- as.integer(comland$NESPP4) - comland$UTILCD <- as.integer(comland$UTILCD) - - comland$AREA <- levels(comland$AREA)[comland$AREA] - ind <- comland$AREA %in% c("OFF","OFR") - comland <- comland[!ind,] - comland$AREA <- as.integer(comland$AREA) - #comland$AREA <- as.factor(comland$AREA) - - # Convert from lbs to metric tons ---------------------------------------- - - comland[, SPPLIVMT := SPPLIVLB * 0.00045359237] - comland[, SPPLIVLB := NULL] - #fix years - comland[YEAR < 100, YEAR := YEAR + 1900L] - #comland$YEAR <- as.character(comland$YEAR) - - # Adjust for inflation ---------------------------------------------------- - if(adjust.ppi == 'y'){ - # Adjust SPPVALUE for inflation - comland <- adjust_inflation(comland,refyear,refmonth) - } - - # Remove market categories of parts -------------------------------------- - comland <- comland[!NESPP4 %in% c(119, 123, 125, 127, 812, 819, 828, 829, 1731, 2351, - 2690, 2699, 3472, as.numeric(paste(348:359, 8, sep = '')), - 3868, as.numeric(paste(469:471, 4, sep = '')), - as.numeric(paste(480:499, 8, sep ='')), 5018, 5039, - 5261, 5265), ] - - #Generate NESPP3 and MKTCAT in comland data - comland[NESPP4 < 100, MKTCAT := as.numeric(substring(NESPP4, 2, 2))] - comland[NESPP4 > 99 & NESPP4 < 1000, MKTCAT := as.numeric(substring(NESPP4, 3, 3))] - comland[NESPP4 > 999, MKTCAT := as.numeric(substring(NESPP4, 4, 4))] - - #drop NESPP4 - comland[, NESPP4 := NULL] - - # Deal with Hakes and Skates------------------------------------------------------------------ - skates_hakes <- comland_skates_hakes(EPUS,out.dir,Stand.alone) - - - skate.hake.us <- skates_hakes$skate.hake.us - skate.hake.nafo <- skates_hakes$skate.hake.nafo - - - # winter & little skates -------------------------------------------------- - - #comland.skates <- comland_winter_little(comland,skate.hake.us) - comland <- comland_winter_little(comland,skate.hake.us) - - # comland_separate_skates ------------------------------------------------- - comland <- comland_separate_hakes(comland,skate.hake.us) - - # Herring -------------------------------------------------------------- - #Herring data is housed by the state of Maine. - comland <- comland_herring(channel,comland) - - # Menhaden ------------------------------------------------------------- - #fix menhaden records - data from Tom Miller/ Andre Bouchheister - comland <- comland_menhaden(comland) - - # Deal with unknowns ------------------------------------- - #1 - drop unknown species/landings - comland <- comland_unknowns(comland) - - #2 - aggregate by quarter year, half year, major gear, and small/large TC - comland.agg <- comland_aggregate(comland,GEARS) - - #3 - Use proportions of known catch to assign unknown catch - #3.A QY/HY------------------------------------------------------------------------------ - comland.agg <- assign_catch_qy_hy(comland.agg) - - #3.B SIZE------------------------------------------------------------------------------ - comland.agg <- assign_catch_size(comland.agg) - - - #3.C GEAR------------------------------------------------------------------------------ - comland.agg <- assign_catch_gear(comland.agg) - - #3.D AREA------------------------------------------------------------------------------ - comland.agg <- assign_catch_area(comland.agg) - - # NAFO data processed ----------------------------------------------------- - nafoland.agg <- comland_nafo(channel,skate.hake.nafo,GEARS) - - # aggregate by EPU -------------------------------------------------------- - if(sum.by == 'EPU'){ - #Assign EPU based on statarea - comland <- aggregate_by_epu(comland.agg,nafoland.agg,EPUS,foreign) - - } else if (sum.by == 'stat.area') { - comland <- comland.agg - } else { - stop(paste0("sum.by = ",sum.by," has not been coded for. Select either EPU or stat.area")) - } - - comland <- list(data=comland, pullDate=pullDate, functionCall = call) - - #save(comland, file = file.path(out.dir, paste0(file.name,Sys.Date(),".RData"))) - saveRDS(comland, file = file.path(out.dir, paste0(file.name,".Rds"))) - - return(comland) - -} diff --git a/R/oldfunctions/Comland_skates_hakes.R b/R/oldfunctions/Comland_skates_hakes.R deleted file mode 100644 index f5ddf98..0000000 --- a/R/oldfunctions/Comland_skates_hakes.R +++ /dev/null @@ -1,192 +0,0 @@ -#'#Comcatch_skates_hakes.r -#' -#'Determine proportion of little/winter skates and silver hake in landings data 7/13 -#'SML -#' -#'@param EPUS List. Designates the stat areas that comprise an EPU. -#'@param out.dir Character string. Path to directory where skate data will be written -#'@param Stand.alone Boolean. Flag to determine whether to save Skate and hake data to file. defualt = F (Both a US catch file and a NAFO catch file will be saved) -#' -#'@return A list -#' -#'\item{skate.hake.us}{landings of skates and hakes in USA } -#'\item{skate.hake.nafo}{landings of skates and hakes outside USA} -#' -#' -#'@importFrom data.table ":=" "key" -#' -#' @noRd - -comland_skates_hakes <- function(EPUS,out.dir,Stand.alone=F){ - - -#------------------------------------------------------------------------------- -#Required packages -#library(rgdal); library(data.table); library(Survdat) - -#------------------------------------------------------------------------------- -#User created functions -#source(paste(r.dir, "Poststrat.r", sep = '')) - -#------------------------------------------------------------------------------- -#Skates and hakes -spp.name <- c('Little_Skate', 'Winter_Skate', 'Silver_Hake') -spp <- c(26, 23, 72) - -#Grab survdat.r -pathToSurvdat <- system.file("extdata","Survdat.RData",package="comlandr") -load(pathToSurvdat) - -#Remove length info -data.table::setkey(survdat, - CRUISE6, - STATION, - STRATUM, - SVSPP) - -catch <- unique(survdat, by = key(survdat)) - -catch <- catch[SVSPP %in% c(22:28, 72, 69), ] -catch <- survdat[SVSPP %in% c(22:28, 72, 69), ] -#Calculate ratios within Stat Areas -#Post stratify to use Stat Area designations -#Stat Areas - - -pathToGIS <- system.file("extdata","Statistical_Areas_2010.shp",package="comlandr") - -Stat.areas <- sf::st_read(dsn=pathToGIS) -catch.stat <- survdat:::post_strat(catch, areaPolygon = Stat.areas, areaDescription = 'Id') - -data.table::setnames(catch.stat, - c("STRATUM", "Id"), - c("SVSTRATUM", "AREA")) - - -data.table::setkey(catch.stat, - YEAR, - SEASON, - AREA) - -#SKATES----------------------------------------------------------------------------- -#Figure out proportion of skates -skates <- catch.stat[SVSPP %in% 22:28, sum(BIOMASS), by = key(catch.stat)] -data.table::setnames(skates, "V1", "skates.all") - -little <- catch.stat[SVSPP == 26, sum(BIOMASS), by = key(catch.stat)] -data.table::setnames(little, "V1", "little") - -all.skates <- merge(skates, little, by = key(catch.stat), all = T) - -winter <- catch.stat[SVSPP == 23, sum(BIOMASS), by = key(catch.stat)] -data.table::setnames(winter, "V1", "winter") - -all.skates <- merge(all.skates, winter, by = key(catch.stat), all = T) - -all.skates[, little.per := little/skates.all] -all.skates[, winter.per := winter/skates.all] - -all.skates[, c('skates.all', 'little', 'winter') := NULL] -all.skates[is.na(little.per), little.per := 0] -all.skates[is.na(winter.per), winter.per := 0] - -#HAKES-------------------------------------------------------------------------------- -#Figure out proportion of silver hake/offshore hake -hakes <- catch.stat[SVSPP %in% c(72, 69), sum(BIOMASS), by = key(catch.stat)] -data.table::setnames(hakes, "V1", "hakes.all") - -silvers <- catch.stat[SVSPP == 72, sum(BIOMASS), by = key(catch.stat)] -data.table::setnames(silvers, "V1", "silver") - -all.hakes <- merge(hakes, silvers, all = T) - -all.hakes[, silver.per := silver/hakes.all] - -all.hakes[, c('hakes.all', 'silver') := NULL] -all.hakes[is.na(silver.per), silver.per := 0] - -#Combine skates and hakes -skate.hake <- merge(all.skates, all.hakes, by = key(catch.stat), all = T) - -skate.hake[SEASON == 'SPRING', Half := 1] -skate.hake[SEASON == 'FALL', Half := 2] -skate.hake[, SEASON := NULL] - -if(Stand.alone == T) save(skate.hake, file = file.path(out.dir, "skates_hakes.RData", sep ='')) -#if(Stand.alone == F) skate.hake.us <- skate.hake -skate.hake.us <- skate.hake - - - - -#Foreign Landings-------------------------------------------------------------------- -#NAFO uses divisions - -catch.stat[, EPU := factor(NA, levels = c('GOM', 'GB', 'MAB', 'SS'))] -catch.stat[AREA %in% EPUS$GOM$statAreas, EPU := 'GOM'] -catch.stat[AREA %in% EPUS$GB$statAreas, EPU := 'GB'] -catch.stat[AREA %in% EPUS$MAB$statAreas, EPU := 'MAB'] -catch.stat[AREA %in% EPUS$SS$statAreas, EPU := 'SS'] - - - -data.table::setkey(catch.stat, - YEAR, - SEASON, - EPU) - - - -#Figure out proportion of skates -skates <- catch.stat[SVSPP %in% 22:28, sum(BIOMASS), by = key(catch.stat)] -data.table::setnames(skates, "V1", "skates.all") - -little <- catch.stat[SVSPP == 26, sum(BIOMASS), by = key(catch.stat)] -data.table::setnames(little, "V1", "little") - -all.skates <- merge(skates, little, by = key(catch.stat), all = T) - -winter <- catch.stat[SVSPP == 23, sum(BIOMASS), by = key(catch.stat)] -data.table::setnames(winter, "V1", "winter") - -all.skates <- merge(all.skates, winter, by = key(catch.stat), all = T) - -all.skates[, little.per := little/skates.all] -all.skates[, winter.per := winter/skates.all] - -all.skates[, c('skates.all', 'little', 'winter') := NULL] -all.skates[is.na(little.per), little.per := 0] -all.skates[is.na(winter.per), winter.per := 0] - -#Figure out proportion of silver hake -hakes <- catch.stat[SVSPP %in% c(72, 69), sum(BIOMASS), by = key(catch.stat)] -data.table::setnames(hakes, "V1", "hakes.all") - -silvers <- catch.stat[SVSPP == 72, sum(BIOMASS), by = key(catch.stat)] -data.table::setnames(silvers, "V1", "silver") - -all.hakes <- merge(hakes, silvers, all = T) - -all.hakes[, silver.per := silver/hakes.all] - -all.hakes[, c('hakes.all', 'silver') := NULL] -all.hakes[is.na(silver.per), silver.per := 0] - -#Combine skates and hakes -skate.hake <- merge(all.skates, all.hakes, by = key(catch.stat), all = T) - -skate.hake[SEASON == 'SPRING', Half := 1] -skate.hake[SEASON == 'FALL', Half := 2] -skate.hake[, SEASON := NULL] -skate.hake <- skate.hake[!is.na(EPU), ] - -if(Stand.alone == T) save(skate.hake, file = file.path(out.dir, "skates_hakes_nafo.RData")) -#if(Stand.alone == F) skate.hake.nafo <- skate.hake -skate.hake.nafo <- skate.hake - -# skate.hake.nafo$AREA <- as.factor(skate.hake.nafo$AREA) -# skate.hake.us$AREA <- as.factor(skate.hake.us$AREA) - -return(list(skate.hake.us=skate.hake.us, skate.hake.nafo=skate.hake.nafo)) - -} diff --git a/R/oldfunctions/GEARs.R b/R/oldfunctions/GEARs.R deleted file mode 100644 index bb6aa18..0000000 --- a/R/oldfunctions/GEARs.R +++ /dev/null @@ -1,17 +0,0 @@ -#' GEARs: Gear type classifications -#' -#' Lists the NESFC gear types (NEGEAR) attributed to a more general "fleet" characteristic -#' -#' @format A list of NEGEAR codes assigned to "fleets" -#' \describe{ -#' \item{otter}{Otter Trawls: Bottom, Bottom paired, Bottom Twin, Hadock Separator} -#' \item{dredge.sc}{Scallop Dredges} -#' \item{pot}{Pots and Traps: Fish, eel, conch, octopus, hagfish , shrimp, lobster, crab} -#' \item{longline}{Bottom and Pelagic Longlines} -#' \item{seine}{Beach, Long, mackerel, menhaden, tuna, scottish Seines} -#' \item{gillnet}{Fixed, Anchored, Sea bass, salmon, crab, floating, run around, other Gillnets} -#' \item{midwater}{Midwater paired and unpaired otter trawls} -#' \item{dredge.o}{Oyster, scrapes, Clam, Crab, conch, mussel, urchin, Quahog, hydraulic dredges} -#'} -#' -"GEARs" diff --git a/R/oldfunctions/aggregate_by_epu.R b/R/oldfunctions/aggregate_by_epu.R deleted file mode 100644 index 6c84cbe..0000000 --- a/R/oldfunctions/aggregate_by_epu.R +++ /dev/null @@ -1,54 +0,0 @@ -#' aggregate data by epu -#' -#'aggregate by epu -#' -#'@param comland.agg Data frame. master data frame containing species landings -#'@param nafoland.agg Data frame. processed NAFO data -#'@param EPUS List. Designates the stat areas that comprise an EPU. Default = EPUs (lazily loaded data) -#'@param foreign Character String. Mark foreign landings and keep seperate. Default = "y" -#' -#'@return Aggregated comland data -#' -#' @noRd - - -aggregate_by_epu <- function(comland.agg,nafoland.agg,EPUS,foreign){ - - #Assign EPU based on statarea - comland.agg[AREA %in% EPUS$GOM$statAreas, EPU := 'GOM'] - comland.agg[AREA %in% EPUS$GB$statAreas, EPU := 'GB'] - comland.agg[AREA %in% EPUS$MAB$statAreas, EPU := 'MAB'] - comland.agg[AREA %in% EPUS$SS$statAreas, EPU := 'SS'] - comland.agg[is.na(EPU), EPU := 'OTHER'] - comland.agg[, EPU := factor(EPU, levels = c('GOM', 'GB', 'MAB', 'SS', 'OTHER'))] - - data.table::setkey(comland.agg, - YEAR, - NESPP3, - QY, - GEAR, - SIZE, - EPU, - UTILCD) - - comland.agg <- comland.agg[, list(sum(SPPLIVMT), sum(SPPVALUE)), by = key(comland.agg)] - - data.table::setnames(comland.agg, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - #Merge comland and nafoland - data.table::setcolorder(nafoland.agg, names(comland.agg)) - - if(foreign == 'y'){ - comland.agg[, US := T] - nafoland.agg[, US := F] - } - - comland.nafo <- data.table::rbindlist(list(comland.agg, nafoland.agg)) - - #Remove Menhaden data - #save(comland.nafo, file = paste(out.dir, "comland_Menhaden.RData", sep = '')) - comland <- comland.nafo[NESPP3 != 221, ] - - return(comland) - -} diff --git a/R/oldfunctions/assign_area.R b/R/oldfunctions/assign_area.R deleted file mode 100644 index a08e902..0000000 --- a/R/oldfunctions/assign_area.R +++ /dev/null @@ -1,70 +0,0 @@ -#' Assigns points to polygon -#' -#' Assign observer data (points, lat and lon) to designated regions (polygons) from a shape file. -#' -#' -# @inheritParams strat_prep -#' @param na.keep Boolean. Logical value to indicate whether original strata names -#' should be retained. -#' -#' @return 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} -#' -#' @importFrom magrittr "%>%" -#' -#'@family comdisc -#' -#' @export - - -assign_area <- function (comdiscData, areaPolygon, areaDescription, na.keep = F) { - - # transform Regional Shape file using lambert conformal conic coordinate ref system - crs <- "+proj=lcc +lat_1=20 +lat_2=60 +lat_0=40 +lon_0=-72 +x_0=0 +y_0=0 +datum=NAD83 +units=m +no_defs +ellps=GRS80 +towgs84=0,0,0" - - areas <- areaPolygon %>% - dplyr::rename(areaDescription = areaDescription) %>% - sf::st_transform(., crs) - - #Need unique link3, lat lon column to make this work - comdiscData[, linkLL := paste0(LINK3, LAT, LON)] - #Should probably do this in the raw data pull - #remove stations missing lat or lon - comdiscData <- comdiscData[!is.na(LAT), ] - comdiscData <- comdiscData[!is.na(LON), ] - - # find unique stations and transform to required crs - locations <- comdiscData %>% - dplyr::select(linkLL, LAT, LON) %>% - dplyr::distinct() %>% - sf::st_as_sf(., coords = c("LON","LAT"), crs=4326) %>% - sf::st_transform(., crs) - - - # Intersect the locations with the polygon - # Assigns locations with polygons - location_area <- sf::st_join(locations, areas, join = sf::st_intersects) %>% - dplyr::select(names(locations), areaDescription) %>% - sf::st_drop_geometry() %>% - dplyr::arrange(linkLL) - - # Join observer data with locations (which now are assigned to an area based on the shape file) - master <- base::merge(comdiscData, location_area, by = c("linkLL")) %>% - dplyr::rename(!!areaDescription := areaDescription) - - # check to see if we want to keep points that fall outside of all of the polygons found in the shape file - if (!(na.keep)) { # removes all points that fall outside of the areas defined by the polygons in stratum - master <- master %>% - dplyr::filter(!is.na(get(areaDescription))) %>% - data.table::as.data.table() - } - #Drop linkLL column - master[, linkLL := NULL] - - return(master[]) - -} - diff --git a/R/oldfunctions/assign_catch_area.R b/R/oldfunctions/assign_catch_area.R deleted file mode 100644 index 5022ccb..0000000 --- a/R/oldfunctions/assign_catch_area.R +++ /dev/null @@ -1,208 +0,0 @@ -#' assign unknown catch using known catch characteristics -#' -#' Uses area. Expand ..... -#' -#'@param comland Data frame. master data frame containing species landings -#' -#'@return updated comland data frame -#' -#'@importFrom data.table ":=" "key" "setcolorder" "as.data.table" -#' -#'@family assign catch -#' -#' @noRd -#' - -assign_catch_area <- function(comland.agg){ - - - unk.area <- comland.agg[AREA == 0, ] - k.area <- comland.agg[AREA != 0, ] - - #3.C.1 - All match - match.key <- c('YEAR', 'NESPP3', 'QY', 'HY', 'SIZE', 'GEAR') - - unk.area.all <- unk.area - - k.area.all <- k.area - - data.table::setkeyv(unk.area.all, match.key) - data.table::setkeyv(k.area.all, match.key) - - area.all <- k.area.all[unk.area.all] - - #No match - need to match with larger aggregation - no.match <- area.all[is.na(SPPLIVMT), ] - no.match[, c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match, c('i.AREA', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop QY - data.table::setkey(no.match, YEAR, NESPP3, HY, SIZE, GEAR) - data.table::setkeyv(k.area.all, key(no.match)) - area.all.2 <- k.area.all[no.match] - no.match.2 <- area.all.2[is.na(SPPLIVMT), ] - no.match.2[, c('AREA', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.2, c('i.AREA', 'i.QY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('AREA', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop HY - data.table::setkey(no.match.2, YEAR, NESPP3, SIZE, GEAR) - data.table::setkeyv(k.area.all, key(no.match.2)) - area.all.3 <- k.area.all[no.match.2] - no.match.3 <- area.all.3[is.na(SPPLIVMT), ] - no.match.3[, c('AREA', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.3, c('i.AREA', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('AREA', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop SIZE - data.table::setkey(no.match.3, YEAR, NESPP3, GEAR) - data.table::setkeyv(k.area.all, key(no.match.3)) - area.all.4 <- k.area.all[no.match.3] - no.match.4 <- area.all.4[is.na(SPPLIVMT), ] - no.match.4[, c('AREA', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.4, c('i.AREA', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('AREA', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop GEAR - data.table::setkey(no.match.4, YEAR, NESPP3) - data.table::setkeyv(k.area.all, key(no.match.4)) - area.all.5 <- k.area.all[no.match.4] - no.match.5 <- area.all.5[is.na(SPPLIVMT), ] - no.match.5[, c('AREA', 'GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.5, c('i.AREA', 'i.GEAR', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', - 'i.SPPLIVMT', 'i.SPPVALUE'), - c('AREA', 'GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Still no match - use 3 or 5 year window then drop year - years <- unique(no.match.5[, YEAR], by = key(no.match.5)) - no.match.6 <- c() - area.all.6 <- c() - - for(i in 1:length(years)){ - #3 year window - k.area.3y <- comland.agg[AREA != 0 & YEAR %in% (years[i] - 1):(years[i] + 1), ] - data.table::setkey(k.area.3y, NESPP3, AREA) - k.area.3y <- k.area.3y[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = c(key(k.area.3y), 'UTILCD')] - data.table::setnames(k.area.3y, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - unk.area.3y <- no.match.5[YEAR == years[i], ] - - data.table::setkey(unk.area.3y, NESPP3) - data.table::setkey(k.area.3y, NESPP3) - area.3y <- k.area.3y[unk.area.3y] - - no.match.3y <- area.3y[is.na(SPPLIVMT), ] - no.match.3y[, c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.3y, c('i.AREA', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - no.match.6 <- data.table::rbindlist(list(no.match.6, no.match.3y)) - area.all.6 <- data.table::rbindlist(list(area.all.6, area.3y)) - } - - years <- unique(no.match.6[, YEAR], by = key(no.match.6)) - no.match.7 <- c() - area.all.7 <- c() - for(i in 1:length(years)){ - #5 year window - k.area.5y <- comland.agg[AREA != 0 & YEAR %in% (years[i] - 2):(years[i] + 2), ] - data.table::setkey(k.area.5y, NESPP3, AREA) - k.area.5y <- k.area.5y[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = c(key(k.area.5y), 'UTILCD')] - data.table::setnames(k.area.5y, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - unk.area.5y <- no.match.6[YEAR == years[i], ] - - data.table::setkey(unk.area.5y, NESPP3) - data.table::setkey(k.area.5y, NESPP3) - area.5y <- k.area.5y[unk.area.5y] - - no.match.5y <- area.5y[is.na(SPPLIVMT), ] - no.match.5y[, c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.5y, c('i.AREA', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - - no.match.7 <- data.table::rbindlist(list(no.match.7, no.match.5y)) - area.all.7 <- data.table::rbindlist(list(area.all.7, area.5y)) - } - #Drop year - data.table::setkey(no.match.7, NESPP3) - k.area.all <- k.area.all[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = c('NESPP3', 'AREA', 'UTILCD')] - data.table::setnames(k.area.all, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - data.table::setkey(k.area.all, NESPP3) - - area.all.8 <- k.area.all[no.match.7] - no.match.8 <- area.all.8[is.na(SPPLIVMT), ] - no.match.8[, c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.8, c('i.AREA', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #If still no match - leave as unknown - - - #Merge all together and proportion catch to known areas - area.all <- area.all [!is.na(SPPLIVMT), ] - area.all.2 <- area.all.2[!is.na(SPPLIVMT), ] - area.all.2[, QY := i.QY] - area.all.2[, i.QY := NULL] - setcolorder(area.all.2, names(area.all)) - area.all.3 <- area.all.3[!is.na(SPPLIVMT), ] - area.all.3[, QY := i.QY] - area.all.3[, HY := i.HY] - area.all.3[, i.QY := NULL] - area.all.3[, i.HY := NULL] - setcolorder(area.all.3, names(area.all)) - area.all.4 <- area.all.4[!is.na(SPPLIVMT), ] - area.all.4[, QY := i.QY] - area.all.4[, HY := i.HY] - area.all.4[, SIZE := i.SIZE] - area.all.4[, i.QY := NULL] - area.all.4[, i.HY := NULL] - area.all.4[, i.SIZE := NULL] - setcolorder(area.all.4, names(area.all)) - area.all.5 <- area.all.5[!is.na(SPPLIVMT), ] - area.all.5[, QY := i.QY] - area.all.5[, HY := i.HY] - area.all.5[, SIZE := i.SIZE] - area.all.5[, GEAR := i.GEAR] - area.all.5[, i.QY := NULL] - area.all.5[, i.HY := NULL] - area.all.5[, i.SIZE := NULL] - area.all.5[, i.GEAR := NULL] - setcolorder(area.all.5, names(area.all)) - area.all.6 <- area.all.6[!is.na(SPPLIVMT), ] - setcolorder(area.all.6, names(area.all)) - area.all.7 <- area.all.7[!is.na(SPPLIVMT), ] - setcolorder(area.all.7, names(area.all)) - area.all.8 <- area.all.8[!is.na(SPPLIVMT), ] - setcolorder(area.all.8, names(area.all)) - - area.all <- data.table::rbindlist(list(area.all, area.all.2, area.all.3, area.all.4, - area.all.5, area.all.6, area.all.7, area.all.8)) - - area.all[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key] - area.all[, unk := i.SPPLIVMT * prop] - area.all[, unk2 := i.SPPVALUE * prop] - area.all[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.AREA', - 'i.UTILCD', 'prop') := NULL] - data.table::setnames(area.all, c('unk','unk2'), c('SPPLIVMT', 'SPPVALUE')) - - setcolorder(no.match.8, names(area.all)) - area.solved <- data.table::rbindlist(list(area.all, no.match.8)) - rm(list = c(ls(pattern = 'area.all'), ls(pattern = 'no.match'))) - - #Merge back area.solved - setcolorder(area.solved, names(comland.agg)) - comland.agg <- data.table::rbindlist(list(k.area, area.solved)) - data.table::setkey(comland.agg, - YEAR, - QY, - HY, - SIZE, - GEAR, - AREA, - NESPP3, - UTILCD) - comland.agg <- comland.agg[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = key(comland.agg)] - data.table::setnames(comland.agg, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - - return(comland.agg) -} diff --git a/R/oldfunctions/assign_catch_gear.R b/R/oldfunctions/assign_catch_gear.R deleted file mode 100644 index f4d83b9..0000000 --- a/R/oldfunctions/assign_catch_gear.R +++ /dev/null @@ -1,218 +0,0 @@ -#' assign unknown catch using known catch characteristics -#' -#' Uses gear. Expand ..... -#' -#'@param comland Data frame. master data frame containing species landings -#' -#'@return updated comland data frame -#' -#'@importFrom data.table ":=" "key" "setcolorder" "as.data.table" -#' -#'@family assign catch -#' -#' @noRd - -assign_catch_gear <- function(comland.agg){ - unk.gear <- comland.agg[GEAR == 'unknown', ] - k.gear <- comland.agg[GEAR != 'unknown', ] - - #3.C.1 - All match - match.key <- c('YEAR', 'NESPP3', 'QY', 'HY', 'SIZE', 'AREA') - - unk.gear.all <- unk.gear[AREA != 0, ] - - k.gear.all <- k.gear[AREA != 0, ] - - data.table::setkeyv(unk.gear.all, match.key) - data.table::setkeyv(k.gear.all, match.key) - - gear.all <- k.gear.all[unk.gear.all] - - #No match - need to match with larger aggregation - no.match <- gear.all[is.na(SPPLIVMT), ] - no.match[, c('GEAR', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match, c('i.GEAR', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('GEAR', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop QY - data.table::setkey(no.match, YEAR, NESPP3, HY, SIZE, AREA) - data.table::setkeyv(k.gear.all, key(no.match)) - gear.all.2 <- k.gear.all[no.match] - no.match.2 <- gear.all.2[is.na(SPPLIVMT), ] - no.match.2[, c('GEAR', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.2, c('i.GEAR', 'i.QY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('GEAR', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop HY - data.table::setkey(no.match.2, YEAR, NESPP3, SIZE, AREA) - data.table::setkeyv(k.gear.all, key(no.match.2)) - gear.all.3 <- k.gear.all[no.match.2] - no.match.3 <- gear.all.3[is.na(SPPLIVMT), ] - no.match.3[, c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.3, c('i.GEAR', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop SIZE - data.table::setkey(no.match.3, YEAR, NESPP3, AREA) - data.table::setkeyv(k.gear.all, key(no.match.3)) - gear.all.4 <- k.gear.all[no.match.3] - no.match.4 <- gear.all.4[is.na(SPPLIVMT), ] - no.match.4[, c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.4, c('i.GEAR', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop AREA - data.table::setkey(no.match.4, YEAR, NESPP3) - data.table::setkeyv(k.gear.all, key(no.match.4)) - gear.all.5 <- k.gear.all[no.match.4] - no.match.5 <- gear.all.5[is.na(SPPLIVMT), ] - no.match.5[, c('AREA', 'GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.5, c('i.AREA', 'i.GEAR', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', - 'i.SPPLIVMT', 'i.SPPVALUE'), - c('AREA', 'GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Still no match - assign to GEAR to other - no.match.5[, GEAR := factor('other', levels = levels(k.gear[, GEAR]))] - - #Merge all together and proportion catch to known gears - gear.all <- gear.all [!is.na(SPPLIVMT), ] - gear.all.2 <- gear.all.2[!is.na(SPPLIVMT), ] - gear.all.2[, QY := i.QY] - gear.all.2[, i.QY := NULL] - setcolorder(gear.all.2, names(gear.all)) - gear.all.3 <- gear.all.3[!is.na(SPPLIVMT), ] - gear.all.3[, QY := i.QY] - gear.all.3[, HY := i.HY] - gear.all.3[, i.QY := NULL] - gear.all.3[, i.HY := NULL] - setcolorder(gear.all.3, names(gear.all)) - gear.all.4 <- gear.all.4[!is.na(SPPLIVMT), ] - gear.all.4[, QY := i.QY] - gear.all.4[, HY := i.HY] - gear.all.4[, SIZE := i.SIZE] - gear.all.4[, i.QY := NULL] - gear.all.4[, i.HY := NULL] - gear.all.4[, i.SIZE := NULL] - setcolorder(gear.all.4, names(gear.all)) - gear.all.5 <- gear.all.5[!is.na(SPPLIVMT), ] - gear.all.5[, QY := i.QY] - gear.all.5[, HY := i.HY] - gear.all.5[, SIZE := i.SIZE] - gear.all.5[, AREA := i.AREA] - gear.all.5[, i.QY := NULL] - gear.all.5[, i.HY := NULL] - gear.all.5[, i.SIZE := NULL] - gear.all.5[, i.AREA := NULL] - setcolorder(gear.all.5, names(gear.all)) - - gear.all <- data.table::rbindlist(list(gear.all, gear.all.2, gear.all.3, - gear.all.4, gear.all.5)) - - gear.all[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key] - gear.all[, unk := i.SPPLIVMT * prop] - gear.all[, unk2 := i.SPPVALUE * prop] - gear.all[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.GEAR', - 'i.UTILCD', 'prop') := NULL] - data.table::setnames(gear.all, c('unk','unk2'), c('SPPLIVMT', 'SPPVALUE')) - - setcolorder(no.match.5, names(gear.all)) - gear.solved <- data.table::rbindlist(list(gear.all, no.match.5)) - rm(list = c(ls(pattern = 'gear.all'), ls(pattern = 'no.match'))) - - #3.C.2 - Species only - no other match - match.key <- c('YEAR', 'NESPP3', 'QY', 'HY', 'SIZE') - - unk.gear.sp <- unk.gear[AREA == 0, ] - unk.gear.sp[, 'AREA' := NULL] - - k.gear.sp <- k.gear[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = c(match.key, 'GEAR', 'UTILCD')] - data.table::setnames(k.gear.sp, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - data.table::setkeyv(unk.gear.sp, match.key) - data.table::setkeyv(k.gear.sp, match.key) - - gear.sp <- k.gear.sp[unk.gear.sp] - - #No match - need to match with larger aggregation - no.match <- gear.sp[is.na(SPPLIVMT), ] - no.match[, c('GEAR', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match, c('i.GEAR', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('GEAR', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop QY - data.table::setkey(no.match, YEAR, NESPP3, HY, SIZE) - data.table::setkeyv(k.gear.sp, key(no.match)) - gear.sp.2 <- k.gear.sp[no.match] - no.match.2 <- gear.sp.2[is.na(SPPLIVMT), ] - no.match.2[, c('GEAR', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.2, c('i.GEAR', 'i.QY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('GEAR', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop HY - data.table::setkey(no.match.2, YEAR, NESPP3, SIZE) - data.table::setkeyv(k.gear.sp, key(no.match.2)) - gear.sp.3 <- k.gear.sp[no.match.2] - no.match.3 <- gear.sp.3[is.na(SPPLIVMT), ] - no.match.3[, c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.3, c('i.GEAR', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop SIZE - data.table::setkey(no.match.3, YEAR, NESPP3) - data.table::setkeyv(k.gear.sp, key(no.match.3)) - gear.sp.4 <- k.gear.sp[no.match.3] - no.match.4 <- gear.sp.4[is.na(SPPLIVMT), ] - no.match.4[, c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.4, c('i.GEAR', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Still no match - assign to GEAR to other - no.match.4[, GEAR := factor('other', levels = levels(k.gear[, GEAR]))] - no.match.4[, AREA := 0] - - #Merge all together and proportion catch to known gears - gear.sp <- gear.sp [!is.na(SPPLIVMT), ] - gear.sp.2 <- gear.sp.2[!is.na(SPPLIVMT), ] - gear.sp.2[, QY := i.QY] - gear.sp.2[, i.QY := NULL] - setcolorder(gear.sp.2, names(gear.sp)) - gear.sp.3 <- gear.sp.3[!is.na(SPPLIVMT), ] - gear.sp.3[, QY := i.QY] - gear.sp.3[, HY := i.HY] - gear.sp.3[, i.QY := NULL] - gear.sp.3[, i.HY := NULL] - setcolorder(gear.sp.3, names(gear.sp)) - gear.sp.4 <- gear.sp.4[!is.na(SPPLIVMT), ] - gear.sp.4[, QY := i.QY] - gear.sp.4[, HY := i.HY] - gear.sp.4[, SIZE := i.SIZE] - gear.sp.4[, i.QY := NULL] - gear.sp.4[, i.HY := NULL] - gear.sp.4[, i.SIZE := NULL] - setcolorder(gear.sp.4, names(gear.sp)) - - gear.sp <- data.table::rbindlist(list(gear.sp, gear.sp.2, gear.sp.3, gear.sp.4)) - - gear.sp[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key] - gear.sp[, unk := i.SPPLIVMT * prop] - gear.sp[, unk2 := i.SPPVALUE * prop] - gear.sp[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.GEAR', - 'i.UTILCD', 'prop') := NULL] - data.table::setnames(gear.sp, c('unk','unk2'), c('SPPLIVMT', 'SPPVALUE')) - gear.sp[, AREA := 0] - - setcolorder(gear.sp, names(gear.solved)) - setcolorder(no.match.4, names(gear.solved)) - gear.solved <- data.table::rbindlist(list(gear.solved, gear.sp, no.match.4)) - rm(list = c(ls(pattern = 'gear.sp'), ls(pattern = 'no.match'))) - - #Merge back gear.solved - setcolorder(gear.solved, names(comland.agg)) - comland.agg <- data.table::rbindlist(list(k.gear, gear.solved)) - data.table::setkey(comland.agg, - YEAR, - QY, - HY, - SIZE, - GEAR, - AREA, - NESPP3, - UTILCD) - comland.agg <- comland.agg[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = key(comland.agg)] - data.table::setnames(comland.agg, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - return(comland.agg) -} diff --git a/R/oldfunctions/assign_catch_qy_hy.R b/R/oldfunctions/assign_catch_qy_hy.R deleted file mode 100644 index f947b3f..0000000 --- a/R/oldfunctions/assign_catch_qy_hy.R +++ /dev/null @@ -1,593 +0,0 @@ -#' assign unknown catch using known catch characteristics -#' -#' Uses Half year and Quarter year. Expand ..... -#' -#'@param comland Data frame. master data frame containing species landings -#' -#'@return updated comland data frame -#' -#'@importFrom data.table ":=" "key" "setcolorder" "as.data.table" -#' -#'@family assign catch -#' -#' @noRd - -assign_catch_qy_hy <- function(comland.agg){ - #3.A QY/HY------------------------------------------------------------------------------ - unk.month <- comland.agg[QY == 0, ] - k.month <- comland.agg[QY != 0, ] - - #3.A.1 - All match - match.key <- c('YEAR', 'NESPP3', 'GEAR', 'SIZE', 'AREA') - - unk.month.all <- unk.month[GEAR != 'unknown'] - unk.month.all <- unk.month.all[SIZE != 'unknown', ] - unk.month.all <- unk.month.all[AREA != 0, ] - - k.month.all <- k.month[GEAR != 'unknown', ] - k.month.all <- k.month.all[SIZE != 'unknown', ] - k.month.all <- k.month.all[AREA != 0, ] - - data.table::setkeyv(unk.month.all, match.key) - data.table::setkeyv(k.month.all, match.key) - - month.all <- k.month.all[unk.month.all] - - #No match - need to match with larger aggregation - no.match <- month.all[is.na(SPPLIVMT), ] - no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match, c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop SIZE - data.table::setkey(no.match, YEAR, NESPP3, AREA, GEAR) - data.table::setkeyv(k.month.all, key(no.match)) - month.all.2 <- k.month.all[no.match] - no.match.2 <- month.all.2[is.na(SPPLIVMT), ] - no.match.2[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.2, c('i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop GEAR - data.table::setkey(no.match.2, YEAR, NESPP3, AREA) - data.table::setkeyv(k.month.all, key(no.match.2)) - month.all.3 <- k.month.all[no.match.2] - no.match.3 <- month.all.3[is.na(SPPLIVMT), ] - no.match.3[, c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.3, c('i.GEAR', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop AREA - data.table::setkey(no.match.3, YEAR, NESPP3) - data.table::setkeyv(k.month.all, key(no.match.3)) - month.all.4 <- k.month.all[no.match.3] - no.match.4 <- month.all.4[is.na(SPPLIVMT), ] - no.match.4[, c('AREA', 'GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.4, c('i.AREA', 'i.GEAR', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', - 'i.SPPLIVMT', 'i.SPPVALUE'), - c('AREA', 'GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Still no match - assign to first QY/HY - no.match.4[, c('QY', 'HY') := 1] - - #Merge all together and proportion catch to known months - month.all <- month.all [!is.na(SPPLIVMT), ] - month.all.2 <- month.all.2[!is.na(SPPLIVMT), ] - month.all.2[, SIZE := i.SIZE] - month.all.2[, i.SIZE := NULL] - setcolorder(month.all.2, names(month.all)) - month.all.3 <- month.all.3[!is.na(SPPLIVMT), ] - month.all.3[, GEAR := i.GEAR] - month.all.3[, SIZE := i.SIZE] - month.all.3[, i.GEAR := NULL] - month.all.3[, i.SIZE := NULL] - setcolorder(month.all.3, names(month.all)) - month.all.4 <- month.all.4[!is.na(SPPLIVMT), ] - month.all.4[, AREA := i.AREA] - month.all.4[, GEAR := i.GEAR] - month.all.4[, SIZE := i.SIZE] - month.all.4[, i.AREA := NULL] - month.all.4[, i.GEAR := NULL] - month.all.4[, i.SIZE := NULL] - setcolorder(month.all.4, names(month.all)) - - month.all <- data.table::rbindlist(list(month.all, month.all.2, month.all.3, month.all.4)) - - month.all[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key] - month.all[, unk := i.SPPLIVMT * prop] - month.all[, unk2 := i.SPPVALUE * prop] - month.all[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.HY', - 'i.QY', 'i.UTILCD', 'prop') := NULL] - data.table::setnames(month.all, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE')) - - setcolorder(no.match.4, names(month.all)) - month.solved <- data.table::rbindlist(list(month.all, no.match.4)) - rm(list = c(ls(pattern = 'month.all'), ls(pattern = 'no.match'))) - - #3.A.2 - GEAR/SIZE - match.key <- c('YEAR', 'NESPP3', 'GEAR', 'SIZE') - - unk.month.g.s <- unk.month[GEAR != 'unknown'] - unk.month.g.s <- unk.month.g.s[SIZE != 'unknown', ] - unk.month.g.s <- unk.month.g.s[AREA == 0, ] - unk.month.g.s <- unk.month.g.s[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = c(match.key, 'QY', 'HY', 'UTILCD')] - data.table::setnames(unk.month.g.s, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - k.month.g.s <- k.month[GEAR != 'unknown', ] - k.month.g.s <- k.month.g.s[SIZE != 'unknown', ] - k.month.g.s <- k.month.g.s[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = c(match.key, 'QY', 'HY', 'UTILCD')] - data.table::setnames(k.month.g.s, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - data.table::setkeyv(unk.month.g.s, match.key) - data.table::setkeyv(k.month.g.s, match.key) - - month.g.s <- k.month.g.s[unk.month.g.s] - - #No match - need to match with larger aggregation - no.match <- month.g.s[is.na(SPPLIVMT), ] - no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match, c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop SIZE - data.table::setkey(no.match, YEAR, NESPP3, GEAR) - data.table::setkeyv(k.month.g.s, key(no.match)) - month.g.s.2 <- k.month.g.s[no.match] - no.match.2 <- month.g.s.2[is.na(SPPLIVMT), ] - no.match.2[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.2, c('i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop GEAR - data.table::setkey(no.match.2, YEAR, NESPP3) - data.table::setkeyv(k.month.g.s, key(no.match.2)) - month.g.s.3 <- k.month.g.s[no.match.2] - no.match.3 <- month.g.s.3[is.na(SPPLIVMT), ] - no.match.3[, c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.3, c('i.GEAR', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Still no match - assign to first QY/HY - no.match.3[, c('QY', 'HY') := 1] - no.match.3[, AREA := 0] - - #Merge all together and proportion catch to known months - month.g.s <- month.g.s [!is.na(SPPLIVMT), ] - month.g.s.2 <- month.g.s.2[!is.na(SPPLIVMT), ] - if(nrow(month.g.s.2) > 0){ - month.g.s.2[, SIZE := i.SIZE] - month.g.s.2[, i.SIZE := NULL] - setcolorder(month.g.s.2, names(month.g.s)) - month.g.s <- data.table::rbindlist(list(month.g.s, month.g.s.2)) - } - month.g.s.3 <- month.g.s.3[!is.na(SPPLIVMT), ] - if(nrow(month.g.s.3) > 0){ - month.g.s.3[, GEAR := i.GEAR] - month.g.s.3[, SIZE := i.SIZE] - month.g.s.3[, i.GEAR := NULL] - month.g.s.3[, i.SIZE := NULL] - setcolorder(month.g.s.3, names(month.g.s)) - month.g.s <- data.table::rbindlist(list(month.g.s, month.g.s.3)) - } - - month.g.s[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key] - month.g.s[, unk := i.SPPLIVMT * prop] - month.g.s[, unk2 := i.SPPVALUE * prop] - month.g.s[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.HY', - 'i.QY', 'i.UTILCD', 'prop') := NULL] - data.table::setnames(month.g.s, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE')) - month.g.s[, AREA := 0] - - setcolorder(month.g.s, names(month.solved)) - setcolorder(no.match.3, names(month.solved)) - month.solved <- data.table::rbindlist(list(month.solved, month.g.s, no.match.3)) - rm(list = c(ls(pattern = 'month.g.s'), ls(pattern = 'no.match'))) - - #3.A.3 - AREA/GEAR - match.key <- c('YEAR', 'NESPP3', 'GEAR', 'AREA') - - unk.month.a.g <- unk.month[GEAR != 'unknown'] - unk.month.a.g <- unk.month.a.g[SIZE == 'unknown', ] - unk.month.a.g <- unk.month.a.g[AREA != 0, ] - unk.month.a.g <- unk.month.a.g[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = c(match.key, 'QY', 'HY', 'UTILCD')] - data.table::setnames(unk.month.a.g, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - k.month.a.g <- k.month[GEAR != 'unknown', ] - k.month.a.g <- k.month.a.g[AREA != 0, ] - k.month.a.g <- k.month.a.g[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = c(match.key, 'QY', 'HY', 'UTILCD')] - data.table::setnames(k.month.a.g, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - data.table::setkeyv(unk.month.a.g, match.key) - data.table::setkeyv(k.month.a.g, match.key) - - month.a.g <- k.month.a.g[unk.month.a.g] - - #No match - need to match with larger aggregation - no.match <- month.a.g[is.na(SPPLIVMT), ] - no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match, c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop GEAR - data.table::setkey(no.match, YEAR, NESPP3, AREA) - data.table::setkeyv(k.month.a.g, key(no.match)) - month.a.g.2 <- k.month.a.g[no.match] - no.match.2 <- month.a.g.2[is.na(SPPLIVMT), ] - no.match.2[, c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.2, c('i.GEAR', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop AREA - data.table::setkey(no.match.2, YEAR, NESPP3) - data.table::setkeyv(k.month.a.g, key(no.match.2)) - month.a.g.3 <- k.month.a.g[no.match.2] - no.match.3 <- month.a.g.3[is.na(SPPLIVMT), ] - no.match.3[, c('AREA', 'GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.3, c('i.AREA', 'i.GEAR', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('AREA', 'GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Still no match - assign to first QY/HY - no.match.3[, c('QY', 'HY') := 1] - no.match.3[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))] - - #Merge all together and proportion catch to known months - month.a.g <- month.a.g [!is.na(SPPLIVMT), ] - month.a.g.2 <- month.a.g.2[!is.na(SPPLIVMT), ] - if(nrow(month.a.g.2) > 0){ - month.a.g.2[, GEAR := i.GEAR] - month.a.g.2[, i.GEAR := NULL] - setcolorder(month.a.g.2, names(month.a.g)) - month.a.g <- data.table::rbindlist(list(month.a.g, month.a.g.2)) - } - month.a.g.3 <- month.a.g.3[!is.na(SPPLIVMT), ] - if(nrow(month.a.g.3) > 0){ - month.a.g.3[, AREA := i.AREA] - month.a.g.3[, GEAR := i.GEAR] - month.a.g.3[, i.AREA := NULL] - month.a.g.3[, i.GEAR := NULL] - setcolorder(month.a.g.3, names(month.a.g)) - month.a.g <- data.table::rbindlist(list(month.a.g, month.a.g.3)) - } - - month.a.g[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key] - month.a.g[, unk := i.SPPLIVMT * prop] - month.a.g[, unk2 := i.SPPVALUE * prop] - month.a.g[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.HY', - 'i.QY', 'i.UTILCD', 'prop') := NULL] - data.table::setnames(month.a.g, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE')) - month.a.g[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))] - - setcolorder(month.a.g, names(month.solved)) - setcolorder(no.match.3, names(month.solved)) - month.solved <- data.table::rbindlist(list(month.solved, month.a.g, no.match.3)) - rm(list = c(ls(pattern = 'month.a.g'), ls(pattern = 'no.match'))) - - #3.A.4 - AREA/TC - match.key <- c('YEAR', 'NESPP3', 'SIZE', 'AREA') - - unk.month.a.s <- unk.month[GEAR == 'unknown'] - unk.month.a.s <- unk.month.a.s[SIZE != 'unknown', ] - unk.month.a.s <- unk.month.a.s[AREA != 0, ] - unk.month.a.s <- unk.month.a.s[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = c(match.key, 'QY', 'HY', 'UTILCD')] - data.table::setnames(unk.month.a.s, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - k.month.a.s <- k.month[SIZE != 'unknown', ] - k.month.a.s <- k.month.a.s[AREA != 0, ] - k.month.a.s <- k.month.a.s[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = c(match.key, 'QY', 'HY', 'UTILCD')] - data.table::setnames(k.month.a.s, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - data.table::setkeyv(unk.month.a.s, match.key) - data.table::setkeyv(k.month.a.s, match.key) - - month.a.s <- k.month.a.s[unk.month.a.s] - - #No match - need to match with larger aggregation - no.match <- month.a.s[is.na(SPPLIVMT), ] - no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match, c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop SIZE - data.table::setkey(no.match, YEAR, NESPP3, AREA) - data.table::setkeyv(k.month.a.s, key(no.match)) - month.a.s.2 <- k.month.a.s[no.match] - no.match.2 <- month.a.s.2[is.na(SPPLIVMT), ] - no.match.2[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.2, c('i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop AREA - data.table::setkey(no.match.2, YEAR, NESPP3) - data.table::setkeyv(k.month.a.s, key(no.match.2)) - month.a.s.3 <- k.month.a.s[no.match.2] - no.match.3 <- month.a.s.3[is.na(SPPLIVMT), ] - no.match.3[, c('AREA', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.3, c('i.AREA', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('AREA', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Still no match - assign to first QY/HY - no.match.3[, c('QY', 'HY') := 1] - no.match.3[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))] - - #Merge all together and proportion catch to known months - month.a.s <- month.a.s [!is.na(SPPLIVMT), ] - month.a.s.2 <- month.a.s.2[!is.na(SPPLIVMT), ] - if(nrow(month.a.s.2) > 0){ - month.a.s.2[, SIZE := i.SIZE] - month.a.s.2[, i.SIZE := NULL] - setcolorder(month.a.s.2, names(month.a.s)) - month.a.s <- data.table::rbindlist(list(month.a.s, month.a.s.2)) - } - month.a.s.3 <- month.a.s.3[!is.na(SPPLIVMT), ] - if(nrow(month.a.s.3) > 0){ - month.a.s.3[, AREA := i.AREA] - month.a.s.3[, SIZE := i.SIZE] - month.a.s.3[, i.AREA := NULL] - month.a.s.3[, i.SIZE := NULL] - setcolorder(month.a.s.3, names(month.a.s)) - month.a.s <- data.table::rbindlist(list(month.a.s, month.a.s.3)) - } - - month.a.s[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key] - month.a.s[, unk := i.SPPLIVMT * prop] - month.a.s[, unk2 := i.SPPVALUE * prop] - month.a.s[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.HY', - 'i.QY', 'i.UTILCD', 'prop') := NULL] - data.table::setnames(month.a.s, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE')) - month.a.s[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))] - - setcolorder(month.a.s, names(month.solved)) - setcolorder(no.match.3, names(month.solved)) - month.solved <- data.table::rbindlist(list(month.solved, month.a.s, no.match.3)) - - rm(list = c(ls(pattern = 'month.a.s'), ls(pattern = 'no.match'))) - - #3.A.5 - SIZE - match.key <- c('YEAR', 'NESPP3', 'SIZE') - - unk.month.si <- unk.month[GEAR == 'unknown'] - unk.month.si <- unk.month.si[SIZE != 'unknown', ] - unk.month.si <- unk.month.si[AREA == 0, ] - unk.month.si <- unk.month.si[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = c(match.key, 'QY', 'HY', 'UTILCD')] - data.table::setnames(unk.month.si, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - k.month.si <- k.month[SIZE != 'unknown', ] - k.month.si <- k.month.si[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = c(match.key, 'QY', 'HY', 'UTILCD')] - data.table::setnames(k.month.si, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - data.table::setkeyv(unk.month.si, match.key) - data.table::setkeyv(k.month.si, match.key) - - month.si <- k.month.si[unk.month.si] - - #No match - need to match with larger aggregation - no.match <- month.si[is.na(SPPLIVMT), ] - no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match, c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop SIZE - data.table::setkey(no.match, YEAR, NESPP3) - data.table::setkeyv(k.month.si, key(no.match)) - month.si.2 <- k.month.si[no.match] - no.match.2 <- month.si.2[is.na(SPPLIVMT), ] - no.match.2[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.2, c('i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Still no match - assign to first QY/HY - no.match.2[, c('QY', 'HY') := 1] - no.match.2[, AREA := 0] - no.match.2[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))] - - #Merge all together and proportion catch to known months - month.si <- month.si [!is.na(SPPLIVMT), ] - month.si.2 <- month.si.2[!is.na(SPPLIVMT), ] - if(nrow(month.si.2) > 0){ - month.si.2[, SIZE := i.SIZE] - month.si.2[, i.SIZE := NULL] - setcolorder(month.si.2, names(month.si)) - month.si <- data.table::rbindlist(list(month.si, month.si.2)) - } - - month.si[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key] - month.si[, unk := i.SPPLIVMT * prop] - month.si[, unk2 := i.SPPVALUE * prop] - month.si[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.HY', 'i.QY', - 'i.UTILCD', 'prop') := NULL] - data.table::setnames(month.si, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE')) - month.si[, AREA := 0] - month.si[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))] - - setcolorder(month.si, names(month.solved)) - setcolorder(no.match.2, names(month.solved)) - month.solved <- data.table::rbindlist(list(month.solved, month.si, no.match.2)) - rm(list = c(ls(pattern = 'month.si'), ls(pattern = 'no.match'))) - - #3.A.6 - GEAR - match.key <- c('YEAR', 'NESPP3', 'GEAR') - - unk.month.g <- unk.month[GEAR != 'unknown'] - unk.month.g <- unk.month.g[SIZE == 'unknown', ] - unk.month.g <- unk.month.g[AREA == 0, ] - unk.month.g <- unk.month.g[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = c(match.key, 'QY', 'HY', 'UTILCD')] - data.table::setnames(unk.month.g, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - k.month.g <- k.month[GEAR != 'unknown', ] - k.month.g <- k.month.g[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = c(match.key, 'QY', 'HY', 'UTILCD')] - data.table::setnames(k.month.g, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - data.table::setkeyv(unk.month.g, match.key) - data.table::setkeyv(k.month.g, match.key) - - month.g <- k.month.g[unk.month.g] - - #No match - need to match with larger aggregation - no.match <- month.g[is.na(SPPLIVMT), ] - no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match, c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop GEAR - data.table::setkey(no.match, YEAR, NESPP3) - data.table::setkeyv(k.month.g, key(no.match)) - month.g.2 <- k.month.g[no.match] - no.match.2 <- month.g.2[is.na(SPPLIVMT), ] - no.match.2[, c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.2, c('i.GEAR', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Still no match - assign to first QY/HY - no.match.2[, c('QY', 'HY') := 1] - no.match.2[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))] - no.match.2[, AREA := 0] - - #Merge all together and proportion catch to known months - month.g <- month.g [!is.na(SPPLIVMT), ] - month.g.2 <- month.g.2[!is.na(SPPLIVMT), ] - if(nrow(month.g.2) > 0){ - month.g.2[, GEAR := i.GEAR] - month.g.2[, i.GEAR := NULL] - setcolorder(month.g.2, names(month.g)) - month.g <- data.table::rbindlist(list(month.g, month.g.2)) - } - - month.g[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key] - month.g[, unk := i.SPPLIVMT * prop] - month.g[, unk2 := i.SPPVALUE * prop] - month.g[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.HY', 'i.QY', - 'i.UTILCD', 'prop') := NULL] - data.table::setnames(month.g, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE')) - month.g[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))] - month.g[, AREA := 0] - - setcolorder(month.g, names(month.solved)) - setcolorder(no.match.2, names(month.solved)) - month.solved <- data.table::rbindlist(list(month.solved, month.g, no.match.2)) - rm(list = c(ls(pattern = 'month.g'), ls(pattern = 'no.match'))) - - #3.A.7 - AREA - match.key <- c('YEAR', 'NESPP3', 'AREA') - - unk.month.a <- unk.month[GEAR == 'unknown'] - unk.month.a <- unk.month.a[SIZE == 'unknown', ] - unk.month.a <- unk.month.a[AREA != 0, ] - unk.month.a <- unk.month.a[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = c(match.key, 'QY', 'HY', 'UTILCD')] - data.table::setnames(unk.month.a, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - k.month.a <- k.month[AREA != 0, ] - k.month.a <- k.month.a[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = c(match.key, 'QY', 'HY', 'UTILCD')] - data.table::setnames(k.month.a, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - data.table::setkeyv(unk.month.a, match.key) - data.table::setkeyv(k.month.a, match.key) - - month.a <- k.month.a[unk.month.a] - - #No match - need to match with larger aggregation - no.match <- month.a[is.na(SPPLIVMT), ] - no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match, c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop AREA - data.table::setkey(no.match, YEAR, NESPP3) - data.table::setkeyv(k.month.a, key(no.match)) - month.a.2 <- k.month.a[no.match] - no.match.2 <- month.a.2[is.na(SPPLIVMT), ] - no.match.2[, c('AREA', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.2, c('i.AREA', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('AREA', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Still no match - assign to first QY/HY - no.match.2[, c('QY', 'HY') := 1] - no.match.2[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))] - no.match.2[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))] - - #Merge all together and proportion catch to known months - month.a <- month.a [!is.na(SPPLIVMT), ] - month.a.2 <- month.a.2[!is.na(SPPLIVMT), ] - if(nrow(month.a.2) > 0){ - month.a.2[, AREA := i.AREA] - month.a.2[, i.AREA := NULL] - setcolorder(month.a.2, names(month.a)) - month.a <- data.table::rbindlist(list(month.a, month.a.2)) - } - - month.a[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key] - month.a[, unk := i.SPPLIVMT * prop] - month.a[, unk2 := i.SPPVALUE * prop] - month.a[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.HY', - 'i.QY', 'i.UTILCD', 'prop') := NULL] - data.table::setnames(month.a, c('unk','unk2'), c('SPPLIVMT', 'SPPVALUE')) - month.a[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))] - month.a[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))] - - setcolorder(month.a, names(month.solved)) - setcolorder(no.match.2, names(month.solved)) - month.solved <- data.table::rbindlist(list(month.solved, month.a, no.match.2)) - rm(list = c(ls(pattern = 'month.a'), ls(pattern = 'no.match'))) - - #3.A.8 - Species only - no other match - match.key <- c('YEAR', 'NESPP3') - - unk.month.sp <- unk.month[GEAR == 'unknown'] - unk.month.sp <- unk.month.sp[SIZE == 'unknown', ] - unk.month.sp <- unk.month.sp[AREA == 0, ] - unk.month.sp <- unk.month.sp[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = c(match.key, 'QY', 'HY', 'UTILCD')] - data.table::setnames(unk.month.sp, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - k.month.sp <- k.month[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = c(match.key, 'QY', 'HY', 'UTILCD')] - data.table::setnames(k.month.sp, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - data.table::setkeyv(unk.month.sp, match.key) - data.table::setkeyv(k.month.sp, match.key) - - month.sp <- k.month.sp[unk.month.sp] - - #No match - assign to first QY/HY - no.match <- month.sp[is.na(SPPLIVMT), ] - no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match, c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - no.match[, c('QY', 'HY') := 1] - no.match[, AREA := 0] - no.match[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))] - no.match[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))] - - #proportion catch to known months - month.sp <- month.sp [!is.na(SPPLIVMT), ] - - month.sp[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key] - month.sp[, unk := i.SPPLIVMT * prop] - month.sp[, unk2 := i.SPPVALUE * prop] - month.sp[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.HY', 'i.QY', - 'i.UTILCD', 'prop') := NULL] - data.table::setnames(month.sp, c('unk','unk2'), c('SPPLIVMT', 'SPPVALUE')) - month.sp[, AREA := 0] - month.sp[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))] - month.sp[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))] - - setcolorder(month.sp, names(month.solved)) - setcolorder(no.match, names(month.solved)) - month.solved <- data.table::rbindlist(list(month.solved, month.sp, no.match)) - rm(list = c(ls(pattern = 'month.sp'), ls(pattern = 'no.match'))) - - #Merge back month.solved - setcolorder(month.solved, names(comland.agg)) - comland.agg <- data.table::rbindlist(list(k.month, month.solved)) - data.table::setkey(comland.agg, - YEAR, - QY, - HY, - SIZE, - GEAR, - AREA, - NESPP3, - UTILCD) - comland.agg <- comland.agg[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = key(comland.agg)] - - - data.table::setnames(comland.agg, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - - - - return(comland.agg) -} diff --git a/R/oldfunctions/assign_catch_size.R b/R/oldfunctions/assign_catch_size.R deleted file mode 100644 index 11cf07c..0000000 --- a/R/oldfunctions/assign_catch_size.R +++ /dev/null @@ -1,381 +0,0 @@ -#' assign unknown catch using known catch characteristics -#' -#' Uses size. Expand ..... -#' -#'@param comland Data frame. master data frame containing species landings -#' -#'@return updated comland data frame -#' -#'@importFrom data.table ":=" "key" "setcolorder" "as.data.table" -#' -#'@family assign catch -#' -#' @noRd - -assign_catch_size <- function(comland.agg){ - - unk.size <- comland.agg[SIZE == 'unknown', ] - k.size <- comland.agg[SIZE != 'unknown', ] - - #3.B.1 - All match - match.key <- c('YEAR', 'NESPP3', 'QY', 'HY', 'GEAR', 'AREA') - - unk.size.all <- unk.size[GEAR != 'unknown'] - unk.size.all <- unk.size.all[AREA != 0, ] - - k.size.all <- k.size[GEAR != 'unknown', ] - k.size.all <- k.size.all[AREA != 0, ] - - data.table::setkeyv(unk.size.all, match.key) - data.table::setkeyv(k.size.all, match.key) - - size.all <- k.size.all[unk.size.all] - - #No match - need to match with larger aggregation - no.match <- size.all[is.na(SPPLIVMT), ] - no.match[, c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match, c('i.SIZE', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop QY - data.table::setkey(no.match, YEAR, NESPP3, HY, GEAR, AREA) - data.table::setkeyv(k.size.all, key(no.match)) - size.all.2 <- k.size.all[no.match] - no.match.2 <- size.all.2[is.na(SPPLIVMT), ] - no.match.2[, c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.2, c('i.SIZE', 'i.QY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop HY - data.table::setkey(no.match.2, YEAR, NESPP3, GEAR, AREA) - data.table::setkeyv(k.size.all, key(no.match.2)) - size.all.3 <- k.size.all[no.match.2] - no.match.3 <- size.all.3[is.na(SPPLIVMT), ] - no.match.3[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.3, c('i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop GEAR - data.table::setkey(no.match.3, YEAR, NESPP3, AREA) - data.table::setkeyv(k.size.all, key(no.match.3)) - size.all.4 <- k.size.all[no.match.3] - no.match.4 <- size.all.4[is.na(SPPLIVMT), ] - no.match.4[, c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.4, c('i.GEAR', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop AREA - data.table::setkey(no.match.4, YEAR, NESPP3) - data.table::setkeyv(k.size.all, key(no.match.4)) - size.all.5 <- k.size.all[no.match.4] - no.match.5 <- size.all.5[is.na(SPPLIVMT), ] - no.match.5[, c('AREA', 'GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.5, c('i.AREA', 'i.GEAR', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('AREA', 'GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Still no match - assign to SIZE to small - no.match.5[, SIZE := factor('small', levels = c('large', 'small', 'unknown'))] - - #Merge all together and proportion catch to known sizes - size.all <- size.all [!is.na(SPPLIVMT), ] - size.all.2 <- size.all.2[!is.na(SPPLIVMT), ] - size.all.2[, QY := i.QY] - size.all.2[, i.QY := NULL] - setcolorder(size.all.2, names(size.all)) - size.all.3 <- size.all.3[!is.na(SPPLIVMT), ] - size.all.3[, QY := i.QY] - size.all.3[, HY := i.HY] - size.all.3[, i.QY := NULL] - size.all.3[, i.HY := NULL] - setcolorder(size.all.3, names(size.all)) - size.all.4 <- size.all.4[!is.na(SPPLIVMT), ] - size.all.4[, QY := i.QY] - size.all.4[, HY := i.HY] - size.all.4[, GEAR := i.GEAR] - size.all.4[, i.QY := NULL] - size.all.4[, i.HY := NULL] - size.all.4[, i.GEAR := NULL] - setcolorder(size.all.4, names(size.all)) - size.all.5 <- size.all.5[!is.na(SPPLIVMT), ] - size.all.5[, QY := i.QY] - size.all.5[, HY := i.HY] - size.all.5[, GEAR := i.GEAR] - size.all.5[, AREA := i.AREA] - size.all.5[, i.QY := NULL] - size.all.5[, i.HY := NULL] - size.all.5[, i.GEAR := NULL] - size.all.5[, i.AREA := NULL] - setcolorder(size.all.5, names(size.all)) - - size.all <- data.table::rbindlist(list(size.all, size.all.2, size.all.3, - size.all.4, size.all.5)) - - size.all[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key] - size.all[, unk := i.SPPLIVMT * prop] - size.all[, unk2 := i.SPPVALUE * prop] - size.all[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.SIZE', - 'i.UTILCD', 'prop') := NULL] - data.table::setnames(size.all, c('unk','unk2'), c('SPPLIVMT', 'SPPVALUE')) - - setcolorder(no.match.5, names(size.all)) - size.solved <- data.table::rbindlist(list(size.all, no.match.5)) - rm(list = c(ls(pattern = 'size.all'), ls(pattern = 'no.match'))) - - #3.B.2 - GEAR - match.key <- c('YEAR', 'NESPP3', 'QY', 'HY', 'GEAR') - - unk.size.g <- unk.size[GEAR != 'unknown'] - unk.size.g <- unk.size.g[AREA == 0, ] - unk.size.g[, AREA := NULL] - - k.size.g <- k.size[GEAR != 'unknown', ] - k.size.g <- k.size.g[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = c(match.key, 'SIZE', 'UTILCD')] - data.table::setnames(k.size.g, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - data.table::setkeyv(unk.size.g, match.key) - data.table::setkeyv(k.size.g, match.key) - - size.g <- k.size.g[unk.size.g] - - #No match - need to match with larger aggregation - no.match <- size.g[is.na(SPPLIVMT), ] - no.match[, c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match, c('i.SIZE', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop QY - data.table::setkey(no.match, YEAR, NESPP3, HY, GEAR) - data.table::setkeyv(k.size.g, key(no.match)) - size.g.2 <- k.size.g[no.match] - no.match.2 <- size.g.2[is.na(SPPLIVMT), ] - no.match.2[, c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.2, c('i.SIZE', 'i.QY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop HY - data.table::setkey(no.match.2, YEAR, NESPP3, GEAR) - data.table::setkeyv(k.size.g, key(no.match.2)) - size.g.3 <- k.size.g[no.match.2] - no.match.3 <- size.g.3[is.na(SPPLIVMT), ] - no.match.3[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.3, c('i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop GEAR - data.table::setkey(no.match.3, YEAR, NESPP3) - data.table::setkeyv(k.size.g, key(no.match.3)) - size.g.4 <- k.size.g[no.match.3] - no.match.4 <- size.g.4[is.na(SPPLIVMT), ] - no.match.4[, c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.4, c('i.GEAR', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Still no match - assign to SIZE to small - no.match.4[, SIZE := factor('small', levels = c('large', 'small', 'unknown'))] - no.match.4[, AREA := 0] - - #Merge all together and proportion catch to known sizes - size.g <- size.g [!is.na(SPPLIVMT), ] - size.g.2 <- size.g.2[!is.na(SPPLIVMT), ] - size.g.2[, QY := i.QY] - size.g.2[, i.QY := NULL] - setcolorder(size.g.2, names(size.g)) - size.g.3 <- size.g.3[!is.na(SPPLIVMT), ] - size.g.3[, QY := i.QY] - size.g.3[, HY := i.HY] - size.g.3[, i.QY := NULL] - size.g.3[, i.HY := NULL] - setcolorder(size.g.3, names(size.g)) - size.g.4 <- size.g.4[!is.na(SPPLIVMT), ] - size.g.4[, QY := i.QY] - size.g.4[, HY := i.HY] - size.g.4[, GEAR := i.GEAR] - size.g.4[, i.QY := NULL] - size.g.4[, i.HY := NULL] - size.g.4[, i.GEAR := NULL] - setcolorder(size.g.4, names(size.g)) - - size.g <- data.table::rbindlist(list(size.g, size.g.2, size.g.3, size.g.4)) - - size.g[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key] - size.g[, unk := i.SPPLIVMT * prop] - size.g[, unk2 := i.SPPVALUE * prop] - size.g[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.SIZE', - 'i.UTILCD', 'prop') := NULL] - data.table::setnames(size.g, c('unk','unk2'), c('SPPLIVMT', 'SPPVALUE')) - size.g[, AREA := 0] - - setcolorder(size.g, names(size.solved)) - setcolorder(no.match.4, names(size.g)) - size.solved <- data.table::rbindlist(list(size.solved, size.g, no.match.4)) - rm(list = c(ls(pattern = 'size.g'), ls(pattern = 'no.match'))) - - #3.B.3 - AREA - match.key <- c('YEAR', 'NESPP3', 'QY', 'HY', 'AREA') - - unk.size.a <- unk.size[GEAR == 'unknown'] - unk.size.a <- unk.size.a[AREA != 0, ] - unk.size.a[, GEAR := NULL] - - k.size.a <- k.size[AREA != 0, ] - k.size.a <- k.size.a[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = c(match.key, 'SIZE', 'UTILCD')] - data.table::setnames(k.size.a, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - data.table::setkeyv(unk.size.a, match.key) - data.table::setkeyv(k.size.a, match.key) - - size.a <- k.size.a[unk.size.a] - - #No match - need to match with larger aggregation - no.match <- size.a[is.na(SPPLIVMT), ] - no.match[, c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match, c('i.SIZE', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop QY - data.table::setkey(no.match, YEAR, NESPP3, HY, AREA) - data.table::setkeyv(k.size.a, key(no.match)) - size.a.2 <- k.size.a[no.match] - no.match.2 <- size.a.2[is.na(SPPLIVMT), ] - no.match.2[, c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.2, c('i.SIZE', 'i.QY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop HY - data.table::setkey(no.match.2, YEAR, NESPP3, AREA) - data.table::setkeyv(k.size.a, key(no.match.2)) - size.a.3 <- k.size.a[no.match.2] - no.match.3 <- size.a.3[is.na(SPPLIVMT), ] - no.match.3[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.3, c('i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop AREA - data.table::setkey(no.match.3, YEAR, NESPP3) - data.table::setkeyv(k.size.a, key(no.match.3)) - size.a.4 <- k.size.a[no.match.3] - no.match.4 <- size.a.4[is.na(SPPLIVMT), ] - no.match.4[, c('AREA', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.4, c('i.AREA', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('AREA', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Still no match - assign to SIZE to small - no.match.4[, SIZE := factor('small', levels = c('large', 'small', 'unknown'))] - no.match.4[, GEAR := factor('unknown', levels = levels(k.size[, GEAR]))] - - #Merge all together and proportion catch to known sizes - size.a <- size.a [!is.na(SPPLIVMT), ] - size.a.2 <- size.a.2[!is.na(SPPLIVMT), ] - size.a.2[, QY := i.QY] - size.a.2[, i.QY := NULL] - setcolorder(size.a.2, names(size.a)) - size.a.3 <- size.a.3[!is.na(SPPLIVMT), ] - size.a.3[, QY := i.QY] - size.a.3[, HY := i.HY] - size.a.3[, i.QY := NULL] - size.a.3[, i.HY := NULL] - setcolorder(size.a.3, names(size.a)) - size.a.4 <- size.a.4[!is.na(SPPLIVMT), ] - size.a.4[, QY := i.QY] - size.a.4[, HY := i.HY] - size.a.4[, AREA := i.AREA] - size.a.4[, i.QY := NULL] - size.a.4[, i.HY := NULL] - size.a.4[, i.AREA := NULL] - setcolorder(size.a.4, names(size.a)) - - size.a <- data.table::rbindlist(list(size.a, size.a.2, size.a.3, size.a.4)) - - size.a[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key] - size.a[, unk := i.SPPLIVMT * prop] - size.a[, unk2 := i.SPPVALUE * prop] - size.a[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.SIZE', - 'i.UTILCD', 'prop') := NULL] - data.table::setnames(size.a, c('unk','unk2'), c('SPPLIVMT', 'SPPVALUE')) - size.a[, GEAR := factor('unknown', levels = levels(k.size[, GEAR]))] - - setcolorder(size.a, names(size.solved)) - setcolorder(no.match.4, names(size.a)) - size.solved <- data.table::rbindlist(list(size.solved, size.a, no.match.4)) - rm(list = c(ls(pattern = 'size.a'), ls(pattern = 'no.match'))) - - #3.B.4 - Species only - no other match - match.key <- c('YEAR', 'NESPP3', 'QY', 'HY') - - unk.size.sp <- unk.size[GEAR == 'unknown'] - unk.size.sp <- unk.size.sp[SIZE == 'unknown', ] - unk.size.sp <- unk.size.sp[AREA == 0, ] - unk.size.sp[, c('GEAR', 'AREA') := NULL] - - k.size.sp <- k.size[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = c(match.key, 'SIZE', 'UTILCD')] - data.table::setnames(k.size.sp, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - data.table::setkeyv(unk.size.sp, match.key) - data.table::setkeyv(k.size.sp, match.key) - - size.sp <- k.size.sp[unk.size.sp] - - #No match - need to match with larger aggregation - no.match <- size.sp[is.na(SPPLIVMT), ] - no.match[, c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match, c('i.SIZE', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop QY - data.table::setkey(no.match, YEAR, NESPP3, HY) - data.table::setkeyv(k.size.sp, key(no.match)) - size.sp.2 <- k.size.sp[no.match] - no.match.2 <- size.sp.2[is.na(SPPLIVMT), ] - no.match.2[, c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.2, c('i.SIZE', 'i.QY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Drop HY - data.table::setkey(no.match.2, YEAR, NESPP3) - data.table::setkeyv(k.size.sp, key(no.match.2)) - size.sp.3 <- k.size.sp[no.match.2] - no.match.3 <- size.sp.3[is.na(SPPLIVMT), ] - no.match.3[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL] - data.table::setnames(no.match.3, c('i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'), - c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')) - #Still no match - assign to SIZE to small - no.match.3[, SIZE := factor('small', levels = c('large', 'small', 'unknown'))] - no.match.3[, GEAR := factor('unknown', levels = levels(k.size[, GEAR]))] - no.match.3[, AREA := 0] - - #Merge together and proportion catch to known sizes - size.sp <- size.sp [!is.na(SPPLIVMT), ] - size.sp.2 <- size.sp.2[!is.na(SPPLIVMT), ] - size.sp.2[, QY := i.QY] - size.sp.2[, i.QY := NULL] - setcolorder(size.sp.2, names(size.sp)) - size.sp.3 <- size.sp.3[!is.na(SPPLIVMT), ] - size.sp.3[, QY := i.QY] - size.sp.3[, HY := i.HY] - size.sp.3[, i.QY := NULL] - size.sp.3[, i.HY := NULL] - setcolorder(size.sp.3, names(size.sp)) - - size.sp <- data.table::rbindlist(list(size.sp, size.sp.2, size.sp.3)) - - size.sp[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key] - size.sp[, unk := i.SPPLIVMT * prop] - size.sp[, unk2 := i.SPPVALUE * prop] - size.sp[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.SIZE', - 'i.UTILCD', 'prop') := NULL] - data.table::setnames(size.sp, c('unk','unk2'), c('SPPLIVMT', 'SPPVALUE')) - size.sp[, AREA := 0] - size.sp[, GEAR := factor('unknown', levels = levels(k.size[, GEAR]))] - - setcolorder(size.sp, names(size.solved)) - setcolorder(no.match.3, names(size.solved)) - size.solved <- data.table::rbindlist(list(size.solved, size.sp, no.match.3)) - rm(list = c(ls(pattern = 'size.sp'), ls(pattern = 'no.match'))) - - #Merge back size.solved - setcolorder(size.solved, names(comland.agg)) - comland.agg <- data.table::rbindlist(list(k.size, size.solved)) - data.table::setkey(comland.agg, - YEAR, - QY, - HY, - SIZE, - GEAR, - AREA, - NESPP3, - UTILCD) - comland.agg <- comland.agg[, list(sum(SPPLIVMT), sum(SPPVALUE)), - by = key(comland.agg)] - data.table::setnames(comland.agg, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - return(comland.agg) - -} diff --git a/R/oldfunctions/comland_aggregate.R b/R/oldfunctions/comland_aggregate.R deleted file mode 100644 index 58b94f0..0000000 --- a/R/oldfunctions/comland_aggregate.R +++ /dev/null @@ -1,64 +0,0 @@ -#' aggregate data by time, gear, tonnage -#' -#'aggregate by quarter year, half year, major gear, and small/large TC -#' -#'@param comland Data frame. master data frame containing species landings -#'@param GEARS List. Designates the NEGEAR codes that comprise a fishing fleet. -#' -#'@return Aggreagted comland data -#' -#' @noRd -#' -comland_aggregate <- function(comland,GEARS){ - - comland[MONTH %in% 1:3, QY := 1] - comland[MONTH %in% 4:6, QY := 2] - comland[MONTH %in% 7:9, QY := 3] - comland[MONTH %in% 10:12, QY := 4] - comland[MONTH == 0, QY := 0] - - comland[MONTH %in% 1:6, HY := 1] - comland[MONTH %in% 7:12, HY := 2] - comland[MONTH == 0, HY := 0] - - #if (is.list(GEARS)) { - # aggregate the NEGEAR2 names based on user input - comland[NEGEAR %in% GEARS$otter, GEAR := 'otter'] - comland[NEGEAR %in% GEARS$dredge.sc, GEAR := 'dredge.sc'] - comland[NEGEAR %in% GEARS$pot, GEAR := 'pot'] - comland[NEGEAR %in% GEARS$longline, GEAR := 'longline'] - comland[NEGEAR %in% GEARS$seine, GEAR := 'seine'] - comland[NEGEAR %in% GEARS$gillnet, GEAR := 'gillnet'] - comland[NEGEAR %in% GEARS$midwater, GEAR := 'midwater'] - comland[NEGEAR %in% GEARS$dredge.o, GEAR := 'dredge.o'] - comland[NEGEAR == 0, GEAR := 'unknown'] - comland[is.na(GEAR), GEAR := 'other'] - comland[, GEAR := as.factor(GEAR)] - #} else { - # # dont aggregate but rename column - # setnames(comland,"NEGEAR","GEAR") - #} - - comland[TONCL1 %in% 1:3, SIZE := 'small'] - comland[TONCL1 > 3, SIZE := 'large'] - comland[TONCL1 == 0, SIZE := 'unknown'] - comland[, SIZE := as.factor(SIZE)] - - - data.table::setkey(comland, - YEAR, - QY, - HY, - GEAR, - SIZE, - AREA, - NESPP3, - UTILCD) - - comland.agg <- comland[, list(sum(SPPLIVMT), sum(SPPVALUE)), by = key(comland)] - - data.table::setnames(comland.agg, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE')) - - - return(comland.agg) -} diff --git a/R/oldfunctions/comland_herring.R b/R/oldfunctions/comland_herring.R deleted file mode 100644 index 1d26506..0000000 --- a/R/oldfunctions/comland_herring.R +++ /dev/null @@ -1,115 +0,0 @@ -#' Processes herring data -#' -#'Herring Data comes from the state of Maine. -#' -#'@param channel DBI object. connection object for database access -#'@param comland Data frame. master data frame containing species landings -#' -#'@return Processed Herring data added to comland -#' -#'@importFrom data.table ":=" "key" -#' -#' @noRd - -comland_herring <- function(channel,comland) { - - herr.qry <- "select year, month, stock_area, negear, gearname, keptmt, discmt - from cfdbs.maine_herring_catch" - - herr.catch <- data.table::as.data.table(DBI::dbGetQuery(channel, herr.qry)) - - herr.catch$YEAR <- as.integer(herr.catch$YEAR) - herr.catch$MONTH <- as.integer(herr.catch$MONTH) - herr.catch$STOCK_AREA <- as.integer(herr.catch$STOCK_AREA) - herr.catch$NEGEAR <- as.integer(herr.catch$NEGEAR) - herr.catch$GEARNAME <- as.factor(herr.catch$GEARNAME) - - - data.table::setkey(herr.catch, YEAR, MONTH, STOCK_AREA, NEGEAR) - - - - herring <- herr.catch[, list(sum(KEPTMT), sum(DISCMT)), by = key(herr.catch)] - - - data.table::setnames(herring, c('STOCK_AREA', 'V1', 'V2'), - c('AREA', 'SPPLIVMT', 'DISCMT')) - - - - #Using averages from comland to fill in categories - herring[, MKTCAT := 5] - - herring[, TONCL1 := 2] - - herring[, UTILCD := 0] - - #compute price/utilization from CF tables - herring.comland <- comland[NESPP3 == 168, ] - - - #Price from comland - herring.price <- herring.comland[, (sum(SPPVALUE) / sum(SPPLIVMT)), by = c('YEAR', 'MONTH')] - - - data.table::setnames(herring.price, 'V1', 'price') - - herring <- merge(herring, herring.price, by = c('YEAR', 'MONTH'), all.x = T) - - - - #Use 1964 prices for < 1964 - herring[YEAR < 1964, price := mean(herring[YEAR == 1964, price])] - #Calculate SPPVALUE from price - herring[, SPPVALUE := round(price * SPPLIVMT)] - - #Utilization from comland - herring.util <- herring.comland[, sum(SPPLIVMT), by = c('YEAR', 'MONTH', 'UTILCD')] - data.table::setnames(herring.util, 'V1', 'SPPLIVMT') - - - herring.util[, SPPLIVMT.ALL := sum(SPPLIVMT), by = c('YEAR', 'MONTH')] - - herring.util[, Prop := SPPLIVMT/SPPLIVMT.ALL] - - - data.table::setorder(herring.util, YEAR, MONTH, Prop) - - - herring.util[, cum.prop := cumsum(Prop), by = c('YEAR', 'MONTH')] - - #Apply proportions to Maine data set - #Not pulled all the time - current through 2017 - herring[, Total := sum(SPPLIVMT), by = c('YEAR', 'MONTH')] - - herring[, Prop := SPPLIVMT / Total] - - data.table::setorder(herring, YEAR, MONTH, Prop) - herring[, cum.prop := cumsum(Prop), by = c('YEAR', 'MONTH')] - - for(iyear in unique(herring.util[, YEAR])){ - for(imonth in unique(herring.util[YEAR == iyear, MONTH])){ - cum.prop.low <- 0 - for(iutil in herring.util[YEAR == iyear & MONTH == imonth, UTILCD]){ - cum.prop.high <- herring.util[YEAR == iyear & MONTH == imonth & - UTILCD == iutil, cum.prop] - herring[YEAR == iyear & MONTH == imonth & cum.prop <= cum.prop.high & - cum.prop > cum.prop.low, UTILCD := iutil] - cum.prop.low <- cum.prop.high - } - } - } - - #fix column headings - herring[, c('Total', 'Prop', 'cum.prop', 'price', 'DISCMT') := NULL] - herring[, NESPP3 := 168] - - data.table::setcolorder(herring, names(comland)) - - #remove herring from data pull and add in Maine numbers - comland <- data.table::rbindlist(list(comland[NESPP3 != 168, ], herring)) - - - return(comland) - -} diff --git a/R/oldfunctions/comland_menhaden.R b/R/oldfunctions/comland_menhaden.R deleted file mode 100644 index 96f553c..0000000 --- a/R/oldfunctions/comland_menhaden.R +++ /dev/null @@ -1,23 +0,0 @@ -#' Processes Menhaden data -#' -#'Fix menhaden records - data from Tom Miller/ Andre Bouchheister -#' -#'@param comland Data frame. master data frame containing species landings -#' -#'@return Processed Menhaden data -#' -#' @noRd - -comland_menhaden <- function(comland){ - ##fix menhaden records - data from Tom Miller/ Andre Bouchheister - #menhaden <- as.data.table(read.csv(paste(data.dir, "Menhaden.csv", sep = ''))) - #menhaden.mab <- menhaden[, MA.Total + CB.Total, by = Year] - ##file metric is 1000s of lbs - convert to mt - #menhaden.mab[, SPPLIVMT := (V1 * 1000) * 0.00045359237] - #menhaden.mab[, V1 := NULL] - # - #menhaden.gom <- menhaden[, list(Year, NE.Total)] - #menhaden.gom[, SPPLIVMT := (NE.Total * 1000) * 0.00045359237] - #menhaden.gom[, NE.Total := NULL] - return(comland) -} diff --git a/R/oldfunctions/comland_nafo.R b/R/oldfunctions/comland_nafo.R deleted file mode 100644 index 119fd1f..0000000 --- a/R/oldfunctions/comland_nafo.R +++ /dev/null @@ -1,268 +0,0 @@ -#' Processes all NAFO data -#' -#'Downnloads and reads in all NAFO data then aggreagtes it -#' -#'@param channel an Object inherited from \link[DBI]{DBIConnection-class}. This object is used to connect -#' to communicate with the database engine. (see \code{\link{connect_to_database}}) -#'@param GEARS List. Designates the NEGEAR codes that comprise a fishing fleet. Default = GEARs (lazily loaded data) -#'@param skate.hake.nafo -#' -#'@return Processed NAFO data -#' -#'@importFrom data.table ":=" "key" "setcolorder" "as.data.table" -#' -#' @noRd - -comland_nafo <- function(channel,skate.hake.nafo,GEARS){ - #Note - NAFO landings by division only so not available in sum.by = "stat.area" - #Add NAFO foreign landings - Data from http://www.nafo.int/data/frames/data.html - temp <- tempfile() - download.file("https://www.nafo.int/Portals/0/Stats/nafo-21b-60-69.zip",temp) - nafo.60 <- as.data.table(read.csv(unz(temp, "NAFO21B-60-69.txt"))) - unlink(temp) - download.file("https://www.nafo.int/Portals/0/Stats/nafo-21b-70-79.zip",temp) - nafo.70 <- as.data.table(read.csv(unz(temp, "NAFO21B-70-79.txt"))) - unlink(temp) - download.file("https://www.nafo.int/Portals/0/Stats/nafo-21b-80-89.zip",temp) - nafo.80 <- as.data.table(read.csv(unz(temp, "NAFO21B-80-89.txt"))) - unlink(temp) - download.file("https://www.nafo.int/Portals/0/Stats/nafo-21b-90-99.zip",temp) - nafo.90 <- as.data.table(read.csv(unz(temp, "NAFO21B-90-99.txt"))) - unlink(temp) - download.file("https://www.nafo.int/Portals/0/Stats/nafo-21b-2000-09.zip",temp) - nafo.00 <- as.data.table(read.csv(unz(temp, "NAFO21B-2000-09.txt"))) - unlink(temp) - download.file("https://www.nafo.int/Portals/0/Stats/nafo-21b-2010-16.zip",temp) - nafo.10 <- as.data.table(read.csv(unz(temp, "nafo-21b-2010-16/NAFO-21B-2010-16.txt"))) - unlink(temp) - - #2010 + data have different column headers - data.table::setnames(nafo.10, - c('Gear', 'AreaCode', 'SpeciesEffort'), - c('GearCode', 'Divcode', 'Code')) - - nafo <- data.table::rbindlist(list(nafo.60, nafo.70, nafo.80, nafo.90, nafo.00, nafo.10), fill = T) - - #Remove US landings (Country code 22), extra divisions (use only 47, 51:56, 61:63), - #and effort codes (1:3) - nafo <- nafo[Country != 22 & Divcode %in% c(47, 51:56, 61:63) & Code > 3, ] - - #Deal with unknown monthly catch????? - - #Get nafo code in a similar format to comland - nafoland <- nafo[, list(Year, GearCode, Tonnage, Divcode, Code, Catches)] - nafoland[, MONTH := 0] - data.table::setnames(nafoland, 'Catches', 'SPPLIVMT') - - month <- c('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec') - for(i in 1:12){ - nafoland.month <- nafo[, list(Year, GearCode, Tonnage, Divcode, Code, get(month[i]))] - nafoland.month[, MONTH := i] - data.table::setnames(nafoland.month, - names(nafoland.month)[6], - 'SPPLIVMT') - nafoland <- data.table::rbindlist(list(nafoland, nafoland.month)) - } - - nafoland <- nafoland[SPPLIVMT != 0,] - - nafoland[, EPU := factor(NA, levels = c('GOM', 'GB', 'MAB', 'SS', 'OTHER'))] - nafoland[Divcode == 47, EPU := 'SS'] - nafoland[Divcode == 51, EPU := 'GOM'] - nafoland[Divcode %in% c(52, 54:56), EPU := 'GB'] - nafoland[Divcode %in% c(53, 61:63), EPU := 'MAB'] - nafoland[is.na(EPU), EPU := 'OTHER'] - - nafoland[, Divcode := NULL] - ##Fix missing Scotian Shelf data from 21B - SS.nafo <- as.data.table(read.csv(system.file("extdata","SS_NAFO_21A.csv",package="comlandr"), skip = 8)) - - #Add NAFOSPP code to SS.nafo - nafo.spp <- as.data.table(read.csv(system.file("extdata","species.txt",package="comlandr"))) - data.table::setnames(nafo.spp, "Abbreviation", "Species_ASFIS") - nafo.spp <- nafo.spp[, list(Code, Species_ASFIS)] - - SS.nafo <- merge(SS.nafo, nafo.spp, by = 'Species_ASFIS', all.x = T) - - #Only grab missing data - SS.nafo <- SS.nafo[Year %in% c(2003, 2008, 2009), ] - - data.table::setkey(SS.nafo, - Year, - Code) - - SS.land <- SS.nafo[, sum(Catch...000.Kg.), by = key(SS.nafo)] - - data.table::setnames(SS.land, "V1", "SPPLIVMT") - - #Add GearCode, Tonnage, Month, and EPU - SS.land[, GearCode := 99] - SS.land[, Tonnage := 0] - SS.land[, MONTH := 0] - SS.land[, EPU := 'SS'] - - setcolorder(SS.land, names(nafoland)) - - nafoland <- data.table::rbindlist(list(nafoland, SS.land)) - - #Rectify NAFO codes with US codes - #Species - data.table::setnames(nafoland, - c('Year', 'GearCode', 'Tonnage', 'Code'), - c('YEAR', 'NAFOGEAR', 'TONCL1', 'NAFOSPP')) - - spp <- as.data.table(DBI::dbGetQuery(channel, "select NAFOSPP, NESPP3 from CFSPP")) - spp$NAFOSPP <- as.integer(spp$NAFOSPP) - spp$NESPP3 <- as.integer(spp$NESPP3) - - #Fix missing NAFO codes - missing.spp <- data.table::data.table(NAFOSPP = c(110, 141, 189, 480, 484, 487, 488, 489), - NESPP3 = c(240, 509, 512, 366, 368, 367, 370, 369)) - spp <- data.table::rbindlist(list(spp, missing.spp)) - - data.table::setkey(spp, NAFOSPP) - spp <- unique(spp, by = key(spp)) - - #Fix many to one relationships - spp[NAFOSPP == 199, NESPP3 := 524] - spp[NAFOSPP == 299, NESPP3 := 525] - spp[NAFOSPP == 469, NESPP3 := 359] - spp[NAFOSPP == 499, NESPP3 := 526] - spp[NAFOSPP == 529, NESPP3 := 764] - spp[NAFOSPP == 699, NESPP3 := 899] - - spp$NAFOSPP <- as.integer(spp$NAFOSPP) - spp$NESPP3 <- as.integer(spp$NESPP3) - - nafoland <- merge(nafoland, spp, by = 'NAFOSPP', all.x = T) - - - #fix codes - nafoland[NAFOSPP == 309, NESPP3 := 150L] - nafoland[NAFOSPP == 462, NESPP3 := 481L] - nafoland[NAFOSPP == 464, NESPP3 := 355L] - nafoland[NAFOSPP == 468, NESPP3 := 493L] - nafoland[NAFOSPP == 704, NESPP3 := 817L] - - #remove species without a match - nafoland <- nafoland[!is.na(NESPP3), ] - - #Remove herring catch - already included from Maine Data earlier - nafoland <- nafoland[NESPP3 != 168, ] - - #Gearcodes - - gear <- as.data.table(DBI::dbGetQuery(channel, "select NEGEAR, NAFOGEAR from Gear")) - gear$NEGEAR <- as.integer(gear$NEGEAR) - gear$NAFOGEAR <- as.integer(gear$NAFOGEAR) - - gear <- unique(gear, by = 'NAFOGEAR') - - nafoland <- merge(nafoland, gear, by = 'NAFOGEAR', all.x = T) - - #fix codes - nafoland[NAFOGEAR == 8, NEGEAR := 50L] - nafoland[NAFOGEAR == 9, NEGEAR := 370L] - nafoland[NAFOGEAR == 19, NEGEAR := 58L] - nafoland[NAFOGEAR == 49, NEGEAR := 60L] - nafoland[NAFOGEAR == 56, NEGEAR := 21L] - - #Tonnage - nafoland[TONCL1 == 7, TONCL1 := 6L] - - #Drop NAFO codes - nafoland[, c('NAFOGEAR', 'NAFOSPP') := NULL] - - #Fix skates - #get little skates and winter skates from skates(ns) - use survey in half years - #Generate Half year variable in comland - nafoland.skates <- nafoland[NESPP3 == 365, ] - nafoland.skates[MONTH %in% 1:6, Half := 1] - nafoland.skates[MONTH %in% 7:12, Half := 2] - - data.table::setkey(skate.hake.nafo, - YEAR, - Half, - EPU) - - nafoland.skates <- merge(nafoland.skates, skate.hake.nafo, by = key(skate.hake.nafo), all.x = T) - - nafoland.skates[NESPP3 == 365, little := little.per * SPPLIVMT] - nafoland.skates[is.na(little), little := 0] - - nafoland.skates[NESPP3 == 365, winter := winter.per * SPPLIVMT] - nafoland.skates[is.na(winter), winter := 0] - - nafoland.skates[NESPP3 == 365, other.skate := SPPLIVMT - (little + winter)] - - #Little (366), winter (367), skates(ns) (365) - #put skates in nafoland format to merge back - little <- nafoland.skates[, list(YEAR, Half, EPU, TONCL1, MONTH, - NESPP3, NEGEAR, little)] - little[, NESPP3 := 366L] - data.table::setnames(little, "little", "SPPLIVMT") - little <- little[SPPLIVMT > 0, ] - - winter <- nafoland.skates[, list(YEAR, Half, EPU, TONCL1, MONTH, - NESPP3, NEGEAR, winter)] - winter[, NESPP3 := 367L] - data.table::setnames(winter, "winter", "SPPLIVMT") - winter <- winter[SPPLIVMT > 0, ] - - other <- nafoland.skates[, list(YEAR, Half, EPU, TONCL1, MONTH, - NESPP3, NEGEAR, other.skate)] - other[, NESPP3 := 365L] - data.table::setnames(other, "other.skate", "SPPLIVMT") - other <- other[SPPLIVMT > 0, ] - - #merge all three and reformat for nafoland - skates.add.back <- data.table::rbindlist(list(little, winter, other)) - - skates.add.back[, Half := NULL] - setcolorder(skates.add.back, names(nafoland)) - - nafoland <- data.table::rbindlist(list(nafoland[NESPP3 != 365, ], skates.add.back)) - - #aggregate nafo landings - #2 - aggregate by quarter year, half year, major gear, and small/large TC - nafoland[MONTH %in% 1:3, QY := 1] - nafoland[MONTH %in% 4:6, QY := 2] - nafoland[MONTH %in% 7:9, QY := 3] - nafoland[MONTH %in% 10:12, QY := 4] - nafoland[MONTH == 0, QY := 1] - - nafoland[NEGEAR %in% GEARS$otter, GEAR := 'otter'] - nafoland[NEGEAR %in% GEARS$dredge.sc, GEAR := 'dredge.sc'] - nafoland[NEGEAR %in% GEARS$pot, GEAR := 'pot'] - nafoland[NEGEAR %in% GEARS$longline, GEAR := 'longline'] - nafoland[NEGEAR %in% GEARS$seine, GEAR := 'seine'] - nafoland[NEGEAR %in% GEARS$gillnet, GEAR := 'gillnet'] - nafoland[NEGEAR %in% GEARS$midwater, GEAR := 'midwater'] - nafoland[NEGEAR %in% GEARS$dredge.o, GEAR := 'dredge.o'] - nafoland[NEGEAR == 99, GEAR := 'unknown'] - nafoland[is.na(GEAR), GEAR := 'other'] - nafoland[, GEAR := as.factor(GEAR)] - - nafoland[TONCL1 %in% 1:3, SIZE := 'small'] - nafoland[TONCL1 > 3, SIZE := 'large'] - nafoland[TONCL1 == 0, SIZE := 'unknown'] - nafoland[, SIZE := as.factor(SIZE)] - - data.table::setkey(nafoland, - YEAR, - QY, - GEAR, - SIZE, - EPU, - NESPP3) - - nafoland.agg <- nafoland[, sum(SPPLIVMT), by = key(nafoland)] - - data.table::setnames(nafoland.agg, "V1", "SPPLIVMT") - - #Create dummy variable for value - nafoland.agg[, SPPVALUE := 0] - nafoland.agg[, UTILCD := 0] - - return(nafoland.agg) -} diff --git a/R/oldfunctions/comland_separate_hakes.R b/R/oldfunctions/comland_separate_hakes.R deleted file mode 100644 index 4b7df0e..0000000 --- a/R/oldfunctions/comland_separate_hakes.R +++ /dev/null @@ -1,57 +0,0 @@ -#'#Comcatch_skates_hakes.r -#' -#'Determine proportion of little/winter skates and silver hake in landings data 7/13 -#'SML -#' -#'@param comland Data frame. Master data frame containing species landings -#'@param skate.hake.us Data frame. Landings of skates and hakes in USA -#' -#'@return updated comland -#' -#'@importFrom data.table ":=" "key" -#' -#' @noRd - -comland_separate_hakes <- function(comland,skate.hake.us) { - #get silver hake from mixed hakes - use survey in half years - #Generate Half year variable in comland - comland.hakes <- comland[NESPP3 == 507, ] - comland.hakes[MONTH %in% 1:6, Half := 1] - comland.hakes[MONTH %in% 7:12, Half := 2] - - comland.hakes <- merge(comland.hakes, skate.hake.us, by = key(skate.hake.us), all.x = T) - - comland.hakes[, silver := silver.per * SPPLIVMT] - comland.hakes[, silver.value := round(silver.per * SPPVALUE)] - comland.hakes[is.na(silver), silver := 0] - comland.hakes[is.na(silver.value), silver.value := 0] - - comland.hakes[, off.hake := SPPLIVMT - silver] - comland.hakes[, off.hake.value := SPPVALUE - silver.value] - - #Silver hake (509), mix hakes (507) - #put hakes in comland format to merge back - silver <- comland.hakes[, list(YEAR, Half, AREA, MONTH, NEGEAR, - TONCL1, NESPP3, UTILCD, MKTCAT, silver, - silver.value)] - silver[, NESPP3 := 509] - data.table::setnames(silver, c('silver', 'silver.value'), c('SPPLIVMT', 'SPPVALUE')) - silver <- silver[SPPLIVMT > 0, ] - - offshore <- comland.hakes[, list(YEAR, Half, AREA, MONTH, NEGEAR, - TONCL1, NESPP3, UTILCD, MKTCAT, off.hake, - off.hake.value)] - offshore[, NESPP3 := 507] - data.table::setnames(offshore, c('off.hake', 'off.hake.value'), c('SPPLIVMT', 'SPPVALUE')) - offshore <- offshore[SPPLIVMT > 0, ] - - #merge both and reformat for comland - hakes.add.back <- data.table::rbindlist(list(silver, offshore)) - - hakes.add.back[, Half := NULL] - data.table::setcolorder(hakes.add.back, names(comland)) - - comland <- data.table::rbindlist(list(comland[NESPP3 != 507, ], hakes.add.back)) - - return(comland) -} diff --git a/R/oldfunctions/comland_unknowns.R b/R/oldfunctions/comland_unknowns.R deleted file mode 100644 index 9cc89f4..0000000 --- a/R/oldfunctions/comland_unknowns.R +++ /dev/null @@ -1,74 +0,0 @@ -#' Processes unknown data -#' -#'drop unknown species/landings -#' -#'@param comland Data frame. master data frame containing species landings -#' -#'@return Processed unknowns in comland -#' -#' @noRd - -comland_unknowns <- function(comland){ - - comland[NEGEAR == 999, NEGEAR := 0] - comland[is.na(TONCL1), TONCL1 := 0] - comland[is.na(AREA), AREA := 0] - comland[AREA == 999, AREA := 0] - comland[is.na(MKTCAT), MKTCAT := 0] - comland[is.na(UTILCD), UTILCD := 0] - - #1 - drop unknown species/landings - comland <- comland[NESPP3 != 0 & SPPLIVMT != 0, ] - - #Sumarry tables - #missing area - #known.area <- comland[AREA != 0, sum(SPPLIVMT), by = NESPP3] - #unknown.area <- comland[AREA == 0, sum(SPPLIVMT), by = NESPP3] - #data.table::setnames(known.area, "V1", "AREA.MT.known") - #data.table::setnames(unknown.area, "V1", "AREA.MT.unknown") - #missing.table <- merge(known.area, unknown.area, by = 'NESPP3', all = T) - # - #missing.table[is.na(AREA.MT.known), AREA.MT.known := 0] - #missing.table[is.na(AREA.MT.unknown), AREA.MT.unknown := 0] - #missing.table[, AREA.Ratio := AREA.MT.unknown / AREA.MT.known] - # - ##missing month - #known.month <- comland[MONTH != 0, sum(SPPLIVMT), by = NESPP3] - #unknown.month <- comland[MONTH == 0, sum(SPPLIVMT), by = NESPP3] - #data.table::setnames(known.month, "V1", "MONTH.MT.known") - #data.table::setnames(unknown.month, "V1", "MONTH.MT.unknown") - #missing.table <- merge(missing.table, known.month, by = 'NESPP3', all = T) - #missing.table <- merge(missing.table, unknown.month, by = 'NESPP3', all = T) - # - #missing.table[is.na(MONTH.MT.known), MONTH.MT.known := 0] - #missing.table[is.na(MONTH.MT.unknown), MONTH.MT.unknown := 0] - #missing.table[, MONTH.Ratio := MONTH.MT.unknown / MONTH.MT.known] - # - ##missing gear - #known.gear <- comland[NEGEAR != 0, sum(SPPLIVMT), by = NESPP3] - #unknown.gear <- comland[NEGEAR == 0, sum(SPPLIVMT), by = NESPP3] - #data.table::setnames(known.gear, "V1", "GEAR.MT.known") - #data.table::setnames(unknown.gear, "V1", "GEAR.MT.unknown") - #missing.table <- merge(missing.table, known.gear, by = 'NESPP3', all = T) - #missing.table <- merge(missing.table, unknown.gear, by = 'NESPP3', all = T) - # - #missing.table[is.na(GEAR.MT.known), GEAR.MT.known := 0] - #missing.table[is.na(GEAR.MT.unknown), GEAR.MT.unknown := 0] - #missing.table[, GEAR.Ratio := GEAR.MT.unknown / GEAR.MT.known] - # - ##missing tonnage class - #known.tc <- comland[TONCL1 != 0, sum(SPPLIVMT), by = NESPP3] - #unknown.tc <- comland[TONCL1 == 0, sum(SPPLIVMT), by = NESPP3] - #data.table::setnames(known.tc, "V1", "TC.MT.known") - #data.table::setnames(unknown.tc, "V1", "TC.MT.unknown") - #missing.table <- merge(missing.table, known.tc, by = 'NESPP3', all = T) - #missing.table <- merge(missing.table, unknown.tc, by = 'NESPP3', all = T) - # - #missing.table[is.na(TC.MT.known), TC.MT.known := 0] - #missing.table[is.na(TC.MT.unknown), TC.MT.unknown := 0] - #missing.table[, TC.Ratio := TC.MT.unknown / TC.MT.known] - # - #write.csv(missing.table, paste(out.dir, "\\Missing_table.csv", sep = ''), row.names = F) - # - return(comland) -} diff --git a/R/oldfunctions/comland_winter_little.R b/R/oldfunctions/comland_winter_little.R deleted file mode 100644 index a488dc8..0000000 --- a/R/oldfunctions/comland_winter_little.R +++ /dev/null @@ -1,81 +0,0 @@ -#'#Comcatch_skates_hakes.r -#' -#'Determine proportion of little/winter skates and silver hake in landings data 7/13 -#'SML -#' -#'@param comland Data frame. Master data frame containing species landings -#'@param skate.hake.us Data frame. Landings of skates and hakes in USA -#' -#'@return updated comland -#' -#'@importFrom data.table ":=" "key" -#' -#' @noRd - -comland_winter_little <- function(comland,skate.hake.us) { - - #get little skates and winter skates from skates(ns) - use survey in half years - #Generate Half year variable in comland - comland.skates <- comland[NESPP3 == 365, ] - comland.skates[MONTH %in% 1:6, Half := 1] - comland.skates[MONTH %in% 7:12, Half := 2] - - data.table::setkey(skate.hake.us, - YEAR, - Half, - AREA) - #beet - #comland.skates$AREA <- as.integer(comland.skates$AREA) - - - comland.skates <- merge(comland.skates, skate.hake.us, by = data.table::key(skate.hake.us), all.x = T) - - - #return(comland.skates) - - comland.skates[, little := little.per * SPPLIVMT] - comland.skates[, little.value := round(little.per * SPPVALUE)] - comland.skates[is.na(little), little := 0] - comland.skates[is.na(little.value), little.value := 0] - - comland.skates[, winter := winter.per * SPPLIVMT] - comland.skates[, winter.value := round(winter.per * SPPVALUE)] - comland.skates[is.na(winter), winter := 0] - comland.skates[is.na(winter.value), winter.value := 0] - - comland.skates[, other.skate := SPPLIVMT - (little + winter)] - comland.skates[, other.skate.value := SPPVALUE - (little.value + winter.value)] - - #Little (366), winter (367), skates(ns) (365) - #put skates in comland format to merge back - little <- comland.skates[, list(YEAR, Half, AREA, MONTH, NEGEAR, - TONCL1, NESPP3, UTILCD, MKTCAT, little, - little.value)] - little[, NESPP3 := 366] - data.table::setnames(little, c('little', 'little.value'), c('SPPLIVMT', 'SPPVALUE')) - little <- little[SPPLIVMT > 0, ] - - winter <- comland.skates[, list(YEAR, Half, AREA, MONTH, NEGEAR, - TONCL1, NESPP3, UTILCD, MKTCAT, winter, - winter.value)] - winter[, NESPP3 := 367] - data.table::setnames(winter, c('winter', 'winter.value'), c('SPPLIVMT', 'SPPVALUE')) - winter <- winter[SPPLIVMT > 0, ] - - other <- comland.skates[, list(YEAR, Half, AREA, MONTH, NEGEAR, - TONCL1, NESPP3, UTILCD, MKTCAT, other.skate, - other.skate.value)] - other[, NESPP3 := 365] - data.table::setnames(other, c('other.skate', 'other.skate.value'), c('SPPLIVMT', 'SPPVALUE')) - other <- other[SPPLIVMT > 0, ] - - #merge all three and reformat for comland - skates.add.back <- data.table::rbindlist(list(little, winter, other)) - - skates.add.back[, Half := NULL] - data.table::setcolorder(skates.add.back, names(comland)) - - comland <- data.table::rbindlist(list(comland[NESPP3 != 365, ], skates.add.back)) -return(comland) - -} diff --git a/R/process_foreign_data.R b/R/process_foreign_data.R index 3051032..d6a2bb3 100644 --- a/R/process_foreign_data.R +++ b/R/process_foreign_data.R @@ -8,10 +8,8 @@ #' Fills in missing data by including from 21A (SS EPU only) #' #' -#'@param channel an Object inherited from \link[DBI]{DBIConnection-class}. This object is used to connect -#' to communicate with the database engine. (see \code{\link[dbutils]{connect_to_database}}) -#'@param nafoland Data frame. output from \code{\url{get_foreign_data}} -#'@param EPUs Data frame. Currently a place holder +#'@inheritParams get_comland_data +#'@param nafoland Data frame. output from \code{\link{get_foreign_data}} #' #' #'@return Data frame: NAFO data diff --git a/README.md b/README.md index 268a0b1..bfceb98 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# comlandr +# comlandr [![gh-pages](https://github.com/NOAA-EDAB/comlandr/workflows/gh-pages/badge.svg)](https://github.com/NOAA-EDAB/comlandr/actions) diff --git a/data/GEARs.rda b/data/GEARs.rda deleted file mode 100644 index 5df3550..0000000 Binary files a/data/GEARs.rda and /dev/null differ diff --git a/man/comlandr-package.Rd b/man/comlandr-package.Rd new file mode 100644 index 0000000..3f5bb21 --- /dev/null +++ b/man/comlandr-package.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/comlandr.R +\docType{package} +\name{comlandr-package} +\alias{comlandr} +\alias{comlandr-package} +\title{comlandr: Pull and process commercial fisheries data} +\description{ +Suite of functions to pull and process landings and discard data in addition to +helper function to pull lookup tables +} +\details{ +\itemize{ +\item Pulls data from StockEff: by area, gear, species, year, month +\item pulls Herring data from state of Maine database +\item Defines fleet structure and assigns fleets to gear types +\item Define geographic areas and assigns statistical areas to geographic areas +\item Assigns landings to unknown gear, area, quarter/half year, size based on similar trips (based on M Palmer, ????) +\item Pulls and processes NAFO (Northwest Atlantic Fisheries Organization) data +\item Uses survey data to apportion hake complex into species +\item Uses survey data to apportion skate complex into species +\item Ajusts species value to specified date +} +} +\section{References}{ + + +Palmer, M (????) Working doc reference and title + +NAFO website: \url{https://www.nafo.int} + +To learn more about using \code{comlandr}, visit \url{https://noaa-edab.github.io/comlandr/articles/comlandr.html} or click the index below +} + +\seealso{ +Useful links: +\itemize{ + \item \url{https://github.com/NOAA-EDAB/comlandr} + \item Report bugs at \url{https://github.com/NOAA-EDAB/comlandr/issues} +} + +} +\author{ +\strong{Maintainer}: Andy Beet \email{andrew.beet@noaa.gov} (\href{https://orcid.org/0000-0001-8270-7090}{ORCID}) + +Authors: +\itemize{ + \item Sean Lucey +} + +} +\keyword{internal} diff --git a/man/figures/logo.png b/man/figures/logo.png new file mode 100644 index 0000000..ff87ff5 Binary files /dev/null and b/man/figures/logo.png differ diff --git a/man/get_areas.Rd b/man/get_areas.Rd index 48aa058..c0da93e 100644 --- a/man/get_areas.Rd +++ b/man/get_areas.Rd @@ -7,7 +7,7 @@ get_areas(channel, areas = "all") } \arguments{ -\item{channel}{an Object inherited from \link[DBI]{DBIConnection-class}. This object is used to connect +\item{channel}{an Object inherited from \code{\link[ROracle]{Oracle}}. This object is used to connect to communicate with the database engine. (see \code{\link[dbutils]{connect_to_database}})} \item{areas}{a specific area code or set of codes. Either numeric or character vector. Defaults to "all" areas diff --git a/man/get_comdisc_data.Rd b/man/get_comdisc_data.Rd index 08e0618..af11e2f 100644 --- a/man/get_comdisc_data.Rd +++ b/man/get_comdisc_data.Rd @@ -16,22 +16,22 @@ get_comdisc_data( ) } \arguments{ -\item{channel}{an Object inherited from \code{ROracle}. This object is used to connect +\item{channel}{an Object inherited from \code{\link[ROracle]{Oracle}}. This object is used to connect to communicate with the database engine. (see \code{\link[dbutils]{connect_to_database}})} \item{comland}{Data frame. Result of \code{get_comland_data}} -\item{aggArea}{boolean} +\item{aggArea}{boolean. Aggregate Statistical Areas into larger spatial units (Default = F)} -\item{areaDescription}{character string} +\item{areaDescription}{character string. Field name in \code{userAreas} denoting spatial unit. (Default = "EPU")} -\item{propDescription}{character string} +\item{propDescription}{character string. Field name in \code{userAreas} denoting the scaling factor. (Default = "MeanProp")} -\item{aggGear}{boolean} +\item{aggGear}{boolean. Aggregate NEGEAR codes to larger "fleets" (Default = F)} -\item{fleetDescription}{character string} +\item{fleetDescription}{character string. Field name in \code{userGears} denoting Fleet. (Default = "Fleet")} -\item{extendsTS}{Boolean. Should the DK (Discard to kept) ratio be extended and applied +\item{extendTS}{Boolean. Should the DK (Discard to kept) ratio be extended and applied to landings beyond observer coverage time period (Discards started in 1989). Default = T} } \value{ @@ -53,9 +53,3 @@ Each row of the data.table represents a species record for a given tow/trip Connects to obdbs and pulls discard data, calculates discard to kept ratios, and applies to landings data obtained using \code{get_comland_data}. } -\section{File Creation}{ - - -A file containing the data.table above will also be saved to the users machine in the directory provided -} - diff --git a/man/get_comdisc_raw_data.Rd b/man/get_comdisc_raw_data.Rd index 8410e06..fb0855c 100644 --- a/man/get_comdisc_raw_data.Rd +++ b/man/get_comdisc_raw_data.Rd @@ -7,10 +7,10 @@ get_comdisc_raw_data(channel, filterByYear) } \arguments{ -\item{channel}{an Object inherited from \code{ROracle}. This object is used to connect +\item{channel}{an Object inherited from \code{\link[ROracle]{Oracle}}. This object is used to connect to communicate with the database engine. (see \code{\link[dbutils]{connect_to_database}})} -\item{filterByYear}{numeric vector} +\item{filterByYear}{numeric vector. Years to retrieve data for (Default = NA, pull all years)} } \value{ Data frame (data.table) (n x 10) @@ -30,9 +30,3 @@ Each row of the data.table represents a species record for a given tow/trip \description{ Connects to obdbs and pulls fields from OBSPP, OBINC, ASMSPP, and ASMINC } -\section{File Creation}{ - - -A file containing the data.table above will also be saved to the users machine in the directory provided -} - diff --git a/man/get_comland_data.Rd b/man/get_comland_data.Rd index 40c0211..b338ce5 100644 --- a/man/get_comland_data.Rd +++ b/man/get_comland_data.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/get_comland_data.R \name{get_comland_data} \alias{get_comland_data} -\title{Extracts commercial data from Database} +\title{Extracts and processes commercial data from Database} \usage{ get_comland_data( channel, @@ -29,48 +29,48 @@ get_comland_data( ) } \arguments{ -\item{channel}{an Object inherited from \code{ROracle}. This object is used to connect +\item{channel}{an Object inherited from \code{\link[ROracle]{Oracle}}. This object is used to connect to communicate with the database engine. (see \code{\link[dbutils]{connect_to_database}})} -\item{filterByYear}{numeric vector} +\item{filterByYear}{numeric vector. Years to retrieve data for (Default = NA, pull all years)} -\item{filterByArea}{numeric vector} +\item{filterByArea}{numeric vector. Statistical Areas to retrieve data for (Default = NA, pull all areas)} -\item{useLanded}{boolean} +\item{useLanded}{boolean. Default = T} -\item{removeParts}{boolean} +\item{removeParts}{boolean. Remove species parts (Heads, wings, etc), Default = T} -\item{useHerringMaine}{boolean} +\item{useHerringMaine}{boolean. Pull data from Maine Herring database or use herring data in commercial landings database (Default = T)} -\item{useForeign}{boolean} +\item{useForeign}{boolean. Pull foreign data from NAFO. Default = T} -\item{refYear}{numeric} +\item{refYear}{numeric. Reference year to use when adjusting species value} -\item{refMonth}{numeric} +\item{refMonth}{numeric. Reference month to use when adjusting species value} -\item{aggArea}{boolean} +\item{disagSkatesHakes}{boolean. Partition skates and hake unclassified landings into species (Default = T)} -\item{userAreas}{data frame} +\item{aggArea}{boolean. Aggregate Statistical Areas into larger spatial units (Default = F)} -\item{areaDescription}{character string} +\item{userAreas}{data frame. Spatial units in which Statistical areas should be aggregated (eg. \code{\link{mskeyAreas}})} -\item{propDescription}{character string} +\item{areaDescription}{character string. Field name in \code{userAreas} denoting spatial unit. (Default = "EPU")} -\item{applyPropLand}{boolean} +\item{propDescription}{character string. Field name in \code{userAreas} denoting the scaling factor. (Default = "MeanProp")} -\item{applyPropValue}{boolean} +\item{applyPropLand}{boolean. Apply the proportions in userAreas to the landings (Default = F)} -\item{aggGear}{boolean} +\item{applyPropValue}{boolean. Apply the proportions in userAreas to the value (Default = F)} -\item{userGears}{data frame} +\item{aggGear}{boolean. Aggregate NEGEAR codes to larger "fleets" (Default = F)} -\item{fleetDescription}{character string} +\item{userGears}{data frame. Fleet designations in which NEGEAR codes should be grouped (eg. \code{\link{mskeyGears}})} -\item{unkVar}{character vector} +\item{fleetDescription}{character string. Field name in \code{userGears} denoting Fleet. (Default = "Fleet")} -\item{knStrata}{character vector} +\item{unkVar}{character vector. Variables in the data, with have missing values, that you wish to assign a value to} -\item{disaggSkatesHakes}{boolean} +\item{knStrata}{character vector. Variables in the data that you wish to use to use to assign values to \code{unkVar}} } \value{ Data frame (data.table) (n x 12) @@ -78,7 +78,7 @@ Each row of the data.table represents a species record for a given tow/trip \item{YEAR}{Year of trip/tow} \item{MONTH}{Month of trip/tow} -\item{NEGEAR}{Fishing gear used on trip/tow} +\item{NEGEAR/Fleet}{Fishing gear used on trip/tow or aggregated to Fleet} \item{TONCL2}{Tonnage class of the fishing vessel (2 digit value)} \item{NESPP3}{Species code (3 charachters)} \item{MARKET_CODE}{market code (2 characters)} @@ -86,15 +86,14 @@ Each row of the data.table represents a species record for a given tow/trip \item{AREA/EPU}{Statistical area/ Ecological Production Unit in which species was reportly caught} \item{UTILCD}{Utilization code} \item{US}{Landing from the USA vessels or foreign vessels} -\item{SPPLIVLB}{live weight (landed = "n") or landed weight (landed="y") in lbs} +\item{SPPLIVMT}{Weight in metric tons.} \item{SPPVALUE}{The value of landed catch to the nearest dollar (U.S.), paid to fisherman by dealer, for a given species.} } \description{ -Connects to cfdbs and pulls fields from WOLANDS, WODETS, CFDETS +Connects to Population dynamics Database STOCKEFF to pull US landings data. +Data is also pulled from NAFO (foreign landings) and the State of Maine (Herring). +These sources of data are then aggregated, species value is adjusted to a user defined reference year, +skate and hake landings (often reported as an unclassified category) are split based on bottom trawl survey, +and missing values are imputed. For more information regarding these methods +see \code{vignette("Overview", package = "comlandr")} } -\section{File Creation}{ - - -A file containing the data.table above will also be saved to the users machine in the directory provided -} - diff --git a/man/get_comland_raw_data.Rd b/man/get_comland_raw_data.Rd index 17846b2..12aeb04 100644 --- a/man/get_comland_raw_data.Rd +++ b/man/get_comland_raw_data.Rd @@ -13,16 +13,16 @@ get_comland_raw_data( ) } \arguments{ -\item{channel}{an Object inherited from \code{ROracle}. This object is used to connect +\item{channel}{an Object inherited from \code{\link[ROracle]{Oracle}}. This object is used to connect to communicate with the database engine. (see \code{\link[dbutils]{connect_to_database}})} -\item{filterByYear}{numeric vector} +\item{filterByYear}{numeric vector. Years to retrieve data for (Default = NA, pull all years)} -\item{filterByArea}{numeric vector} +\item{filterByArea}{numeric vector. Statistical Areas to retrieve data for (Default = NA, pull all areas)} -\item{useLanded}{boolean} +\item{useLanded}{boolean. Default = T} -\item{removeParts}{boolean} +\item{removeParts}{boolean. Remove species parts (Heads, wings, etc), Default = T} } \value{ Data frame (data.table) (n x 10) @@ -31,20 +31,15 @@ Each row of the data.table represents a species record for a given tow/trip \item{YEAR}{Year of trip/tow} \item{MONTH}{Month of trip/tow} \item{NEGEAR}{Fishing gear used on trip/tow} -\item{TONCL1}{Tonnage class of the fishing vessel} +\item{TONCL2}{Two digit Tonnage class code of the fishing vessel} \item{NESPP3}{Species code (3 charachters)} \item{NESPP4}{Species code and market code (4 characters)} \item{AREA}{Statistical area in which species was reportly caught} \item{UTILCD}{Utilization code} -\item{SPPLIVLB}{live weight (landed = "n") or landed weight (landed="y") in lbs} +\item{SPPLIVMT}{live weight (landed = "n") or landed weight (landed="y") in lbs} \item{SPPVALUE}{The value of landed catch to the nearest dollar (U.S.), paid to fisherman by dealer, for a given species.} } \description{ -Connects to cfdbs and pulls fields from WOLANDS, WODETS, CFDETS +Connects to Population dynamics Database STOCKEFF. This database contains the information +from from WOLANDS, WODETS, CFDETS and CAMS. } -\section{File Creation}{ - - -A file containing the data.table above will also be saved to the users machine in the directory provided -} - diff --git a/man/get_foreign_data.Rd b/man/get_foreign_data.Rd index c244b1c..5fe1f11 100644 --- a/man/get_foreign_data.Rd +++ b/man/get_foreign_data.Rd @@ -35,5 +35,8 @@ Data frame: NAFO data \item{NESPP3}{NEFSC species code} } \description{ -Downloads, imports, aggregates NAFO data +Downloads, imports, aggregates NAFO data from 21B data base +} +\seealso{ +NAFO 21B website: \url{https://www.nafo.int/Data/Catch-Statistics-STATLANT-21B} } diff --git a/man/get_gears.Rd b/man/get_gears.Rd index 0d824b5..534ec48 100644 --- a/man/get_gears.Rd +++ b/man/get_gears.Rd @@ -7,7 +7,7 @@ get_gears(channel, gears = "all") } \arguments{ -\item{channel}{DBI Object. Inherited from \link[DBI]{DBIConnection-class}. This object is used to connect +\item{channel}{an Object inherited from \code{\link[ROracle]{Oracle}}. This object is used to connect to communicate with the database engine. (see \code{\link[dbutils]{connect_to_database}})} \item{gears}{specific gear code or set of codes. Either numeric or character vector. Defaults to "all" gears. diff --git a/man/get_herring_data.Rd b/man/get_herring_data.Rd new file mode 100644 index 0000000..9a387e6 --- /dev/null +++ b/man/get_herring_data.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_herring_data.R +\name{get_herring_data} +\alias{get_herring_data} +\title{Pull Herring data} +\usage{ +get_herring_data(channel, comland, filterByYear, filterByArea, useForeign) +} +\arguments{ +\item{channel}{an Object inherited from \code{\link[ROracle]{Oracle}}. This object is used to connect +to communicate with the database engine. (see \code{\link[dbutils]{connect_to_database}})} + +\item{comland}{Data frame. master data frame containing species landings} + +\item{filterByYear}{numeric vector. Years to retrieve data for (Default = NA, pull all years)} + +\item{filterByArea}{numeric vector. Statistical Areas to retrieve data for (Default = NA, pull all areas)} + +\item{useForeign}{boolean. Pull foreign data from NAFO. Default = T} +} +\value{ +Processed Herring data added to comland +} +\description{ +Herring Data comes from the state of Maine and replaces the herring data from StockEff (since +it is incomplete). Pulled from NEFSC_GARFO.maine_herring_catch +} diff --git a/man/get_locations.Rd b/man/get_locations.Rd index c51eacd..c029243 100644 --- a/man/get_locations.Rd +++ b/man/get_locations.Rd @@ -7,8 +7,8 @@ get_locations(channel, sqlStatement = "select * from cfdbs.loc") } \arguments{ -\item{channel}{DBI Object. Inherited from \link[DBI]{DBIConnection-class}. This object is used to connect -to communicate with the database engine. (see \code{\link{connect_to_database}})} +\item{channel}{an Object inherited from \code{\link[ROracle]{Oracle}}. This object is used to connect +to communicate with the database engine. (see \code{\link[dbutils]{connect_to_database}})} \item{sqlStatement}{Character string. An sql statement (optional). If no \code{sqlStatement} is provided the default sql statement "\code{select * from cfdbs.loc}" is used} diff --git a/man/get_ports.Rd b/man/get_ports.Rd index 358bc4b..aec88bd 100644 --- a/man/get_ports.Rd +++ b/man/get_ports.Rd @@ -7,7 +7,7 @@ get_ports(channel, ports = "all") } \arguments{ -\item{channel}{DBI Object. Inherited from \link[DBI]{DBIConnection-class}. This object is used to connect +\item{channel}{an Object inherited from \code{\link[ROracle]{Oracle}}. This object is used to connect to communicate with the database engine. (see \code{\link[dbutils]{connect_to_database}})} \item{ports}{a specific port code or set of codes. Either numeric or character vector. Defaults to "all" ports. diff --git a/man/get_species.Rd b/man/get_species.Rd index cf14db7..044c613 100644 --- a/man/get_species.Rd +++ b/man/get_species.Rd @@ -7,7 +7,7 @@ get_species(channel, species = "all") } \arguments{ -\item{channel}{DBI Object. Inherited from \link[DBI]{DBIConnection-class}. This object is used to connect +\item{channel}{an Object inherited from \code{\link[ROracle]{Oracle}}. This object is used to connect to communicate with the database engine. (see \code{\link[dbutils]{connect_to_database}})} \item{species}{a specific species code or set of codes. Either numeric or character vector. (NESPP3 codes) diff --git a/man/get_species_itis.Rd b/man/get_species_itis.Rd index efa7255..adf6855 100644 --- a/man/get_species_itis.Rd +++ b/man/get_species_itis.Rd @@ -7,8 +7,8 @@ get_species_itis(channel, species = "all", nameType = "common_name") } \arguments{ -\item{channel}{DBI Object. Inherited from \link[DBI]{DBIConnection-class}. This object is used to connect -to communicate with the database engine. (see \code{\link{connect_to_database}})} +\item{channel}{an Object inherited from \code{\link[ROracle]{Oracle}}. This object is used to connect +to communicate with the database engine. (see \code{\link[dbutils]{connect_to_database}})} \item{species}{A specific species code or set of codes. Either numeric or character vector. Defaults to "all" species. Numeric codes (SPECIES_ITIS, NESPP4) are converted to VARCHAR2 (6 and 4 characters respectively) when creating the sql statement.} diff --git a/man/get_vessels.Rd b/man/get_vessels.Rd index efec5e2..f7deda4 100644 --- a/man/get_vessels.Rd +++ b/man/get_vessels.Rd @@ -11,7 +11,7 @@ get_vessels( ) } \arguments{ -\item{channel}{DBI Object. Inherited from \link[DBI]{DBIConnection-class}. This object is used to connect +\item{channel}{an Object inherited from \code{\link[ROracle]{Oracle}}. This object is used to connect to communicate with the database engine. (see \code{\link[dbutils]{connect_to_database}})} \item{sqlStatement}{an sql statement (optional)} diff --git a/man/process_foreign_data.Rd b/man/process_foreign_data.Rd index b59edb3..5dd8969 100644 --- a/man/process_foreign_data.Rd +++ b/man/process_foreign_data.Rd @@ -7,12 +7,14 @@ process_foreign_data(channel, nafoland, useLanded = T, useHerringMaine = T) } \arguments{ -\item{channel}{an Object inherited from \link[DBI]{DBIConnection-class}. This object is used to connect +\item{channel}{an Object inherited from \code{\link[ROracle]{Oracle}}. This object is used to connect to communicate with the database engine. (see \code{\link[dbutils]{connect_to_database}})} -\item{nafoland}{Data frame. output from \code{\url{get_foreign_data}}} +\item{nafoland}{Data frame. output from \code{\link{get_foreign_data}}} -\item{EPUs}{Data frame. Currently a place holder} +\item{useLanded}{boolean. Default = T} + +\item{useHerringMaine}{boolean. Pull data from Maine Herring database or use herring data in commercial landings database (Default = T)} } \value{ Data frame: NAFO data diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index 2f687da..eda9d99 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -19,6 +19,7 @@ reference: - get_foreign_data - get_comdisc_data - get_comdisc_raw_data + - get_herring_data - get_species - get_species_itis - get_areas @@ -48,6 +49,8 @@ navbar: articles: text: Help menu: + - text: Overview of package + href: articles/Overview.html - text: Foreign Data (NAFO) - text: NAFO Data structure href: articles/ForeignCatch.html diff --git a/vignettes/Overview.Rmd b/vignettes/Overview.Rmd new file mode 100644 index 0000000..59eb4c1 --- /dev/null +++ b/vignettes/Overview.Rmd @@ -0,0 +1,37 @@ +--- +title: "Overview" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Overview} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + + +We will attempt to summarise the data sources, methods, assumptions made, and the caveats of note in the `comlandr` package. + +## Data sources + +### Commercial landings + +### Herring landings + +### Foreign landings + + +## Processing steps + +## Discards + +## Caveats + +* Although US landings data (SPPLIVLB) pulled from STOCKEFF can be retrieved from as early as 1964, species value (SPPVALUE) is only available from 1982. Prior to this date the value can not be reliably validated. + +* Menhaden landings are not complete in the commercial database.