From 7d4c5a5f751c3cf643de50b32170636d2699331f Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Sun, 28 Feb 2021 23:06:02 -0500 Subject: [PATCH 01/60] changed get_comland_data to include raw and simplified --- R/get_comland_raw_data.R | 119 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 119 insertions(+) create mode 100644 R/get_comland_raw_data.R diff --git a/R/get_comland_raw_data.R b/R/get_comland_raw_data.R new file mode 100644 index 0000000..d1d4ab7 --- /dev/null +++ b/R/get_comland_raw_data.R @@ -0,0 +1,119 @@ +#' Extracts commercial data from Database +#' +#' Connects to cfdbs and pulls fields from WOLANDS, WODETS, CFDETS +#' +#'@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 endyear Numeric Scalar. Final year of query. +#'@param landed Character String. Use landed weight ("y" - meatwt) for scallops and clams instead of live weight ("n" - livewt). +#'@param out.dir path to directory where final output will be saved +#' +#' +#'@return Data frame (data.table) (n x 10) +#'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{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{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, useLanded = T, + removeParts = T){ + + call <- capture_function_call() + + message("Pulling landings data from database. This could take a while (> 1 hour) ... ") + + #Generate vector of tables to loop through + if(any(filterByYear < 1964)) stop("Landings data start in 1964") + + tables <- as.numeric(c(substr(filterByYear[which(filterByYear <= 1993)], 3, 4), + filterByYear[which(filterByYear > 1993)])) + tables[which(tables > 1993)] <- paste0('CFDETS', tables[which(tables > 1993)], 'AA') + tables[which(tables > 63 & tables <= 81)] <- paste0('WOLANDS', tables[which(tables > 63 & tables <= 81)]) + tables[which(tables > 81 & tables <= 93)] <- paste0('WODETS', tables[which(tables > 81 & tables <= 93)]) + + #output objects + comland <- c() + sql <- c() + + for(itab in 1:length(tables)){ + #Data query + landings.qry <- paste("select year, month, negear, toncl1, nespp3, nespp4, area, + spplivlb, spplndlb, sppvalue, utilcd + from", tables[itab]) + sql <- c(sql, landings.qry) + + comland.yr <- data.table::as.data.table(DBI::dbGetQuery(channel, landings.qry)) + + # Use landed weight instead of live weight for shellfish + if(useLanded) {comland.yr[NESPP3 %in% 743:800, SPPLIVLB := SPPLNDLB]} + + # Remove fish parts so live weight is not double counted + if(removeParts){ + comland <- comland[!NESPP4 %in% c(119, 123, 125, 127, 812, 819, 828, 829, 1731, + 2351, 2690, 2699, 3472, + as.numeric(paste0(348:359, 8)), 3868, + as.numeric(paste0(469:471, 4)), + as.numeric(paste0(480:499, 8)), 5018, 5039, + 5261, 5265), ] + } + + #Sum landings and value + data.table::setkey(comland.yr, + YEAR, + MONTH, + NEGEAR, + TONCL1, + NESPP3, + AREA, + UTILCD) + #landings + comland.yr[, V1 := sum(SPPLIVLB, na.rm = T), by = key(comland.yr)] + #value + comland.yr[, V2 := sum(SPPVALUE, na.rm = T), by = key(comland.yr)] + + #Remove extra rows/columns + comland.yr <- unique(comland.yr, by = key(comland.yr)) + comland.yr[, c('SPPLIVLB', 'SPPLNDLB', 'SPPVALUE', 'NESPP4') := NULL] + + #Rename summed columns + data.table::setnames(comland.yr, c('V1', 'V2'), c('SPPLIVLB', 'SPPVALUE')) + + comland <- data.table::rbindlist(list(comland, comland.yr)) + + message("Pulled data from ",tables[itab]," ...") + + } + + #Convert number fields from chr to num + numberCols <- c('YEAR', 'MONTH', 'NEGEAR', 'TONCL1', 'NESPP3', 'NESPP4', 'UTILCD', + 'AREA') + comland[, (numberCols):= lapply(.SD, as.numeric), .SDcols = numberCols][] + + #Adjust pounds to metric tons + comland[, SPPLIVMT := SPPLIVLB * 0.00045359237] + comland[, SPPLIVLB := NULL] + + #standardize YEAR field + comland[YEAR < 100, YEAR := YEAR + 1900L] + + + return(list(comland = comland[], + sql = sql, + pullDate = date(), + functionCall = call)) +} + From 49252c2632f3d6bfae35ba1435f71c0ca28b4f95 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Tue, 2 Mar 2021 22:32:31 -0500 Subject: [PATCH 02/60] New function for getting state of Maine herring data --- R/get_herring_data.R | 123 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 123 insertions(+) create mode 100644 R/get_herring_data.R diff --git a/R/get_herring_data.R b/R/get_herring_data.R new file mode 100644 index 0000000..52e9249 --- /dev/null +++ b/R/get_herring_data.R @@ -0,0 +1,123 @@ +#' 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 + +get_herring_data <- function(channel, comland, filterByYear) { + + call <- c(comland$call, capture_function_call()) + + #Pulling data + message("Pulling Atlantic herring data from maine_herring_catch ...") + + if(is.na(filterByYear[1])){ + years <- ">= 1963" + }else{ + years <- paste0("in (", survdat:::sqltext(filterByYear), ")") + } + + herr.qry <- paste0("select year, month, stock_area, negear, gearname, keptmt, discmt + from maine_herring_catch + where year ", years) + + sql <- c(comland$sql, herr.qry) + + #pull out comland data + comland <- comland$comland + + herr.catch <- data.table::as.data.table(DBI::dbGetQuery(channel, herr.qry)) + + #Convert number fields from chr to num + numberCols <- c('YEAR', 'MONTH', 'STOCK_AREA', 'NEGEAR', 'GEARNAME') + herr.catch[, (numberCols):= lapply(.SD, as.numeric), .SDcols = numberCols] + + #Aggregate data + data.table::setkey(herr.catch, YEAR, MONTH, STOCK_AREA, NEGEAR) + + herring <- herr.catch[, list(sum(KEPTMT, na.rm = T), sum(DISCMT, na.rm = T)), + 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 := 3] + + herring[, UTILCD := 0] + + #compute price/utilization from CF tables + herring.comland <- comland[NESPP3 == 168, ] + + #Price from comland + herring.price <- herring.comland[, (sum(SPPVALUE, na.rm = T) / sum(SPPLIVMT, na.rm = T)), + 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(list(comland = comland[], + sql = sql, + pullDate = date(), + functionCall = call)) + +} From 4c98495b4c87e13269f6f45ad298012e31c65954 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Tue, 2 Mar 2021 22:43:34 -0500 Subject: [PATCH 03/60] Added other list objects to output --- R/adjust_inflation.R | 22 ++++++++++++++++++---- 1 file changed, 18 insertions(+), 4 deletions(-) diff --git a/R/adjust_inflation.R b/R/adjust_inflation.R index 9cd6f97..f15b0db 100644 --- a/R/adjust_inflation.R +++ b/R/adjust_inflation.R @@ -6,8 +6,8 @@ #' #' #'@param comland Data frame. master data frame containing species landings -#'@param refmonth Integer. Reference month -#'@param refyear Integer. Reference year +#'@param refMonth Integer. Reference month +#'@param refYear Integer. Reference year #' #'@return comland data frame adjusted for inflation #' @@ -16,7 +16,17 @@ -adjust_inflation <- function(comland,refyear,refmonth){ +adjust_inflation <- function(comland, refYear, refMonth){ + + call <- c(comland$call, capture_function_call()) + + #Pulling data + message("Adjusting for inflation ...") + + #pull out comland data + sql <- comland$sql + comland <- comland$comland + temp <- tempfile() download.file("http://download.bls.gov/pub/time.series/wp/wp.data.3.ProcessedFoods", temp) inflate <- data.table::as.data.table(read.delim(temp)) @@ -37,5 +47,9 @@ adjust_inflation <- function(comland,refyear,refmonth){ #Remove extra column comland[, PPI := NULL] - return(comland) + + return(list(comland = comland[], + sql = sql, + pullDate = date(), + functionCall = call)) } From 77e3dfbcd27b1b2545d953fe06dc4308130e510e Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Wed, 3 Mar 2021 16:30:12 -0500 Subject: [PATCH 04/60] removed capture call and fixed comland.yr error --- R/get_comland_raw_data.R | 20 ++++++++------------ 1 file changed, 8 insertions(+), 12 deletions(-) diff --git a/R/get_comland_raw_data.R b/R/get_comland_raw_data.R index d1d4ab7..9554fce 100644 --- a/R/get_comland_raw_data.R +++ b/R/get_comland_raw_data.R @@ -31,8 +31,6 @@ get_comland_raw_data <- function(channel, filterByYear = NA, useLanded = T, removeParts = T){ - - call <- capture_function_call() message("Pulling landings data from database. This could take a while (> 1 hour) ... ") @@ -63,12 +61,12 @@ get_comland_raw_data <- function(channel, filterByYear = NA, useLanded = T, # Remove fish parts so live weight is not double counted if(removeParts){ - comland <- comland[!NESPP4 %in% c(119, 123, 125, 127, 812, 819, 828, 829, 1731, - 2351, 2690, 2699, 3472, - as.numeric(paste0(348:359, 8)), 3868, - as.numeric(paste0(469:471, 4)), - as.numeric(paste0(480:499, 8)), 5018, 5039, - 5261, 5265), ] + comland.yr <- comland.yr[!NESPP4 %in% c(119, 123, 125, 127, 812, 819, 828, + 829, 1731, 2351, 2690, 2699, 3472, + as.numeric(paste0(348:359, 8)), 3868, + as.numeric(paste0(469:471, 4)), + as.numeric(paste0(480:499, 8)), 5018, + 5039, 5261, 5265), ] } #Sum landings and value @@ -111,9 +109,7 @@ get_comland_raw_data <- function(channel, filterByYear = NA, useLanded = T, comland[YEAR < 100, YEAR := YEAR + 1900L] - return(list(comland = comland[], - sql = sql, - pullDate = date(), - functionCall = call)) + return(list(comland = comland[], + sql = sql)) } From 9a7513e30374aab4c56cddfcb5d324f6932284a1 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Wed, 3 Mar 2021 16:30:46 -0500 Subject: [PATCH 05/60] New version calling subfunctions --- R/get_comland_data.R | 88 +++++++++++--------------------------------- 1 file changed, 21 insertions(+), 67 deletions(-) diff --git a/R/get_comland_data.R b/R/get_comland_data.R index a59dae7..2eb8bb8 100644 --- a/R/get_comland_data.R +++ b/R/get_comland_data.R @@ -27,75 +27,29 @@ #' #'A file containing the data.table above will also be saved to the users machine in the directory provided #' +#' #'@export -get_comland_data <- function(channel,landed,endyear,out.dir) { - - - message("Pulling landings data from database. This could take a while (> 1 hour) ... ") - #Landings - tables <- c(paste0('WOLANDS', 64:81), - paste0('WODETS', 82:93), - paste0('CFDETS', 1994:endyear, 'AA')) - - #Generate one table - comland <- c() - for(i in 1:length(tables)){ - landings.qry <- paste("select year, month, negear, toncl1, nespp3, nespp4, area, - spplivlb, spplndlb, sppvalue, utilcd - from", tables[i]) - - comland.yr <- as.data.table(DBI::dbGetQuery(channel, landings.qry)) - - data.table::setkey(comland.yr, - YEAR, - MONTH, - NEGEAR, - TONCL1, - NESPP3, - NESPP4, - AREA, - UTILCD) - - message("Pulled data from ",tables[i]," ...") - - # Use landed weight instead of live weight for shellfish - if(landed == 'y') {comland.yr[NESPP3 %in% 743:800, SPPLIVLB := SPPLNDLB]} - - #Sum landings and value - #landings - comland.yr[, V1 := sum(SPPLIVLB), by = key(comland.yr)] - #value - #Fix null values - comland.yr[is.na(SPPVALUE), SPPVALUE := 0] - comland.yr[, V2 := sum(SPPVALUE), by = key(comland.yr)] - - #Remove extra rows/columns - comland.yr <- unique(comland.yr, by = key(comland.yr)) - comland.yr[, c('SPPLIVLB', 'SPPLNDLB', 'SPPVALUE') := NULL] - - #Rename summed columns - data.table::setnames(comland.yr, c('V1', 'V2'), c('SPPLIVLB', 'SPPVALUE')) - - comland <- data.table::rbindlist(list(comland, comland.yr)) - } - - # save in RODBC format - 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 <- as.factor(comland$AREA) - - - - # Save file. - if(landed == 'n') saveRDS(comland, file = file.path(out.dir, paste0("comland_raw_US_livewt.RDS"))) - if(landed == 'y') saveRDS(comland, file = file.path(out.dir, paste0("comland_raw_US_meatwt.RDS"))) - +get_comland_data <- function(channel, filterByYear = NA, useLanded = T, + removeParts = T, useHerringMaine = T, useForeign = T, + refYear = NA, refMonth = NA) { + + call <- dbutils::capture_function_call() + + #Pull raw data + comland <- comlandr::get_comland_raw_data(channel, filterByYear, useLanded, + removeParts) + + #Pull herring data from the state of Maine + if(useHerringMaine) comland <- comlandr::get_herring_data(channel, comland, + filterByYear) + + #Pull foreign landings + if(useForeign) comland <- comlandr::get_foreign_data(channel, comland, filterByYear) + + #Apply correction for inflation + if(!is.na(refYear)) comland <- comlandr::adjust_inflation(comland, refYear, refMonth) + return(comland) } From 6f2c600292ee2629e16685becf365fb16f83496c Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Wed, 3 Mar 2021 16:31:27 -0500 Subject: [PATCH 06/60] Added sqltext function from survdat --- R/sqltext.R | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) create mode 100644 R/sqltext.R diff --git a/R/sqltext.R b/R/sqltext.R new file mode 100644 index 0000000..4f143bf --- /dev/null +++ b/R/sqltext.R @@ -0,0 +1,18 @@ +#' Convert output to text for DB query +#' +#' @param x +#' +#' Not exported +#' @noRd + +sqltext <- function(x){ + out <- x[1] + if(length(x) > 1){ + for(i in 2:length(x)){ + out <- paste(out, x[i], sep = "','") + } + } + out <- paste("'", out, "'", sep = '') + return(out) +} + From 19c560222dc308aee8c90301e94204589a79af7d Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Wed, 3 Mar 2021 16:48:32 -0500 Subject: [PATCH 07/60] Fixed NESPP4 null error --- R/get_comland_raw_data.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/get_comland_raw_data.R b/R/get_comland_raw_data.R index 9554fce..38a0402 100644 --- a/R/get_comland_raw_data.R +++ b/R/get_comland_raw_data.R @@ -97,8 +97,7 @@ get_comland_raw_data <- function(channel, filterByYear = NA, useLanded = T, } #Convert number fields from chr to num - numberCols <- c('YEAR', 'MONTH', 'NEGEAR', 'TONCL1', 'NESPP3', 'NESPP4', 'UTILCD', - 'AREA') + numberCols <- c('YEAR', 'MONTH', 'NEGEAR', 'TONCL1', 'NESPP3', 'UTILCD', 'AREA') comland[, (numberCols):= lapply(.SD, as.numeric), .SDcols = numberCols][] #Adjust pounds to metric tons From f468c449e95f804244925f0e254cab8711b1f0b4 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Wed, 3 Mar 2021 16:49:55 -0500 Subject: [PATCH 08/60] Added call to output --- R/get_comland_data.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/get_comland_data.R b/R/get_comland_data.R index 2eb8bb8..0d656b8 100644 --- a/R/get_comland_data.R +++ b/R/get_comland_data.R @@ -50,6 +50,8 @@ get_comland_data <- function(channel, filterByYear = NA, useLanded = T, #Apply correction for inflation if(!is.na(refYear)) comland <- comlandr::adjust_inflation(comland, refYear, refMonth) + comland$call <- call + return(comland) } From c49839db9c73d1fded18733849d8612b8535a39d Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Wed, 3 Mar 2021 16:50:44 -0500 Subject: [PATCH 09/60] Added new functions via roxygen --- DESCRIPTION | 2 +- NAMESPACE | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4c55125..503e13b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -12,7 +12,7 @@ Suggests: rmarkdown, testthat VignetteBuilder: knitr -RoxygenNote: 7.1.0 +RoxygenNote: 7.1.1 Imports: data.table, sf, diff --git a/NAMESPACE b/NAMESPACE index 8ed0b51..979b64c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,6 +2,7 @@ export(comland) export(get_comland_data) +export(get_comland_raw_data) export(plot_comland) importFrom(data.table,":=") importFrom(data.table,"as.data.table") From b30393f1e1bf823849003a19d19260c3dd25bf59 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Wed, 3 Mar 2021 16:51:47 -0500 Subject: [PATCH 10/60] Removed date and call from output --- R/get_herring_data.R | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/R/get_herring_data.R b/R/get_herring_data.R index 52e9249..7888417 100644 --- a/R/get_herring_data.R +++ b/R/get_herring_data.R @@ -13,8 +13,6 @@ get_herring_data <- function(channel, comland, filterByYear) { - call <- c(comland$call, capture_function_call()) - #Pulling data message("Pulling Atlantic herring data from maine_herring_catch ...") @@ -115,9 +113,7 @@ get_herring_data <- function(channel, comland, filterByYear) { comland <- data.table::rbindlist(list(comland[NESPP3 != 168, ], herring)) - return(list(comland = comland[], - sql = sql, - pullDate = date(), - functionCall = call)) + return(list(comland = comland[], + sql = sql)) } From ef17bc9a524356818410372003903ad1a824576d Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Wed, 3 Mar 2021 22:20:07 -0500 Subject: [PATCH 11/60] Changed parts to chr and added mktcat --- R/get_comland_raw_data.R | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/R/get_comland_raw_data.R b/R/get_comland_raw_data.R index 38a0402..14649ea 100644 --- a/R/get_comland_raw_data.R +++ b/R/get_comland_raw_data.R @@ -61,12 +61,13 @@ get_comland_raw_data <- function(channel, filterByYear = NA, useLanded = T, # Remove fish parts so live weight is not double counted if(removeParts){ - comland.yr <- comland.yr[!NESPP4 %in% c(119, 123, 125, 127, 812, 819, 828, - 829, 1731, 2351, 2690, 2699, 3472, - as.numeric(paste0(348:359, 8)), 3868, - as.numeric(paste0(469:471, 4)), - as.numeric(paste0(480:499, 8)), 5018, - 5039, 5261, 5265), ] + comland.yr <- comland.yr[!NESPP4 %in% c('0119', '0123', '0125', '0127', + '0812', '0819', '0828', '0829', + '1731', '2351', '2690', '2699', + '3472', paste0(348:359, 8), + '3868', paste0(469:471, 4), + paste0(480:499, 8), '5018', + '5039', '5261', '5265'), ] } #Sum landings and value @@ -82,7 +83,10 @@ get_comland_raw_data <- function(channel, filterByYear = NA, useLanded = T, comland.yr[, V1 := sum(SPPLIVLB, na.rm = T), by = key(comland.yr)] #value comland.yr[, V2 := sum(SPPVALUE, na.rm = T), by = key(comland.yr)] - + + #Create market category + comland.yr[, MKTCAT := substr(NESPP4, 4, 4)] + #Remove extra rows/columns comland.yr <- unique(comland.yr, by = key(comland.yr)) comland.yr[, c('SPPLIVLB', 'SPPLNDLB', 'SPPVALUE', 'NESPP4') := NULL] @@ -97,7 +101,8 @@ get_comland_raw_data <- function(channel, filterByYear = NA, useLanded = T, } #Convert number fields from chr to num - numberCols <- c('YEAR', 'MONTH', 'NEGEAR', 'TONCL1', 'NESPP3', 'UTILCD', 'AREA') + numberCols <- c('YEAR', 'MONTH', 'NEGEAR', 'TONCL1', 'NESPP3', 'UTILCD', 'AREA', + 'MKTCAT') comland[, (numberCols):= lapply(.SD, as.numeric), .SDcols = numberCols][] #Adjust pounds to metric tons From fbc0d00ca43c8a31ad9d988d4c858fdea320397f Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Wed, 3 Mar 2021 22:21:10 -0500 Subject: [PATCH 12/60] Added get_herring_data to exports --- NAMESPACE | 1 + R/get_herring_data.R | 1 + 2 files changed, 2 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 979b64c..c475bab 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,6 +3,7 @@ export(comland) export(get_comland_data) export(get_comland_raw_data) +export(get_herring_data) export(plot_comland) importFrom(data.table,":=") importFrom(data.table,"as.data.table") diff --git a/R/get_herring_data.R b/R/get_herring_data.R index 7888417..d43a161 100644 --- a/R/get_herring_data.R +++ b/R/get_herring_data.R @@ -10,6 +10,7 @@ #'@importFrom data.table ":=" "key" #' #' @noRd +#' @export get_herring_data <- function(channel, comland, filterByYear) { From c59f57319fde769758fa6c800cc5dad9d1f397f5 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Fri, 5 Mar 2021 14:15:28 -0500 Subject: [PATCH 13/60] Added function to disaggregate skates --- NAMESPACE | 1 + R/disaggregate_skates.R | 111 ++++++++++++++++++++++++++++++++++++++++ R/get_comland_data.R | 10 +++- 3 files changed, 121 insertions(+), 1 deletion(-) create mode 100644 R/disaggregate_skates.R diff --git a/NAMESPACE b/NAMESPACE index c475bab..c418b8e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,7 @@ # Generated by roxygen2: do not edit by hand export(comland) +export(disaggregate_skates) export(get_comland_data) export(get_comland_raw_data) export(get_herring_data) diff --git a/R/disaggregate_skates.R b/R/disaggregate_skates.R new file mode 100644 index 0000000..9bd53a3 --- /dev/null +++ b/R/disaggregate_skates.R @@ -0,0 +1,111 @@ +#'#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 +#' @export + +disaggregate_skates <- function(comland, channel, filterByYear) { + + message("Disaggregating little and winter skates from skates(ns) ... ") + + #Grab skate data from NEFSC bottom trawl survey + skates <- 22:28 + survey <- survdat::get_survdat_data(channel, filterByYear, getLengths = F) + skate.survey <- survey$survdat[SVSPP %in% skates, ] + + #Identify Stat areas catch occured in + Stat.areas <- sf::st_read(dsn=system.file("extdata","Statistical_Areas_2010.shp", + package="comlandr"), quiet = T) + skate.survey <- survdat::post_strat(skate.survey, Stat.areas, 'Id') + data.table::setnames(skate.survey, 'Id', 'AREA') + + #Figure out proportion of skates + data.table::setkey(skate.survey, YEAR, SEASON, AREA) + + skates.prop <- skate.survey[, .(skates.all = sum(BIOMASS)), + by = key(skate.survey)] + + little <- skate.survey[SVSPP == 26, .(little = sum(BIOMASS)), + by = key(skate.survey)] + + skates.prop <- merge(skates.prop, little, by = key(skate.survey), all = T) + + winter <- skate.survey[SVSPP == 23, .(winter = sum(BIOMASS)), + by = key(skate.survey)] + + skates.prop <- merge(skates.prop, winter, by = key(skate.survey), all = T) + + skates.prop[, little.per := little/skates.all] + skates.prop[, winter.per := winter/skates.all] + + #Drop extra columns and fix NAs + skates.prop[, c('skates.all', 'little', 'winter') := NULL] + skates.prop[is.na(little.per), little.per := 0] + skates.prop[is.na(winter.per), winter.per := 0] + + #disaggregate little and winter skates from skates(ns) - use survey in half years + #Generate season variable in comland + comland.skates <- comland$comland[NESPP3 == 365, ] + comland.skates[MONTH %in% 1:6, SEASON := 'SPRING'] + comland.skates[MONTH %in% 7:12, SEASON := 'FALL'] + + comland.skates <- merge(comland.skates, skates.prop, + by = c('YEAR', 'SEASON', 'AREA'), all.x = T) + + #Fix NAs + comland.skates[is.na(little.per), little.per := 0] + comland.skates[is.na(winter.per), winter.per := 0] + + #Disaggregate + comland.skates[, little := little.per * SPPLIVMT] + comland.skates[, little.value := round(little.per * SPPVALUE)] + + comland.skates[, winter := winter.per * SPPLIVMT] + comland.skates[, winter.value := round(winter.per * SPPVALUE)] + + 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, 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, 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, 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)) + + data.table::setcolorder(skates.add.back, names(comland$comland)) + + comland$comland <- data.table::rbindlist(list(comland$comland[NESPP3 != 365, ], + skates.add.back)) + + return(comland) + +} diff --git a/R/get_comland_data.R b/R/get_comland_data.R index 0d656b8..0721da5 100644 --- a/R/get_comland_data.R +++ b/R/get_comland_data.R @@ -32,7 +32,8 @@ get_comland_data <- function(channel, filterByYear = NA, useLanded = T, removeParts = T, useHerringMaine = T, useForeign = T, - refYear = NA, refMonth = NA) { + refYear = NA, refMonth = NA, disaggSkates = T, + disaggHakes = T) { call <- dbutils::capture_function_call() @@ -50,6 +51,13 @@ get_comland_data <- function(channel, filterByYear = NA, useLanded = T, #Apply correction for inflation if(!is.na(refYear)) comland <- comlandr::adjust_inflation(comland, refYear, refMonth) + #Disaggregate skates and hakes + if(disaggSkates) comland <- comlandr::disaggregate_skates(comland, channel, + filterByYear) + if(disaggHakes) comland <- comlandr::disaggregate_hakes(comland, channel, + filterByYear) + + comland$call <- call return(comland) From ad1148f772ba37ae01bbef64893de404c608c83b Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Fri, 5 Mar 2021 15:42:43 -0500 Subject: [PATCH 14/60] merged disaggregate_skates and disaggregate_hakes --- NAMESPACE | 1 + R/disaggregate_skates_hakes.R | 196 ++++++++++++++++++++++++++++++++++ R/get_comland_data.R | 7 +- 3 files changed, 199 insertions(+), 5 deletions(-) create mode 100644 R/disaggregate_skates_hakes.R diff --git a/NAMESPACE b/NAMESPACE index c418b8e..5160ca9 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,6 +2,7 @@ export(comland) export(disaggregate_skates) +export(disaggregate_skates_hakes) export(get_comland_data) export(get_comland_raw_data) export(get_herring_data) diff --git a/R/disaggregate_skates_hakes.R b/R/disaggregate_skates_hakes.R new file mode 100644 index 0000000..514ba2a --- /dev/null +++ b/R/disaggregate_skates_hakes.R @@ -0,0 +1,196 @@ +#'#Disaggregate skates and hakes +#' +#'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 +#' @export + +disaggregate_skates_hakes <- function(comland, channel, filterByYear) { + + message("Grabbing survey data to disaggregate skates and hakes ... ") + + #Grab survey data from NEFSC bottom trawl survey + survey <- survdat::get_survdat_data(channel, filterByYear, getLengths = F) + + #Skates---- + message("Disaggregating little and winter skates from skates(ns) ... ") + skates <- 22:28 + skate.survey <- survey$survdat[SVSPP %in% skates, ] + + #Identify Stat areas catch occured in + Stat.areas <- sf::st_read(dsn=system.file("extdata","Statistical_Areas_2010.shp", + package="comlandr"), quiet = T) + skate.survey <- survdat::post_strat(skate.survey, Stat.areas, 'Id') + data.table::setnames(skate.survey, 'Id', 'AREA') + + #Figure out proportion of skates + data.table::setkey(skate.survey, YEAR, SEASON, AREA) + + skates.prop <- skate.survey[, .(skates.all = sum(BIOMASS)), + by = key(skate.survey)] + + little <- skate.survey[SVSPP == 26, .(little = sum(BIOMASS)), + by = key(skate.survey)] + + skates.prop <- merge(skates.prop, little, by = key(skate.survey), all = T) + + winter <- skate.survey[SVSPP == 23, .(winter = sum(BIOMASS)), + by = key(skate.survey)] + + skates.prop <- merge(skates.prop, winter, by = key(skate.survey), all = T) + + skates.prop[, little.per := little/skates.all] + skates.prop[, winter.per := winter/skates.all] + + #Drop extra columns and fix NAs + skates.prop[, c('skates.all', 'little', 'winter') := NULL] + skates.prop[is.na(little.per), little.per := 0] + skates.prop[is.na(winter.per), winter.per := 0] + + #disaggregate little and winter skates from skates(ns) - use survey in half years + #Generate season variable in comland + comland.skates <- comland$comland[NESPP3 == 365, ] + comland.skates[MONTH %in% 1:6, SEASON := 'SPRING'] + comland.skates[MONTH %in% 7:12, SEASON := 'FALL'] + + comland.skates <- merge(comland.skates, skates.prop, + by = c('YEAR', 'SEASON', 'AREA'), all.x = T) + + #Fix NAs + comland.skates[is.na(little.per), little.per := 0] + comland.skates[is.na(winter.per), winter.per := 0] + + #Disaggregate + comland.skates[, little := little.per * SPPLIVMT] + comland.skates[, little.value := round(little.per * SPPVALUE)] + + comland.skates[, winter := winter.per * SPPLIVMT] + comland.skates[, winter.value := round(winter.per * SPPVALUE)] + + 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, 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, 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, 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)) + + data.table::setcolorder(skates.add.back, names(comland$comland)) + + comland$comland <- data.table::rbindlist(list(comland$comland[NESPP3 != 365, ], + skates.add.back)) + + #Hakes ---- + message("Disaggregating silver and offshore hake from whiting ... ") + + #Grab hake data from NEFSC bottom trawl survey + hake <- c(69, 72) + hake.survey <- survey$survdat[SVSPP %in% hake, ] + + #Identify Stat areas catch occured in + hake.survey <- survdat::post_strat(hake.survey, Stat.areas, 'Id') + data.table::setnames(hake.survey, 'Id', 'AREA') + + #Figure out proportion of skates + data.table::setkey(hake.survey, YEAR, SEASON, AREA) + + hake.prop <- hake.survey[, .(hake.all = sum(BIOMASS, na.rm = T)), + by = key(hake.survey)] + + silvers <- hake.survey[SVSPP == 72, .(silver = sum(BIOMASS, na.rm = T)), + by = key(hake.survey)] + + hake.prop <- merge(hake.prop, silvers, all = T) + hake.prop[is.na(silver), silver := 0] + + hake.prop[, silver.per := silver / hake.all] + + hake.prop[, offshore.per := 1 - silver.per] + hake.prop[, c('hake.all', 'silver') := NULL] + + #disaggregate silver and offshore hake from whiting - use survey in half years + #Generate season variable in comland + comland.hakes <- comland$comland[NESPP3 == 507, ] + comland.hakes[MONTH %in% 1:6, SEASON := 'SPRING'] + comland.hakes[MONTH %in% 7:12, SEASON := 'FALL'] + + comland.hakes <- merge(comland.hakes, hake.prop, + by = c('YEAR', 'SEASON', 'AREA'), all.x = T) + + #Fix NAs + comland.hakes[is.na(silver.per), silver.per := 0] + comland.hakes[is.na(offshore.per), offshore.per := 0] + + #Disaggregate + comland.hakes[, silver := silver.per * SPPLIVMT] + comland.hakes[, silver.value := round(silver.per * SPPVALUE)] + + comland.hakes[, offshore := offshore.per * SPPLIVMT] + comland.hakes[, offshore.value := round(offshore.per * SPPVALUE)] + + comland.hakes[, other.hakes := SPPLIVMT - (silver + offshore)] + comland.hakes[, other.hakes.value := SPPVALUE - (silver.value + offshore.value)] + + #Silver (509), offshore (508), whiting (507) + #put hakes in comland format to merge back + silver <- comland.hakes[, list(YEAR, 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, AREA, MONTH, NEGEAR, + TONCL1, NESPP3, UTILCD, MKTCAT, offshore, + offshore.value)] + offshore[, NESPP3 := 508] + data.table::setnames(offshore, c('offshore', 'offshore.value'), c('SPPLIVMT', 'SPPVALUE')) + offshore <- offshore[SPPLIVMT > 0, ] + + other <- comland.hakes[, list(YEAR, AREA, MONTH, NEGEAR, + TONCL1, NESPP3, UTILCD, MKTCAT, other.hakes, + other.hakes.value)] + other[, NESPP3 := 507] + data.table::setnames(other, c('other.hakes', 'other.hakes.value'), c('SPPLIVMT', 'SPPVALUE')) + other <- other[SPPLIVMT > 0, ] + + #merge all three and reformat for comland + hakes.add.back <- data.table::rbindlist(list(silver, offshore, other)) + + data.table::setcolorder(hakes.add.back, names(comland$comland)) + + comland$comland <- data.table::rbindlist(list(comland$comland[NESPP3 != 507, ], + hakes.add.back)) + + return(comland) + +} diff --git a/R/get_comland_data.R b/R/get_comland_data.R index 0721da5..0f5e50c 100644 --- a/R/get_comland_data.R +++ b/R/get_comland_data.R @@ -32,8 +32,7 @@ get_comland_data <- function(channel, filterByYear = NA, useLanded = T, removeParts = T, useHerringMaine = T, useForeign = T, - refYear = NA, refMonth = NA, disaggSkates = T, - disaggHakes = T) { + refYear = NA, refMonth = NA, disagSkatesHakes = T) { call <- dbutils::capture_function_call() @@ -52,10 +51,8 @@ get_comland_data <- function(channel, filterByYear = NA, useLanded = T, if(!is.na(refYear)) comland <- comlandr::adjust_inflation(comland, refYear, refMonth) #Disaggregate skates and hakes - if(disaggSkates) comland <- comlandr::disaggregate_skates(comland, channel, + if(disagSkatesHakes) comland <- comlandr::disaggregate_skates_hakes(comland, channel, filterByYear) - if(disaggHakes) comland <- comlandr::disaggregate_hakes(comland, channel, - filterByYear) comland$call <- call From 2b8e3bc55e26dc6372d41ffa2a15f825ff4bd78f Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Fri, 5 Mar 2021 15:43:31 -0500 Subject: [PATCH 15/60] Removed disaggregate_skates --- R/disaggregate_skates.R | 111 ---------------------------------------- 1 file changed, 111 deletions(-) delete mode 100644 R/disaggregate_skates.R diff --git a/R/disaggregate_skates.R b/R/disaggregate_skates.R deleted file mode 100644 index 9bd53a3..0000000 --- a/R/disaggregate_skates.R +++ /dev/null @@ -1,111 +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 -#' @export - -disaggregate_skates <- function(comland, channel, filterByYear) { - - message("Disaggregating little and winter skates from skates(ns) ... ") - - #Grab skate data from NEFSC bottom trawl survey - skates <- 22:28 - survey <- survdat::get_survdat_data(channel, filterByYear, getLengths = F) - skate.survey <- survey$survdat[SVSPP %in% skates, ] - - #Identify Stat areas catch occured in - Stat.areas <- sf::st_read(dsn=system.file("extdata","Statistical_Areas_2010.shp", - package="comlandr"), quiet = T) - skate.survey <- survdat::post_strat(skate.survey, Stat.areas, 'Id') - data.table::setnames(skate.survey, 'Id', 'AREA') - - #Figure out proportion of skates - data.table::setkey(skate.survey, YEAR, SEASON, AREA) - - skates.prop <- skate.survey[, .(skates.all = sum(BIOMASS)), - by = key(skate.survey)] - - little <- skate.survey[SVSPP == 26, .(little = sum(BIOMASS)), - by = key(skate.survey)] - - skates.prop <- merge(skates.prop, little, by = key(skate.survey), all = T) - - winter <- skate.survey[SVSPP == 23, .(winter = sum(BIOMASS)), - by = key(skate.survey)] - - skates.prop <- merge(skates.prop, winter, by = key(skate.survey), all = T) - - skates.prop[, little.per := little/skates.all] - skates.prop[, winter.per := winter/skates.all] - - #Drop extra columns and fix NAs - skates.prop[, c('skates.all', 'little', 'winter') := NULL] - skates.prop[is.na(little.per), little.per := 0] - skates.prop[is.na(winter.per), winter.per := 0] - - #disaggregate little and winter skates from skates(ns) - use survey in half years - #Generate season variable in comland - comland.skates <- comland$comland[NESPP3 == 365, ] - comland.skates[MONTH %in% 1:6, SEASON := 'SPRING'] - comland.skates[MONTH %in% 7:12, SEASON := 'FALL'] - - comland.skates <- merge(comland.skates, skates.prop, - by = c('YEAR', 'SEASON', 'AREA'), all.x = T) - - #Fix NAs - comland.skates[is.na(little.per), little.per := 0] - comland.skates[is.na(winter.per), winter.per := 0] - - #Disaggregate - comland.skates[, little := little.per * SPPLIVMT] - comland.skates[, little.value := round(little.per * SPPVALUE)] - - comland.skates[, winter := winter.per * SPPLIVMT] - comland.skates[, winter.value := round(winter.per * SPPVALUE)] - - 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, 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, 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, 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)) - - data.table::setcolorder(skates.add.back, names(comland$comland)) - - comland$comland <- data.table::rbindlist(list(comland$comland[NESPP3 != 365, ], - skates.add.back)) - - return(comland) - -} From 012bf051dab37b547216e180b1a6854910e38766 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Mon, 8 Mar 2021 10:43:57 -0500 Subject: [PATCH 16/60] Added confidentiality message --- R/get_comland_data.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/get_comland_data.R b/R/get_comland_data.R index 0f5e50c..156da18 100644 --- a/R/get_comland_data.R +++ b/R/get_comland_data.R @@ -56,7 +56,8 @@ get_comland_data <- function(channel, filterByYear = NA, useLanded = T, comland$call <- call - + + message("Some data may be CONFIDENTIAL ... DO NOT disseminate without proper Non-disclosure agreement.") return(comland) } From 73e5c79b95a7de7304b5f273b043cfab819316cd Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Mon, 8 Mar 2021 10:44:32 -0500 Subject: [PATCH 17/60] Removed disaggregate_skates --- NAMESPACE | 1 - 1 file changed, 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index 5160ca9..45f1819 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,7 +1,6 @@ # Generated by roxygen2: do not edit by hand export(comland) -export(disaggregate_skates) export(disaggregate_skates_hakes) export(get_comland_data) export(get_comland_raw_data) From 52475135aaa97dbe135eb0c1f316113056f57965 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Sun, 21 Mar 2021 22:58:08 -0400 Subject: [PATCH 18/60] Added assign_area for assigning stat areas to new areas --- NAMESPACE | 1 + R/assign_area.R | 48 ++++++++++++++++++++++++++++++++++++++++++++++ man/assign_area.Rd | 25 ++++++++++++++++++++++++ 3 files changed, 74 insertions(+) create mode 100644 R/assign_area.R create mode 100644 man/assign_area.Rd diff --git a/NAMESPACE b/NAMESPACE index 45f1819..c2589fb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +export(assign_area) export(comland) export(disaggregate_skates_hakes) export(get_comland_data) diff --git a/R/assign_area.R b/R/assign_area.R new file mode 100644 index 0000000..a15c468 --- /dev/null +++ b/R/assign_area.R @@ -0,0 +1,48 @@ +#' Assign landing records to an aggregated area +#' +#' Takes the output from \code{get_comland_data} and further aggregates from NAFO +#' statistical areas to a user defined area. Allows for species to be assigned by +#' 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 propDescription Character. Name of column in userAreas that defines the +#' proportions of landings assigned to new area. +#' +#'@export + +assign_area <- function(comland, userAreas, areaDescription, propDescription){ + + call <- dbutils::capture_function_call() + + #Pull out landings from comland object + landings <- comland$comland + + #Convert userAreas to data.table + areas <- data.table::as.data.table(userAreas) + setnames(areas, c(areaDescription, propDescription), c('newarea', 'prop')) + + #Merge new area descriptions to landings + new.area.land <- merge(landings, areas, by = c('NESPP3', 'AREA')) + + #Proportion landings to new areas + new.area.land[, newspplivmt := SPPLIVMT * prop] + new.area.land[, newsppvalue := SPPVALUE * prop] + + #Drop extra columns + new.area.land[, c('AREA', 'SPPLIVMT', 'SPPVALUE', 'prop') := NULL] + + #Rename columns + data.table::setnames(new.area.land, c('newarea', 'newspplivmt', 'newsppvalue'), + c(areaDescription, 'SPPLIVMT', 'SPPVALUE')) + + #Add changes back into comland + comland$comland <- new.area.land[] + comland$call <- c(comland$call, call) + comland$userAreas <- userAreas + + return(comland) +} diff --git a/man/assign_area.Rd b/man/assign_area.Rd new file mode 100644 index 0000000..cc15f9e --- /dev/null +++ b/man/assign_area.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/assign_area.R +\name{assign_area} +\alias{assign_area} +\title{Assign landing records to an aggregated area} +\usage{ +assign_area(comland, userAreas, areaDescription, propDescription) +} +\arguments{ +\item{comland}{Data set generated by \code{get_comland_data}} + +\item{userAreas}{Data frame. Definitions to aggregate statistical areas to user defined +areas} + +\item{areaDescription}{Character. Name of column in userAreas that defines the new +area.} + +\item{propDescription}{Character. Name of column in userAreas that defines the +proportions of landings assigned to new area.} +} +\description{ +Takes the output from \code{get_comland_data} and further aggregates from NAFO +statistical areas to a user defined area. Allows for species to be assigned by +proportions to more than two user defined areas from one stat area +} From 6acf2ec2a2607db622f8ebee9b9cd61f0aa69bbb Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Wed, 2 Jun 2021 10:00:50 -0400 Subject: [PATCH 19/60] updated help files --- man/comland.Rd | 2 +- man/get_comland_data.Rd | 16 ++++++++++--- man/get_comland_raw_data.Rd | 47 +++++++++++++++++++++++++++++++++++++ 3 files changed, 61 insertions(+), 4 deletions(-) create mode 100644 man/get_comland_raw_data.Rd diff --git a/man/comland.Rd b/man/comland.Rd index 5518bb0..06b5870 100644 --- a/man/comland.Rd +++ b/man/comland.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/comland.r +% Please edit documentation in R/Comland.r \name{comland} \alias{comland} \title{Comland.r Version now controlled by git - originally part of comcatch.r} diff --git a/man/get_comland_data.Rd b/man/get_comland_data.Rd index ceed4f2..633bd9e 100644 --- a/man/get_comland_data.Rd +++ b/man/get_comland_data.Rd @@ -4,16 +4,26 @@ \alias{get_comland_data} \title{Extracts commercial data from Database} \usage{ -get_comland_data(channel, landed, endyear, out.dir) +get_comland_data( + channel, + filterByYear = NA, + useLanded = T, + removeParts = T, + useHerringMaine = T, + useForeign = T, + refYear = NA, + refMonth = NA, + disagSkatesHakes = T +) } \arguments{ \item{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}})} -\item{landed}{Character String. Use landed weight ("y" - meatwt) for scallops and clams instead of live weight ("n" - livewt).} - \item{endyear}{Numeric Scalar. Final year of query.} +\item{landed}{Character String. Use landed weight ("y" - meatwt) for scallops and clams instead of live weight ("n" - livewt).} + \item{out.dir}{path to directory where final output will be saved} } \value{ diff --git a/man/get_comland_raw_data.Rd b/man/get_comland_raw_data.Rd new file mode 100644 index 0000000..bccc060 --- /dev/null +++ b/man/get_comland_raw_data.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_comland_raw_data.R +\name{get_comland_raw_data} +\alias{get_comland_raw_data} +\title{Extracts commercial data from Database} +\usage{ +get_comland_raw_data( + channel, + filterByYear = NA, + useLanded = T, + removeParts = T +) +} +\arguments{ +\item{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}})} + +\item{endyear}{Numeric Scalar. Final year of query.} + +\item{landed}{Character String. Use landed weight ("y" - meatwt) for scallops and clams instead of live weight ("n" - livewt).} + +\item{out.dir}{path to directory where final output will be saved} +} +\value{ +Data frame (data.table) (n x 10) +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{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{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 +} +\section{File Creation}{ + + +A file containing the data.table above will also be saved to the users machine in the directory provided +} + From 8d05ebe3177d2f13a71eecc67b1747a94c6acb3a Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Wed, 16 Jun 2021 14:28:39 -0400 Subject: [PATCH 20/60] retain original area --- R/assign_area.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/assign_area.R b/R/assign_area.R index a15c468..57106f6 100644 --- a/R/assign_area.R +++ b/R/assign_area.R @@ -33,7 +33,7 @@ assign_area <- function(comland, userAreas, areaDescription, propDescription){ new.area.land[, newsppvalue := SPPVALUE * prop] #Drop extra columns - new.area.land[, c('AREA', 'SPPLIVMT', 'SPPVALUE', 'prop') := NULL] + new.area.land[, c('SPPLIVMT', 'SPPVALUE', 'prop') := NULL] #Rename columns data.table::setnames(new.area.land, c('newarea', 'newspplivmt', 'newsppvalue'), From 5f4651df6a0334ba96a8c2850e0ea9cb0d7bc95f Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Wed, 16 Jun 2021 23:23:40 -0400 Subject: [PATCH 21/60] added code to capture mesh size --- R/get_comland_raw_data.R | 25 +++++++++++++++++++++++-- 1 file changed, 23 insertions(+), 2 deletions(-) diff --git a/R/get_comland_raw_data.R b/R/get_comland_raw_data.R index 14649ea..cc4d672 100644 --- a/R/get_comland_raw_data.R +++ b/R/get_comland_raw_data.R @@ -49,12 +49,32 @@ get_comland_raw_data <- function(channel, filterByYear = NA, useLanded = T, for(itab in 1:length(tables)){ #Data query - landings.qry <- paste("select year, month, negear, toncl1, nespp3, nespp4, area, + #Need to add mesh data post 1981 + if(substr(tables[itab], 1, 3) == 'WOL'){ + landings.qry <- paste("select year, month, negear, toncl1, nespp3, nespp4, area, spplivlb, spplndlb, sppvalue, utilcd from", tables[itab]) + comland.yr <- data.table::as.data.table(DBI::dbGetQuery(channel, landings.qry)) + comland.yr[, MESH := 5] #Identify all as large mesh + } else { + if(filterByYear[itab] > 1993){ + trip.table <- paste0('CFDETT', filterByYear[itab], 'AA') + } + if(filterByYear[itab] > 81 & filterByYear[itab] <= 93){ + trip.table <- paste0('WODETT', substr(filterByYear[itab], 3, 4)) + } + landings.qry <- paste("select a.year, a.month, a.negear, a.toncl1, a.nespp3, + a.nespp4, a.area, a.spplivlb, a.spplndlb, a.sppvalue, + a.utilcd, b.mesh + from", tables[itab], "a,", trip.table, "b + where a.link = b.link") + comland.yr <- data.table::as.data.table(DBI::dbGetQuery(channel, landings.qry)) + } sql <- c(sql, landings.qry) - comland.yr <- data.table::as.data.table(DBI::dbGetQuery(channel, landings.qry)) + #Identify small/large mesh fisheries + comland.yr[MESH <= 3, MESHCAT := 'SM'] + comland.yr[MESH > 3, MESHCAT := 'LG'] # Use landed weight instead of live weight for shellfish if(useLanded) {comland.yr[NESPP3 %in% 743:800, SPPLIVLB := SPPLNDLB]} @@ -75,6 +95,7 @@ get_comland_raw_data <- function(channel, filterByYear = NA, useLanded = T, YEAR, MONTH, NEGEAR, + MESHCAT, TONCL1, NESPP3, AREA, From 987def115df1f32f285bb94d8b7d06875d27bcfc Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Wed, 16 Jun 2021 23:34:53 -0400 Subject: [PATCH 22/60] fixed years in if statement --- R/get_comland_raw_data.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/get_comland_raw_data.R b/R/get_comland_raw_data.R index cc4d672..9a2496b 100644 --- a/R/get_comland_raw_data.R +++ b/R/get_comland_raw_data.R @@ -60,7 +60,7 @@ get_comland_raw_data <- function(channel, filterByYear = NA, useLanded = T, if(filterByYear[itab] > 1993){ trip.table <- paste0('CFDETT', filterByYear[itab], 'AA') } - if(filterByYear[itab] > 81 & filterByYear[itab] <= 93){ + if(filterByYear[itab] > 1981 & filterByYear[itab] <= 1993){ trip.table <- paste0('WODETT', substr(filterByYear[itab], 3, 4)) } landings.qry <- paste("select a.year, a.month, a.negear, a.toncl1, a.nespp3, From 79d64d9ff31d3c3a125b323acd104bd741f67323 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Thu, 17 Jun 2021 00:05:04 -0400 Subject: [PATCH 23/60] Needed to add meshcat to other scripts --- R/disaggregate_skates_hakes.R | 24 ++++++++++++------------ R/get_comland_raw_data.R | 3 ++- R/get_herring_data.R | 2 ++ 3 files changed, 16 insertions(+), 13 deletions(-) diff --git a/R/disaggregate_skates_hakes.R b/R/disaggregate_skates_hakes.R index 514ba2a..3a8b97f 100644 --- a/R/disaggregate_skates_hakes.R +++ b/R/disaggregate_skates_hakes.R @@ -81,22 +81,22 @@ disaggregate_skates_hakes <- function(comland, channel, filterByYear) { #Little (366), winter (367), skates(ns) (365) #put skates in comland format to merge back little <- comland.skates[, list(YEAR, AREA, MONTH, NEGEAR, - TONCL1, NESPP3, UTILCD, MKTCAT, little, - little.value)] + TONCL1, NESPP3, UTILCD, MESHCAT, 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, AREA, MONTH, NEGEAR, - TONCL1, NESPP3, UTILCD, MKTCAT, winter, - winter.value)] + TONCL1, NESPP3, UTILCD, MESHCAT, 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, AREA, MONTH, NEGEAR, - TONCL1, NESPP3, UTILCD, MKTCAT, other.skate, - other.skate.value)] + TONCL1, NESPP3, UTILCD, MESHCAT, 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, ] @@ -163,22 +163,22 @@ disaggregate_skates_hakes <- function(comland, channel, filterByYear) { #Silver (509), offshore (508), whiting (507) #put hakes in comland format to merge back silver <- comland.hakes[, list(YEAR, AREA, MONTH, NEGEAR, - TONCL1, NESPP3, UTILCD, MKTCAT, silver, - silver.value)] + TONCL1, NESPP3, UTILCD, MESHCAT, 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, AREA, MONTH, NEGEAR, - TONCL1, NESPP3, UTILCD, MKTCAT, offshore, - offshore.value)] + TONCL1, NESPP3, UTILCD, MESHCAT, MKTCAT, + offshore, offshore.value)] offshore[, NESPP3 := 508] data.table::setnames(offshore, c('offshore', 'offshore.value'), c('SPPLIVMT', 'SPPVALUE')) offshore <- offshore[SPPLIVMT > 0, ] other <- comland.hakes[, list(YEAR, AREA, MONTH, NEGEAR, - TONCL1, NESPP3, UTILCD, MKTCAT, other.hakes, - other.hakes.value)] + TONCL1, NESPP3, UTILCD, MESHCAT, MKTCAT, + other.hakes, other.hakes.value)] other[, NESPP3 := 507] data.table::setnames(other, c('other.hakes', 'other.hakes.value'), c('SPPLIVMT', 'SPPVALUE')) other <- other[SPPLIVMT > 0, ] diff --git a/R/get_comland_raw_data.R b/R/get_comland_raw_data.R index 9a2496b..d5e3bf1 100644 --- a/R/get_comland_raw_data.R +++ b/R/get_comland_raw_data.R @@ -75,7 +75,8 @@ get_comland_raw_data <- function(channel, filterByYear = NA, useLanded = T, #Identify small/large mesh fisheries comland.yr[MESH <= 3, MESHCAT := 'SM'] comland.yr[MESH > 3, MESHCAT := 'LG'] - + comland.yr[, MESH := NULL] + # Use landed weight instead of live weight for shellfish if(useLanded) {comland.yr[NESPP3 %in% 743:800, SPPLIVLB := SPPLNDLB]} diff --git a/R/get_herring_data.R b/R/get_herring_data.R index d43a161..6ea517d 100644 --- a/R/get_herring_data.R +++ b/R/get_herring_data.R @@ -53,6 +53,8 @@ get_herring_data <- function(channel, comland, filterByYear) { herring[, TONCL1 := 3] herring[, UTILCD := 0] + + herring[, MESHCAT := 'LG'] #compute price/utilization from CF tables herring.comland <- comland[NESPP3 == 168, ] From 4c900916545f2b98e2fa26aef63275ea7033bb47 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Wed, 23 Jun 2021 09:14:27 -0400 Subject: [PATCH 24/60] Beginnings of get_discard_data...will need to turn into function --- R/get_discard_data.R | 447 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 447 insertions(+) create mode 100644 R/get_discard_data.R diff --git a/R/get_discard_data.R b/R/get_discard_data.R new file mode 100644 index 0000000..dc209cf --- /dev/null +++ b/R/get_discard_data.R @@ -0,0 +1,447 @@ +#Comdisc.r +library(here); library(data.table); library(comlandr) + +channel <- dbutils::connect_to_database(server="nova",uid="slucey") + +get_observer_data <- function(channel, filterByYear, ) +endyear <- 2017 + +strat.var <- c('YEAR', 'QY', 'EPU', 'GEAR') +haullevel <- F #Toggle whether to save haul by haul data or not +landings.file <- 'comland_meatwt_deflated.RData' + + + +#------------------------------------------------------------------------------- +#User created functions +#Sums the number of occurances +count<-function(x){ + num<-rep(1,length(x)) + out<-sum(num) + return(out) + } + +#------------------------------------------------------------------------------- + +filterByYear <- 1989 + +#Create year vector +if(is.na(filterByYear[1])){ + years <- ">= 1989" +}else{ + years <- paste0("in (", survdat:::sqltext(filterByYear), ")") +} + +ob.qry <- paste0("select year, month, area, negear, nespp4, hailwt, catdisp, drflag, + tripid, haulnum, lathbeg, lonhbeg, link3 + from OBSPP + where obsrflag = 1 + and program not in ('127', '900', '250', '160') + and year ", years, + "\n union + select year, month, area, negear, nespp4, hailwt, catdisp, drflag, + tripid, haulnum, lathbeg, lonhbeg, link3 + from ASMSPP + where obsrflag = 1 + and program not in ('127', '900', '250', '160') + and year ", years) + +ob <- data.table::as.data.table(DBI::dbGetQuery(channel, ob.qry)) + +#Add protected species here +mammal.qry <- paste0("select distinct a.year, a.month, b.area, b.negear, a.nespp4, + 1 as hailwt, 0 as catdisp, 1 as drflag, a.tripid, a.haulnum, + b.lathbeg, b.lonhbeg, a.link3 + from obinc a, obspp b + where a.tripid = b.tripid + and a.year ", years, + "\n union + select distinct a.year, a.month, b.area, b.negear, a.nespp4, + 1 as hailwt, 0 as catdisp, 1 as drflag, a.tripid, a.haulnum, + b.lathbeg, b.lonhbeg, a.link3 + from asminc a, asmspp b + where a.tripid = b.tripid + and a.year ", years) + +mammal <- data.table::as.data.table(DBI::dbGetQuery(channel, mammal.qry)) + +ob <- rbindlist(list(ob, mammal)) + +#Grab otter trawl gear tables to get mesh size for small verses large mesh +mesh.qry <- paste0("select link3, codmsize + from OBOTGH + where year ", years) +mesh <- data.table::as.data.table(DBI::dbGetQuery(channel, mesh.qry)) + +#Convert mesh size from mm to inches +mesh[, CODMSIZE := CODMSIZE * 0.0393701] +mesh[CODMSIZE <= 3, MESHCAT := 'SM'] +mesh[CODMSIZE > 3, MESHCAT := 'LG'] +mesh[, CODMSIZE := NULL] + +ob <- merge(ob, mesh, by = 'LINK3', all.x = T) + +#Clean up data set +#Remove those with unknown disposition +ob <- ob[CATDISP != 9, ] + +#remove record if weight is missing +ob <- ob[!is.na(HAILWT), ] + +#remove non-living items (clappers and stomach contents) and unknown living matter +ob <- ob[!(NESPP4 %in% c(0, 6800:6802, 6805, 6810, 6820, 6830, 6850:6857, 6882, 6883, 6894:6897))] + +#Convert lat/lon to decimal degrees +ob[, LATDD := substr(LATHBEG, 1, 2) + ((substr(LATHBEG, 3, 4) + substr(LATHBEG, 5, 6)) + / 60)] + +#Convert weights +convert.qry <- "select nespp4_obs, catdisp_code, drflag_code, cf_lndlb_livlb, cf_rptqty_lndlb + from obspecconv" +convert <- data.table::as.data.table(DBI::dbGetQuery(channel, convert.qry)) + +setnames(convert, + c('NESPP4_OBS', 'CATDISP_CODE', 'DRFLAG_CODE'), + c('NESPP4', 'CATDISP', 'DRFLAG')) + +setkey(convert, + NESPP4, + CATDISP, + DRFLAG) + +ob.code <- merge(ob, convert, by = key(convert), all.x = T) + +#missing cf's will be set to 1 Assume living +ob.code[is.na(CF_LNDLB_LIVLB), CF_LNDLB_LIVLB := 1] +ob.code[is.na(CF_RPTQTY_LNDLB), CF_RPTQTY_LNDLB := 1] + +ob.code[, C.HAILWT := HAILWT * CF_RPTQTY_LNDLB * CF_LNDLB_LIVLB] + +#Grab common name and PR flags +comname.qry <- "select NESPP4, comname, sciname, cetacean, turtle, pinniped + from obspec" + +comname <- data.table::as.data.table(DBI::dbGetQuery(channel, comname.qry)) +comname[CETACEAN == 1 | TURTLE == 1 | PINNIPED == 1, PR := 1] +comname[is.na(PR), PR := 0] +comname[, c('CETACEAN', 'TURTLE', 'PINNIPED') := NULL] + +ob.code <- merge(comname, ob.code, by = 'NESPP4') + +#Convert to metric tons to align with commercial landings data +ob.code[PR == 0, C.HAILWT := C.HAILWT * 0.00045359237] + +#Change to NESPP3 to combine market categories +ob.code[, NESPP3 := substring(NESPP4, 1, 3)] +#Birds, mammals, etc don't have unique NESPP3 codes +ob.code[is.na(NESPP3), NESPP3 := NESPP4] + +ob.code[, MKTCAT := as.numeric(substring(NESPP4, 4, 4))] + +#drop NESPP4 +ob.code[, NESPP4 := NULL] + +#Deal with skate(ns) for little and winter skates +source(file.path(data.dir.2, 'Comland_skates_hakes.R')) + +#get little skates and winter skates from skates(ns) - use survey in half years +#Generate Half year variable in comland +ob.skates <- ob.code[NESPP3 == 365, ] +ob.skates[MONTH %in% 1:6, Half := 1] +ob.skates[MONTH %in% 7:12, Half := 2] + +setkey(skate.hake.us, + YEAR, + Half, + AREA) + +ob.skates <- merge(ob.skates, skate.hake.us, by = key(skate.hake.us), all.x = T) + +ob.skates[NESPP3 == 365, little := little.per * C.HAILWT] +ob.skates[is.na(little), little := 0] + +ob.skates[NESPP3 == 365, winter := winter.per * C.HAILWT] +ob.skates[is.na(winter), winter := 0] + +ob.skates[NESPP3 == 365, other.skate := C.HAILWT - (little + winter)] + +#Little (366), winter (367), skates(ns) (365) +#put skates in ob.code format to merge back +little <- ob.skates[, list(COMNAME, SCINAME, PR, CATDISP, DRFLAG, + YEAR, MONTH, AREA, NEGEAR, HAILWT, + TRIPID, HAULNUM, LINK1, LINK3, CF_LNDLB_LIVLB, + CF_RPTQTY_LNDLB, little, NESPP3, MKTCAT)] +little[, NESPP3 := 366] +setnames(little, "little", "C.HAILWT") +little <- little[C.HAILWT > 0, ] + +winter <- ob.skates[, list(COMNAME, SCINAME, PR, CATDISP, DRFLAG, + YEAR, MONTH, AREA, NEGEAR, HAILWT, + TRIPID, HAULNUM, LINK1, LINK3, CF_LNDLB_LIVLB, + CF_RPTQTY_LNDLB, winter, NESPP3, MKTCAT)] +winter[, NESPP3 := 367] +setnames(winter, "winter", "C.HAILWT") +winter <- winter[C.HAILWT > 0, ] + +other <- ob.skates[, list(COMNAME, SCINAME, PR, CATDISP, DRFLAG, + YEAR, MONTH, AREA, NEGEAR, HAILWT, + TRIPID, HAULNUM, LINK1, LINK3, CF_LNDLB_LIVLB, + CF_RPTQTY_LNDLB, other.skate, NESPP3, MKTCAT)] +other[, NESPP3 := 365] +setnames(other, "other.skate", "C.HAILWT") +other <- other[C.HAILWT > 0, ] + +#merge all three and reformat for ob +skates.add.back <- rbindlist(list(little, winter, other)) + +setcolorder(skates.add.back, names(ob.code)) + +ob.code <- rbindlist(list(ob.code[NESPP3 != 365, ], skates.add.back)) + +#Assign stat areas to EPUs +gom <- c(500,510,512:515) +gb <- c(521:526,551,552,561,562) +mab <- c(537,539,600,612:616,621,622,625,626,631,632) +ss <- c(463:467,511) + +ob.code[AREA %in% gom, EPU := 'GOM'] +ob.code[AREA %in% gb, EPU := 'GB'] +ob.code[AREA %in% mab, EPU := 'MAB'] +ob.code[AREA %in% ss, EPU := 'SS'] +ob.code[is.na(EPU), EPU := 'OTHER'] +ob.code[, EPU := factor(EPU, levels = c('GOM', 'GB', 'MAB', 'SS', 'OTHER'))] + +#Create quarter year variable +ob.code[MONTH %in% 1:3, QY := 1] +ob.code[MONTH %in% 4:6, QY := 2] +ob.code[MONTH %in% 7:9, QY := 3] +ob.code[MONTH %in% 10:12, QY := 4] + +#Aggregate Gear +otter <- 50:59 +dredge.sc <- 131:132 +pot <- c(189:190, 200:219, 300, 301) +longline <- c(10, 40) +seine <- c(70:79, 120:129, 360) +gillnet <- c(100:119, 500, 510, 520) +midwater <- c(170, 370) +dredge.o <- c(281, 282, 380:400) + +ob.code[NEGEAR %in% otter, GEAR := 'otter'] +ob.code[NEGEAR %in% dredge.sc, GEAR := 'dredge.sc'] +ob.code[NEGEAR %in% pot, GEAR := 'pot'] +ob.code[NEGEAR %in% longline, GEAR := 'longline'] +ob.code[NEGEAR %in% seine, GEAR := 'seine'] +ob.code[NEGEAR %in% gillnet, GEAR := 'gillnet'] +ob.code[NEGEAR %in% midwater, GEAR := 'midwater'] +ob.code[NEGEAR %in% dredge.o, GEAR := 'dredge.o'] +ob.code[is.na(GEAR), GEAR := 'other'] +ob.code[, GEAR := as.factor(GEAR)] + +ob.code[, c('DRFLAG', 'MONTH', 'AREA', 'NEGEAR', + 'HAILWT', 'CF_LNDLB_LIVLB', 'CF_RPTQTY_LNDLB') := NULL] + +setkeyv(ob.code, c(strat.var, 'NESPP3', 'CATDISP')) + +if(haullevel == T){#This is broken + ob.haul <- ob.code + save(comdisc, file = file.path(out.dir, "Observer_Discards_by_Haul.RData")) +} + +ob.sums <- ob.code[, sum(C.HAILWT), by = key(ob.code)] + +#Make a new function +#Calculate kept and discards +ob.discard <- ob.sums[CATDISP == 0, ] + +setnames(ob.discard, + "V1", + "DISCARD") + +setkeyv(ob.sums, strat.var) + +ob.kept <- ob.sums[CATDISP == 1, sum(V1), by = key(ob.sums)] + +setnames(ob.kept, + "V1", + "KEPT.ALL") + +ob.all <- merge(ob.kept, ob.discard, by = key(ob.sums)) + +ob.all[, CATDISP := NULL] + +ob.all[, DK := DISCARD / KEPT.ALL] +ob.all[is.na(DK), DK := 1.0] +ob.all[, c('KEPT.ALL', 'DISCARD') := NULL] + +#Get landings +load(file.path(data.dir, landings.file)) + +setkeyv(comland, strat.var) + +tot.land <- comland[, sum(SPPLIVMT), by = key(comland)] + +setnames(tot.land, + "V1", + "TOT.LAND") + +comdisc <- merge(ob.all, tot.land, by = key(comland)) + +comdisc[, DISC := DK * TOT.LAND] + +#Variance +#Need to add back individual trip data +rm(ob) #Free up memory +setkeyv(comdisc, c(strat.var, 'NESPP3')) + +disc.var <- unique(comdisc, by = key(comdisc)) + +#Trip kept all +setkeyv(ob.code, c(strat.var, 'TRIPID')) + +trip.kept <- ob.code[CATDISP == 1, sum(C.HAILWT), by = key(ob.code)] +setnames(trip.kept, "V1", "trip.k") + +#Trip discard by species +setkeyv(ob.code, c(strat.var, 'TRIPID', 'NESPP3')) + +trip.disc <- ob.code[CATDISP == 0, sum(C.HAILWT), by = key(ob.code)] +setnames(trip.disc, "V1", "trip.d") + +trip.all <- merge(trip.disc, trip.kept, by = c(strat.var, 'TRIPID'), all = T) +trip.all[is.na(trip.k), trip.k := 0] + +disc.var <- merge(disc.var, trip.all, by = c(strat.var, 'NESPP3')) + +#Calculate the number of observed trips +setkeyv(ob.code, c(strat.var, 'TRIPID')) + +trips <- unique(ob.code, by = key(ob.code)) + +trip.count <- trips[, count(TRIPID), by = strat.var] + +setnames(trip.count, "V1", "n") + +disc.var <- merge(disc.var, trip.count, by = strat.var) + +#Calculate the total number of trips +#CFDBS is on sole - need to switch connection +odbcClose(channel) +if(Sys.info()['sysname']=="Windows"){ + channel <- odbcDriverConnect() +} else { + channel <- odbcConnect('sole', uid, pwd) +} + +tables <- c(paste('WODETS', 89:93, sep = ''), + paste('CFDETS', 1994:endyear, 'AA', sep = '')) + +comtrip.qry <- "select year, month, area, negear, count(link) as N + from WODETS89 + group by year, month, area, negear" +comtrip <- as.data.table(sqlQuery(channel, comtrip.qry)) + +for(i in 2:length(tables)){ + tripyr.qry <- paste("select year, month, area, negear, count(link) as N + from", tables[i], + "group by year, month, area, negear") + tripyr <- as.data.table(sqlQuery(channel, tripyr.qry)) + + comtrip <- rbindlist(list(comtrip, tripyr)) + } + +comtrip[AREA %in% gom, EPU := 'GOM'] +comtrip[AREA %in% gb, EPU := 'GB'] +comtrip[AREA %in% mab, EPU := 'MAB'] +comtrip[AREA %in% ss, EPU := 'SS'] +comtrip[is.na(EPU), EPU := 'OTHER'] +comtrip[, EPU := factor(EPU, levels = c('GOM', 'GB', 'MAB', 'SS', 'OTHER'))] + +comtrip[YEAR < 100, YEAR := YEAR + 1900] + +comtrip[MONTH %in% 1:3, QY := 1] +comtrip[MONTH %in% 4:6, QY := 2] +comtrip[MONTH %in% 7:9, QY := 3] +comtrip[MONTH %in% 10:12, QY := 4] + +comtrip[NEGEAR %in% otter, GEAR := 'otter'] +comtrip[NEGEAR %in% dredge.sc, GEAR := 'dredge.sc'] +comtrip[NEGEAR %in% pot, GEAR := 'pot'] +comtrip[NEGEAR %in% longline, GEAR := 'longline'] +comtrip[NEGEAR %in% seine, GEAR := 'seine'] +comtrip[NEGEAR %in% gillnet, GEAR := 'gillnet'] +comtrip[NEGEAR %in% midwater, GEAR := 'midwater'] +comtrip[NEGEAR %in% dredge.o, GEAR := 'dredge.o'] +comtrip[is.na(GEAR), GEAR := 'other'] +comtrip[, GEAR := as.factor(GEAR)] + +setkeyv(comtrip, strat.var) + +comtrip.count <- comtrip[, sum(N), by = key(comtrip)] + +setnames(comtrip.count, "V1", "N") + +disc.var <- merge(disc.var, comtrip.count, by = key(comtrip), all.x = T) + +#Fix groups that don't line up properly - actual value of N not that important only relative size +N.avg <- disc.var[, mean(N, na.rm = T)] +disc.var[is.na(N), N := N.avg] + +#Calculate variance +#Need to expand so zero discards by species are represented +setkeyv(disc.var, c(strat.var, 'TRIPID')) +var.trips <- unique(disc.var, by = key(disc.var)) +#drop species specific data +var.trips[, c('NESPP3', 'DK', 'DISC', 'trip.d') := NULL] + +#Get list of species +spp <- unique(disc.var[, NESPP3]) +all.spp.var <- c() +for(i in 1:length(spp)){ + spp.trip <- disc.var[NESPP3 == spp[i], ] + #Get rid of extra data + spp.trip[, c('TOT.LAND', 'DISC', 'trip.k', 'n', 'N') := NULL] + + spp.var <- merge(var.trips, spp.trip, by = c(strat.var, 'TRIPID'), all.x = T) + + #Fix NAs + spp.var[is.na(NESPP3), NESPP3 := spp[i]] + spp.var[is.na(trip.d), trip.d := 0] + + #Merge in DK ratios + setkeyv(spp.trip, strat.var) + spp.dk <- unique(spp.trip, by = key(spp.trip)) + spp.var[, DK := NULL] + spp.dk[, c('NESPP3', 'TRIPID', 'trip.d') := NULL] + spp.var <- merge(spp.var, spp.dk, by = strat.var, all.x = T) + spp.var[is.na(DK), DK := 0] + + spp.var[, step.1 := (sum(trip.d^2 + DK^2 * trip.k^2 - 2 * DK * trip.d * trip.k)/(n - 1)), by = strat.var] + + setkeyv(spp.var, strat.var) + spp.var <- unique(spp.var, by = key(spp.var)) + spp.var[, c('TRIPID', 'trip.d', 'trip.k', 'DK') := NULL] + + spp.var[, DISC.VAR := TOT.LAND^2 * ((N - n)/n*N) * (1/(TOT.LAND/n)^2) * step.1] + spp.var[, c('TOT.LAND', 'n', 'N', 'step.1') := NULL] + + all.spp.var <- rbindlist(list(all.spp.var, spp.var)) + } +comdisc <- merge(comdisc, all.spp.var, by = c(strat.var, 'NESPP3'), all.x = T) + +#Add species names +#Change to NESPP3 to combine market categories +comname[NESPP4 < 100, NESPP3 := as.numeric(substring(NESPP4, 1, 1))] +comname[NESPP4 > 99 & NESPP4 < 1000, NESPP3 := as.numeric(substring(NESPP4, 1, 2))] +comname[(NESPP4 > 999 & NESPP4 < 6100) | + NESPP4 %in% c(7100:7109, 8020:8029), NESPP3 := as.numeric(substring(NESPP4, 1, 3))] +#Birds, mammals, etc don't have unique NESPP3 codes +comname[NESPP4 > 6099 & !NESPP4 %in% c(7100:7109, 8020:8029), NESPP3 := NESPP4] + +setkey(comname, NESPP3) +comname <- unique(comname, by = key(comname)) +comname[, c('NESPP4', 'SCINAME') := NULL] + +comdisc <- merge(comname, comdisc, by = 'NESPP3') + +save(comdisc, file = file.path(out.dir, "Comdisc.RData")) From 5384215800c73d6f9e3775930a74e3ed6a753ac6 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Fri, 9 Jul 2021 16:37:17 -0400 Subject: [PATCH 25/60] First cut at grabbing the raw observer data --- R/get_comdisc_raw_data.R | 154 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 154 insertions(+) create mode 100644 R/get_comdisc_raw_data.R diff --git a/R/get_comdisc_raw_data.R b/R/get_comdisc_raw_data.R new file mode 100644 index 0000000..5099630 --- /dev/null +++ b/R/get_comdisc_raw_data.R @@ -0,0 +1,154 @@ +#' Extracts observer data from Database +#' +#' Connects to obdbs and pulls fields from OBSPP, OBINC, ASMSPP, and ASMINC +#' +#'@inheritParams get_comlands_raw_data +#' +#'@return Data frame (data.table) (n x 10) +#'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{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{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){ + + #Create year vector + if(is.na(filterByYear[1])){ + years <- ">= 1989" + }else{ + years <- paste0("in (", comlandr:::sqltext(filterByYear), ")") + } + + ob.qry <- paste0("select year, month, area, negear, nespp4, hailwt, catdisp, drflag, + tripid, haulnum, lathbeg, lonhbeg, link3 + from OBSPP + where obsrflag = 1 + and program not in ('127', '900', '250', '160') + and year ", years, + "\n union + select year, month, area, negear, nespp4, hailwt, catdisp, drflag, + tripid, haulnum, lathbeg, lonhbeg, link3 + from ASMSPP + where obsrflag = 1 + and program not in ('127', '900', '250', '160') + and year ", years) + + ob <- data.table::as.data.table(DBI::dbGetQuery(channel, ob.qry)) + + #Add protected species here + mammal.qry <- paste0("select distinct a.year, a.month, b.area, b.negear, a.nespp4, + 1 as hailwt, 0 as catdisp, 1 as drflag, a.tripid, a.haulnum, + b.lathbeg, b.lonhbeg, a.link3 + from obinc a, obspp b + where a.tripid = b.tripid + and a.year ", years, + "\n union + select distinct a.year, a.month, b.area, b.negear, a.nespp4, + 1 as hailwt, 0 as catdisp, 1 as drflag, a.tripid, a.haulnum, + b.lathbeg, b.lonhbeg, a.link3 + from asminc a, asmspp b + where a.tripid = b.tripid + and a.year ", years) + + mammal <- data.table::as.data.table(DBI::dbGetQuery(channel, mammal.qry)) + + ob <- data.table::rbindlist(list(ob, mammal)) + + #Grab otter trawl gear tables to get mesh size for small verses large mesh + mesh.qry <- paste0("select link3, codmsize + from OBOTGH + where year ", years) + mesh <- data.table::as.data.table(DBI::dbGetQuery(channel, mesh.qry)) + + #Convert mesh size from mm to inches + mesh[, CODMSIZE := CODMSIZE * 0.0393701] + mesh[CODMSIZE <= 3, MESHCAT := 'SM'] + mesh[CODMSIZE > 3, MESHCAT := 'LG'] + mesh[, CODMSIZE := NULL] + + ob <- merge(ob, mesh, by = 'LINK3', all.x = T) + + #Clean up data set + #Remove those with unknown disposition + ob <- ob[CATDISP != 9, ] + + #remove record if weight is missing + ob <- ob[!is.na(HAILWT), ] + + #remove non-living items (clappers and stomach contents) and unknown living matter + ob <- ob[!(NESPP4 %in% c(0, 6800:6802, 6805, 6810, 6820, 6830, 6850:6857, 6882, + 6883, 6894:6897))] + + #Convert lat/lon to decimal degrees + ob[, LATDD := as.numeric(substr(LATHBEG, 1, 2)) + ((as.numeric(substr(LATHBEG, 3, 4)) + + as.numeric(substr(LATHBEG, 5, 6))) + /60)] + ob[, LONDD := as.numeric(substr(LONHBEG, 1, 2)) + ((as.numeric(substr(LONHBEG, 3, 4)) + + as.numeric(substr(LONHBEG, 5, 6))) + /60) * -1] + ob[, c('LATHBEG', 'LONHBEG') := NULL] + + #Convert weights + convert.qry <- "select nespp4_obs, catdisp_code, drflag_code, cf_lndlb_livlb, cf_rptqty_lndlb + from obspecconv" + convert <- data.table::as.data.table(DBI::dbGetQuery(channel, convert.qry)) + + setnames(convert, + c('NESPP4_OBS', 'CATDISP_CODE', 'DRFLAG_CODE'), + c('NESPP4', 'CATDISP', 'DRFLAG')) + + setkey(convert, + NESPP4, + CATDISP, + DRFLAG) + + ob.code <- merge(ob, convert, by = key(convert), all.x = T) + + #missing cf's will be set to 1 Assume living + ob.code[is.na(CF_LNDLB_LIVLB), CF_LNDLB_LIVLB := 1] + ob.code[is.na(CF_RPTQTY_LNDLB), CF_RPTQTY_LNDLB := 1] + + ob.code[, C.HAILWT := HAILWT * CF_RPTQTY_LNDLB * CF_LNDLB_LIVLB] + + #Grab PR flags + prflag.qry <- "select NESPP4, cetacean, turtle, pinniped + from obspec" + + prflag <- data.table::as.data.table(DBI::dbGetQuery(channel, prflag.qry)) + prflag[CETACEAN == 1 | TURTLE == 1 | PINNIPED == 1, PR := 1] + prflag[is.na(PR), PR := 0] + prflag[, c('CETACEAN', 'TURTLE', 'PINNIPED') := NULL] + + ob.code <- merge(ob.code, prflag, by = 'NESPP4', all.x = T) + + #Convert to metric tons to align with commercial landings data + ob.code[PR == 0, SPPLIVMT := C.HAILWT * 0.00045359237] + + #Change to NESPP3 to combine market categories + ob.code[PR == 0, NESPP3 := substring(NESPP4, 1, 3)] + #Birds, mammals, etc don't have unique NESPP3 codes + ob.code[is.na(NESPP3), NESPP3 := NESPP4] + + ob.code[PR == 0, MKTCAT := as.numeric(substring(NESPP4, 4, 4))] + ob.code[is.na(MKTCAT), MKTCAT := 0] + + #drop extra columns NESPP4 + ob.code[, c('DRFLAG', 'CF_LNDLB_LIVLB', 'CF_RPTQTY_LNDLB', 'HAILWT', 'C.HAILWT', + 'NESPP4') := NULL] + +} + From be6bd3368caa80cd67592b78a1bcc4c2c2eba19c Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Tue, 13 Jul 2021 12:51:50 -0400 Subject: [PATCH 26/60] Added dressing and return statement --- R/get_comdisc_raw_data.R | 28 +++++++++++++++++++++------- 1 file changed, 21 insertions(+), 7 deletions(-) diff --git a/R/get_comdisc_raw_data.R b/R/get_comdisc_raw_data.R index 5099630..606a815 100644 --- a/R/get_comdisc_raw_data.R +++ b/R/get_comdisc_raw_data.R @@ -26,6 +26,12 @@ get_comdisc_raw_data <- function(channel, filterByYear){ + message("Pulling observer data from database. This could take a while (> 1 hour) ... ") + + #output objects + comdisc <- c() + sql <- c() + #Create year vector if(is.na(filterByYear[1])){ years <- ">= 1989" @@ -48,6 +54,7 @@ get_comdisc_raw_data <- function(channel, filterByYear){ and year ", years) ob <- data.table::as.data.table(DBI::dbGetQuery(channel, ob.qry)) + sql <- c(sql, ob.qry) #Add protected species here mammal.qry <- paste0("select distinct a.year, a.month, b.area, b.negear, a.nespp4, @@ -65,6 +72,7 @@ get_comdisc_raw_data <- function(channel, filterByYear){ and a.year ", years) mammal <- data.table::as.data.table(DBI::dbGetQuery(channel, mammal.qry)) + sql <- c(sql, mammal.qry) ob <- data.table::rbindlist(list(ob, mammal)) @@ -73,6 +81,7 @@ get_comdisc_raw_data <- function(channel, filterByYear){ from OBOTGH where year ", years) mesh <- data.table::as.data.table(DBI::dbGetQuery(channel, mesh.qry)) + sql <- c(sql, mesh.qry) #Convert mesh size from mm to inches mesh[, CODMSIZE := CODMSIZE * 0.0393701] @@ -106,6 +115,7 @@ get_comdisc_raw_data <- function(channel, filterByYear){ convert.qry <- "select nespp4_obs, catdisp_code, drflag_code, cf_lndlb_livlb, cf_rptqty_lndlb from obspecconv" convert <- data.table::as.data.table(DBI::dbGetQuery(channel, convert.qry)) + sql <- c(sql, convert.qry) setnames(convert, c('NESPP4_OBS', 'CATDISP_CODE', 'DRFLAG_CODE'), @@ -129,26 +139,30 @@ get_comdisc_raw_data <- function(channel, filterByYear){ from obspec" prflag <- data.table::as.data.table(DBI::dbGetQuery(channel, prflag.qry)) + sql <- c(sql, prflag.qry) + prflag[CETACEAN == 1 | TURTLE == 1 | PINNIPED == 1, PR := 1] prflag[is.na(PR), PR := 0] prflag[, c('CETACEAN', 'TURTLE', 'PINNIPED') := NULL] - ob.code <- merge(ob.code, prflag, by = 'NESPP4', all.x = T) + comdisc <- merge(ob.code, prflag, by = 'NESPP4', all.x = T) #Convert to metric tons to align with commercial landings data - ob.code[PR == 0, SPPLIVMT := C.HAILWT * 0.00045359237] + comdisc[PR == 0, SPPLIVMT := C.HAILWT * 0.00045359237] #Change to NESPP3 to combine market categories - ob.code[PR == 0, NESPP3 := substring(NESPP4, 1, 3)] + comdisc[PR == 0, NESPP3 := substring(NESPP4, 1, 3)] #Birds, mammals, etc don't have unique NESPP3 codes - ob.code[is.na(NESPP3), NESPP3 := NESPP4] + comdisc[is.na(NESPP3), NESPP3 := NESPP4] - ob.code[PR == 0, MKTCAT := as.numeric(substring(NESPP4, 4, 4))] - ob.code[is.na(MKTCAT), MKTCAT := 0] + comdisc[PR == 0, MKTCAT := as.numeric(substring(NESPP4, 4, 4))] + comdisc[is.na(MKTCAT), MKTCAT := 0] #drop extra columns NESPP4 - ob.code[, c('DRFLAG', 'CF_LNDLB_LIVLB', 'CF_RPTQTY_LNDLB', 'HAILWT', 'C.HAILWT', + comdisc[, c('DRFLAG', 'CF_LNDLB_LIVLB', 'CF_RPTQTY_LNDLB', 'HAILWT', 'C.HAILWT', 'NESPP4') := NULL] + return(list(comdisc = comdisc[], + sql = sql)) } From 1ed31173a4b0812d99135b99a47a659cc2ddedc6 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Tue, 13 Jul 2021 13:16:38 -0400 Subject: [PATCH 27/60] migrated the post_strat function from survdat --- R/post_strat.R | 63 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) create mode 100644 R/post_strat.R diff --git a/R/post_strat.R b/R/post_strat.R new file mode 100644 index 0000000..44aca3e --- /dev/null +++ b/R/post_strat.R @@ -0,0 +1,63 @@ +#' Assigns points to polygon +#' +#' Assign survey 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{surveyData} 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 survdat +#' +#' @export + + +post_strat <- function (surveyData, 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) + + # find unique stations and transform to required crs + stations <- surveyData %>% + dplyr::select(CRUISE6, STRATUM, STATION, LAT, LON) %>% + dplyr::distinct() %>% + sf::st_as_sf(., coords = c("LON","LAT"), crs=4326) %>% + sf::st_transform(., crs) + + + # Intersect the stations with the polygon + # Assigns stations with polygons + station_area <- sf::st_join(stations, areas, join = sf::st_intersects) %>% + dplyr::select(names(stations), areaDescription) %>% + sf::st_drop_geometry() %>% + dplyr::arrange(CRUISE6, STRATUM, STATION) + + # Join survey data with stations (which now are assigned to an area based on the shape file) + master <- base::merge(surveyData, station_area, + by = c("CRUISE6","STRATUM","STATION")) %>% + dplyr::rename(!!areaDescription := areaDescription) + + # check to see if we want to keep points that fall outside of all o fthe 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() + } + + + return(master) + +} + From bc650f1568841420608fd9859f2508754c5eb023 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Tue, 13 Jul 2021 13:21:27 -0400 Subject: [PATCH 28/60] Adapted for observer data rather than survey data --- R/post_strat.R | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/R/post_strat.R b/R/post_strat.R index 44aca3e..888f009 100644 --- a/R/post_strat.R +++ b/R/post_strat.R @@ -1,13 +1,13 @@ #' Assigns points to polygon #' -#' Assign survey data (points, lat and lon) to designated regions (polygons) from a shape file. +#' 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{surveyData} data.table with one additional column labeled +#' @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}) @@ -15,12 +15,12 @@ #' #' @importFrom magrittr "%>%" #' -#'@family survdat +#'@family comdisc #' #' @export -post_strat <- function (surveyData, areaPolygon, areaDescription, na.keep = F) { +post_strat <- function (comdisc, 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" @@ -30,26 +30,26 @@ post_strat <- function (surveyData, areaPolygon, areaDescription, na.keep = F) { sf::st_transform(., crs) # find unique stations and transform to required crs - stations <- surveyData %>% - dplyr::select(CRUISE6, STRATUM, STATION, LAT, LON) %>% + locations <- comdisc %>% + dplyr::select(LINK3, LAT, LON) %>% dplyr::distinct() %>% sf::st_as_sf(., coords = c("LON","LAT"), crs=4326) %>% sf::st_transform(., crs) - # Intersect the stations with the polygon - # Assigns stations with polygons - station_area <- sf::st_join(stations, areas, join = sf::st_intersects) %>% - dplyr::select(names(stations), areaDescription) %>% + # 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(CRUISE6, STRATUM, STATION) + dplyr::arrange(LINK3) - # Join survey data with stations (which now are assigned to an area based on the shape file) - master <- base::merge(surveyData, station_area, - by = c("CRUISE6","STRATUM","STATION")) %>% + # Join observer data with locations (which now are assigned to an area based on the shape file) + master <- base::merge(comdisc, location_area, + by = c("LINK3")) %>% dplyr::rename(!!areaDescription := areaDescription) - # check to see if we want to keep points that fall outside of all o fthe polygons found in the shape file + # 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))) %>% From e9bb4dc10398d9d7c40569539729857ae4909dd5 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Tue, 13 Jul 2021 13:31:08 -0400 Subject: [PATCH 29/60] Renamed functions to better align with what they are doing --- R/aggregate_area.R | 48 ++++++++++++++++++++ R/assign_area.R | 111 +++++++++++++++++++++++++-------------------- R/post_strat.R | 63 ------------------------- 3 files changed, 111 insertions(+), 111 deletions(-) create mode 100644 R/aggregate_area.R delete mode 100644 R/post_strat.R diff --git a/R/aggregate_area.R b/R/aggregate_area.R new file mode 100644 index 0000000..96346fe --- /dev/null +++ b/R/aggregate_area.R @@ -0,0 +1,48 @@ +#' Assign landing records to an aggregated area +#' +#' Takes the output from \code{get_comland_data} and further aggregates from NAFO +#' statistical areas to a user defined area. Allows for species to be assigned by +#' 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 propDescription Character. Name of column in userAreas that defines the +#' proportions of landings assigned to new area. +#' +#'@export + +aggregate_area <- function(comland, userAreas, areaDescription, propDescription){ + + call <- dbutils::capture_function_call() + + #Pull out landings from comland object + landings <- comland$comland + + #Convert userAreas to data.table + areas <- data.table::as.data.table(userAreas) + setnames(areas, c(areaDescription, propDescription), c('newarea', 'prop')) + + #Merge new area descriptions to landings + new.area.land <- merge(landings, areas, by = c('NESPP3', 'AREA')) + + #Proportion landings to new areas + new.area.land[, newspplivmt := SPPLIVMT * prop] + new.area.land[, newsppvalue := SPPVALUE * prop] + + #Drop extra columns + new.area.land[, c('SPPLIVMT', 'SPPVALUE', 'prop') := NULL] + + #Rename columns + data.table::setnames(new.area.land, c('newarea', 'newspplivmt', 'newsppvalue'), + c(areaDescription, 'SPPLIVMT', 'SPPVALUE')) + + #Add changes back into comland + comland$comland <- new.area.land[] + comland$call <- c(comland$call, call) + comland$userAreas <- userAreas + + return(comland) +} diff --git a/R/assign_area.R b/R/assign_area.R index 57106f6..abe2d44 100644 --- a/R/assign_area.R +++ b/R/assign_area.R @@ -1,48 +1,63 @@ -#' Assign landing records to an aggregated area -#' -#' Takes the output from \code{get_comland_data} and further aggregates from NAFO -#' statistical areas to a user defined area. Allows for species to be assigned by -#' 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 propDescription Character. Name of column in userAreas that defines the -#' proportions of landings assigned to new area. -#' -#'@export - -assign_area <- function(comland, userAreas, areaDescription, propDescription){ - - call <- dbutils::capture_function_call() - - #Pull out landings from comland object - landings <- comland$comland - - #Convert userAreas to data.table - areas <- data.table::as.data.table(userAreas) - setnames(areas, c(areaDescription, propDescription), c('newarea', 'prop')) - - #Merge new area descriptions to landings - new.area.land <- merge(landings, areas, by = c('NESPP3', 'AREA')) - - #Proportion landings to new areas - new.area.land[, newspplivmt := SPPLIVMT * prop] - new.area.land[, newsppvalue := SPPVALUE * prop] - - #Drop extra columns - new.area.land[, c('SPPLIVMT', 'SPPVALUE', 'prop') := NULL] - - #Rename columns - data.table::setnames(new.area.land, c('newarea', 'newspplivmt', 'newsppvalue'), - c(areaDescription, 'SPPLIVMT', 'SPPVALUE')) - - #Add changes back into comland - comland$comland <- new.area.land[] - comland$call <- c(comland$call, call) - comland$userAreas <- userAreas - - return(comland) -} +#' 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 (comdisc, 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) + + # find unique stations and transform to required crs + locations <- comdisc %>% + dplyr::select(LINK3, 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(LINK3) + + # Join observer data with locations (which now are assigned to an area based on the shape file) + master <- base::merge(comdisc, location_area, + by = c("LINK3")) %>% + 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() + } + + + return(master) + +} + diff --git a/R/post_strat.R b/R/post_strat.R deleted file mode 100644 index 888f009..0000000 --- a/R/post_strat.R +++ /dev/null @@ -1,63 +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 - - -post_strat <- function (comdisc, 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) - - # find unique stations and transform to required crs - locations <- comdisc %>% - dplyr::select(LINK3, 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(LINK3) - - # Join observer data with locations (which now are assigned to an area based on the shape file) - master <- base::merge(comdisc, location_area, - by = c("LINK3")) %>% - 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() - } - - - return(master) - -} - From 72bab3600a2e6eefd6677aec083b26c4b91f5b20 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Tue, 13 Jul 2021 22:25:24 -0400 Subject: [PATCH 30/60] Changed LATDD LONDD to LAT and LON for consistency --- R/get_comdisc_raw_data.R | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/R/get_comdisc_raw_data.R b/R/get_comdisc_raw_data.R index 606a815..98717aa 100644 --- a/R/get_comdisc_raw_data.R +++ b/R/get_comdisc_raw_data.R @@ -103,12 +103,12 @@ get_comdisc_raw_data <- function(channel, filterByYear){ 6883, 6894:6897))] #Convert lat/lon to decimal degrees - ob[, LATDD := as.numeric(substr(LATHBEG, 1, 2)) + ((as.numeric(substr(LATHBEG, 3, 4)) - + as.numeric(substr(LATHBEG, 5, 6))) - /60)] - ob[, LONDD := as.numeric(substr(LONHBEG, 1, 2)) + ((as.numeric(substr(LONHBEG, 3, 4)) - + as.numeric(substr(LONHBEG, 5, 6))) - /60) * -1] + ob[, LAT := as.numeric(substr(LATHBEG, 1, 2)) + ((as.numeric(substr(LATHBEG, 3, 4)) + + as.numeric(substr(LATHBEG, 5, 6))) + /60)] + ob[, LON := as.numeric(substr(LONHBEG, 1, 2)) + ((as.numeric(substr(LONHBEG, 3, 4)) + + as.numeric(substr(LONHBEG, 5, 6))) + /60) * -1] ob[, c('LATHBEG', 'LONHBEG') := NULL] #Convert weights From 6d13355feed972fe82919f1251d382c6f8371ff0 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Tue, 13 Jul 2021 22:53:02 -0400 Subject: [PATCH 31/60] negative multiplier in the wrong spot for LON conversion --- R/get_comdisc_raw_data.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/get_comdisc_raw_data.R b/R/get_comdisc_raw_data.R index 98717aa..df81af0 100644 --- a/R/get_comdisc_raw_data.R +++ b/R/get_comdisc_raw_data.R @@ -106,9 +106,9 @@ get_comdisc_raw_data <- function(channel, filterByYear){ ob[, LAT := as.numeric(substr(LATHBEG, 1, 2)) + ((as.numeric(substr(LATHBEG, 3, 4)) + as.numeric(substr(LATHBEG, 5, 6))) /60)] - ob[, LON := as.numeric(substr(LONHBEG, 1, 2)) + ((as.numeric(substr(LONHBEG, 3, 4)) + ob[, LON := (as.numeric(substr(LONHBEG, 1, 2)) + ((as.numeric(substr(LONHBEG, 3, 4)) + as.numeric(substr(LONHBEG, 5, 6))) - /60) * -1] + /60)) * -1] ob[, c('LATHBEG', 'LONHBEG') := NULL] #Convert weights From 4cb06b07b196fbc3b811786c94f1ce5c53c64c35 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Tue, 13 Jul 2021 23:01:46 -0400 Subject: [PATCH 32/60] Switched to linkLL as a unique identifier --- R/assign_area.R | 49 ++++++++++++++++++++++++++++--------------------- 1 file changed, 28 insertions(+), 21 deletions(-) diff --git a/R/assign_area.R b/R/assign_area.R index abe2d44..56d608a 100644 --- a/R/assign_area.R +++ b/R/assign_area.R @@ -20,44 +20,51 @@ #' @export -assign_area <- function (comdisc, areaPolygon, areaDescription, na.keep = F) { +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 %>% + # 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) - # find unique stations and transform to required crs - locations <- comdisc %>% - dplyr::select(LINK3, LAT, LON) %>% + #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) %>% + # 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(LINK3) + dplyr::arrange(linkLL) - # Join observer data with locations (which now are assigned to an area based on the shape file) - master <- base::merge(comdisc, location_area, - by = c("LINK3")) %>% + # 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 + # 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() + dplyr::filter(!is.na(get(areaDescription))) %>% + data.table::as.data.table() } + #Drop linkLL column + master[, linkLL := NULL] - - return(master) + return(master[]) } From 8e37f0db189b3e4c00b5289cfbe1ea50ed8f6014 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Tue, 13 Jul 2021 23:31:43 -0400 Subject: [PATCH 33/60] First cut at aggregate gear based on aggregate area --- R/aggregate_gear.R | 50 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) create mode 100644 R/aggregate_gear.R diff --git a/R/aggregate_gear.R b/R/aggregate_gear.R new file mode 100644 index 0000000..45fa6ed --- /dev/null +++ b/R/aggregate_gear.R @@ -0,0 +1,50 @@ +#' Assign landing records to an aggregated area +#' +#' Takes the output from \code{get_comland_data} and further aggregates from NAFO +#' statistical areas to a user defined area. Allows for species to be assigned by +#' 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 propDescription Character. Name of column in userAreas that defines the +#' proportions of landings assigned to new area. +#' +#'@export + +aggregate_gear <- function(comData, userGears, fleetDescription){ + + call <- dbutils::capture_function_call() + + #Convert userGears to data.table + gears <- data.table::as.data.table(userGears) + data.table::setnames(gears, fleetDescription, 'fleet') + + #Assign gears to fleets + #Generate NEGEAR2 codes from NEGEAR + if(is.numeric(comData$NEGEAR)){ + comData[NEGEAR < 100, NEGEAR3 := paste0(0, NEGEAR)] + comData[NEGEAR >= 100, NEGEAR3 := NEGEAR] + comData[, NEGEAR2 := as.numeric(substr(NEGEAR3, 1, 2))] + } else { + comData[, NEGEAR2 := as.numeric(substr(NEGEAR, 1, 2))] + } + + fleets <- unique(gears$fleet) + + for(ifleet in 1:length(fleets)){ + fleet.gear <- gears[fleet == fleets[ifleet], NEGEAR2] + fleet.mesh <- unique(gears[fleet == fleets[ifleet], MESHCAT]) + + comData[NEGEAR2 %in% fleet.gear & MESHCAT == fleet.mesh, fleet := fleets[ifleet]] + } + + comData[, fleet := as.factor(fleet)] + + #Rename columns + data.table::setnames(comData, 'fleet', fleetDescription) + + return(comData) +} From 32ba8f0c36bd6ec7241e7eaa8d3d759c0a9469bc Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Tue, 13 Jul 2021 23:53:25 -0400 Subject: [PATCH 34/60] first cut at dk --- R/calc_DK.R | 61 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) create mode 100644 R/calc_DK.R diff --git a/R/calc_DK.R b/R/calc_DK.R new file mode 100644 index 0000000..ffe0ccc --- /dev/null +++ b/R/calc_DK.R @@ -0,0 +1,61 @@ +#' Calculate discard to kept ratio +#' +#' Use observer data to calculate the ratio of discards to kept by species. +#' +#' +#' @inheritParams strat_prep +#' @param na.keep Boolean. Logical value to indicate whether original strata names +#' should be retained. +#' +#' @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 + + +calc_DK <- function(comdiscData, areaDescription, fleetDescription){ + + #Standardize column names + data.table::setnames(comdiscData, c(areaDescription, fleetDescription), + c('area', 'fleet')) + + #sum catch by species/disposition/area/fleet + ob.sums <- comdiscData[, sum(SPPLIVMT), by = c('YEAR', 'area', 'fleet', 'NESPP3', + 'CATDISP')] + #identify discards + ob.discard <- ob.sums[CATDISP == 0, ] + + setnames(ob.discard, "V1", "DISCARD") + ob.discard[, CATDISP := NULL] + + #Sum kept by area/fleet + ob.kept <- ob.sums[CATDISP == 1, sum(V1), by = c('YEAR', 'area', 'fleet')] + + setnames(ob.kept, "V1", "KEPT.ALL") + + #Merge discards and kept + dk <- merge(ob.kept, ob.discard, by = c('YEAR', 'area', 'fleet')) + + #Calculate ratio + dk[, DK := DISCARD / KEPT.ALL] + #NAs result if divide by 0 so set DK to 1 (all discards) + dk[is.na(DK), DK := 1.0] + + #Remove extra columns + dk[, c('KEPT.ALL', 'DISCARD') := NULL] + + #Replace standard column names + #Standardize column names + data.table::setnames(dk, c('area', 'fleet'), + c(areaDescription, fleetDescription)) + + return(dk) +} + \ No newline at end of file From 2a3d28f8746fc0eae80a368092bc4398b99bf36f Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Mon, 30 Aug 2021 10:50:50 -0400 Subject: [PATCH 35/60] Added tag for using NEGEAR column and fixed setname issue --- R/aggregate_gear.R | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/R/aggregate_gear.R b/R/aggregate_gear.R index 45fa6ed..c3266d9 100644 --- a/R/aggregate_gear.R +++ b/R/aggregate_gear.R @@ -14,22 +14,24 @@ #' #'@export -aggregate_gear <- function(comData, userGears, fleetDescription){ +aggregate_gear <- function(comData, userGears, fleetDescription, negear = T){ call <- dbutils::capture_function_call() #Convert userGears to data.table gears <- data.table::as.data.table(userGears) - data.table::setnames(gears, fleetDescription, 'fleet') + gears <- data.table::setnames(gears, fleetDescription, 'fleet') #Assign gears to fleets #Generate NEGEAR2 codes from NEGEAR - if(is.numeric(comData$NEGEAR)){ - comData[NEGEAR < 100, NEGEAR3 := paste0(0, NEGEAR)] - comData[NEGEAR >= 100, NEGEAR3 := NEGEAR] - comData[, NEGEAR2 := as.numeric(substr(NEGEAR3, 1, 2))] - } else { - comData[, NEGEAR2 := as.numeric(substr(NEGEAR, 1, 2))] + if(negear){ + if(is.numeric(comData$NEGEAR)){ + comData[NEGEAR < 100, NEGEAR3 := paste0(0, NEGEAR)] + comData[NEGEAR >= 100, NEGEAR3 := NEGEAR] + comData[, NEGEAR2 := as.numeric(substr(NEGEAR3, 1, 2))] + } else { + comData[, NEGEAR2 := as.numeric(substr(NEGEAR, 1, 2))] + } } fleets <- unique(gears$fleet) From 65251724cbe7339af2b10109e933aaecdb8dbd2b Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Mon, 30 Aug 2021 11:03:34 -0400 Subject: [PATCH 36/60] removed negear flag as it was unnecessary...probably need a gear column for userGears --- R/aggregate_gear.R | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/R/aggregate_gear.R b/R/aggregate_gear.R index c3266d9..824eb85 100644 --- a/R/aggregate_gear.R +++ b/R/aggregate_gear.R @@ -14,7 +14,7 @@ #' #'@export -aggregate_gear <- function(comData, userGears, fleetDescription, negear = T){ +aggregate_gear <- function(comData, userGears, fleetDescription){ call <- dbutils::capture_function_call() @@ -24,14 +24,12 @@ aggregate_gear <- function(comData, userGears, fleetDescription, negear = T){ #Assign gears to fleets #Generate NEGEAR2 codes from NEGEAR - if(negear){ - if(is.numeric(comData$NEGEAR)){ - comData[NEGEAR < 100, NEGEAR3 := paste0(0, NEGEAR)] - comData[NEGEAR >= 100, NEGEAR3 := NEGEAR] - comData[, NEGEAR2 := as.numeric(substr(NEGEAR3, 1, 2))] - } else { - comData[, NEGEAR2 := as.numeric(substr(NEGEAR, 1, 2))] - } + if(is.numeric(comData$NEGEAR)){ + comData[NEGEAR < 100, NEGEAR3 := paste0(0, NEGEAR)] + comData[NEGEAR >= 100, NEGEAR3 := NEGEAR] + comData[, NEGEAR2 := as.numeric(substr(NEGEAR3, 1, 2))] + } else { + comData[, NEGEAR2 := as.numeric(substr(NEGEAR, 1, 2))] } fleets <- unique(gears$fleet) From 735487547e71db7ebbf45788edfe69127e2d8576 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Mon, 30 Aug 2021 11:19:30 -0400 Subject: [PATCH 37/60] fixed setname issue --- R/calc_DK.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/R/calc_DK.R b/R/calc_DK.R index ffe0ccc..c4f63a1 100644 --- a/R/calc_DK.R +++ b/R/calc_DK.R @@ -23,8 +23,9 @@ calc_DK <- function(comdiscData, areaDescription, fleetDescription){ #Standardize column names - data.table::setnames(comdiscData, c(areaDescription, fleetDescription), - c('area', 'fleet')) + comdiscData <- data.table::setnames(comdiscData, c(areaDescription, + fleetDescription), + c('area', 'fleet')) #sum catch by species/disposition/area/fleet ob.sums <- comdiscData[, sum(SPPLIVMT), by = c('YEAR', 'area', 'fleet', 'NESPP3', @@ -56,6 +57,6 @@ calc_DK <- function(comdiscData, areaDescription, fleetDescription){ data.table::setnames(dk, c('area', 'fleet'), c(areaDescription, fleetDescription)) - return(dk) + return(dk[]) } \ No newline at end of file From e05ea3fbadc33071bc8dce23d431aa41c5a22daf Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Mon, 30 Aug 2021 11:20:41 -0400 Subject: [PATCH 38/60] added brackets to output --- R/aggregate_gear.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/aggregate_gear.R b/R/aggregate_gear.R index 824eb85..5a0e060 100644 --- a/R/aggregate_gear.R +++ b/R/aggregate_gear.R @@ -46,5 +46,5 @@ aggregate_gear <- function(comData, userGears, fleetDescription){ #Rename columns data.table::setnames(comData, 'fleet', fleetDescription) - return(comData) + return(comData[]) } From bb86c7175d2f6e0b649fd936de0a8398acc8b8d0 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Mon, 30 Aug 2021 23:11:12 -0400 Subject: [PATCH 39/60] Put in check for no mesh characteristic --- R/aggregate_gear.R | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/R/aggregate_gear.R b/R/aggregate_gear.R index 5a0e060..a33d1e0 100644 --- a/R/aggregate_gear.R +++ b/R/aggregate_gear.R @@ -37,8 +37,12 @@ aggregate_gear <- function(comData, userGears, fleetDescription){ for(ifleet in 1:length(fleets)){ fleet.gear <- gears[fleet == fleets[ifleet], NEGEAR2] fleet.mesh <- unique(gears[fleet == fleets[ifleet], MESHCAT]) - - comData[NEGEAR2 %in% fleet.gear & MESHCAT == fleet.mesh, fleet := fleets[ifleet]] + #Check if there is a mesh characteristic associated with this gear + if(is.na(fleet.mesh)){ + comData[NEGEAR2 %in% fleet.gear, fleet := fleets[ifleet]] + } else { + comData[NEGEAR2 %in% fleet.gear & MESHCAT == fleet.mesh, fleet := fleets[ifleet]] + } } comData[, fleet := as.factor(fleet)] From 50c296a01736b36529cf347483173357649979c9 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Mon, 30 Aug 2021 23:24:53 -0400 Subject: [PATCH 40/60] Made more generic for comland and comdisc --- R/aggregate_area.R | 38 ++++++++++++++++++++------------------ 1 file changed, 20 insertions(+), 18 deletions(-) diff --git a/R/aggregate_area.R b/R/aggregate_area.R index 96346fe..2e3805e 100644 --- a/R/aggregate_area.R +++ b/R/aggregate_area.R @@ -14,35 +14,37 @@ #' #'@export -aggregate_area <- function(comland, userAreas, areaDescription, propDescription){ +aggregate_area <- function(comData, userAreas, areaDescription, propDescription, + applyPropValue = T){ call <- dbutils::capture_function_call() - #Pull out landings from comland object - landings <- comland$comland - #Convert userAreas to data.table areas <- data.table::as.data.table(userAreas) setnames(areas, c(areaDescription, propDescription), c('newarea', 'prop')) #Merge new area descriptions to landings - new.area.land <- merge(landings, areas, by = c('NESPP3', 'AREA')) + new.area <- merge(comData, areas, by = c('NESPP3', 'AREA')) #Proportion landings to new areas - new.area.land[, newspplivmt := SPPLIVMT * prop] - new.area.land[, newsppvalue := SPPVALUE * prop] - - #Drop extra columns - new.area.land[, c('SPPLIVMT', 'SPPVALUE', 'prop') := NULL] - - #Rename columns - data.table::setnames(new.area.land, c('newarea', 'newspplivmt', 'newsppvalue'), - c(areaDescription, 'SPPLIVMT', 'SPPVALUE')) + new.area[, newspplivmt := SPPLIVMT * prop] + if(applyPropValue) new.area[, newsppvalue := SPPVALUE * prop] + + #Drop extra columns and rename + if(applyPropValue){ + new.area[, c('SPPLIVMT', 'SPPVALUE', 'prop') := NULL] + data.table::setnames(new.area, c('newarea', 'newspplivmt', 'newsppvalue'), + c(areaDescription, 'SPPLIVMT', 'SPPVALUE')) + } else { + new.area[, c('SPPLIVMT', 'prop') := NULL] + data.table::setnames(new.area, c('newarea', 'newspplivmt'), + c(areaDescription, 'SPPLIVMT')) + } #Add changes back into comland - comland$comland <- new.area.land[] - comland$call <- c(comland$call, call) - comland$userAreas <- userAreas + # comland$comland <- new.area.land[] + # comland$call <- c(comland$call, call) + # comland$userAreas <- userAreas - return(comland) + return(comData[]) } From f1d778fbf2dceea1b6eb8b63ddf17892cdd36f79 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Mon, 30 Aug 2021 23:33:21 -0400 Subject: [PATCH 41/60] wrong output...dummy --- R/aggregate_area.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/aggregate_area.R b/R/aggregate_area.R index 2e3805e..6645628 100644 --- a/R/aggregate_area.R +++ b/R/aggregate_area.R @@ -46,5 +46,5 @@ aggregate_area <- function(comData, userAreas, areaDescription, propDescription, # comland$call <- c(comland$call, call) # comland$userAreas <- userAreas - return(comData[]) + return(new.area[]) } From c41031e2bf88f23b42e981d6c4b79a7f3024df59 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Mon, 30 Aug 2021 23:57:10 -0400 Subject: [PATCH 42/60] Put in check for species without proportions within area...assume 1 --- R/aggregate_area.R | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/R/aggregate_area.R b/R/aggregate_area.R index 6645628..a325905 100644 --- a/R/aggregate_area.R +++ b/R/aggregate_area.R @@ -24,7 +24,15 @@ aggregate_area <- function(comData, userAreas, areaDescription, propDescription, setnames(areas, c(areaDescription, propDescription), c('newarea', 'prop')) #Merge new area descriptions to landings - new.area <- merge(comData, areas, by = c('NESPP3', 'AREA')) + setnames(comData, areaDescription, 'newarea') + new.area <- merge(comData, areas, by = c('NESPP3', 'newarea'), all.x = T) + + #If no proportion assume 100% in + validAreas <- unique(areas[, newarea]) + new.area[is.na(prop) & newarea %in% validAreas, prop := 1] + + #drop records outside the scope + new.area <- new.area[!is.na(prop), ] #Proportion landings to new areas new.area[, newspplivmt := SPPLIVMT * prop] @@ -41,6 +49,9 @@ aggregate_area <- function(comData, userAreas, areaDescription, propDescription, c(areaDescription, 'SPPLIVMT')) } + #Revert names in original dataset + data.table::setnames(comData, 'newarea', areaDescription) + #Add changes back into comland # comland$comland <- new.area.land[] # comland$call <- c(comland$call, call) From 9dbdefb7fd33e4d2d14f24ccd5178763b3b3ed20 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Tue, 31 Aug 2021 00:02:43 -0400 Subject: [PATCH 43/60] Fixed stupid late night fix --- R/aggregate_area.R | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/R/aggregate_area.R b/R/aggregate_area.R index a325905..4530ed8 100644 --- a/R/aggregate_area.R +++ b/R/aggregate_area.R @@ -24,8 +24,7 @@ aggregate_area <- function(comData, userAreas, areaDescription, propDescription, setnames(areas, c(areaDescription, propDescription), c('newarea', 'prop')) #Merge new area descriptions to landings - setnames(comData, areaDescription, 'newarea') - new.area <- merge(comData, areas, by = c('NESPP3', 'newarea'), all.x = T) + new.area <- merge(comData, areas, by = c('NESPP3', 'AREA'), all.x = T) #If no proportion assume 100% in validAreas <- unique(areas[, newarea]) @@ -48,9 +47,7 @@ aggregate_area <- function(comData, userAreas, areaDescription, propDescription, data.table::setnames(new.area, c('newarea', 'newspplivmt'), c(areaDescription, 'SPPLIVMT')) } - - #Revert names in original dataset - data.table::setnames(comData, 'newarea', areaDescription) + #Add changes back into comland # comland$comland <- new.area.land[] From 028375d3fc99ca76566aafb0384180c1469853d2 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Fri, 19 Nov 2021 14:48:53 -0500 Subject: [PATCH 44/60] Added area and gear tables to data folder --- DESCRIPTION | 2 ++ NAMESPACE | 4 ++++ data-raw/All_Species_Proportions.rds | Bin 0 -> 20787 bytes data-raw/aggregate_area_table.R | 17 ++++++++++++++++ data-raw/aggregate_gears_table.R | 29 +++++++++++++++++++++++++++ data/mskeyAreas.rda | Bin 0 -> 20913 bytes data/mskeyGears.rda | Bin 0 -> 441 bytes 7 files changed, 52 insertions(+) create mode 100644 data-raw/All_Species_Proportions.rds create mode 100644 data-raw/aggregate_area_table.R create mode 100644 data-raw/aggregate_gears_table.R create mode 100644 data/mskeyAreas.rda create mode 100644 data/mskeyGears.rda diff --git a/DESCRIPTION b/DESCRIPTION index 503e13b..96e8046 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,3 +23,5 @@ Imports: Remotes: andybeet/dbutils, NOAA-EDAB/survdat +Depends: + R (>= 2.10) diff --git a/NAMESPACE b/NAMESPACE index c2589fb..2ae18f1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,8 +1,12 @@ # Generated by roxygen2: do not edit by hand +export(aggregate_area) +export(aggregate_gear) export(assign_area) +export(calc_DK) export(comland) export(disaggregate_skates_hakes) +export(get_comdisc_raw_data) export(get_comland_data) export(get_comland_raw_data) export(get_herring_data) diff --git a/data-raw/All_Species_Proportions.rds b/data-raw/All_Species_Proportions.rds new file mode 100644 index 0000000000000000000000000000000000000000..94e7719681ca1ec6287fe48c781ff06cb997010b GIT binary patch literal 20787 zcmV)bK&ihUiwFP!000002JKx3T#ar2Z;^(XlqizQmaI^|QD#PDgit7n1`%a6R5GGS zWwne{qG%cIz4u;c)oGm0A(=)0Q|`*+dHkQn^Yp%N=kt8u-?^{*+Sm8DuG7b>$-@rvQPHOKKV~c^*-4r z`(&T|gHpdw_Q^ikCx4PO>63l3Pxi?^`BP*{pX`%;vQPHOKKYf*>63l3Pxi?^`JW`M z75ZeK{2NlaPxi@wQ9AU=KG`RKx^(K3eX>vX7TIh5PD}p>Ns~V*Q~qI@^PeIAwfOx% z)X)6S{+;BH(%T=U&t39AT#x_b^W*=r`0*dp+n=Qm-;=#uAAXn~^fDg)>wjYtK7+b{ly`rAKkmz4ja{Fm&{e|%o|PwC%3#7Ar8@5mqRr+$+E>NS2({X6n! z+vi?x_pFuwru?_)qw>Ghe_Jd6j{HgXvDfhQ&+_XBpO>}r50bsikNxy` z>F?T!pR9*J{O>t_^7;MlIsNE;{6TijTKOCKo&EXganR4=%{S}&)p&ogpYHztni`V`~IW-|L>f`5C5I!Z|dm}kE6b~FMn44Nq+y{y8pCa|55AvS@!-r>-@{> z{j=-&qx1ZRmw!60`q8}m&c0hK|Nrt2#}U6bzdy?7ziTI){(t$W?V-t^l;5oDyYu}W zyY<6I6~kU z0doQt1dbCpLEt2TQv|LMa3$bQ;2MD&1Uw1cC-8zmB7p(|#RMt|yd==f#>X$<97td( zfn@|%5LiQCErE>$Gzn}Wu#LbD0y_z46WGm$E*pAm>?L4Gz>0tmfiMEm1X2j(638b| zNT7&~Vgh6W6gHX&v=R991za2i1`!xa;01vs0?7nY2&57yAW%$zM4;^pxOoW-Aizg} zpMWrdF$BgEkR&jUfD{2~0y4kB-9O9OAH`Km0$+3X@ACC)j{X^b{uVcXi<4bk)cp+( zcJS^Ffp7WuE$@oH;@KbN*dOKAH=OF^&mZ7Ouj7Ryfi8ahU2gn;y!e(AU-O~MPJNFH zy9wxh$2N7@q#y#{a^tsb(f9082j~QT5^w&fP5EIy@JI3HNAu-dpZ8DuJDsn%)#dm8 z3cvn{@B5l>B?SH{-u;Fz{9XSy?9cnY-{tGPKfzg(AIRG-duL1F&+<3$D-OpI=;CtT zSA1rlDM#6F@Vc4f=f-o}3H)82TXFm{#=G+;IG;!0uX6v-#DRa5_h|(FPAoX=D_!`5 zdcb}959-37)rTLg6W{8?pUr8$){EcLhu_L;ex?q5kN>)Vf%m@^V}8x~@A18h*Np^v zE3f(gLT+>VJKX*~4*%U;`+I!+qw!}K557J3u5u+oS^Lzbx4*YfYdL-y zcmLL2{T`41MDFw}-u-`h(jT>xKRRdrGcoR;$%mHyhHd*Zxp0?_`Z~w?HsAe$dG1fm zZGWUs`zLbQ-^yXXcXq#ZZb1aTcXmJFp5hPZoCN*$Y& z&pYD*9RjXj?fJLyC=q{l^#5(Y-*Tnvyu0~IaOW5LO!V8y{jNRhidBesqH7;I+k73* zbj9dlU+vvD^X+V>PC)mobrpQ6*BKX76MHrAtF?6O=iM*pZr?HPPL7_tm5zS$div@Z zuPesriX}R8oDz`lMPAPtbgzrhr49~s??cx)cJYeP z;qHCg_s!m^e>L7$vE(meHbSSm&aHFJU7XJQDjqZWg3dk)zvxJJzR=b7+h-yt?TCB1 z$Y1rP&++Asr-A)$4;yTqmad$=j6egizOFNmBEV$h;}>ux5Xd6X+LH@*=5bwP z*?%=o2RsOLjiE#6Df65DyZY_Y)vms6IDTOhyXW??r+#<6uh&}q%k_1R`&HXttf{)^ ze7bT44%4s3?&|9UyWJ3u9vj-R=Ya&e`tG=|sweR681D%Vbj_8R-*@{eA^Q7``F8S- z@X^1@5%Yh!_g#D4wa49i>qyjRezTX3gzd@U==24h=i8+pD+%l*Y{FOT?%X#Ij-KD} zzOBELI790%_&PW1;!Ssb>tD{d^L@uTcG$zlFZQPMyV{q%?&c4be(Y?!G$=E?tHuJPNehuJc5H={dD

8-(`;p z{r|dd$GDw$A00N>h=4Hx69SP0a(es}H|KZS5Oq7p+4vjpUwlEQeGwAi9AJa7KjpH+6`9I_q`K?eG_HkNSd+d$g{yuGqYj(}bPuw0(yO zT`1^@XS>>P>>@Z?O6*NXIXi#iq!MLw2@Z6P(Z%hre^V{`YP_yoq2QY`$DTQKmUrn~ z*L-LMUJ^LmQ^wJ87W;|$#S`TWj_%*%JKlHtq^|QN+I7G0^23#1fs??zU!sGno!={o zxp$P+uw_RM)}^yG#F)E?=PteLvcE)(&}o<19PEsZh%@fC!Ck&w_pA0_>tFLP(akls z-g5|i0T=xXx}H1G9SaiolAUe3=1uUUv)(bHO~<}|d*9l{c=SNMg4o#UAh>-nm$?%z4$zktj23%X*h zPQPjT<$Kq=?m6!Iaz0#~J@2>$IC^YHSA9B1x4-WGtzs*|<@aCE(XO*?-ml9z?1=e( zTQ~Ac{myw1;EMd>hdSzY>Sh+mO+ z*^;f(+*7{DPEHYbHC^#Q*WEz(8GU7EJNCHy{yFUnw>r@Ay-Ux!$~tq4v@hd!u9b-Q zxyS#qkB;ZAJfd?w#2$3*U1uGEo;n@%JHRpKi$CZn>x`QOzk1iDBVD#{Nax>`@o;qb zZ?1ht#5Zo^BZvD6`wDwkVXv9Ue@fx+?OiXN^1nfmUNif?!roulYbMfH_@93=eG~b? z6Zub>=YMtK|46LSSJ+qhGl||?7SvbRSJ+qBSJ+qhKU4U3-}e>v75-CP?A_h}SMOb~ z8S{U+@L#d|y=L|Q%Z0sB6MN0({4W>wnu+x4!oT;r@3j6$3wzB(e)5!mm?Hh}7518m z^y?`am>?{1QE&LN+s@Kf{E$C1-C@!M{1<|7aEcr#SUj zOuc7N@{YRVfzcQsC*L$yVAH9YGKT^|v zlG*qfe&UA_q0f-?0%reX7O~eXuJ^f!zojuh*~0$|Zt^D+?H}{KKYJqoHP)*4sp*gY z)=M1ezsvU@Hqbw20RAyI`X9`ce|2U5b;t6P-P}Jv&A#*h2jXxBr+<{k7qL%8vJ% zWBeI({&7eD6TII)rSt!CVEK~?_H*0x8twQii~Bd6@W0B%zohQ}hW-Cx7VKvb{h!yu z-mSy`>g0QiI{vtw>y=*QpIhEfjv@cvn17+--_)LeLHWL4$iXqF8G z=0mjQ+$S<V3DY z&IaifpVXOkEL4d%MZD6ILfv&q`#sh7kym3lYuOMV)N@%45*>R1>2KPTJx}H!F?RTP z)5*`#aOv4w>g=JQSS%26l3R~*fwMW)o?0k;pJXwMPaU<~%Y&y)QU^oLF!p-LSVZ1& zem!X?H)stB)n4bUQSK;yC$01$YHw-Vc~6!{UgE-*NWWXCS5#@8kiG%wgI)@0;f6pyW-o8=9ZzbtvJ&pFBvtQE+dz@-bC_;O9SLq2cm)VrqXN1 zRaD&$kkecH0;GqN_GXlfLnM{k^n#xQ7%HC57Y(uz8NP1C@{#3WtPn0LYD+}nV)v8{ zUWZV#b8!pclJ&fv5X(OF%QPgT*y?adi0SY9N#dP-ULxE4F!o}Rdw%H38F4d zo${t5QMXxq3@4WoD4zF5zZp0bWid~ZglnpheqoB?HL1O*AKgN`7A}KY zsWojznaaq2x{G(5t`%xC+Kje~L?Ta*S87R)Js7K&Z3~axi^yAv;}*4~f%H-G@`3fj zAejiz4)Keie$0_NdPNJ;Z6;`GUywsh5ciFd7G@~$e4m;rAdLFm=d+*W@F4AAPOMz? zOEm6V6DF{AByvvpCmb$cjgkd=vR*UYL8Yu>Os|~<`VxD&jASk39)9hicW^lx{Wb>7 zP+E=Ht$rE{_%qN@RFlnn$_NQ}^y4Z0mxASXAu}S+3Y5INw+5M>2P?hmL{6g}ibIrg zL$Xv+KSI=}kZFyEjq?XhZV5zEfJn0X)HPs;^519mzl6f_mt5D(CZfUQ)AX>h97s|W zSR`xt8MN}Lv#*HgqiDrlm(twnsN5C!ZkhdUkk|O}XemBK-Kz2Cc^fw(E89pk%>M!E zuj!`PkoA#zUB9x$Vkc?`4D`<%7leEk&41f7Pt?=)_T$>pjI6V5wJi&mprC5V2yeM& z)JFAtV4|@HMQc_v&+L^z!l7XC%1KUWplU=ogld7cqwvOKgTr9%iW#y}lMjCRpIf(D z9z*5n!!xEGz5sITgls+*KgtUaz1mWv42tm5Ga3W6QFiI2$wH1sP$GDfN$uxRxnon# zlf?0PU>qAg3i|C~BHbsXn|K6~RMBm>(m7vPQ3pV^%qe_nW=d*)s~Xm8!PctDDid zcS4$RHeayT1=1|ZhpH_%JnFgAq)X-Nl`@nc!5In$L z0na429(}%WAsX!lZ_cgnkJ!dIuZV5+sB1kM7d!1NGKP(9X8b9* zeQYr*lvWProUjbE1?kztODP~ZjLFGdcNRq)_gjamsDjoWU~_cG4%BS8$-n*aSrl$c zZdASAg!=35v;DOVk$Tm0;-*t-s60~|`uK?g$cjSJGWYhNlrG`yFv1x%lT^3l6!!yl zbn<}-c5$faKSX-Vjw?u`H00#Y(MA2TC2Hx9_o8spIsOU$W@w1qedFTn17NC!oYIti zg}CU2m**_M3;MKW^q3PaAkTLhzjKKs=mRutDwNcb%hLR~%uXA%a>FN%rivinvp6tm zULJ~HN8VHyo()=m$r;6O^iWfNW^l!zdnj1`inNRpg0hJD{atYll-rcH5YjBr7JhuE zIq)NjZTN?-r3r#Y6^idabuxkrmIihXr^7x=b<&G+w^ffl{7U~*t0$cHK)tP|2frI@Pk_ELZz<MA#E-w_m279x=uspC;j4Zqm8Jux|=p^{C?1zR6;Ayjz;m2H+myAfl+pMm{(Z9cX*7*XSu$Bq0#64>X=*oZK-1HMGB)|Lcq+WS(%w!LjLJ>4 zwbM7FV1-uj{F7JM=e5pvSL|H2Ub{})r!*G%N6QM{N2a3QCVbH5m`G4rvSSC$K72y~TjJr%p<$UWvf^Vl0>6co)eplMg3aU;(h1=lyo&-KXF9=-&% zB64nP-&CQ-^zz&kN-C=FuF$-@`7WxW4!-_4%pN4Kq@4Kt*>ZrQNw zu?&ho7LUzw@d1s?#n>(M5h@)xt!QljPBCj=>!!H_B(uTK-^j>;mhQe*=d%Qw>~dqH z2WTSl*`!8+8x&CW!fsTW@}N}ya>|mCA3!}IaIlhm36;;}m5c0o+3~>Q{HaO{+3`V@ z>pmU!Imw-A88Yx3sy$wcRMQ$kIxqObF(465$5kH5wVwgQ*jjT}@Eg43==`Am;FL<1 zl@!tzta4b?&gQ4@_N7BO<&nDU96h>qE@~dg7RYKZMiDE-;e8w#wSGz-f*j|N7ib$# z|I9>Fg;qw2^=Jf(kG%H$og~{1onP0Mb_B8Yc@cs|Q&A(WI9@7s0}4aWghv=^g1L9U zU|`&I_?=xlTdHypn%3`+dGzK25)XKPw9>eR24lw4xI2z0QeG|k#xNa>ZI>R^A0CKE zDI2Shoh~SvaCYqKH4{){&9(3ChK207f|8dbIt2Mu^SAEICV?)f_%X|c4|yeVpN`mm z1T$erVRN=RZa*95l`p`J`b!%tIoB#7HSYfTkMRO%DzGfrJRt+YTAbULKJ`HpNv$^K zU^{|7d8M|Q@PcXJLR+4a55G;p&rJ^%qX}!*OZx9eSU)?X<_CUYe&D5*VM7&&Z2_E_Vvh(cIDLM^aj&W?Sa#%dGMXQWX|VR?D*>S zgHk`a92AJ&TNUWB6OGmN*}MW`h_TX)r{=qYF-dR9qAG1fJ;*G4CD@9lv-WE>&q?6P zlT5n>kA%<|=_24fCJSj}8V{#Uu13wnSDPGHtU!T}`1%?{BQ%;-E?i|g4vCX|_8GYoQ6RpdS#SG8G>w|yd`0#S!eu7x*NY>eL5KTtW#C989e)*aR_!{PqC8KY z)_9D^0z5)ByV(70u3NcFYyz5C{oS8x)F9|g`uy42#h|OJ+%XSyNAAvJ;evN^K!0aP zyQ$;6u3@;j0 zEf0tV#Um+v_J@%tG*Pb?%E2>zKhkt3x3d;+K=H(|VY|uxpzR<3Hf!)?)P@~7`NCHk z<@YOZDO{Y4x<`JmGKNGTZ+WqlbT?RqxQ=D8+98m3=qkX{7F)M1*Hp|L0l8aDXk zvl^5eg&Y(PPXJYXujSCl0bqr>>!%zU3iqRx!%p9o0C|DDyy5UXkT&LRPuDR)t%T9t zTElzn_Ld`MMKY25@U!!sB|4x_unM1A$zGSG$O>tTx2VzNI(UgW6-9}m9_?}Is2N2{ zo13rz^($zR=bot|cTro*fHpHwo!hIQEkBBq3J&G-#_TxPK<(rS&Rd|Ql`UG-E)UA% zGcrzl#6fjvUEmqH7_~m}B7@)LBJY`bE@}8qwx5uRopmP_Ij0|=bPY2Gb8EDO+M{Ri z-!N#@5}qBXuZoa2j9h`-!m00Bt0UO)vWi6Wy~*r&**s3{NdPKeUm9oHtO#;{1*4?? z6t>?ec$S(lf$c{EhnKK+qSSm-CHL%X&^D?GY>g2Fea5ToMUI2-g~p^h#MOyrii(26FFNAj`OQ^`T|(I6Q+c8w4_zsS3B z=){X>DA<}hs=xgO)SsNQGHCr^Jj8XSSBXJZ;4ulFG%}NI~^{#n>=nWKpETc`f$V3g-Wygla z*Fh@UIp{8P5vnv6Q9`6FQRFxEYNAguXaW0Xi%)X_>F(%^tyzMo3QgL(a(5jb1XV1x zXjcJ~;k>D(tpL^QUX{t+lm}@u?=X5W9jWtW$5%~KLw&H>oRlMmDBs)uNOpVyD62Ro z958eR>9UQ-(dXwt+A@7LP5C~^Z^yPUu7{el+57l5>wbPM(%*vFf@L;2|m0cHE=eVDZ8+kO1klg~x!=-XIV7An{Hp6qWo_O$tA+1KFZ}*;S4b)a@&c z8h67US(?{)k2u$&!Z1PhePKV4Q^gtFS5G2?TT*e3Oe^*~-N?3@M+NI`cE*rNZfL5s z{4{d^C0vwUK3MKtdiMj36moY~pepg6vvCp_mx(KhNbhwM3^q|kfoK)=%al=f3jBH%y1AW@3w87rF0V{{m=Td4^07iz3GKH zdmba;kv-|+Is|>_}DZ|0bms}d2jA{fGsOH$|Lqlg7tcv z#BJnZsvf3JZ@z$){VR~sUQ%E>TRwA1jeBuAg1i(Ck0T% zgo^jnKSz0b$+|gH*l`KffPPtK0_f9^C6ALgL(EGTsT~XD!I=Fa+rM!u0-fy5rB$22 zlzHcF7!VA9HH2zXpYWfj`mD{WczOxx* zzx$rgxk+HfZ~(VOsv%(22euikTn@eU+*d=x?;wQ7OE*no z1ez@Ozh3%63AwKn%RU^<2c1{v@@dr(2$HkndB9P}UccGmd73W~S)u2@Q|CSys-}}d zgwny1cE0{*F zSlj8z@ZL%0xt_QN%mz+Ym_`6fZM<4l?N@`k@R7~-7i9>M8#DN5$xt+zw@D1;`HT#Y z)nvJY?x-s{aOMg1I#NC~ZH_FFMt!WU|B$n9L913#n-<}RqDAKWd@cqeEyn1Sx~3}X z*V452*Rwzy9RA*^wGm~G8jFN1MM6utW-yPBtD$Nby92w%z!w%o1c~I+FSy^hVu$#=9=+}Jzjpu*tmJMaPDO=R@Wc5i5L(1trXp`RDI+m7|*(FI2{$V>nKz9 z03%H{hG#|?ysjS|!o0}NlX*01o_}PZ{_@5b?-uYPHOx;?N{EI;W8Yaqdvnn!6BV;h zV>%KQLnq!^yb=vTd7{*INf+ES z`gH{A>=hf1#ScSF|{Rn(?v@oEu70h{$ zMAO_?A@+T{!@Y;>^*ld(D2*K#>>h5HzhkE%Sf6egFL9ZL=T=5Fe76MAQ*g_s%2XY z!F*x3S*EA}=?_KRZw!=0(}1K~+r|1J5Qk*JG~cj3xWCYWz*%mejpp_4-erKMWyugBDYUD-REODB>sg>xB*yY({_3dYeDX^ zn=>Cwy$`z9jM|CyQ(!I>G5dDrRM}EYAmZ@NHhH@{V7xk@ZT@H#62nz9!?o4HT%^tT^jQ`3#oKBp zuMa}*@#Qo9wtC~mDLTLHelajiq$D04x&?dQeley4%E8Kh8R*>qp0nK@^|uxzs1sWlA4P;MQKx{?m_logP9y<2hr$gk#Wy78nJ1^GxcV0qj9P7 ztyTwj6en;58`|#x>pZHSn`N={&@<#5V|S!d8B#*+?WjM)^KJo~CneGFg z)RCqjIz^&vzTH7E`nQdbc*M>_FE=DD-IfE!?ZNNHDm9{%!+5-{-ww9@Z=pmx_=6G5 zzVj&DNE zWwk(~k?g#(T>q|A<|8D#$BmSxv%v5kP+Y`qf~Kq6=FD_z#*>XQYjz(ygmOs^Cws|$ zpgL7Y#@WwAfosBu;Ea0IgxqTJ9eJLem&fPnM4v|R7V?2+ZU!25#U7-d?~kOz9~BPf z*P&$4#&hBm-BG`8E6?f$myj*bQ0M2p_r~!SGz_*{ z=x!c>8GDZ3pIf-IvC-xd?pf^?~zp18CFEUVNQ?5XC+Wis(Le-XG4PV#aVsqSWW+@vFU1 zP$^*kXwYputJV>j!pVas5^YRbu@#t~>~D+h-48F>t65vlt_16V_L5B=<8f8tl6P}u zJ8IV4KB!m9iNak^#pPFj1|!)=dHT_@cpBIA*>)KhnvUFZ7&GS_LNtV;`>Tb3$un5V zCshKEq6MY%jU++7yZ`LGC==Rp~2pmsob z?U1GF$Y(mutTxr|wlh>4Pen(EB$RxNwWl$UpuyT{oSXhY+URjVOO>r{rFDGhb{q*Yb7c|jH)92VQp z6r}U}AGPtSAacW5jiqhdz=)V1J<5;*#$vPkimU2C*%;U+eEvB|m3DK*eUGv89cGfr zWd=LHA7?62CJXwUfS^$2VQjs*?{U?#g6-d`+>;hmqfpzCQ+p`|)qLWi8tlA*bo`+7 zCauHB=c*7Ww$MVo=CxgmbUvW6@x4+#$3u|$xyb^Sen>wXJYtF*J3fw_%xjUbhaIPA zC!FN9K*+2Q6(R}K;ohjrZJS{UmcpH4YUwSIoUc@hDb=8=qGUNIgk6Fhe;j z!hPT5;V9+zm0QBR09t=OVPjaV`KcIN1a&5qXaiGn9r#O1IGm2e?o=H}y z0;M4G`ooKcDBEP4=0lYM<$_O2{JE>BIPELXvu!ZwHz&>C7{!B}ipH zM4a~-amaw}PtUJ?b7PAS9H($yo9K2P4O3rRjdLH1ltZ&DjY5{9E^x2Na6UVf(U(N) zoO%uV($fL!4l$8?=)K=|F)1`HE8MzFZZ<+=H%?7DwHb_s4No6FwL;VYfBAE>xKQ(I zR`}B9XcUOMIv*0VM$@a4gNJ8^fHKJDWuyEml!`e8Nz7#P?di7s_ofp;T{_-F$mlgn zO~c|#$BCh4W5;I`3OnTn)GkeaO|Ota{vi`lxn&_J8LDq{PDBmVcWP13TDGFrF;l8} zg(&i9x)Gxcv)Q~Jy2QKnC7b7!hhGek1kEpMboE1P6g@bdr0m1ahmJ{ZHHwo&j@ylw zPoCZaS+17La`rM*ddzI)ym|;VR`(38gW37F$Jw(tr(a>8)2tO+WOk!`t()QMC-cx? zzwn0p;8`f7_jC4)mj^Z4In~8r7fP%u4iryT1Z|8!9M}CZD2}Z={_#;9$RQqTR}ZJ7 z!ZlvMaD+a{;l<*Iq#aS=v@UT}NG&M7pLL5@RHH12d)B%GDkxArANHzl5Nax)jXxvs z0W_cJOKBs=py-(uX@6!MXs=f9HRf|ik+|**Nk%qkA#LyFik6_rwf|rb4KvWlfjTWN zjwn*Rt2m;FPVA=!Avb^Xya`mg%Z7C~)KMZ=yjd%CC(4_11V-A82Bp8-M^mLkpgiI< z$m-V!@<8{a+ol~wnRm{X`CI3(%SG~c<<)?CQGxv*86}-x04nL#HD2fbs2c1%d4Nks#mCTC$Uk59QyyXhibb>s zM1U?HRx5cz9);^y@KXv|pvK+|DEdf4$%&-<>-iN>KQ(sD@kv*ZzP!~&Xd^rC3@bMb zD?fm^72_|j7=IfLoze+O9mR&xsN4Bwb;Uw9UtU#_XYx!!U9%;=$L)EpLLTa0kV0Z1( z<2*l5^D~2I?{7hg=AK(uCy0U`d0{$T?KE<1>0UGRKcIf&^%b@%1;}ug^x9_ZhKA7v zjkWw_q&yq7!LXk#r~_Ad^?PW6(i*+!mfM1;w@oo{PM1acggVBEH^rb`?%V(rb*}#@ z>Jmk(rZl}nmZH?12=lk742sCKv+-(xI``tcTqA&tYgk>n@aQ_eXtN6lOZ>8+Yk zd14kIufSmaii4;$v?fnmCh^TU5uiG(yLbDv07_U|k0aP|asA`8<>`F4ktuxjaLd6V zs6Vm5h=czzvX`uol5ej9y?#fn;;kCwOkF(FK4A`O)6Z;QEy9O9{Z~tLbD5x97$g@? zS3|DAB$JKa253Am^zfsxfrwlCY^uu1HE6hd?7)^+7m#QmvBrH~UiZ8k4a75*13n;b zvqRb^b#YKN7G4)yDvr`EHtFf6NuXCxI!rPbMZtRE@~m7HREHNH+yBu6r18QkXgk-ZN7#A0#gt`YE1j2+3~ZsOk}1fXyVxn?~yZ5KQp)DEMEr7Aje-{?@@IF$R9`TST3oE3V~D= zn>D=H(~SE0;e{Yu5=C8$kQ9PV>W8hJ;~6g?jtj@mQU zCoAu&A@AiU9@WtOXtd;v);T!^dE6hkECkkp;xWa7Lw+mD;(Z0$Z>WLv>`u8%-DXss z3tRDc`Z^TNsGNQ40RuGpP~905&!J>kQBnK=O;F#uxOf~d0Oe>3C60OvIIOhr7NTrKY~2EEo|N?wtaJ=U0EIBiGr#*rF$;M zqx5K%*5Qj5psEhZO^k>~<3aK#tXzjUg<}F-MK4hP`KlSmjC4>qLRH)8qfme6M4QrB zbL6xP;OF(*i`u99F$1$bkmoqflBOMx`ps&aRyjRDnor)n%*gd9UOmZcuf{XfWGQXQ zOW%RqV&UcsyX-(8ex(1?tVmRtk9oTwXcNfsCOj0`LXdL;v#!1OMxI!+-%a~i)Hd4( z%y{7mx~J~T>c@ML6FW;n`Nj+|Ck8*L*wBc;JvH+4gEylrZRD_=n8l!6e{JUGSZ2+?ZS{Fi4O0447*eee0*DBCt-hFtx8 zP{he%mQmADo}iS@ar!ps4G9p+)*{GhBSlo8P7bJsQ!#QIE(QxXj;D@)o z$n}uod%y@sxyvA*&nn`e%zppSs_GDGE$!F5xEhXPQ7NIAJ+i1umKhZoDhSfe1I-hq z%|YJ6ciBtuGb&dz%A#xgp?<*aV|$J7qH(eDs|0pGac`9sn6J-+KEC3?XeWK-hAs6? zs-6yd#j31pqqUJ+CzUUJQ3o`Z)Ut=eSE5Mrsmbl){b(AJnm+R=AHvOp@9kL@j`{`3 zQM`Mo$h?#IWc7LlkROfX%Sli|h4*vDj-&Qq@kLB?UULv0DIcd6&7gzz{^(hQ>fJEd z?#b6Y{t1|C5@NChqL4RmoX_wQAuy#$2lnkff`=c|b}%;tqtbfx(HNtTpstxyc50jp z%Fc5JoUR2(Nd@YMTwZ}RCCb2lQ4Cneod)_W;(?RnXSMKZThu0~Esp#6~pugYq7$B8|xJjuR&kQSO9(cA3^$QIn!zIrk=XCL^$79&>{HS&F z-?$0j7R5Z8UQ-0-owsdUr?BI{m~7z(74|4OrBiTkX$xxdugrFplSR>T=4$_Z3otWX z1JVa(f~ltxH)xAFQg6gpi|HGK=_ozzeS$f{rv?r&jW7dasLUz+)#3xsfeny6t^gR?GRsV76cM`pl9@tO7aDVQ-aD zI7lQ*?Df|VSgFbVkHb>Xk*}?(TvT^qh%=1GfeV~ly z;F}ufn=7g=ruUZZX)i<0L9cB9rH;^aIVh{h{v>bCfKm&3m0K0qWr` z;Wvdxqf}&-Q*vP{nkM^NUZL9|HlyNFt};KGcE%(aR?|?k*56t1$uxGp>0eoUjh%P1 zVs_|iv7q!cQ+MrJL$KPGCuwXN0m_Db4}(=@kUM>ib}QRo)OmYrIi(AA&$re!`m>wD zSS0IRpkGTn0*Zgk9jba7sQzxoPe-opu9yDu;-V+J2cb4sP|M4z9C=q}Ia*)eiP|vT zr;yKK=OGyj>QqUf51wi2p3n>?w{Y9gum*%2I`1mYj$51B&kN@&jzF!{Op=Yd6!M?C zFKpfU926zzqxn}9P;Of}M6=WhvBNn;X5F^KQ+<-@xlKylj>9Qko@8+6z*Sk7oVzp$_X0U9^>^3bgM#k0?tHd%)aWLiG5Fy(qV6}`7 z@@)RZL43N~<=Ah@4$JEgR(e^s&?cbvuH%%3Q{lL;^0{!uS|2dOk4v50dI@Pv71a>M zU=-%;y+V%m23`AQil%BD%Jy!kKR=6|2Z}5-3}!w>Vdc1OM@BZF(70~-M#X)o_2k#y z8hV)>hc|^Vd5@xSwB+IkYweIMdM*3al67db(WnYMQ;sB(p|HctB>23wjr5+r1WoHnmcX0kc8dw%x4kiXe(tEE%@4v>vq$ zPql8ErXX*Uc8k&KI5DKZ*` zFD#Dl&rJbMSat!&8y?W-%Sfh^l2LR?z)w_t1+qA2t+zE}!pUg?nPX!(+b*9P`|gtl z^3xO@j&0FEtr+=veEw$8sx$gMA9f7oIo7WptSdyt!JHJId)go;i`;nlAP1pAPV=`b znSgRHe~&~KJFero!CYiy1~SE(&f2Jjif2aa&)t6vs=J}~cAw>7MW$XVA3qT_X?L$` zG-#sAYp^np@>`IG)ogIPSqF-Xr}$clrJ%j3pJ%7M5XDDKbQ6kCf;FI@slOLLNUZ5& z+udVOCFvc-k;T^k1YQ?|^+8~sUE(`w-dUuKANa;=Av;bK{SbTU=1A1J*DmxSjYIKC z!QgRK#%%pu5>YfRpB)d^#qD14w3|1~0*)xV@>cjnw}|*CE2DUmyW9b@A!w}jd}ila zgBWXT;d(1$FebR1-#**H{A$>E+H8;+DD4XrIEY=1|e?Q%HxE$Ca5C69^jLG|h|p3Rk| zsC;w4TTM0*C29fN0+^cAhF})q?N-jDud$e_HOA7uJ5xH<8H8WQe>h6g0VbLAm%rDE2U?dzjOHl^;_2 zomLY%7=iMZ5Bo|-I}`7vi1*J?6JMdk{tpGmmf0R#X7^41At;$V$Z(hP98epMrLL*2 z>ABavp;YC&jorVSlswPd1E{-R;2>|1flQac>Ny*-*v|?k@2oA5yEyl@P%Z^D)w5H) zR+od8aZTb(;tkYopL)*c%x+YjUr~63Vv3qeYi7$nyMxpsx>T~-V$`2oI(N`iIn*qx z7u4O~*fZ`6z3I2DXQJfHOs|Mf?x1X5b9>RHSkO-L3y9y}0dhjEC?_c$Eb-y^w1L;xlIp3FKIMc|18j5%rOqIWA7z57z4wHx0D1v88|VEKHK}J>?D%Ivu~qQ+sYo3aac|&LYp_b+lk7Qn;WYQ97wu~v zf_iZ1))0}6sCK6cojRR@L~-iA#Y<xemBO_Ck-RI8@94!b+z(==<2S1`lYwBi! zjqyEvZ{rnj(0c+BXWK#k4BwvevYlzxH@v|*oqN`A-hI@LUEQFak@zdS!OB1V*!)}$ zSZ@tlA`{sDT~&6Bex(FkPpE5`yT0nFw|Q)BZue(^jeZ_p5%P~doc5mG0G-qNJHg1Ly-bj7MQ2w*v+?_V$;O@Wc-cm%_B>#%5FUEn!ncUAQ!~~3m!V$955)d_b{lcWPJ^E84w| zDV+o@LH^k2TTLiBdSh@>f^>KP)o(uUmy2`)sUJt$UT+1Iyx@{uRxuWhB>y$3+tiVL zFMMU_-3O=}v3}}$*Q;Qu?i5+NO%=(jhfhe86-2|7XKymilt7bL(~PW>WVgTQD)+7k zH96y)#2?K<^n~e#y7w1@A@*^Y#>)3-I%QooMqC3F>r;{>N+3wZ!>+u)Cy1(bWhH~2 z)PcpC6yikUK5kGTH5^T&)GyyX?ty{@nZEmOo1um> za*EnCRiwzycdwqB2!^&TSHSug$cWr<@U&+O>T>+4o}yexJR5%U=P7@*~|&1 z;>I;rW8=UIv9#JYW&&=iPp>RkCxX)b#mDak12l!!5wmtrMDazwe7AXlztV>;*|=kA z(u>p!s4~Al)T(4LNb!^3;Yu}_bz`PkH`l@Y)IbqZ?h%xQtZCo>X$2a}0!oxh9wOnY zy61pf%fQN=HvFstJFl1+^Fge76`aq=RX7f)0?RbXe3aW$)UAKhfBxnx$O@TEAL0F& zeO`*A*DYTJ*2j42!|*87thl~lZqXt%a5qL22|J`>00d}q*3C+b!XFsyD=_Uo^O0+Yx6R_U3e zcFF_k)N*O$-}4PQup$(V(V<6qEPM2{LWlZdj(aM|*@Gl$Pi}x5q2@c~s5mMv=?D7` zO+uXa1#`j0!aerKa1i5ot3EF87-wR2`8_H`IC7Ug8whfXrJL5c51>ik90A=BBJViC z(FhcQ68UF|T5P-5ej#P$BNTdGQfRu&0ClO6&XpxVsi~A=>5m6K%VN;Qaen!z6rfO_J=lhlz1N%YemAHY@@KWVvp{m-d}m8nMir}V z$lDp#pt!Emxjb4JW%+v*%aaSxc%4csQ*D`sx4=u}>aN{><@H$5S8J}D)87OIyl#7i zrT9?OHfz-pqZ6phUot@C!ax+AjyccI$3Ur(*M>O{%~9iApg%QpQ;+|hO!qKO(Li0l zc!jj82-F2H4%Ta9`~CTE=I;^AMIA?$vGhzku=rNTy?=HK4~v$0)jik?`W_K}QEeLX zC9l*wu`<~4Wb9Poryr0qm-S}RR$g{~#>4fI(-UmyX)v`G4E^aL5JbEv{ z1mzU5iKBTfKpE8Bc(6?si8_sWi$#osy#CC6l$z@%N47Y zpy1Oyk9GR$NE{{M?^%BgRNLIPwXdTxz%{y@0Bs%L0-@#RB~(Q zv+ZH5=FBZaZBW@}AQ>rh2TgnSH1RB9q9ohg=+1i))RoN7Db{+9;?mk%@?#ZIDPkP4 z;`CThgC}k=VCy$k!-928dHk>VLeuv+?aZ%=;%Ra3D;tlZ!SL$k{0Dp3dF!-KB;`6> z*S8*AeV(1a%{uAw&}1db&ej|}dU|Vjd-no^fq5opzlt|5-glL=!-8|q*Bmd11$hzW z_@Y$yIH#gCPi1dJQ-iZgm7g$z0*;XR!?%L@d2m(J0U3CW;Tk$o=@OWvb6SyuCc*pN z)>+fVHBric`&07P4e)jo&fR;^rzfu8o^?F(-CX!fiK>ph;D#C{$*BAV7ASEqHqp~K z-d(S0_2fs=yOcp!S-yM9XA6`K*>qiGMgl1B3LdxYWydjZMjxBsItCk)2cP4Moy5)$ zf;^ACw!#iT;hq;a9g_2s?%s%UUY0i)T!?GA^vA&W5dPKBysV? z`Vp?(<#tA8F%wQ|{c7JyUG2g>xGIld21|-Zcut}%SRWc5HmbN|`9{_Cue|Bq^`H2! zo_o#zI;i{ADqdctqjaMFQi%e2G}f)Xe(uO}P;1p_0*T2enW;aw?yw1H8~8rn9%F#w z%?$phu~R^0MYXb`KA~i+&495s{n+O@alePydz8L-QR~b90aXtBL!*{Ug4Xcj;l5#w zpv;w@zOK*_<<2*}wKmYv;5JIWEy)Urx3A0+tmOi!wtq}WJ3B6Pw-&ap*8}OLTz%j* zXHe`o&zwDNhKe|eskH2~j$}I(z=^ET9OT1+6z2zg! zcE1)eJ^Bc&`kR7v7aWi{g=5`kvqn5eQOjDU1L`Vc+n$ZAMux-tfgZO|JtH+>dkk>3(D<&FF zY;Jx#rpM0~)X_AS&wUKKth#s5+}U7hRC>#fyM~gp(#u8*PVI?T4xe>XnSUHPgQ8|e z&Q1aSy;rTI?r6j~)CTW-bQ+D7NgDTuk3qv;1JQR)qKJAnL>7aE;ktiYrkvF#umTnA zd>fA7+Uu$FMh4GA8Z$Uh@lhMOxHCI1Iy)j!R|F4FdneaES&Ty8 z>(|=WIQ)wLc{V{i0^jqXHp(~0kNY#~B2G9NTe>1sVqnx_PJb{n7G=j9$%C>WXM?)- zQ;-HQ|qL(R~A5$Bf;NA2u+XUxWUBme4! zS3)t7$hFj_G_dUeU3u-rb60!ph3jkE(GBZb;ASgn^!YhEPhWa!BDH^y{g3llG?6x} zBQG)zwQt>mD~`>Y(f79?;+@=$rHfyIK_1C)o9lzd8UCwBm>D8|-lp_>GHR$jG|qOM zng#MlJ$v_jpCD?JwJ5EY7m#;w>3lwpI^v#S9C1(Z49OkGBEpVSr=9nydp3i32I%p} zv}Ru5L|t`KrQUjfWLVM8>4j<{c}gqeT}CJxX2tTv3FiOmnR-+$<>Mi?Ul^)yBrs|n zYK=#JnzHv8>Te%7>)n4NQV*>zJzm=rwVwb<$O5HP9IS zM~BYchNe4_rlaRh!{f5ydnJ~-g0-$Z;#uZkTupGOySGCa71~xS;(``}dVZ`)YuJ30 z)JIDUxN-rd<2x4&s$u6vP0#(Zv*n@n0prkk!%J%a#<^hCy&hd)HF-r6^o{QA?h61Pwzyj}+=|Mef7cZWO80l6+F<`i!l=nF`ycj_p}b%0sev;{qOyJUO* zY2$WOtX0+gFqQ|@cY`EHrAnh@C^a(0FdVG)Ni2uDL|pY9H;6*t^{aK>dD5SM(~N~+ zN_2e0@vu`WfobkP>eQauJ^aWm7gX?4`0jo&g02l*GF1T2j?cYXw*u>6n#y_wSF8uEJtj1--MoEvs#nD0G z`v$YmGrTgWt+^1D=8Z24##{%ft$wKNG-psNef+OiMfUv8x5Rc*B3ToZN~MNdgExTr zgxjCja1jEcgA2lH7NKdSz2kuy{0I$5ckwv-0IUN6j^srLQ0Dv5@$~1H#C}gA_B#+o zEBr!&*BpY2neH@J=3bO|oVdv2%R=(Y`7Yxa{gG32ZQ7LmX=t>`UHhCZbG7ZZm!k~y zwUO(FX$v7QY$o3=_PDioYLCwtxRb5d&zz(J3Q=4}8E=*D2HLQTP0`n9fqY)PPK-@e3DGBCv2vLM;{a(Fc=9A527Ua>o}lQ2aYS4^Y-A z{Xw}KefC_a4a!2S7!59MU@^12Ro&dcdi_*%xP=m;Vk+fBEGL5@OWWdSG760svxC)~ z^nZ1}@&5IqA}{xVsdeCr#wH)cFIzEuN}(Par%ipETbo z8m?cM^MKjIj}?9;mps)`Bk*Ct$djH}YAQ13)JPRX=ZDvd^TO`Du=P-jZeh>CM%O|Nd^xUH|X(3#%kF17wNOVq0z!ao# z@yt71a}M?Gr(XFa-2!X2cSY+I9b8jO(7tY33-Xm1gBvfVqoTxeQp%az$g`)_2$p7n zY;HX79=8C_=)ZZsJ0l7#fvODMQ!?WD3-U(@bsC5sWE`I$%&+jI8u2Kix3I#*JP{m`)3N%P0$yhyQ@3Spk z_tU76V70GT-5@vuRjXu&wR}7aQYpjC&gKR2>_9yC0-mL}|RQaSWW-4?c5W?Y%|;QRiJwbt*( zqSy$y@@Kdur+oTuJ<4gSTk-yxD0{Dvvu@(`@9IsL^ag3kuI6Mg8Jw+tIR#+7d(hu4 zM;z+D%{e<0@8hcc;1oyxGhl5pwtnvR0FA0ihYxs<1w~fvrjPAyln3i4J$w5MH6tdS z_imR#VZMLe3(k=4{yhXl?S00u{nudM1!*jH9%VICW~4i^klOxje_s#Cf zJH1lpt=Bb6`d$0pC8fiUoH{w@Ajq%Z(EW}Gp+a=HT%d3%Xs&c}mDp?)<;f|kq+j{< z`%XJKfv}U0QLZJQD^X4YWnHbC$>ky4{g)bt3SBXu0_Ltc$E8cBpfGNU)!IWDsFA2d z$dU%xmv!IHuY2FU@?IzJ;9Co3b58uZG5gv6;poT8&k^4}7wXK8 zj~q&`b$mQ~^70MB>&EOFjr`4p+hZ5}dY_nsws5`NC5A_0#yKCVbb5GUR=@w@1#XlN zn>xXV-U{ZL$)aN!K!Es~ldlv9{AwPoS39kIb4;*Z`E$_DF_V#U>BbJnNv}~~F>-=d z=;B|kugPs z`X!5q@BP;-(NI^P*)^9HMr*tO8MXndb#;u?4;h<$JK?TX{k=XpKK~!T81s6XB>@1M CKt0L; literal 0 HcmV?d00001 diff --git a/data-raw/aggregate_area_table.R b/data-raw/aggregate_area_table.R new file mode 100644 index 0000000..4819127 --- /dev/null +++ b/data-raw/aggregate_area_table.R @@ -0,0 +1,17 @@ +#Aggregate areas table + +#The proportion of catch inside and outside was calculated from the MS Keyrun +#project for Georges Bank. +library(here); library(data.table) + +mskeyAreas <- readRDS(here::here('data-raw/All_Species_Proportions.rds')) +mskeyAreas[InOut == 'in', EPU := 'GB'] +mskeyAreas[AREA %in% c(521, 522, 551, 561) & InOut == 'out', EPU := 'GOM'] +mskeyAreas[AREA %in% c(526, 537, 538) & InOut == 'out', EPU := 'MAB'] +mskeyAreas[is.na(EPU), EPU := 'Other'] + +#Drop InOut column +mskeyAreas[, InOut := NULL] + +#Output to package +usethis::use_data(mskeyAreas, overwrite = TRUE) \ No newline at end of file diff --git a/data-raw/aggregate_gears_table.R b/data-raw/aggregate_gears_table.R new file mode 100644 index 0000000..cb9ea21 --- /dev/null +++ b/data-raw/aggregate_gears_table.R @@ -0,0 +1,29 @@ +#Aggregate gears table + +#Gear designations from the MS Keyrun project for Georges Bank. + +library(data.table) + +#Create Gear table +mskeyGears <- data.table(NEGEAR2 = c(5, + 5, 16, 32, 35, 36, + 1, 2, 8, 10, 50, 52, 14, 26, + 12, 17, 37, + 18, 15, 19, 20, 21, 23, 30, 33, 53, + 13, + 40, + 22, 25, 38, 41, + 3, 4, 6, 11), + MESHCAT = c('SM', rep('LG', 5), rep(NA, 30)), + Fleet = c('SM Mesh', + rep('LG Mesh', 5), + rep('Fixed Gear', 8), + rep('Pelagic', 3), + rep('Trap', 9), + 'Scallop Dredge', + 'Clam Dredge', + rep('Other Dredge', 4), + rep('HMS', 4))) + +#Output to package +usethis::use_data(mskeyGears, overwrite = TRUE) \ No newline at end of file diff --git a/data/mskeyAreas.rda b/data/mskeyAreas.rda new file mode 100644 index 0000000000000000000000000000000000000000..eb318dff9a124ca5aee8dbdc4b09308d59fbe616 GIT binary patch literal 20913 zcmV)dK&QV#T4*^jL0KkKSp}$7n*eU9|NsC0|NsC0|NsC0|NsC0|NsC0|NsC0|NsC0 z|NsC0|Nr1Se*ge|Qjt;tNl<_Q1ppJh>+fFHbJe-3>}p#MZaS;ByNs^uS+Z@>&P^#g zvvW1ub=P;bPk;{&ci&#udu`&r_kB0JxzC$=_HA>!UGCg>Z+kl_zWDHc?W^wVJ9WM9 zJ?m$8Qf%(rsk+21k3FZm*SERLw)eZb#6E(NDyu_LK&42aQ15-3Q|H^c6-kkkOr|sd zo`PXh_JK6O04A9*j0D8Mnqt;y`AvvvrUg&YHbF;K`9N6DCa!GJ0vLf=?p}qY;SI*iBC+CYoeq$&rz% zK|F?<7!rDEgeWvb5D|y~Mwlf(6B88LWju{1rXXa~MnuzS5}$#pdnDRwdNgEdq{B(I zF{2`A(TRc{fi&`lfs%QudY_;sCKFFnCel4jG@4`{DTP5Mr6Nr-29)q7jWp8)GGxR3{shyutdoMeg=!$Bm3SPBqPWQr_; z$g2TlrcjF_g2F6|PLz^Ju~rHKz)}dvuvruoEUE-TEP$YoIs|~EiveP+779g*DF(^{ zkWeBq5Q58T_rgL7NT8%xqy+(BBLQSsp%hX@Qbhn&i#(zM1tP!{6-Wqzk}8V?NDByz zf{;=fumD(!$q`kGLevqmsDz3_Hc%;5M1qvkK&rP^1X9)R-IXMeP*sYs6j&(;v0#iP zG8ef9;)2o=#sa`uX_h1`R2BlrECm5#G65Q+)*x-t02q5ezIzMcToY~h`m7(Pko7FX zlMf(3kP;ZIZ4j~$fxH9)K*0YL{F}I1fDn@2_i|dY7NjJAk)O8AcLnmjZl?ikbNZ`3 z!gcx0j}CDTakrKseALxOpm|}QG?(@ugqR_sx|DoS2ny^l7#5tq>Vy{tVh0=v1}$7) z#iVandaGV*ZAo+U$ZGlx@c1@}bU_Z3A@qo0u=u=3T>R*p&Dn_;`t`^l%Mp5amSL+M z_{aYw(=mVgGCh@9tbokHVi-TXBg+NAIXcy)<8^!#bz8U?)>=W0uR35Gb|9I_ks8WhdLfy3T@d5~?Hf^mSf1U#lBo#mV;fMgvG*bs*|Aq4j} zp@m))d0tvY>5puLCxNrel8X0&PyL7FBr#9}sFibBz3wl>p|fcYnf9a_kf8)0qtO`U zdQd3n5F^xPkjCUTT}A-R6c{0s$ei|M5hw^l0v=Zxye{XMxsV`87pQlx{jY^8bKE@> z47&(T`7CxY4&?$j2r+y)2uxCY+o%>mJYUi8fM%1!n=E8M;vu$KXH-5V$uoV{kKp+oI~c!nl&J>Xrk z##%v>;p9OEGR-JZpn%Z)XfQC;1}JXvsh3zWdU~P>FzC^ma@1}crECfq%Gfa^j2s+; zlp5?Hoe+{_70(2jBp4(HV#EMv7_tEmln{!0hJJ=oq#I9|fPn~+NfHtOV08@MamX@$ zIL;cUEXI}@K`dn|be?`4s*Xye(vInSQ@owQqAS66W1fXSq6tg|Lf@%w}vFBt9`j-7&RF=4fQpQGg+y&`WxO1~gjx zwiYfeOX1$JtV6a0IwCVp_XdT(oI~Js{*vd6jB`}ju4btNFsqC^Yk?a9G}Tp2nkZYC zxjT2+GWf2FNn>N!1T?`kDGhuk#{Y%1LP8MCZ#j#eHq_4E<g?|9tV)tswUt5y zv4IT=K`{tY)&LWxbv4#Xy%|GpqsT|ya|$rv|RynAa+3KG*tqiYjKnYCdeO9jI(v9 zSQ*0|XV>@LrNAM*W_r_t-3rXW2uX3IEM;T33`Rcm9!{jl*_=QE7u`m9umBCC2uT19 zb2cm_2uLY&;=z1+sYN2xSxlrVidv$DVNoimr9o<>6cGhjptPtI)fB3f)l^baMyi&E zlBB8%q@_ZIWeB9IC>98Z*kqEBk|_vSfk-t=N+_uyh$^gsNGys-Q&dqF0?3F{Axv0P zN`j#Pq#!JWkXaT&0>~%|HA7HEMW!qff{H4!QYeWLg2IrYswt|bMw*0bf|4mEB$UBv z3P}Qxs;L2`rBxcDkfw^L8G@`7M2aY+iY$>pRgw!N76er!SV*Lc1qBuYge*W=0H!R0 z%0jBCgpomHiV;;1rbrSBK#D>_^dzJfOA;&Bw1TGASQ+J~Eig0z<{zXrV z^1O~qACmev>zp?Gjj#?QUAyeN|Fvf+dLaPZFoDJ)4R32ukoHjBx!Q!!c{Kw@kerH1 zA-P~qPqnE&QveU@fhNW4v)H={Yl_}|FBY6Cwg8BM0{<^KB#{6_MJF8FIl|I?nzjHI z0<+@5cDc3P)8Mm^DuC~eGasi;^cKMu#w8t}~_t1P&Q!g2XdrgXz zf};+&&;$Sk5CPi^1{>P<9oHEAzSJK9+gI9RmIYUFtcn74_kETpQLsn= z05;G+6>O$IT;10H%U8PV4%D=T*Zph-}l%|hQBay6e${8_ic?bi1h*HshGmCiKtAL_UVIyN9 zGL?sz@awm{zHQjNWFjC4OrPVP*UE)&)KWx1FgHI!CvZ(FH~bMCW8lTF7m65CRqVBo z$e$AMg&8^_IcC&{;uw9`==;m0s59TMwLQ;eb+mYW$?u#IdBy>mnHd-`EH)fn=Z_;P zBT&wl)c9v_x_*u6*&k%crYO%A24lQpGU7ib+THae zL%7yM2(oEH9(XqXgto8&0g#RN&vg%TH(AjfIT7+pMWJ@7AaZX}Gh6TUOm9s!KMtCm zQqzluW^yA>i4i{^lkp*p6=W{|XuM0>H3C3LK=J?x0)rQ`<<;>qYNnP;(!qfI3h>&l zHpC5JLi()_K!yyg=^j#dr%^ma(Q7(&2S5OT*bHAHVmnm!^fb8j5O!H#Q!DdY*V)Hl z8i%`h@1aXJOi4-=b#pPxuf3G=ilHn$cc&81zZI;$_^@AO&-h0Rf>E(i`Oe2u#OlOz z*u{9nDgTB~K|O+uYI#<~YEy?dpW1!3 z+9hUzpX+A{Z4E_H)zmBrujyDio{IUqyb+eq$hO(Zu}fj(OMoL7j?))TTmBHEoP%+{ z{>0`*do`Pdu1oHHgidKzKd#9SbC-~EB#8skLa1wZHLO>To&W$B>m=K4D&Ft5=Az)? zIe57d-p7SP&_ny>U0z0dpApRsePAjo6Z|QqWREW?#(|aX-hnq4WZbIM6>AQ=a6Ls; z)6?wttV}O|K6Dpfri6n54ZOeu3UUL64pU z4L>;-`DnE=U>!;W5-dy4T`)HW*t~Xl| zI!BkHULefGXae5ChQg+kp<9LTTE0gem|MabBQ5nTyWmv$5$J>FNrZG&b^iCw1(ky> zuscb@hROSNAjP@E-gYBnwG)Qg2|$CRfnE~`yoxR_J7hZb?B7!LYp9o zvr=N}J0IuKW_By%8$JfEsYghqUeK}8?kN-B@t<@m--^}Fx8+%F|6|qJ8SN3>Td>6! zbdQf#no z8^#k-tv-tP5P@6xXrRxq$X#Pc}QC%0ith_1lGc=pnF8rb3gI_y1` zQe6)?#-IQoQMQXnAsAP;rKmxhN@-a(VBc=D&V8QuO6 zRFH&W3`--ZVkIQXG*Wt+8U=+sD9A8!7V#Y=eMLmRX+2-6Zwnw+=h8zHawGzE%_=+; zc53PVSpYClW%6Ytj!S-W&9miF@~bhBc%)AqVO|&j91%bOE0t)3Gr!VQd%fcCTE$qa zu(E&zhYm=~TFUeEeH^hRe*EX!Q{$Z}pV8unLXV$VhuS7_@W}rVszQ7^IgW=0X44ZW z>`=LSMGiOC1kuiHbD$wKJc!(l?+4i0i!ik9iHglbfb)nilJD=7-IIIeC9wudURq^t z$4y0V=NoWfvZqI_1?@8vAl9q9Xp9ADM1^YhMHWXLbx6sjMw)9>JM1ZfR4I<0=z1uI z(ftg1W4voDFXZl7P!LFboio0`cMVKTV{0{7^tK%*tf{c==YF4Ox#kwa44+WH-^O;3 z@^YG6h>vz|);C zbQuG~S2$uSj(Mf&sAyy-9TyXA-NSKOVo*ZCZDTC16U$prDD6Ewm&2V2aa5>@FOg{| zKc{ONYT5suEhU`rU|MA~Zaanz@N!!$U1D#1jmI~O))>rlqu9{x-F4d{l8sV4wz6$B%u6D;B8JI;;Azok`}`_+HOwgv!Uh$Ph2;rij| zkDlX^sK`7>a)nX08*7i$|Iac1Jwp@FT#ufiJ~rs^NsBNq`zba#9rkiF3-Ja^QQvY` zYd7epG*F-orRj;}emj;35*pdv()}7-61BdMmIkIDPn54i_jt5z+wmSB5sKR1s( zf;!9712k8!WvNcNfS0XlywpQ&@}De)ZrHQ{AWMc<$*zXC2D7M&7pL~4bbayf0{RB_ zjcy2hwE<16yj*Yh#x0c%;R9@=HG=XV*+QSe*jqK{ zgvjHNT2ku@S8BqIS-(W9JEE2sj@6rvb0h4re@Xd-xAPyR`-npDLeV{3YEnfH*DfU9 zd5IC4huonSiu1M~yhgbWPagSM<~E^H-EzA=g^yd_7-YR;J*|$cXAX%U@SW*iw#q}005#StdEMo#iz^3F)V}*OdD`*T6bUaXR8yDgla<%Cjp&Up z$$;2aDrLK{WtIO=R)hdS08VPEhQ}(8xy`JcSH;AUJX;cUt<^MIV)7QZiTOvDlyrm_ zV>f?PqNznU$Y(QQe60~gSP4#_T3?l?0(2mNt!6v8NQq5L#a>YgRVIk1t7oul>=9Dc z{APs~&Z@l`?CzV!Y}YUMc`QwI(jJpjBRK6jDXmKEGSo9OojWHT?CrHTd#3J}6PD#} z9TK}`;QXf4Z`vSx&sAKEbCj4!24U^FI%E%hcXQz7zNoy{O^=LvJ%iLMh3u}D%Abh! ztuExX>aVd#)Ht#&2Y14g082tCLVu`V)S%SczU2S%FUv#d$x$gs`UOn)T~DSYsHyk%Iyw#nH;H`;g4`o=3;)$%fI^3a#5KU z4gUFkTk@&t*}Q)vs(-rdOhX`Ob+L^`NM@u&*T$6YnD|~#t#p=#@A4~3^_x!O{GXfD zm@!y3KR3ftkoHmSSy6tlP1xuST-|P<<&l?q+R=2eS+;+RoSL#_%^TP?ZoalaJn!h2Be7&a!_AO5R8Gfr|830GC4F7F;pID|aB= zhq}`nzUZJqA--pJaLv+nv60*jkJgzW2dO@vPPSfpZ$G80A0ELylHMclPWQ(Xc`D7` zZ|KyR=j{av=C{o2vvsTr|E3wEZ0>^R)CKpnt51p~Lg7A)Y(_qBi@a|cZH_QL#A9BBGGgT;;J z$jlf>#ZU9MS3`z_YvK-bT5{IW|5YW2O&L~`l^NlC^)+?15HlaFYY9I8*RbwPP+q9x z+6^gI+{(id^%&mRi6~K>?(LpD<@v|js#kvBRwIr#)=E#gnt)q|EoKbLok8S(_uVar z(%t(U{T()G1R%BRzdza8e>>wo!lBCy@scHEGLgB+b2LX-Rzo!pSE7KHJU5qfZ3%;K$Cr*LC(O`5AZEIl}wVGn`5ZV}z01 z72|GLzV%frw(4~2HFmT`B%VvuC4A%PwB7FT(l7B6v&v9ousj)1)Z|?P!M)}I8Tn1) z4p5;5yqu+TU*#tYJ$m3YZ@aM80{>6~+qOABZuLICiuF&=a~+!Z%M%S{CT&ryjM?hm zQYeKzpo+Ee5P!)T@w}=>Rouy(=<~d!vueZm#;j$&QWGLfnqQykvzue#<(MD*`ABGG zcJh7sGYfHljGw1H2TLyiv755@Yo?-6tE%2_T7Jt-^8b*2>KhJB>&Zr^zdZN)@74H$gxDlWbyi9 z5>I`4a2!2Z@5j}ax2b1brm_9%Tmckb@0KMcEA$Jd7qs}--U^`o*n~1>%XC0T^$fd&*#C^*`p`j%8xk*C6R?!c)Rs-ks2e|9>1{& zsw)}xg0)oYt3^&HmH^8}KYUQ`zOLccu-SyqETit<&!^sCmz!zsLb~-WBK>BQm$Evz zUS{#k=kb1Q=j5K*r>Z$)bsJhu_bp~;6*C1PMvnb1i%|HEFa5&L7<#ZXW3nSoUXqER zUME$qgzAYZnP*efZ_%CPe`L5fr6(If0rA*jkb$Mc{cmwq)G5kV$s$K?LszrFxA$c0 zfkA`z25<$-aaI1j!`496kyfF$KEKDD+e}RJck5jp1W;MJ z9v!5JZmv()wH!A%Yz$v}8m*=@S8vM#c= z4e}Opb#f@r<3*B(J|2tSsSnSDv zD~o({WCaeqQ68DXh<>5kmzj))JVKp=Ma}WWj$_}n2tpQ~few#C3)O@?HY4m|l=wUQ z)O@-Xb*(qlJyFshd3*Xn4I2t!kz zpdMmL+V|M>(DcX5rQ5GKODB6UKUFNN{2>7Hmcu@a+CTcGVsLlgAurZVdmJ_o2o(Hf9Hcvy;)cH89Rb z(*zGsV0%_a+q@*dN1>PY_I6rHq+ZmBa_+;JZJ)s$B7o--S6o38ydONci?u1%#Op}6 zs4n~d`>gy~lSD`LL#+|17!Akq6_ps{w*INm7eVwKA%S5QIL}j zL04(yZ^>RmfB^&mfebk_OBFisA;-5A$9_eJ%9aO34h~c5%Pw){y!wJ6+Rd&1-S^3}>%-w(@hoSL19+O2kxB3c*o| z0)m37jAIrE$fQ`t3Iat17?DL(NU>t5DHKIuLM$Ml5lAcnWQfF65rjk$ivbB`0v*@y$wG+-O1m=$4<0+pW`S z857`7v^lFNG39v|AIIKLW?E>_^|YV&6Ia?}%*2qiOwDodclaKAUy&>I=^_7jqzt)c z)a>+l<0dhc?7R}bKAe)ius&9eX&d_qZ$?!x4YvHrxMFf0gONg=}J!G^r?vzSFeD> zzAlZ4_=30hUeCb4zZg^i2njUd+pL_tii|i=>`ffUN$>3_aHPc%W~amez*wgxt*sN0ss*KNn6RofJ6uu z4lmT^MFbrKKT2y^HkOgO6ugmT9Mo=X+^1Dq3F&&~NAsc}00jFL_&j#4BP@(`!O4x-kW~LL@fsCw^mZcOP-(P+*SL)c7hlgq?fXDI z#K6++Jn2;kBY}*gdt-Yes~NsBxQh`W(mH7nSWNq`2i8yO5(Hw_Z7Gnn>t@hj?z!lz0EiGKJGopAuYudw zw)E=OuZH!1i>NMrQ4j<~Uq7?gn4cfj9>pIY6iCscrWAw7& zHeMzG0RgU7V42*)gkg9WA8c}W&G-aBfmF_3aF2>-eLs8DAOR2%w;EUbf8G(xLF&8C z!>PBzb#ho+*G@6VA!5rA^dNu`K?IHff;KI6d2QJhdrt6-2yHsN}dzHfr6T&^h%63(jo^5V0=1Pil96%PDoYw>&;O9yG9~z4RBR#~975YlCI@ALeH##Hh6W99m~_9vf(&W9gIIK+M8Y z0~w6sbN!yXmv9D^wpfbK;lzquJxVl(IKxhlGQh_@5k0`3-T!M${NA>+$L{X={s!r5 zDXWP#7wqmbUEnq4WHvRMqQ%IHwU=+pQ9 zJBQ*tS9&Zb9hJws*~wDVg(mY} zcUqO5;)sdbpWVsXNJeLah@ca6WI#s8ga8Nxu%8;Qyyi!5DgHGDfAys8pII$rCLcUq z|1U9Tv0>KKzFGMHLk#CTaj^BfPNz1+003`}*#n_S?RlSPx;bI`G+1Wcw7S3E=;L@C zzm(`0`Dw`fNwp@+=u4&P_kv_8vYb_3rJ4 zY_u4PYoGMAR*cc~3ynTBGy;!I+w7EZ5C8;N=yzHMv)`X_FAnuy4WTCkvn!n@;l2bpc>4=DkqiE}upKKm%7|3)QgrW9~AI!gt}`d;Fy8>-TEfV)^n32qX$faY6mZ&q(i(f~~M_=GV`Obg{1ONmIPYGMAX??@ncLd&)jaxJ%3zQwM zOnsWR{xgN)rzpUW#v)41X|fFVGT^!EwCrD``vPXyn@t>-;Cl7Bx7Ds7NQtXw-(sts zrX9;Ko$8a`t8&%-mXZu;E!?^aYkt!dqegL*Vbc~I|F0Vw>_-w>d-q!AH-mtL-1uUp zweUE=W@Zc-nT-RdR<~JFwQsxa$YJ@E|Ihi*zIgR*CS!@*OFXdEwL%@V&h`4$(&H;v z##o?)2ovkA&u>zS$}-vPR1@hFFnkNb;k3n3#?_WdyyKLMH=aGivyYGJ~`pEx-o%q?56AOHv;2Q7d(n{1t|tQ7ggf6oP!rS%rR zl&(nFRxcz3`(S|trq?wd?J}F{Ow+Jg$a^qzL+1NgNeta#B`SpxB>2;dY0`b8>e?=N zU#P^6KG8FHsCONFNfhq^8yepDAbxRe_aV{<00j^D#Q-< zviz6h!~g*V0CTj_mT0u2Lj7OOjbF9b%h=#qJ@WjoJ6iV&RS7a?^Il1SfD67`4v+Q3 z-|n{|!4aVC{bkI|&=@sdy_P7X`4YTmIo)Zx@nH4WFydEq(^ zYBrgI#ktP0zbJyfq?hs=HSfaZ8P!X!FYCXk>p&AThWf~4x?@-R;6)z;e#M5V#e1sP zO-Rt91q)!dEQn!5IklQ^8M%bTUHks`bhCK2Z!)EP91DRxA?Hbu zh0@tV^5vKM*eF~H$B#u&3@Zz<0RRobgcONj0wo6v`6Q&T1y=xFs7x0@)&LLy?DuJO z>T5_FF^(d(K%>X%EGw}`u{fB^%teI)4^QkKE2u-CJ#u46_ZFO!3yF0$4$IH->1W+ilcH{)Z9 zX3p^9v@$*~R_M96M|OS9BnTn^fQTXjGyrA?5Ob%!4JHZ$lcs^$aQZQB@HO3jGoPEK zS?T78KQ={N*kmr$cHGpWv{@3y*UP3*-fnm}yNn8HzyJWy>ne$E>Vox7ZC2Bp^N!7r zKNpayJIt$nT@xV7SHHloj&OvJu@czQyB_ww0{-0!MVJHwq5uGb08aaQOAgklv`J#c zT`+$7S!sWLw_e>9W2-jDZ&l90R&YIpAFvuKD`Pnt3#&|MrXQ}2H~e<^f2Vz@r(z=m zjR+v215;P$)l8_nrl5VfGvSf?@fE*X`i^72j>=`%6{VhP3B3v?7I3X6+`XQO1R6X; zluplHb{B0zSugnqJRkr8fB{6}8RRFy6KnB9fCK^+ zaT$qw5YwFU)$tz$ZK6~Utn-;wdvBZVq`YUSgj}6*;XOy>UL;(UHL4pKC11kB~8_zcOHxtmqUT>>Zb z-a`$4-e=oU7Y5MY0J+%4(aZZs`}cF7Wn-002Kq@X<=*85-{VeD_7hZLVVIQLKvZ zPUHI(^IGw@zXRH#wmlxy3CwjX>U?ily9Rm0>1T8o+o=r|ITm#!uWf^?6ZKwd%PQ1j z3fr5<{NiWGXI-wEaPzuDKT^}r6?k?i>#KoDdJk!`Rvj>^Y(qMmF&5X348!-FZ&cq` zGSLDAP(ALd?DqBQ=}<{P z&2ZaPieVlAIx1(etRvYNe-8boDLMK9RXWcVO(7D?AC2tkztXuv zbq3t^c?Usrq@g?gG87YPrYDY1o(S z{3OEk6pTL_H*Cy3mJ4MgQ#nxY*Z?2^2qpaj-hmH>x2}lBBqox<$|wN8%*QhWHBN!nL7Yv`;cRT5po z3(62c4B#*T6^E+~s>psRHY$VV1Flg5KhlfG=Tsl%%L|4ySqDL*g?2wtz4L$oAR$J# zI6PF})wR!qb$V6@Lc-6NeROh$VK3h7uQB5h%{X6s;S~WHy#F@F@nI;{ z{BAqf+!xb`f_|d}SR(-d1Q8y$>f*T%tC6g{$iDkLLia-1iLScGn(w-~1ImV*Wz?N= zG4npPCnYUAg`g(SHB_X@8B;o~{XiQkYv-LEph0CcvLkU=2{%RYZB@HtczpfS%Y(vB zilf5)9>-;Rg-j7BNJ_I-$lAtI-hSv*Xw3e*1t)%C(70Q001z0}`6rN4Lj44_r+OTE zR;t5D59YnP#73)FKFGz|M3Qr$K%yPb(k2^5D#}|YCOiLMfY5VF1!h`ow$Q~u03c>E zc{Oy$%`e3Fm$MeuJ0~DHmBJ)+yD{RavN5`4Y~nt5iElR&g-uUgw!R2!<|15FKs~9~F*gELpSw z2p#>nh`n4B93*&UE%FrpB8L{TOPag!Ykb&%K5!`U7rwlBrw!hpTUKUOWk1M=(~VJ= zAuOS(5Bc1*qJ(^F>WI2rjq#!RlyS&?R@Scml4%xpV|9&&BB?huj(wv~`$dla#N{a( zQcaF;#?nU;TDe4KPCR)D^a>{z9o`bR=#yB%+~`)b3*jHzJN4CmnxrocMuZSJ-UO!- zR5v(@y-A{W1W38ec78ikw^@10{dM)Kp7ZS^@cf^EyQHK#_Fs_Z1Z(0rcvL4mBP~Op zf=Z0xWmEtH1wP9y5a#2@0;o26{)`E%$5&?uL(68a(8%rs_VoQ+s026#Bar`D6ebirl?Y!V@aP#+hDu)RN^3}4hq(X z$MqP?+l4?*w+%Kq4g~zV7-HW0^EUZNaWO7fajQk!W#51_8S7QnfCN{ zCjXf6iasL-4r+Bl|7`WC85a|d9seDEwe5HPC)hAJE(>~QpMz}i)L+XJAe^pb2YK4K zjGsHzACPULsYPMd{J%ZY_M6XxQ0mO%K?2foD!$lPMhKV3?kxhq;l?e*fh*pa00gn6 zNOy9@Y^!0}IiC)UWdSzbX~>Bw=KwDy81N^=o1GMsHL88a{;@x;`IjSegy&B!{b9TE?CiUG1xuDK=^7L3IkqK*+0gn$k_m^Rw!g(UsB6aI9v_x$3C;D7TrY}PGv692pH!i2^jj6RiD2D z&o}3ujuqj&sB{nj1O)^vOq&Kbxkaoods^qdqT{9aZS z%a=ymyf;C58Dyf9l&Gl+F@Qyr-3#R^D3(~8_FerU5v#f!`ZolHXXt@v+E~8xmv4FP z@?;X2NXtV7EkE%yY3%FUEn?;FZ+Wl`cj^MmbGTZfe)D+t%BCWMNUEz!>1Y16ZXmq2 zUDpE(t=Eu7v~1Wu$UOdR11(Y>H0c;M-g3>D$dp9M4*b9AS+UuUzMn|gtAkPy7ytv` zL#cR`V{`)4Ot=%vV@_c{c$O8E&ttsv#K|bcafyYAHFNWEMZz7LgcV#5beI&|=25?S zDU&0YG6c@z*6obWEi^v{{%7f1saaW@s9NN1EamZ{CZeFjC`2eLE{6Sl6;}B5hODoHUbt|58nhE7yqw25hbu>fZRbU% z>PRwu^P8gaUc9{mgG>hxl7EZMIxgjm)q395Ztfyp_vhT~>22=J^E& zHeCEgIe2&i%DM>)lWY*~4?$_1#eKKT!-F9{mc;R7vUtE&r!(D>!|F7c?7EhMW;`ZBZMS;~ zJ93Q2N@-m})<)Fj9t7{a924U3tXhxrzCh5GW!W?}|DO^!|MZmmvC!XOW-|R4J27C% zqv@xEGg)iHi~Q#4Z*5TblH|ll+u-xAgK+GD(vrPpW0GSULUYBNWG70~+&3khl)_J}PnEJlmU3=2sHKmGhc5^w8t&e}Z#dp`pX=3aP zd1hu500M;of`Uyj(wvey@vhlzwSzuoL{07Om~HV03a#?+gvBoL(t;Bt+bTbM;7-QJsA~z zXS&*(#z&dIrnjq&h(RvlKN?hMEvPP`YHFZD?+RxWM@)n0;y^qAKwpQVw$J(*qD~SM ziEohOfQx#$$VTyqJx#aeTD5FRWLM9hstSYuagQu3`KPkoV(*<2IeH;|02mj(T1JSrMl0 z2>0DFbekysRem?xnCjx8txU4Wnx+Gj<$i=Igh8sxNDUJwdZb*^xO^*v4HlWkA9(0q zz9p&LHsH8D790SN?n%-R6*oiioBr}zDAt^FC);;#%l2`zvANdp8Oa#Sn_brn^_2Kl z8Pk>Q#j;W1nDcTmiV~NiC~;#Ny=%pQyARI&`9?VSuzVrP3B!JaGB>Ehd$ghtEq}LL1umB<-H6Q|E;tnhhbnyt>>dP6QS42LL6T{Ka2n%S1x7R zJ3}oU;Sg(ndYvsVf)_zqh_Ty2ISv`lc+t#>M8#qSIn-E8Cm3V9M2Cp94Yi;Bu%T3H z4siRt`r4m#@?0JK#yA2RJF$Q7nXxADq(IHu z5J(tVsdA-pS2V@~Bi94ymlx;h2!&#wQUC$~pidde^$f+SIj{#5wL4#IFd!PiB9ObS zO?fCZ3Sq|Ym^?nCl1&&7IBsEt2R!WkodUQAbadWPQ9rCr*Q?D;FSL);hyny6feY9K z4LNi0A16WlBpwZG#ed?t#xnZK+3f6Qe3ep{RD;x8o`*7tM1-rS?I1}?r>J`s&_H0% zFsc~C1!!B9Ce2#nxMS+0OvF|I0tDkd*ymFV=W;uusa}M8B}`N2Qr4E*WqtlP)ijD- zqhP9zg4NIOP`&exsoGwYEso>T;5lU$(*Fo~w}FTvB`l7`IK<+GY*&TGcNA)=ED>|bh&%28v)}Pe$sb4l>q*zeGcuZ6Jh}IvrUmo2^&sPR}OmVm% zKpUqK#P}fWH7Pbrog&vsDJwwa)UGIk?8|&G0^C%OpH9rUTtgg2GMBCCG{bgfo#h(V zAHl%#Ckwj&CzRfp>z{bs;t|YDep|#9^GomavK(_!4R#(4jrF!3q|9-Lp%=E(J;)sQ z051eMP<>Pof0!Ys={na3Y?{XQjgq<-w&)5z*LM_beK2Iw?RYlX%_){QNSL)U zJ_*9ZDJf&0fpdSf;x)>N@3ThsV^=pK=+qDM=9&7Y3vn7eJt0)F~ULYq^P{V~b>C$@f*eY}kx((w&KwQHF;UMby%>&@2?KmF zXCvIjnuD6gl{Q8n%t9RLjLumOYxSuubv|Vo&boudekUbYT|IC(`VSSK-JSQJTj)Wr z3y`x=n@5g#bBozK@$!50?LD81FP5NxpNVsr`Ti;V&rxCMYqya~MY^Mq=DS6e8QIw+ zf?#7w3FY8XysR&pL}_4Vz#$R=SONw{a;#S_p@OyBXDo1v;ba?Vaw^VbCiy=HFDZaw zoiRjy10TNLDL&^XHj(dkBvL}dm*BKeE@S)NAUNz=#Pg_@=FdL1tAMv$gqgbZFp2Y{ zj1gL9wzkj<>kM|`oL+EL+E^PG zV4JD(3=1n{54PfYIkO=xK|wO1c=5a$Uh1SnF>Bl0s40wSC7Q)f07gVj!2n>xtup}o ziej7(-F8juRM9i$uL4V34#92QKKUer|4zUB`NaIL44-jdkDRXeV@El_-mISM$0xL& z+nz&})7LVGh?|#OoDNp8IIjo8w0e7?UIK6F$~|Sh-*}*SJU;CM1b6M$ z5B05l3vW*HdW#Q1AiSnugbF(^XrAKyFPkr;GQ0PBm5aK!sMuuFoa6vN(n5eLXm@Ix ziWKtRcPR{^)Amy8)_6Tz@+}Obk0klm+MSz(cKIEhhVq}Yov%$b&Y^|*``^B%r+=d^ zpAYf)7tgJ4S)+(eG2Y(L8o%tn;*SOguIZSUb5$Iv9X2x|N&m8F6tfv#LwW@I`_z>{4^ag?9 zEUwM!FtxVRW(ho9w|Q~ICzs)JiT+LYJp$PC8x(QlvmVc(6_Q+ha~b*t3T)pVdC8QG zLQg~RYf?P9-ETQds&8Gg@VlVq10)?zW+qfhgk5sjACti(K$N(V%qN_2)Z}g-&sy!hFkuc za3Ad&3Y1wHdi9Wr8(3O|iIbZIMh4I9Mu+vqW|ZN2Nbq{Edk!bt+1}y!o-ZVJ+g0O= zZam!n`gkTglzyKo3ZY`vWj?9Z9yoFoma2-=nDNTKK4N(PTY08k8PrD$GB8Af81n)u z865)!{g~>@$wSlj`y1Fe&h_=Asfvme03@KV=?W)y$-kzVJ}#<_-w9KlLv4&IWYTE2 z72IRF?2V`%-))All_#q{I}!jy5tzGpl>?b;0+H+JkQ>(Xk_9xyVn!!wg6!K}Xg2Y+ z?QpjyAq`3$*OyXYcYRHqHh<5s5AEgFcXO_?PNSC6Sq-Z+y+1Q&KgoUDB-|SMp}(8rAM0MT<$ZJ=y{%RX_DA-yl0>B@mQ^Hvhc~EdTw!_q1EH-erDA( z=p6b5wp?#{%RS%O6b5Dl!Qf1;bp3?YWKpFsJT&p&Oj_Q?HH2a5@F>ujqGX3oJ0w3sLw(ADQ@~Ff+@Q(3|0hPFnMPT)qJJkhiKDztb_a#~oNu|T_k6uQ z)Y3jj#iOnMHM)LHCSupxX88AMtZtbO6V9y;->|ZH3G-Ri-BH`2yd?bpHxJ2LC)H*t zq`OYBGNNKVEw9$uTgy6zLqhPo9bR*}`Z(*4zw6;Wp04-zZ>J2Oc?rrPn&@i%zSO&6 zvwp*tVK9s~=zUF1{>dS82n8x-*X{Kak(ogCzEl;7mTmO}*vCEf1C(N`+@#XxI~zYz z)4y9g@?TCh>d@-hgXAmmI^9J>2fJ6Clcs$KUzVbCpSrlOSA6a*6DWcF-2V4jC;f3V zk0PE==eByTKLuImw*54Cy=8Ox8pJ#+CnC?q&3{lF9b*fJTPyPPZjDG&9sJ8TRERSz zsp^e}AqD&%_o{)OzaXdV5Fjb)?_>E(IaCklc~-qzJ;$ScUk@)}eZ8GcgTrP5gU5Ov z*0|1Yhq-y2Ty%VOXY;Q4Pc6K|YWnS`42KlKch5=PN4{l3d=5$g8upmfiW4G|gS%h+ z%vNB169RO=$@P9`W^QXkmYD?#eJK2f(MLllU9t*Bl>>Bq_wLd2_Jh@A;Ja!J&qqb4 zmVYj;jKUo+QAFh*g2Uu*7VHn6m@Fl`Cb8K%cZtjM7DETDuLbZrD&gcZBU`KFVW@@` z=DPZaNW+@j0S8Z{I+F!1AX{>jr7@tS}Y9DPkJkI}N<|jyrZFh9r(r|KkNU9FFXb{o9tq9^Z4%a2LHtd9=-6=ks-Ghj8d;lZQk0 zzcKz!uIIC|O$s04;CQ;+r<|VuVO|?20{iY-jRyHe=UlMN;Ux>W5G{FCTue)b1P zY~y~NbZM}Ad@UN}lkv_>Y5f}_g*r|KSSprZGK%7%1!|_ z$Op?#{R#1q-I7TIn+RS2Vsd|nlu~TUe0clAz@@*4Jp)=zay+g(Of|-X0Eirkf_myPX-?bW|=?XD_V($ePFnY8B>aRT?xn zO6bdvT&rL^06_)}5MTrV+0k77NS{7m;uqUt9pFS^3DL zavUVyESIC|&OV5f2}c{IB3V9bA^b`#g~P+xioiO-HT26?2)bgpMO_cNyLj#2hNkE1k} zi5v_PBdGVNoo(Innry&>np!S^#wNy7uGnUwz7dN=?O1%UzplO&y+k8@2w(MV<`BDnf*%|uk^ zd6iZDZ_H@^i)Nk-gS-Wzx-^|Tq<4t)sdMUfPuc%*hSteU00h)=?JY^?`_CUcXzv>- z+Q8OgmgiSAoDxi6j@Z;cIZ4P%OzszJ6;`$0nW<}4X?Edqf9}ivR*8f5QI%Z9qj;f3g4f+(19?+~7a}00ck*umOw! z5U3h701Y%WXd6>y8W{|L01TLbaibk|JtiYGYH>n^Qwg z9-|Y{s5CS^Lr17-w4R}-wKk~ufqqA$Jp>5Fvyx8b)s!XcedHI&T2=b?vgF0PL!zHi=vmn0AWc9k`OW&1Wd>Qa4?XKEC$mgL6&wfKyiwxW&Ztv zX5uAzGBs%J*9foSiNLLz#@%AJP+(?AW)nxKX{NzgsTBc*O3))T>n=T#BQ^F7&ANM-TzS4 j#v#9ORe%Xq*|R4v7K^ikf=Fuwm;7DH6yZWchivjJU4_FK literal 0 HcmV?d00001 From 02852f3fb00a554a0205f5516c97e93def7d8f79 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Fri, 19 Nov 2021 15:20:26 -0500 Subject: [PATCH 45/60] Modified to directly include aggregate functions --- R/get_comland_data.R | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/R/get_comland_data.R b/R/get_comland_data.R index 156da18..7028d22 100644 --- a/R/get_comland_data.R +++ b/R/get_comland_data.R @@ -32,7 +32,13 @@ get_comland_data <- function(channel, filterByYear = NA, useLanded = T, removeParts = T, useHerringMaine = T, useForeign = T, - refYear = NA, refMonth = NA, disagSkatesHakes = T) { + refYear = NA, refMonth = NA, disagSkatesHakes = T, + userAreas = system.file("data", "mykeyAreas.rda", + package = "comlandr"), + areaDescription = 'EPU', propDescription = 'MeanProp', + userGears = system.file("data", "mykeyGears.rda", + package = "comlandr"), + fleetDescription = 'Fleet') { call <- dbutils::capture_function_call() @@ -54,6 +60,12 @@ get_comland_data <- function(channel, filterByYear = NA, useLanded = T, if(disagSkatesHakes) comland <- comlandr::disaggregate_skates_hakes(comland, channel, filterByYear) + #Aggregate areas + if(userAreas) comland <- aggregate_area(comland, userAreas, areaDescription, + propDescription) + + #Aggregate gears + if(userGears) comland <- aggregate_gear(comland, userGears, fleetDescription) comland$call <- call From 19caf9393658cc6173bcb252bbb63363b5f1cfd0 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Thu, 3 Feb 2022 22:40:43 -0500 Subject: [PATCH 46/60] + allow.cartesian so you can assign multiple regions by proportion --- R/aggregate_area.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/aggregate_area.R b/R/aggregate_area.R index 4530ed8..74e7100 100644 --- a/R/aggregate_area.R +++ b/R/aggregate_area.R @@ -24,7 +24,7 @@ aggregate_area <- function(comData, userAreas, areaDescription, propDescription, setnames(areas, c(areaDescription, propDescription), c('newarea', 'prop')) #Merge new area descriptions to landings - new.area <- merge(comData, areas, by = c('NESPP3', 'AREA'), all.x = T) + new.area <- merge(comData, areas, by = c('NESPP3', 'AREA'), all.x = T, allow.cartesian=TRUE) #If no proportion assume 100% in validAreas <- unique(areas[, newarea]) From 0ad173f2530543c929ab182ec3384e93fe5cb8ca Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Thu, 3 Feb 2022 22:41:42 -0500 Subject: [PATCH 47/60] fixed how default areas/gear are read --- R/get_comland_data.R | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/R/get_comland_data.R b/R/get_comland_data.R index 7028d22..cc92c6d 100644 --- a/R/get_comland_data.R +++ b/R/get_comland_data.R @@ -33,11 +33,8 @@ get_comland_data <- function(channel, filterByYear = NA, useLanded = T, removeParts = T, useHerringMaine = T, useForeign = T, refYear = NA, refMonth = NA, disagSkatesHakes = T, - userAreas = system.file("data", "mykeyAreas.rda", - package = "comlandr"), - areaDescription = 'EPU', propDescription = 'MeanProp', - userGears = system.file("data", "mykeyGears.rda", - package = "comlandr"), + userAreas = comlandr::mskeyAreas, areaDescription = 'EPU', + propDescription = 'MeanProp', userGears = comlandr::mykeyGears, fleetDescription = 'Fleet') { call <- dbutils::capture_function_call() @@ -61,11 +58,11 @@ get_comland_data <- function(channel, filterByYear = NA, useLanded = T, filterByYear) #Aggregate areas - if(userAreas) comland <- aggregate_area(comland, userAreas, areaDescription, + if(!is.null(userAreas)) comland <- aggregate_area(comland, userAreas, areaDescription, propDescription) #Aggregate gears - if(userGears) comland <- aggregate_gear(comland, userGears, fleetDescription) + if(!is.null(userGears)) comland <- aggregate_gear(comland, userGears, fleetDescription) comland$call <- call From 37fb5eb9afdccd42dd2f1aed9c3ab2599986a12b Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Wed, 30 Mar 2022 10:49:06 -0400 Subject: [PATCH 48/60] Added filterByArea and aggArea/Gear flags --- R/get_comland_data.R | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/R/get_comland_data.R b/R/get_comland_data.R index cc92c6d..3ae74b8 100644 --- a/R/get_comland_data.R +++ b/R/get_comland_data.R @@ -30,18 +30,19 @@ #' #'@export -get_comland_data <- function(channel, filterByYear = NA, useLanded = T, +get_comland_data <- function(channel, filterByYear = NA, filterByArea = NA, useLanded = T, removeParts = T, useHerringMaine = T, useForeign = T, refYear = NA, refMonth = NA, disagSkatesHakes = T, - userAreas = comlandr::mskeyAreas, areaDescription = 'EPU', - propDescription = 'MeanProp', userGears = comlandr::mykeyGears, + aggArea = F, userAreas = comlandr::mskeyAreas, + areaDescription = 'EPU', propDescription = 'MeanProp', + aggGear = F, userGears = comlandr::mykeyGears, fleetDescription = 'Fleet') { call <- dbutils::capture_function_call() #Pull raw data - comland <- comlandr::get_comland_raw_data(channel, filterByYear, useLanded, - removeParts) + comland <- comlandr::get_comland_raw_data(channel, filterByYear, filterByArea, + useLanded, removeParts) #Pull herring data from the state of Maine if(useHerringMaine) comland <- comlandr::get_herring_data(channel, comland, @@ -58,11 +59,11 @@ get_comland_data <- function(channel, filterByYear = NA, useLanded = T, filterByYear) #Aggregate areas - if(!is.null(userAreas)) comland <- aggregate_area(comland, userAreas, areaDescription, + if(aggArea) comland <- aggregate_area(comland, userAreas, areaDescription, propDescription) #Aggregate gears - if(!is.null(userGears)) comland <- aggregate_gear(comland, userGears, fleetDescription) + if(aggGear) comland <- aggregate_gear(comland, userGears, fleetDescription) comland$call <- call From d60331ea08ea8ca1024832f9ed9cf39e157e5148 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Wed, 30 Mar 2022 11:09:45 -0400 Subject: [PATCH 49/60] Added filterByArea --- R/get_comland_raw_data.R | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/R/get_comland_raw_data.R b/R/get_comland_raw_data.R index d5e3bf1..d04d12d 100644 --- a/R/get_comland_raw_data.R +++ b/R/get_comland_raw_data.R @@ -29,8 +29,8 @@ #' #'@export -get_comland_raw_data <- function(channel, filterByYear = NA, useLanded = T, - removeParts = T){ +get_comland_raw_data <- function(channel, filterByYear = NA, filterByArea = NA, + useLanded = T, removeParts = T){ message("Pulling landings data from database. This could take a while (> 1 hour) ... ") @@ -54,6 +54,10 @@ get_comland_raw_data <- function(channel, filterByYear = NA, useLanded = T, landings.qry <- paste("select year, month, negear, toncl1, nespp3, nespp4, area, spplivlb, spplndlb, sppvalue, utilcd from", tables[itab]) + if(!is.na(filterByArea[1])){ + landings.qry <- paste0(landings.qry, " where area in (", survdat:::sqltext(filterByArea), ") + order by area") + } comland.yr <- data.table::as.data.table(DBI::dbGetQuery(channel, landings.qry)) comland.yr[, MESH := 5] #Identify all as large mesh } else { @@ -68,6 +72,10 @@ get_comland_raw_data <- function(channel, filterByYear = NA, useLanded = T, a.utilcd, b.mesh from", tables[itab], "a,", trip.table, "b where a.link = b.link") + if(!is.na(filterByArea[1])){ + landings.qry <- paste0(landings.qry, " and a.area in (", survdat:::sqltext(filterByArea), ") + order by area") + } comland.yr <- data.table::as.data.table(DBI::dbGetQuery(channel, landings.qry)) } sql <- c(sql, landings.qry) From 1ac0f962ed32cf1359ec4afb7674bfa48d5a7b05 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Wed, 30 Mar 2022 11:14:17 -0400 Subject: [PATCH 50/60] Added other filterByArea arguments --- R/get_comland_data.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/R/get_comland_data.R b/R/get_comland_data.R index 3ae74b8..c1cfa58 100644 --- a/R/get_comland_data.R +++ b/R/get_comland_data.R @@ -46,17 +46,18 @@ get_comland_data <- function(channel, filterByYear = NA, filterByArea = NA, useL #Pull herring data from the state of Maine if(useHerringMaine) comland <- comlandr::get_herring_data(channel, comland, - filterByYear) + filterByYear, filterByArea) #Pull foreign landings - if(useForeign) comland <- comlandr::get_foreign_data(channel, comland, filterByYear) + if(useForeign) comland <- comlandr::get_foreign_data(channel, comland, filterByYear, + filterByArea) #Apply correction for inflation if(!is.na(refYear)) comland <- comlandr::adjust_inflation(comland, refYear, refMonth) #Disaggregate skates and hakes if(disagSkatesHakes) comland <- comlandr::disaggregate_skates_hakes(comland, channel, - filterByYear) + filterByYear, filterByArea) #Aggregate areas if(aggArea) comland <- aggregate_area(comland, userAreas, areaDescription, From 4a27600e0fc2bdac7957904e7834fbdc2a980109 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Wed, 30 Mar 2022 11:17:36 -0400 Subject: [PATCH 51/60] added filterByArea --- R/get_herring_data.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/get_herring_data.R b/R/get_herring_data.R index 6ea517d..5ea4143 100644 --- a/R/get_herring_data.R +++ b/R/get_herring_data.R @@ -12,7 +12,7 @@ #' @noRd #' @export -get_herring_data <- function(channel, comland, filterByYear) { +get_herring_data <- function(channel, comland, filterByYear, filterByArea) { #Pulling data message("Pulling Atlantic herring data from maine_herring_catch ...") @@ -26,6 +26,10 @@ get_herring_data <- function(channel, comland, filterByYear) { herr.qry <- paste0("select year, month, stock_area, negear, gearname, keptmt, discmt from maine_herring_catch where year ", years) + if(!is.na(filterByArea[1])){ + herr.qry <- paste0(herr.qry, " and area in (", survdat:::sqltext(filterByArea), ") + order by area") + } sql <- c(comland$sql, herr.qry) From 5f08c7e4f66f05e34790be4b1477f992a34f4bdc Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Wed, 30 Mar 2022 11:25:11 -0400 Subject: [PATCH 52/60] added filterByArea --- R/disaggregate_skates_hakes.R | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/R/disaggregate_skates_hakes.R b/R/disaggregate_skates_hakes.R index 3a8b97f..0c3f929 100644 --- a/R/disaggregate_skates_hakes.R +++ b/R/disaggregate_skates_hakes.R @@ -31,6 +31,9 @@ disaggregate_skates_hakes <- function(comland, channel, filterByYear) { skate.survey <- survdat::post_strat(skate.survey, Stat.areas, 'Id') data.table::setnames(skate.survey, 'Id', 'AREA') + #Filter By Area + if(!is.na(filterByArea[1])) skate.survey <- skate.survey[AREA %in% filterByArea, ] + #Figure out proportion of skates data.table::setkey(skate.survey, YEAR, SEASON, AREA) @@ -120,6 +123,9 @@ disaggregate_skates_hakes <- function(comland, channel, filterByYear) { hake.survey <- survdat::post_strat(hake.survey, Stat.areas, 'Id') data.table::setnames(hake.survey, 'Id', 'AREA') + #Filter By Area + if(!is.na(filterByArea[1])) hake.survey <- hake.survey[AREA %in% filterByArea, ] + #Figure out proportion of skates data.table::setkey(hake.survey, YEAR, SEASON, AREA) From 913765ecd3cda13089b6e9569307a32867d78f2b Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Wed, 30 Mar 2022 11:33:21 -0400 Subject: [PATCH 53/60] area not called area in herring database --- R/get_herring_data.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/get_herring_data.R b/R/get_herring_data.R index 5ea4143..5f655a5 100644 --- a/R/get_herring_data.R +++ b/R/get_herring_data.R @@ -27,8 +27,8 @@ get_herring_data <- function(channel, comland, filterByYear, filterByArea) { from maine_herring_catch where year ", years) if(!is.na(filterByArea[1])){ - herr.qry <- paste0(herr.qry, " and area in (", survdat:::sqltext(filterByArea), ") - order by area") + herr.qry <- paste0(herr.qry, " and stock_area in (", survdat:::sqltext(filterByArea), ") + order by stock_area") } sql <- c(comland$sql, herr.qry) From b307cadc8a82aa4eb8b67b4c475e6acdd7403261 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Wed, 30 Mar 2022 11:52:58 -0400 Subject: [PATCH 54/60] retain records from non specified areas and assume 100% prop --- R/aggregate_area.R | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/R/aggregate_area.R b/R/aggregate_area.R index 74e7100..67abbd2 100644 --- a/R/aggregate_area.R +++ b/R/aggregate_area.R @@ -21,17 +21,13 @@ aggregate_area <- function(comData, userAreas, areaDescription, propDescription, #Convert userAreas to data.table areas <- data.table::as.data.table(userAreas) - setnames(areas, c(areaDescription, propDescription), c('newarea', 'prop')) + data.table::setnames(areas, c(areaDescription, propDescription), c('newarea', 'prop')) #Merge new area descriptions to landings new.area <- merge(comData, areas, by = c('NESPP3', 'AREA'), all.x = T, allow.cartesian=TRUE) #If no proportion assume 100% in - validAreas <- unique(areas[, newarea]) - new.area[is.na(prop) & newarea %in% validAreas, prop := 1] - - #drop records outside the scope - new.area <- new.area[!is.na(prop), ] + new.area[is.na(prop), prop := 1] #Proportion landings to new areas new.area[, newspplivmt := SPPLIVMT * prop] From 633abfd8cc16fe740eda0c106ee4c109ef844084 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Wed, 30 Mar 2022 13:11:34 -0400 Subject: [PATCH 55/60] forgot filterByArea argument in function call --- R/disaggregate_skates_hakes.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/disaggregate_skates_hakes.R b/R/disaggregate_skates_hakes.R index 0c3f929..c54dc86 100644 --- a/R/disaggregate_skates_hakes.R +++ b/R/disaggregate_skates_hakes.R @@ -13,7 +13,7 @@ #' @noRd #' @export -disaggregate_skates_hakes <- function(comland, channel, filterByYear) { +disaggregate_skates_hakes <- function(comland, channel, filterByYear, filterByArea) { message("Grabbing survey data to disaggregate skates and hakes ... ") From fc68278498844cb36963b3dfa53cf0ee28a618fa Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Tue, 26 Apr 2022 14:08:10 -0400 Subject: [PATCH 56/60] added proportion as an argument --- R/aggregate_area.R | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/R/aggregate_area.R b/R/aggregate_area.R index 67abbd2..bac11b8 100644 --- a/R/aggregate_area.R +++ b/R/aggregate_area.R @@ -14,9 +14,15 @@ #' #'@export -aggregate_area <- function(comData, userAreas, areaDescription, propDescription, +aggregate_area <- function(comland, userAreas, areaDescription, propDescription, applyPropValue = T){ + #Pulling data + message("Aggregating Areas ...") + + #Grab just the data + comData <- comland$comland + call <- dbutils::capture_function_call() #Convert userAreas to data.table @@ -46,9 +52,9 @@ aggregate_area <- function(comData, userAreas, areaDescription, propDescription, #Add changes back into comland - # comland$comland <- new.area.land[] - # comland$call <- c(comland$call, call) - # comland$userAreas <- userAreas + comland$comland <- new.area[] + comland$call <- c(comland$call, call) + comland$userAreas <- userAreas - return(new.area[]) + return(comland[]) } From c784d8a8ee94d88d83ee07a7021993ebf7b6b196 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Tue, 26 Apr 2022 15:35:46 -0400 Subject: [PATCH 57/60] first addition get discard data --- R/get_discard_data.R | 894 +++++++++++++++++++++---------------------- 1 file changed, 447 insertions(+), 447 deletions(-) diff --git a/R/get_discard_data.R b/R/get_discard_data.R index dc209cf..db52015 100644 --- a/R/get_discard_data.R +++ b/R/get_discard_data.R @@ -1,447 +1,447 @@ -#Comdisc.r -library(here); library(data.table); library(comlandr) - -channel <- dbutils::connect_to_database(server="nova",uid="slucey") - -get_observer_data <- function(channel, filterByYear, ) -endyear <- 2017 - -strat.var <- c('YEAR', 'QY', 'EPU', 'GEAR') -haullevel <- F #Toggle whether to save haul by haul data or not -landings.file <- 'comland_meatwt_deflated.RData' - - - -#------------------------------------------------------------------------------- -#User created functions -#Sums the number of occurances -count<-function(x){ - num<-rep(1,length(x)) - out<-sum(num) - return(out) - } - -#------------------------------------------------------------------------------- - -filterByYear <- 1989 - -#Create year vector -if(is.na(filterByYear[1])){ - years <- ">= 1989" -}else{ - years <- paste0("in (", survdat:::sqltext(filterByYear), ")") -} - -ob.qry <- paste0("select year, month, area, negear, nespp4, hailwt, catdisp, drflag, - tripid, haulnum, lathbeg, lonhbeg, link3 - from OBSPP - where obsrflag = 1 - and program not in ('127', '900', '250', '160') - and year ", years, - "\n union - select year, month, area, negear, nespp4, hailwt, catdisp, drflag, - tripid, haulnum, lathbeg, lonhbeg, link3 - from ASMSPP - where obsrflag = 1 - and program not in ('127', '900', '250', '160') - and year ", years) - -ob <- data.table::as.data.table(DBI::dbGetQuery(channel, ob.qry)) - -#Add protected species here -mammal.qry <- paste0("select distinct a.year, a.month, b.area, b.negear, a.nespp4, - 1 as hailwt, 0 as catdisp, 1 as drflag, a.tripid, a.haulnum, - b.lathbeg, b.lonhbeg, a.link3 - from obinc a, obspp b - where a.tripid = b.tripid - and a.year ", years, - "\n union - select distinct a.year, a.month, b.area, b.negear, a.nespp4, - 1 as hailwt, 0 as catdisp, 1 as drflag, a.tripid, a.haulnum, - b.lathbeg, b.lonhbeg, a.link3 - from asminc a, asmspp b - where a.tripid = b.tripid - and a.year ", years) - -mammal <- data.table::as.data.table(DBI::dbGetQuery(channel, mammal.qry)) - -ob <- rbindlist(list(ob, mammal)) - -#Grab otter trawl gear tables to get mesh size for small verses large mesh -mesh.qry <- paste0("select link3, codmsize - from OBOTGH - where year ", years) -mesh <- data.table::as.data.table(DBI::dbGetQuery(channel, mesh.qry)) - -#Convert mesh size from mm to inches -mesh[, CODMSIZE := CODMSIZE * 0.0393701] -mesh[CODMSIZE <= 3, MESHCAT := 'SM'] -mesh[CODMSIZE > 3, MESHCAT := 'LG'] -mesh[, CODMSIZE := NULL] - -ob <- merge(ob, mesh, by = 'LINK3', all.x = T) - -#Clean up data set -#Remove those with unknown disposition -ob <- ob[CATDISP != 9, ] - -#remove record if weight is missing -ob <- ob[!is.na(HAILWT), ] - -#remove non-living items (clappers and stomach contents) and unknown living matter -ob <- ob[!(NESPP4 %in% c(0, 6800:6802, 6805, 6810, 6820, 6830, 6850:6857, 6882, 6883, 6894:6897))] - -#Convert lat/lon to decimal degrees -ob[, LATDD := substr(LATHBEG, 1, 2) + ((substr(LATHBEG, 3, 4) + substr(LATHBEG, 5, 6)) - / 60)] - -#Convert weights -convert.qry <- "select nespp4_obs, catdisp_code, drflag_code, cf_lndlb_livlb, cf_rptqty_lndlb - from obspecconv" -convert <- data.table::as.data.table(DBI::dbGetQuery(channel, convert.qry)) - -setnames(convert, - c('NESPP4_OBS', 'CATDISP_CODE', 'DRFLAG_CODE'), - c('NESPP4', 'CATDISP', 'DRFLAG')) - -setkey(convert, - NESPP4, - CATDISP, - DRFLAG) - -ob.code <- merge(ob, convert, by = key(convert), all.x = T) - -#missing cf's will be set to 1 Assume living -ob.code[is.na(CF_LNDLB_LIVLB), CF_LNDLB_LIVLB := 1] -ob.code[is.na(CF_RPTQTY_LNDLB), CF_RPTQTY_LNDLB := 1] - -ob.code[, C.HAILWT := HAILWT * CF_RPTQTY_LNDLB * CF_LNDLB_LIVLB] - -#Grab common name and PR flags -comname.qry <- "select NESPP4, comname, sciname, cetacean, turtle, pinniped - from obspec" - -comname <- data.table::as.data.table(DBI::dbGetQuery(channel, comname.qry)) -comname[CETACEAN == 1 | TURTLE == 1 | PINNIPED == 1, PR := 1] -comname[is.na(PR), PR := 0] -comname[, c('CETACEAN', 'TURTLE', 'PINNIPED') := NULL] - -ob.code <- merge(comname, ob.code, by = 'NESPP4') - -#Convert to metric tons to align with commercial landings data -ob.code[PR == 0, C.HAILWT := C.HAILWT * 0.00045359237] - -#Change to NESPP3 to combine market categories -ob.code[, NESPP3 := substring(NESPP4, 1, 3)] -#Birds, mammals, etc don't have unique NESPP3 codes -ob.code[is.na(NESPP3), NESPP3 := NESPP4] - -ob.code[, MKTCAT := as.numeric(substring(NESPP4, 4, 4))] - -#drop NESPP4 -ob.code[, NESPP4 := NULL] - -#Deal with skate(ns) for little and winter skates -source(file.path(data.dir.2, 'Comland_skates_hakes.R')) - -#get little skates and winter skates from skates(ns) - use survey in half years -#Generate Half year variable in comland -ob.skates <- ob.code[NESPP3 == 365, ] -ob.skates[MONTH %in% 1:6, Half := 1] -ob.skates[MONTH %in% 7:12, Half := 2] - -setkey(skate.hake.us, - YEAR, - Half, - AREA) - -ob.skates <- merge(ob.skates, skate.hake.us, by = key(skate.hake.us), all.x = T) - -ob.skates[NESPP3 == 365, little := little.per * C.HAILWT] -ob.skates[is.na(little), little := 0] - -ob.skates[NESPP3 == 365, winter := winter.per * C.HAILWT] -ob.skates[is.na(winter), winter := 0] - -ob.skates[NESPP3 == 365, other.skate := C.HAILWT - (little + winter)] - -#Little (366), winter (367), skates(ns) (365) -#put skates in ob.code format to merge back -little <- ob.skates[, list(COMNAME, SCINAME, PR, CATDISP, DRFLAG, - YEAR, MONTH, AREA, NEGEAR, HAILWT, - TRIPID, HAULNUM, LINK1, LINK3, CF_LNDLB_LIVLB, - CF_RPTQTY_LNDLB, little, NESPP3, MKTCAT)] -little[, NESPP3 := 366] -setnames(little, "little", "C.HAILWT") -little <- little[C.HAILWT > 0, ] - -winter <- ob.skates[, list(COMNAME, SCINAME, PR, CATDISP, DRFLAG, - YEAR, MONTH, AREA, NEGEAR, HAILWT, - TRIPID, HAULNUM, LINK1, LINK3, CF_LNDLB_LIVLB, - CF_RPTQTY_LNDLB, winter, NESPP3, MKTCAT)] -winter[, NESPP3 := 367] -setnames(winter, "winter", "C.HAILWT") -winter <- winter[C.HAILWT > 0, ] - -other <- ob.skates[, list(COMNAME, SCINAME, PR, CATDISP, DRFLAG, - YEAR, MONTH, AREA, NEGEAR, HAILWT, - TRIPID, HAULNUM, LINK1, LINK3, CF_LNDLB_LIVLB, - CF_RPTQTY_LNDLB, other.skate, NESPP3, MKTCAT)] -other[, NESPP3 := 365] -setnames(other, "other.skate", "C.HAILWT") -other <- other[C.HAILWT > 0, ] - -#merge all three and reformat for ob -skates.add.back <- rbindlist(list(little, winter, other)) - -setcolorder(skates.add.back, names(ob.code)) - -ob.code <- rbindlist(list(ob.code[NESPP3 != 365, ], skates.add.back)) - -#Assign stat areas to EPUs -gom <- c(500,510,512:515) -gb <- c(521:526,551,552,561,562) -mab <- c(537,539,600,612:616,621,622,625,626,631,632) -ss <- c(463:467,511) - -ob.code[AREA %in% gom, EPU := 'GOM'] -ob.code[AREA %in% gb, EPU := 'GB'] -ob.code[AREA %in% mab, EPU := 'MAB'] -ob.code[AREA %in% ss, EPU := 'SS'] -ob.code[is.na(EPU), EPU := 'OTHER'] -ob.code[, EPU := factor(EPU, levels = c('GOM', 'GB', 'MAB', 'SS', 'OTHER'))] - -#Create quarter year variable -ob.code[MONTH %in% 1:3, QY := 1] -ob.code[MONTH %in% 4:6, QY := 2] -ob.code[MONTH %in% 7:9, QY := 3] -ob.code[MONTH %in% 10:12, QY := 4] - -#Aggregate Gear -otter <- 50:59 -dredge.sc <- 131:132 -pot <- c(189:190, 200:219, 300, 301) -longline <- c(10, 40) -seine <- c(70:79, 120:129, 360) -gillnet <- c(100:119, 500, 510, 520) -midwater <- c(170, 370) -dredge.o <- c(281, 282, 380:400) - -ob.code[NEGEAR %in% otter, GEAR := 'otter'] -ob.code[NEGEAR %in% dredge.sc, GEAR := 'dredge.sc'] -ob.code[NEGEAR %in% pot, GEAR := 'pot'] -ob.code[NEGEAR %in% longline, GEAR := 'longline'] -ob.code[NEGEAR %in% seine, GEAR := 'seine'] -ob.code[NEGEAR %in% gillnet, GEAR := 'gillnet'] -ob.code[NEGEAR %in% midwater, GEAR := 'midwater'] -ob.code[NEGEAR %in% dredge.o, GEAR := 'dredge.o'] -ob.code[is.na(GEAR), GEAR := 'other'] -ob.code[, GEAR := as.factor(GEAR)] - -ob.code[, c('DRFLAG', 'MONTH', 'AREA', 'NEGEAR', - 'HAILWT', 'CF_LNDLB_LIVLB', 'CF_RPTQTY_LNDLB') := NULL] - -setkeyv(ob.code, c(strat.var, 'NESPP3', 'CATDISP')) - -if(haullevel == T){#This is broken - ob.haul <- ob.code - save(comdisc, file = file.path(out.dir, "Observer_Discards_by_Haul.RData")) -} - -ob.sums <- ob.code[, sum(C.HAILWT), by = key(ob.code)] - -#Make a new function -#Calculate kept and discards -ob.discard <- ob.sums[CATDISP == 0, ] - -setnames(ob.discard, - "V1", - "DISCARD") - -setkeyv(ob.sums, strat.var) - -ob.kept <- ob.sums[CATDISP == 1, sum(V1), by = key(ob.sums)] - -setnames(ob.kept, - "V1", - "KEPT.ALL") - -ob.all <- merge(ob.kept, ob.discard, by = key(ob.sums)) - -ob.all[, CATDISP := NULL] - -ob.all[, DK := DISCARD / KEPT.ALL] -ob.all[is.na(DK), DK := 1.0] -ob.all[, c('KEPT.ALL', 'DISCARD') := NULL] - -#Get landings -load(file.path(data.dir, landings.file)) - -setkeyv(comland, strat.var) - -tot.land <- comland[, sum(SPPLIVMT), by = key(comland)] - -setnames(tot.land, - "V1", - "TOT.LAND") - -comdisc <- merge(ob.all, tot.land, by = key(comland)) - -comdisc[, DISC := DK * TOT.LAND] - -#Variance -#Need to add back individual trip data -rm(ob) #Free up memory -setkeyv(comdisc, c(strat.var, 'NESPP3')) - -disc.var <- unique(comdisc, by = key(comdisc)) - -#Trip kept all -setkeyv(ob.code, c(strat.var, 'TRIPID')) - -trip.kept <- ob.code[CATDISP == 1, sum(C.HAILWT), by = key(ob.code)] -setnames(trip.kept, "V1", "trip.k") - -#Trip discard by species -setkeyv(ob.code, c(strat.var, 'TRIPID', 'NESPP3')) - -trip.disc <- ob.code[CATDISP == 0, sum(C.HAILWT), by = key(ob.code)] -setnames(trip.disc, "V1", "trip.d") - -trip.all <- merge(trip.disc, trip.kept, by = c(strat.var, 'TRIPID'), all = T) -trip.all[is.na(trip.k), trip.k := 0] - -disc.var <- merge(disc.var, trip.all, by = c(strat.var, 'NESPP3')) - -#Calculate the number of observed trips -setkeyv(ob.code, c(strat.var, 'TRIPID')) - -trips <- unique(ob.code, by = key(ob.code)) - -trip.count <- trips[, count(TRIPID), by = strat.var] - -setnames(trip.count, "V1", "n") - -disc.var <- merge(disc.var, trip.count, by = strat.var) - -#Calculate the total number of trips -#CFDBS is on sole - need to switch connection -odbcClose(channel) -if(Sys.info()['sysname']=="Windows"){ - channel <- odbcDriverConnect() -} else { - channel <- odbcConnect('sole', uid, pwd) -} - -tables <- c(paste('WODETS', 89:93, sep = ''), - paste('CFDETS', 1994:endyear, 'AA', sep = '')) - -comtrip.qry <- "select year, month, area, negear, count(link) as N - from WODETS89 - group by year, month, area, negear" -comtrip <- as.data.table(sqlQuery(channel, comtrip.qry)) - -for(i in 2:length(tables)){ - tripyr.qry <- paste("select year, month, area, negear, count(link) as N - from", tables[i], - "group by year, month, area, negear") - tripyr <- as.data.table(sqlQuery(channel, tripyr.qry)) - - comtrip <- rbindlist(list(comtrip, tripyr)) - } - -comtrip[AREA %in% gom, EPU := 'GOM'] -comtrip[AREA %in% gb, EPU := 'GB'] -comtrip[AREA %in% mab, EPU := 'MAB'] -comtrip[AREA %in% ss, EPU := 'SS'] -comtrip[is.na(EPU), EPU := 'OTHER'] -comtrip[, EPU := factor(EPU, levels = c('GOM', 'GB', 'MAB', 'SS', 'OTHER'))] - -comtrip[YEAR < 100, YEAR := YEAR + 1900] - -comtrip[MONTH %in% 1:3, QY := 1] -comtrip[MONTH %in% 4:6, QY := 2] -comtrip[MONTH %in% 7:9, QY := 3] -comtrip[MONTH %in% 10:12, QY := 4] - -comtrip[NEGEAR %in% otter, GEAR := 'otter'] -comtrip[NEGEAR %in% dredge.sc, GEAR := 'dredge.sc'] -comtrip[NEGEAR %in% pot, GEAR := 'pot'] -comtrip[NEGEAR %in% longline, GEAR := 'longline'] -comtrip[NEGEAR %in% seine, GEAR := 'seine'] -comtrip[NEGEAR %in% gillnet, GEAR := 'gillnet'] -comtrip[NEGEAR %in% midwater, GEAR := 'midwater'] -comtrip[NEGEAR %in% dredge.o, GEAR := 'dredge.o'] -comtrip[is.na(GEAR), GEAR := 'other'] -comtrip[, GEAR := as.factor(GEAR)] - -setkeyv(comtrip, strat.var) - -comtrip.count <- comtrip[, sum(N), by = key(comtrip)] - -setnames(comtrip.count, "V1", "N") - -disc.var <- merge(disc.var, comtrip.count, by = key(comtrip), all.x = T) - -#Fix groups that don't line up properly - actual value of N not that important only relative size -N.avg <- disc.var[, mean(N, na.rm = T)] -disc.var[is.na(N), N := N.avg] - -#Calculate variance -#Need to expand so zero discards by species are represented -setkeyv(disc.var, c(strat.var, 'TRIPID')) -var.trips <- unique(disc.var, by = key(disc.var)) -#drop species specific data -var.trips[, c('NESPP3', 'DK', 'DISC', 'trip.d') := NULL] - -#Get list of species -spp <- unique(disc.var[, NESPP3]) -all.spp.var <- c() -for(i in 1:length(spp)){ - spp.trip <- disc.var[NESPP3 == spp[i], ] - #Get rid of extra data - spp.trip[, c('TOT.LAND', 'DISC', 'trip.k', 'n', 'N') := NULL] - - spp.var <- merge(var.trips, spp.trip, by = c(strat.var, 'TRIPID'), all.x = T) - - #Fix NAs - spp.var[is.na(NESPP3), NESPP3 := spp[i]] - spp.var[is.na(trip.d), trip.d := 0] - - #Merge in DK ratios - setkeyv(spp.trip, strat.var) - spp.dk <- unique(spp.trip, by = key(spp.trip)) - spp.var[, DK := NULL] - spp.dk[, c('NESPP3', 'TRIPID', 'trip.d') := NULL] - spp.var <- merge(spp.var, spp.dk, by = strat.var, all.x = T) - spp.var[is.na(DK), DK := 0] - - spp.var[, step.1 := (sum(trip.d^2 + DK^2 * trip.k^2 - 2 * DK * trip.d * trip.k)/(n - 1)), by = strat.var] - - setkeyv(spp.var, strat.var) - spp.var <- unique(spp.var, by = key(spp.var)) - spp.var[, c('TRIPID', 'trip.d', 'trip.k', 'DK') := NULL] - - spp.var[, DISC.VAR := TOT.LAND^2 * ((N - n)/n*N) * (1/(TOT.LAND/n)^2) * step.1] - spp.var[, c('TOT.LAND', 'n', 'N', 'step.1') := NULL] - - all.spp.var <- rbindlist(list(all.spp.var, spp.var)) - } -comdisc <- merge(comdisc, all.spp.var, by = c(strat.var, 'NESPP3'), all.x = T) - -#Add species names -#Change to NESPP3 to combine market categories -comname[NESPP4 < 100, NESPP3 := as.numeric(substring(NESPP4, 1, 1))] -comname[NESPP4 > 99 & NESPP4 < 1000, NESPP3 := as.numeric(substring(NESPP4, 1, 2))] -comname[(NESPP4 > 999 & NESPP4 < 6100) | - NESPP4 %in% c(7100:7109, 8020:8029), NESPP3 := as.numeric(substring(NESPP4, 1, 3))] -#Birds, mammals, etc don't have unique NESPP3 codes -comname[NESPP4 > 6099 & !NESPP4 %in% c(7100:7109, 8020:8029), NESPP3 := NESPP4] - -setkey(comname, NESPP3) -comname <- unique(comname, by = key(comname)) -comname[, c('NESPP4', 'SCINAME') := NULL] - -comdisc <- merge(comname, comdisc, by = 'NESPP3') - -save(comdisc, file = file.path(out.dir, "Comdisc.RData")) +# #Comdisc.r +# library(here); library(data.table); library(comlandr) +# +# #channel <- dbutils::connect_to_database(server="nova",uid="slucey") +# +# #get_observer_data <- function(channel, filterByYear, ) +# endyear <- 2017 +# +# strat.var <- c('YEAR', 'QY', 'EPU', 'GEAR') +# haullevel <- F #Toggle whether to save haul by haul data or not +# landings.file <- 'comland_meatwt_deflated.RData' +# +# +# +# #------------------------------------------------------------------------------- +# #User created functions +# #Sums the number of occurances +# count<-function(x){ +# num<-rep(1,length(x)) +# out<-sum(num) +# return(out) +# } +# +# #------------------------------------------------------------------------------- +# +# filterByYear <- 1989 +# +# #Create year vector +# if(is.na(filterByYear[1])){ +# years <- ">= 1989" +# }else{ +# years <- paste0("in (", survdat:::sqltext(filterByYear), ")") +# } +# +# ob.qry <- paste0("select year, month, area, negear, nespp4, hailwt, catdisp, drflag, +# tripid, haulnum, lathbeg, lonhbeg, link3 +# from OBSPP +# where obsrflag = 1 +# and program not in ('127', '900', '250', '160') +# and year ", years, +# "\n union +# select year, month, area, negear, nespp4, hailwt, catdisp, drflag, +# tripid, haulnum, lathbeg, lonhbeg, link3 +# from ASMSPP +# where obsrflag = 1 +# and program not in ('127', '900', '250', '160') +# and year ", years) +# +# ob <- data.table::as.data.table(DBI::dbGetQuery(channel, ob.qry)) +# +# #Add protected species here +# mammal.qry <- paste0("select distinct a.year, a.month, b.area, b.negear, a.nespp4, +# 1 as hailwt, 0 as catdisp, 1 as drflag, a.tripid, a.haulnum, +# b.lathbeg, b.lonhbeg, a.link3 +# from obinc a, obspp b +# where a.tripid = b.tripid +# and a.year ", years, +# "\n union +# select distinct a.year, a.month, b.area, b.negear, a.nespp4, +# 1 as hailwt, 0 as catdisp, 1 as drflag, a.tripid, a.haulnum, +# b.lathbeg, b.lonhbeg, a.link3 +# from asminc a, asmspp b +# where a.tripid = b.tripid +# and a.year ", years) +# +# mammal <- data.table::as.data.table(DBI::dbGetQuery(channel, mammal.qry)) +# +# ob <- rbindlist(list(ob, mammal)) +# +# #Grab otter trawl gear tables to get mesh size for small verses large mesh +# mesh.qry <- paste0("select link3, codmsize +# from OBOTGH +# where year ", years) +# mesh <- data.table::as.data.table(DBI::dbGetQuery(channel, mesh.qry)) +# +# #Convert mesh size from mm to inches +# mesh[, CODMSIZE := CODMSIZE * 0.0393701] +# mesh[CODMSIZE <= 3, MESHCAT := 'SM'] +# mesh[CODMSIZE > 3, MESHCAT := 'LG'] +# mesh[, CODMSIZE := NULL] +# +# ob <- merge(ob, mesh, by = 'LINK3', all.x = T) +# +# #Clean up data set +# #Remove those with unknown disposition +# ob <- ob[CATDISP != 9, ] +# +# #remove record if weight is missing +# ob <- ob[!is.na(HAILWT), ] +# +# #remove non-living items (clappers and stomach contents) and unknown living matter +# ob <- ob[!(NESPP4 %in% c(0, 6800:6802, 6805, 6810, 6820, 6830, 6850:6857, 6882, 6883, 6894:6897))] +# +# #Convert lat/lon to decimal degrees +# ob[, LATDD := substr(LATHBEG, 1, 2) + ((substr(LATHBEG, 3, 4) + substr(LATHBEG, 5, 6)) +# / 60)] +# +# #Convert weights +# convert.qry <- "select nespp4_obs, catdisp_code, drflag_code, cf_lndlb_livlb, cf_rptqty_lndlb +# from obspecconv" +# convert <- data.table::as.data.table(DBI::dbGetQuery(channel, convert.qry)) +# +# setnames(convert, +# c('NESPP4_OBS', 'CATDISP_CODE', 'DRFLAG_CODE'), +# c('NESPP4', 'CATDISP', 'DRFLAG')) +# +# setkey(convert, +# NESPP4, +# CATDISP, +# DRFLAG) +# +# ob.code <- merge(ob, convert, by = key(convert), all.x = T) +# +# #missing cf's will be set to 1 Assume living +# ob.code[is.na(CF_LNDLB_LIVLB), CF_LNDLB_LIVLB := 1] +# ob.code[is.na(CF_RPTQTY_LNDLB), CF_RPTQTY_LNDLB := 1] +# +# ob.code[, C.HAILWT := HAILWT * CF_RPTQTY_LNDLB * CF_LNDLB_LIVLB] +# +# #Grab common name and PR flags +# comname.qry <- "select NESPP4, comname, sciname, cetacean, turtle, pinniped +# from obspec" +# +# comname <- data.table::as.data.table(DBI::dbGetQuery(channel, comname.qry)) +# comname[CETACEAN == 1 | TURTLE == 1 | PINNIPED == 1, PR := 1] +# comname[is.na(PR), PR := 0] +# comname[, c('CETACEAN', 'TURTLE', 'PINNIPED') := NULL] +# +# ob.code <- merge(comname, ob.code, by = 'NESPP4') +# +# #Convert to metric tons to align with commercial landings data +# ob.code[PR == 0, C.HAILWT := C.HAILWT * 0.00045359237] +# +# #Change to NESPP3 to combine market categories +# ob.code[, NESPP3 := substring(NESPP4, 1, 3)] +# #Birds, mammals, etc don't have unique NESPP3 codes +# ob.code[is.na(NESPP3), NESPP3 := NESPP4] +# +# ob.code[, MKTCAT := as.numeric(substring(NESPP4, 4, 4))] +# +# #drop NESPP4 +# ob.code[, NESPP4 := NULL] +# +# #Deal with skate(ns) for little and winter skates +# source(file.path(data.dir.2, 'Comland_skates_hakes.R')) +# +# #get little skates and winter skates from skates(ns) - use survey in half years +# #Generate Half year variable in comland +# ob.skates <- ob.code[NESPP3 == 365, ] +# ob.skates[MONTH %in% 1:6, Half := 1] +# ob.skates[MONTH %in% 7:12, Half := 2] +# +# setkey(skate.hake.us, +# YEAR, +# Half, +# AREA) +# +# ob.skates <- merge(ob.skates, skate.hake.us, by = key(skate.hake.us), all.x = T) +# +# ob.skates[NESPP3 == 365, little := little.per * C.HAILWT] +# ob.skates[is.na(little), little := 0] +# +# ob.skates[NESPP3 == 365, winter := winter.per * C.HAILWT] +# ob.skates[is.na(winter), winter := 0] +# +# ob.skates[NESPP3 == 365, other.skate := C.HAILWT - (little + winter)] +# +# #Little (366), winter (367), skates(ns) (365) +# #put skates in ob.code format to merge back +# little <- ob.skates[, list(COMNAME, SCINAME, PR, CATDISP, DRFLAG, +# YEAR, MONTH, AREA, NEGEAR, HAILWT, +# TRIPID, HAULNUM, LINK1, LINK3, CF_LNDLB_LIVLB, +# CF_RPTQTY_LNDLB, little, NESPP3, MKTCAT)] +# little[, NESPP3 := 366] +# setnames(little, "little", "C.HAILWT") +# little <- little[C.HAILWT > 0, ] +# +# winter <- ob.skates[, list(COMNAME, SCINAME, PR, CATDISP, DRFLAG, +# YEAR, MONTH, AREA, NEGEAR, HAILWT, +# TRIPID, HAULNUM, LINK1, LINK3, CF_LNDLB_LIVLB, +# CF_RPTQTY_LNDLB, winter, NESPP3, MKTCAT)] +# winter[, NESPP3 := 367] +# setnames(winter, "winter", "C.HAILWT") +# winter <- winter[C.HAILWT > 0, ] +# +# other <- ob.skates[, list(COMNAME, SCINAME, PR, CATDISP, DRFLAG, +# YEAR, MONTH, AREA, NEGEAR, HAILWT, +# TRIPID, HAULNUM, LINK1, LINK3, CF_LNDLB_LIVLB, +# CF_RPTQTY_LNDLB, other.skate, NESPP3, MKTCAT)] +# other[, NESPP3 := 365] +# setnames(other, "other.skate", "C.HAILWT") +# other <- other[C.HAILWT > 0, ] +# +# #merge all three and reformat for ob +# skates.add.back <- rbindlist(list(little, winter, other)) +# +# setcolorder(skates.add.back, names(ob.code)) +# +# ob.code <- rbindlist(list(ob.code[NESPP3 != 365, ], skates.add.back)) +# +# #Assign stat areas to EPUs +# gom <- c(500,510,512:515) +# gb <- c(521:526,551,552,561,562) +# mab <- c(537,539,600,612:616,621,622,625,626,631,632) +# ss <- c(463:467,511) +# +# ob.code[AREA %in% gom, EPU := 'GOM'] +# ob.code[AREA %in% gb, EPU := 'GB'] +# ob.code[AREA %in% mab, EPU := 'MAB'] +# ob.code[AREA %in% ss, EPU := 'SS'] +# ob.code[is.na(EPU), EPU := 'OTHER'] +# ob.code[, EPU := factor(EPU, levels = c('GOM', 'GB', 'MAB', 'SS', 'OTHER'))] +# +# #Create quarter year variable +# ob.code[MONTH %in% 1:3, QY := 1] +# ob.code[MONTH %in% 4:6, QY := 2] +# ob.code[MONTH %in% 7:9, QY := 3] +# ob.code[MONTH %in% 10:12, QY := 4] +# +# #Aggregate Gear +# otter <- 50:59 +# dredge.sc <- 131:132 +# pot <- c(189:190, 200:219, 300, 301) +# longline <- c(10, 40) +# seine <- c(70:79, 120:129, 360) +# gillnet <- c(100:119, 500, 510, 520) +# midwater <- c(170, 370) +# dredge.o <- c(281, 282, 380:400) +# +# ob.code[NEGEAR %in% otter, GEAR := 'otter'] +# ob.code[NEGEAR %in% dredge.sc, GEAR := 'dredge.sc'] +# ob.code[NEGEAR %in% pot, GEAR := 'pot'] +# ob.code[NEGEAR %in% longline, GEAR := 'longline'] +# ob.code[NEGEAR %in% seine, GEAR := 'seine'] +# ob.code[NEGEAR %in% gillnet, GEAR := 'gillnet'] +# ob.code[NEGEAR %in% midwater, GEAR := 'midwater'] +# ob.code[NEGEAR %in% dredge.o, GEAR := 'dredge.o'] +# ob.code[is.na(GEAR), GEAR := 'other'] +# ob.code[, GEAR := as.factor(GEAR)] +# +# ob.code[, c('DRFLAG', 'MONTH', 'AREA', 'NEGEAR', +# 'HAILWT', 'CF_LNDLB_LIVLB', 'CF_RPTQTY_LNDLB') := NULL] +# +# setkeyv(ob.code, c(strat.var, 'NESPP3', 'CATDISP')) +# +# if(haullevel == T){#This is broken +# ob.haul <- ob.code +# save(comdisc, file = file.path(out.dir, "Observer_Discards_by_Haul.RData")) +# } +# +# ob.sums <- ob.code[, sum(C.HAILWT), by = key(ob.code)] +# +# #Make a new function +# #Calculate kept and discards +# ob.discard <- ob.sums[CATDISP == 0, ] +# +# setnames(ob.discard, +# "V1", +# "DISCARD") +# +# setkeyv(ob.sums, strat.var) +# +# ob.kept <- ob.sums[CATDISP == 1, sum(V1), by = key(ob.sums)] +# +# setnames(ob.kept, +# "V1", +# "KEPT.ALL") +# +# ob.all <- merge(ob.kept, ob.discard, by = key(ob.sums)) +# +# ob.all[, CATDISP := NULL] +# +# ob.all[, DK := DISCARD / KEPT.ALL] +# ob.all[is.na(DK), DK := 1.0] +# ob.all[, c('KEPT.ALL', 'DISCARD') := NULL] +# +# #Get landings +# load(file.path(data.dir, landings.file)) +# +# setkeyv(comland, strat.var) +# +# tot.land <- comland[, sum(SPPLIVMT), by = key(comland)] +# +# setnames(tot.land, +# "V1", +# "TOT.LAND") +# +# comdisc <- merge(ob.all, tot.land, by = key(comland)) +# +# comdisc[, DISC := DK * TOT.LAND] +# +# #Variance +# #Need to add back individual trip data +# rm(ob) #Free up memory +# setkeyv(comdisc, c(strat.var, 'NESPP3')) +# +# disc.var <- unique(comdisc, by = key(comdisc)) +# +# #Trip kept all +# setkeyv(ob.code, c(strat.var, 'TRIPID')) +# +# trip.kept <- ob.code[CATDISP == 1, sum(C.HAILWT), by = key(ob.code)] +# setnames(trip.kept, "V1", "trip.k") +# +# #Trip discard by species +# setkeyv(ob.code, c(strat.var, 'TRIPID', 'NESPP3')) +# +# trip.disc <- ob.code[CATDISP == 0, sum(C.HAILWT), by = key(ob.code)] +# setnames(trip.disc, "V1", "trip.d") +# +# trip.all <- merge(trip.disc, trip.kept, by = c(strat.var, 'TRIPID'), all = T) +# trip.all[is.na(trip.k), trip.k := 0] +# +# disc.var <- merge(disc.var, trip.all, by = c(strat.var, 'NESPP3')) +# +# #Calculate the number of observed trips +# setkeyv(ob.code, c(strat.var, 'TRIPID')) +# +# trips <- unique(ob.code, by = key(ob.code)) +# +# trip.count <- trips[, count(TRIPID), by = strat.var] +# +# setnames(trip.count, "V1", "n") +# +# disc.var <- merge(disc.var, trip.count, by = strat.var) +# +# #Calculate the total number of trips +# #CFDBS is on sole - need to switch connection +# odbcClose(channel) +# if(Sys.info()['sysname']=="Windows"){ +# channel <- odbcDriverConnect() +# } else { +# channel <- odbcConnect('sole', uid, pwd) +# } +# +# tables <- c(paste('WODETS', 89:93, sep = ''), +# paste('CFDETS', 1994:endyear, 'AA', sep = '')) +# +# comtrip.qry <- "select year, month, area, negear, count(link) as N +# from WODETS89 +# group by year, month, area, negear" +# comtrip <- as.data.table(sqlQuery(channel, comtrip.qry)) +# +# for(i in 2:length(tables)){ +# tripyr.qry <- paste("select year, month, area, negear, count(link) as N +# from", tables[i], +# "group by year, month, area, negear") +# tripyr <- as.data.table(sqlQuery(channel, tripyr.qry)) +# +# comtrip <- rbindlist(list(comtrip, tripyr)) +# } +# +# comtrip[AREA %in% gom, EPU := 'GOM'] +# comtrip[AREA %in% gb, EPU := 'GB'] +# comtrip[AREA %in% mab, EPU := 'MAB'] +# comtrip[AREA %in% ss, EPU := 'SS'] +# comtrip[is.na(EPU), EPU := 'OTHER'] +# comtrip[, EPU := factor(EPU, levels = c('GOM', 'GB', 'MAB', 'SS', 'OTHER'))] +# +# comtrip[YEAR < 100, YEAR := YEAR + 1900] +# +# comtrip[MONTH %in% 1:3, QY := 1] +# comtrip[MONTH %in% 4:6, QY := 2] +# comtrip[MONTH %in% 7:9, QY := 3] +# comtrip[MONTH %in% 10:12, QY := 4] +# +# comtrip[NEGEAR %in% otter, GEAR := 'otter'] +# comtrip[NEGEAR %in% dredge.sc, GEAR := 'dredge.sc'] +# comtrip[NEGEAR %in% pot, GEAR := 'pot'] +# comtrip[NEGEAR %in% longline, GEAR := 'longline'] +# comtrip[NEGEAR %in% seine, GEAR := 'seine'] +# comtrip[NEGEAR %in% gillnet, GEAR := 'gillnet'] +# comtrip[NEGEAR %in% midwater, GEAR := 'midwater'] +# comtrip[NEGEAR %in% dredge.o, GEAR := 'dredge.o'] +# comtrip[is.na(GEAR), GEAR := 'other'] +# comtrip[, GEAR := as.factor(GEAR)] +# +# setkeyv(comtrip, strat.var) +# +# comtrip.count <- comtrip[, sum(N), by = key(comtrip)] +# +# setnames(comtrip.count, "V1", "N") +# +# disc.var <- merge(disc.var, comtrip.count, by = key(comtrip), all.x = T) +# +# #Fix groups that don't line up properly - actual value of N not that important only relative size +# N.avg <- disc.var[, mean(N, na.rm = T)] +# disc.var[is.na(N), N := N.avg] +# +# #Calculate variance +# #Need to expand so zero discards by species are represented +# setkeyv(disc.var, c(strat.var, 'TRIPID')) +# var.trips <- unique(disc.var, by = key(disc.var)) +# #drop species specific data +# var.trips[, c('NESPP3', 'DK', 'DISC', 'trip.d') := NULL] +# +# #Get list of species +# spp <- unique(disc.var[, NESPP3]) +# all.spp.var <- c() +# for(i in 1:length(spp)){ +# spp.trip <- disc.var[NESPP3 == spp[i], ] +# #Get rid of extra data +# spp.trip[, c('TOT.LAND', 'DISC', 'trip.k', 'n', 'N') := NULL] +# +# spp.var <- merge(var.trips, spp.trip, by = c(strat.var, 'TRIPID'), all.x = T) +# +# #Fix NAs +# spp.var[is.na(NESPP3), NESPP3 := spp[i]] +# spp.var[is.na(trip.d), trip.d := 0] +# +# #Merge in DK ratios +# setkeyv(spp.trip, strat.var) +# spp.dk <- unique(spp.trip, by = key(spp.trip)) +# spp.var[, DK := NULL] +# spp.dk[, c('NESPP3', 'TRIPID', 'trip.d') := NULL] +# spp.var <- merge(spp.var, spp.dk, by = strat.var, all.x = T) +# spp.var[is.na(DK), DK := 0] +# +# spp.var[, step.1 := (sum(trip.d^2 + DK^2 * trip.k^2 - 2 * DK * trip.d * trip.k)/(n - 1)), by = strat.var] +# +# setkeyv(spp.var, strat.var) +# spp.var <- unique(spp.var, by = key(spp.var)) +# spp.var[, c('TRIPID', 'trip.d', 'trip.k', 'DK') := NULL] +# +# spp.var[, DISC.VAR := TOT.LAND^2 * ((N - n)/n*N) * (1/(TOT.LAND/n)^2) * step.1] +# spp.var[, c('TOT.LAND', 'n', 'N', 'step.1') := NULL] +# +# all.spp.var <- rbindlist(list(all.spp.var, spp.var)) +# } +# comdisc <- merge(comdisc, all.spp.var, by = c(strat.var, 'NESPP3'), all.x = T) +# +# #Add species names +# #Change to NESPP3 to combine market categories +# comname[NESPP4 < 100, NESPP3 := as.numeric(substring(NESPP4, 1, 1))] +# comname[NESPP4 > 99 & NESPP4 < 1000, NESPP3 := as.numeric(substring(NESPP4, 1, 2))] +# comname[(NESPP4 > 999 & NESPP4 < 6100) | +# NESPP4 %in% c(7100:7109, 8020:8029), NESPP3 := as.numeric(substring(NESPP4, 1, 3))] +# #Birds, mammals, etc don't have unique NESPP3 codes +# comname[NESPP4 > 6099 & !NESPP4 %in% c(7100:7109, 8020:8029), NESPP3 := NESPP4] +# +# setkey(comname, NESPP3) +# comname <- unique(comname, by = key(comname)) +# comname[, c('NESPP4', 'SCINAME') := NULL] +# +# comdisc <- merge(comname, comdisc, by = 'NESPP3') +# +# save(comdisc, file = file.path(out.dir, "Comdisc.RData")) From d89aa8c6a1c13433a9ee8834d6b06df3be83db46 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Tue, 26 Apr 2022 15:37:05 -0400 Subject: [PATCH 58/60] These will need to be updated again --- man/aggregate_area.Rd | 31 +++++++++++++++++++++++++++++++ man/aggregate_gear.Rd | 25 +++++++++++++++++++++++++ man/assign_area.Rd | 30 ++++++++++++++++-------------- man/calc_DK.Rd | 27 +++++++++++++++++++++++++++ man/get_comdisc_raw_data.Rd | 32 ++++++++++++++++++++++++++++++++ man/get_comland_data.Rd | 10 +++++++++- man/get_comland_raw_data.Rd | 1 + 7 files changed, 141 insertions(+), 15 deletions(-) create mode 100644 man/aggregate_area.Rd create mode 100644 man/aggregate_gear.Rd create mode 100644 man/calc_DK.Rd create mode 100644 man/get_comdisc_raw_data.Rd diff --git a/man/aggregate_area.Rd b/man/aggregate_area.Rd new file mode 100644 index 0000000..22ff63a --- /dev/null +++ b/man/aggregate_area.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aggregate_area.R +\name{aggregate_area} +\alias{aggregate_area} +\title{Assign landing records to an aggregated area} +\usage{ +aggregate_area( + comland, + userAreas, + areaDescription, + propDescription, + applyPropValue = T +) +} +\arguments{ +\item{comland}{Data set generated by \code{get_comland_data}} + +\item{userAreas}{Data frame. Definitions to aggregate statistical areas to user defined +areas} + +\item{areaDescription}{Character. Name of column in userAreas that defines the new +area.} + +\item{propDescription}{Character. Name of column in userAreas that defines the +proportions of landings assigned to new area.} +} +\description{ +Takes the output from \code{get_comland_data} and further aggregates from NAFO +statistical areas to a user defined area. Allows for species to be assigned by +proportions to more than two user defined areas from one stat area +} diff --git a/man/aggregate_gear.Rd b/man/aggregate_gear.Rd new file mode 100644 index 0000000..a36efee --- /dev/null +++ b/man/aggregate_gear.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aggregate_gear.R +\name{aggregate_gear} +\alias{aggregate_gear} +\title{Assign landing records to an aggregated area} +\usage{ +aggregate_gear(comData, userGears, fleetDescription) +} +\arguments{ +\item{comland}{Data set generated by \code{get_comland_data}} + +\item{userAreas}{Data frame. Definitions to aggregate statistical areas to user defined +areas} + +\item{areaDescription}{Character. Name of column in userAreas that defines the new +area.} + +\item{propDescription}{Character. Name of column in userAreas that defines the +proportions of landings assigned to new area.} +} +\description{ +Takes the output from \code{get_comland_data} and further aggregates from NAFO +statistical areas to a user defined area. Allows for species to be assigned by +proportions to more than two user defined areas from one stat area +} diff --git a/man/assign_area.Rd b/man/assign_area.Rd index cc15f9e..bbb4302 100644 --- a/man/assign_area.Rd +++ b/man/assign_area.Rd @@ -2,24 +2,26 @@ % Please edit documentation in R/assign_area.R \name{assign_area} \alias{assign_area} -\title{Assign landing records to an aggregated area} +\title{Assigns points to polygon} \usage{ -assign_area(comland, userAreas, areaDescription, propDescription) +assign_area(comdiscData, areaPolygon, areaDescription, na.keep = F) } \arguments{ -\item{comland}{Data set generated by \code{get_comland_data}} - -\item{userAreas}{Data frame. Definitions to aggregate statistical areas to user defined -areas} - -\item{areaDescription}{Character. Name of column in userAreas that defines the new -area.} +\item{na.keep}{Boolean. Logical value to indicate whether original strata names +should be retained.} +} +\value{ +Returns a \code{comdiscData} data.table with one additional column labeled + with the value of \code{areaDescription} -\item{propDescription}{Character. Name of column in userAreas that defines the -proportions of landings assigned to new area.} +\item{areaDescription}{The name of the region (found in \code{areaPolygon}) + that a record in \code{surveyData} is assigned to} } \description{ -Takes the output from \code{get_comland_data} and further aggregates from NAFO -statistical areas to a user defined area. Allows for species to be assigned by -proportions to more than two user defined areas from one stat area +Assign observer data (points, lat and lon) to designated regions (polygons) from a shape file. +} +\seealso{ +Other comdisc: +\code{\link{calc_DK}()} } +\concept{comdisc} diff --git a/man/calc_DK.Rd b/man/calc_DK.Rd new file mode 100644 index 0000000..57b78d6 --- /dev/null +++ b/man/calc_DK.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calc_DK.R +\name{calc_DK} +\alias{calc_DK} +\title{Calculate discard to kept ratio} +\usage{ +calc_DK(comdiscData, areaDescription, fleetDescription) +} +\arguments{ +\item{na.keep}{Boolean. Logical value to indicate whether original strata names +should be retained.} +} +\value{ +Returns a \code{comdiscData} data.table with one additional column labeled + with the value of \code{areaDescription} + +\item{areaDescription}{The name of the region (found in \code{areaPolygon}) + that a record in \code{surveyData} is assigned to} +} +\description{ +Use observer data to calculate the ratio of discards to kept by species. +} +\seealso{ +Other comdisc: +\code{\link{assign_area}()} +} +\concept{comdisc} diff --git a/man/get_comdisc_raw_data.Rd b/man/get_comdisc_raw_data.Rd new file mode 100644 index 0000000..7c088fa --- /dev/null +++ b/man/get_comdisc_raw_data.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_comdisc_raw_data.R +\name{get_comdisc_raw_data} +\alias{get_comdisc_raw_data} +\title{Extracts observer data from Database} +\usage{ +get_comdisc_raw_data(channel, filterByYear) +} +\value{ +Data frame (data.table) (n x 10) +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{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{SPPVALUE}{The value of landed catch to the nearest dollar (U.S.), paid to fisherman by dealer, for a given species.} +} +\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 633bd9e..bec04e6 100644 --- a/man/get_comland_data.Rd +++ b/man/get_comland_data.Rd @@ -7,13 +7,21 @@ get_comland_data( channel, filterByYear = NA, + filterByArea = NA, useLanded = T, removeParts = T, useHerringMaine = T, useForeign = T, refYear = NA, refMonth = NA, - disagSkatesHakes = T + disagSkatesHakes = T, + aggArea = F, + userAreas = comlandr::mskeyAreas, + areaDescription = "EPU", + propDescription = "MeanProp", + aggGear = F, + userGears = comlandr::mykeyGears, + fleetDescription = "Fleet" ) } \arguments{ diff --git a/man/get_comland_raw_data.Rd b/man/get_comland_raw_data.Rd index bccc060..a75ceda 100644 --- a/man/get_comland_raw_data.Rd +++ b/man/get_comland_raw_data.Rd @@ -7,6 +7,7 @@ get_comland_raw_data( channel, filterByYear = NA, + filterByArea = NA, useLanded = T, removeParts = T ) From db3a8d806f7a9cd33bb4bb1e66b9f2d3b365454f Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Fri, 29 Apr 2022 10:07:29 -0400 Subject: [PATCH 59/60] Remove inheritParams from survdat --- R/assign_area.R | 2 +- R/calc_DK.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/assign_area.R b/R/assign_area.R index 56d608a..a08e902 100644 --- a/R/assign_area.R +++ b/R/assign_area.R @@ -3,7 +3,7 @@ #' Assign observer data (points, lat and lon) to designated regions (polygons) from a shape file. #' #' -#' @inheritParams strat_prep +# @inheritParams strat_prep #' @param na.keep Boolean. Logical value to indicate whether original strata names #' should be retained. #' diff --git a/R/calc_DK.R b/R/calc_DK.R index c4f63a1..8b79047 100644 --- a/R/calc_DK.R +++ b/R/calc_DK.R @@ -3,7 +3,7 @@ #' Use observer data to calculate the ratio of discards to kept by species. #' #' -#' @inheritParams strat_prep +# @inheritParams strat_prep #' @param na.keep Boolean. Logical value to indicate whether original strata names #' should be retained. #' From 6d380a501cedad70053026300d92373699b56527 Mon Sep 17 00:00:00 2001 From: Sean Lucey Date: Fri, 29 Apr 2022 14:59:37 -0400 Subject: [PATCH 60/60] Added a default to filterByYear --- R/get_comland_raw_data.R | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/R/get_comland_raw_data.R b/R/get_comland_raw_data.R index d04d12d..4b3cdd2 100644 --- a/R/get_comland_raw_data.R +++ b/R/get_comland_raw_data.R @@ -32,7 +32,12 @@ get_comland_raw_data <- function(channel, filterByYear = NA, filterByArea = NA, useLanded = T, removeParts = T){ - message("Pulling landings data from database. This could take a while (> 1 hour) ... ") + #If not specifying a year default to 1964 - 2019 + if(is.na(filterByYear)) filterByYear <- 1964:2019 + + message(paste0("Pulling landings data from ", + filterByYear[1], " to ", filterByYear[length(filterByYear)], + ". This could take a while (> 1 hour) ... ")) #Generate vector of tables to loop through if(any(filterByYear < 1964)) stop("Landings data start in 1964")