From 4b93f65db897e0b8efda73f53a114c9fd263d414 Mon Sep 17 00:00:00 2001 From: kellijohnson-NOAA Date: Thu, 16 Mar 2023 15:39:27 -0700 Subject: [PATCH 01/26] fix(pull_catch): Allow a vector of common or latin the if statement was failing for the case when the latin or common name input arguments were a vector rather than a single character string because, for example, common_name = c("sablefish", "longnose skate") would return FALSE FALSE in the if statement because it was checking species and not species[1] because logically if a user wants all species the vector species will just be one entry and thus the check for species[1] is okay. --- R/pull_catch.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/pull_catch.R b/R/pull_catch.R index 7830379..4f2e56e 100644 --- a/R/pull_catch.R +++ b/R/pull_catch.R @@ -200,7 +200,7 @@ pull_catch <- function(common_name = NULL, ] # Link each data set together based on trawl_id - if (species == "pull all"){ + if (species[1] == "pull all"){ grid <- expand.grid( "trawl_id" = unique(all_tows$trawl_id), "common_name" = unique(positive_tows$common_name), From d6329a4e50b772c7d0a9cd8c2248e1db26166c7b Mon Sep 17 00:00:00 2001 From: kellijohnson-NOAA Date: Fri, 17 Mar 2023 05:36:36 -0700 Subject: [PATCH 02/26] Changes all if(species[1] == "pull all") to any() --- R/PullBio.fn.R | 2 +- R/PullCatch.fn.R | 2 +- R/pull_bio.R | 2 +- R/pull_biological_samples.R | 2 +- R/pull_catch.R | 4 ++-- 5 files changed, 6 insertions(+), 6 deletions(-) diff --git a/R/PullBio.fn.R b/R/PullBio.fn.R index a12cad1..c5fac49 100644 --- a/R/PullBio.fn.R +++ b/R/PullBio.fn.R @@ -134,7 +134,7 @@ PullBio.fn <- function(Name = NULL, SciName = NULL, YearRange = c(1980, 5000), S "&variables=", paste0(Vars, collapse = ",") ) - if (Species[1] == "pull all") { + if (any(Species == "pull all")) { UrlText <- paste0( "https://www.webapps.nwfsc.noaa.gov/data/api/v1/source/trawl.individual_fact/selection.json?filters=project=", paste(strsplit(project, " ")[[1]], collapse = "%20"), ",", "station_invalid=0,", diff --git a/R/PullCatch.fn.R b/R/PullCatch.fn.R index babd913..854d7db 100644 --- a/R/PullCatch.fn.R +++ b/R/PullCatch.fn.R @@ -174,7 +174,7 @@ PullCatch.fn <- function(Name = NULL, SciName = NULL, YearRange = c(1980, 5000), "&variables=", paste0(Vars, collapse = ",") ) - if (Species[1] == "pull all") { + if (any(Species == "pull all")) { UrlText <- paste0( "https://www.webapps.nwfsc.noaa.gov/data/api/v1/source/trawl.catch_fact/selection.json?filters=project=", paste(strsplit(project, " ")[[1]], collapse = "%20"), ",", "station_invalid=0,", diff --git a/R/pull_bio.R b/R/pull_bio.R index 9722487..cf9386d 100644 --- a/R/pull_bio.R +++ b/R/pull_bio.R @@ -97,7 +97,7 @@ pull_bio <- function(common_name = NULL, } add_species <- paste0("field_identified_taxonomy_dim$", var_name, "|=[", species_str,"]") - if (species[1] == "pull all") { + if (any(species == "pull all")) { add_species <- "" } diff --git a/R/pull_biological_samples.R b/R/pull_biological_samples.R index 9fd64aa..ad3488d 100644 --- a/R/pull_biological_samples.R +++ b/R/pull_biological_samples.R @@ -61,7 +61,7 @@ pull_biological_samples <- function(common_name = NULL, } add_species <- paste0("field_identified_taxonomy_dim$", var_name, "|=[", species_str,"]") - if (species[1] == "pull all") { + if (any(species == "pull all")) { add_species <- "" } diff --git a/R/pull_catch.R b/R/pull_catch.R index 4f2e56e..4ad3652 100644 --- a/R/pull_catch.R +++ b/R/pull_catch.R @@ -129,7 +129,7 @@ pull_catch <- function(common_name = NULL, } add_species <- paste0("field_identified_taxonomy_dim$", var_name, "|=[", species_str,"]") - if (species[1] == "pull all") { + if (any(species == "pull all")) { add_species <- "" } @@ -200,7 +200,7 @@ pull_catch <- function(common_name = NULL, ] # Link each data set together based on trawl_id - if (species[1] == "pull all"){ + if (any(species == "pull all")) { grid <- expand.grid( "trawl_id" = unique(all_tows$trawl_id), "common_name" = unique(positive_tows$common_name), From edf344998dff4c7a6436c7172fbd7826593f6b19 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Thu, 14 Mar 2024 14:24:38 -0700 Subject: [PATCH 03/26] refactor: remove Data_formatted and Area_swept_ha_der The information in each of these colums was available in other columns (Data == Date_formatted and Area_Swept_ha == Area_Swept_ha_der). I opted to retain the column name that has been historically returned by the PullCatch.fn and PullBio.fn functions. --- R/pull_bio.R | 56 +++++++++++++++++++++++++------------------------- R/pull_catch.R | 56 +++++++++++++++++++++++++------------------------- 2 files changed, 56 insertions(+), 56 deletions(-) diff --git a/R/pull_bio.R b/R/pull_bio.R index cf9386d..351e775 100644 --- a/R/pull_bio.R +++ b/R/pull_bio.R @@ -7,11 +7,11 @@ #' @template sci_name #' @template years #' @template survey -#' @template dir +#' @template dir #' @template convert -#' @template verbose +#' @template verbose #' -#' @author Chantel Wetzel +#' @author Chantel Wetzel #' @export #' #' @import chron @@ -38,11 +38,11 @@ # "vermilion and sunset rockfish"), SurveyName = "NWFSC.Combo") #' } #' -pull_bio <- function(common_name = NULL, - sci_name = NULL, - years = c(1980, 2050), - survey = NULL, - dir = NULL, +pull_bio <- function(common_name = NULL, + sci_name = NULL, + years = c(1980, 2050), + survey = NULL, + dir = NULL, convert = TRUE, verbose = TRUE) { @@ -50,10 +50,10 @@ pull_bio <- function(common_name = NULL, if (survey %in% c("NWFSC.Shelf.Rockfish", "NWFSC.Hook.Line")) { stop("The catch pull currently does not work for NWFSC Hook & Line Survey data.", "\nA subset of the data is available on the data warehouse https://www.webapp.nwfsc.noaa.gov/data", - "\nContact John Harms (john.harms@noaa.gov) for the full data set.") + "\nContact John Harms (john.harms@noaa.gov) for the full data set.") } - check_dir(dir = dir, verbose = verbose) + check_dir(dir = dir, verbose = verbose) if (is.null(common_name)) { var_name <- "scientific_name" @@ -96,16 +96,16 @@ pull_bio <- function(common_name = NULL, } } add_species <- paste0("field_identified_taxonomy_dim$", var_name, "|=[", species_str,"]") - + if (any(species == "pull all")) { add_species <- "" } - url_text <- get_url(data_table = "trawl.individual_fact", - project_long = project_long, - add_species = add_species, - years = years, - vars_long = vars_long) + url_text <- get_url(data_table = "trawl.individual_fact", + project_long = project_long, + add_species = add_species, + years = years, + vars_long = vars_long) if (verbose) { message("Pulling biological data. This can take up to ~ 30 seconds (or more).") @@ -122,18 +122,18 @@ pull_bio <- function(common_name = NULL, # Some early entries are NA for standard sample indicators. These should be retained. standard_lengths <- bio_pull[, "standard_survey_length_or_width_indicator"] %in% c(NA, "NA", "Standard Survey Length or Width") bio_pull <- bio_pull[standard_lengths, ] - + # Remove non-standard ages nonstandard_age <- which(bio_pull[, "standard_survey_age_indicator"] == "Not Standard Survey Age") if (length(nonstandard_age) > 0) { - bio_pull[nonstandard_age, "age_years"] <- NA + bio_pull[nonstandard_age, "age_years"] <- NA } # Remove non-standard weights nonstandard_wgt <- which(bio_pull[, "standard_survey_weight_indicator"] == "Not Standard Survey Weight") if (length(nonstandard_wgt) > 0) { - bio_pull[nonstandard_wgt, "weight_kg"] <- NA - } + bio_pull[nonstandard_wgt, "weight_kg"] <- NA + } # Remove water hauls water_hauls <- is.na(bio_pull[, "operation_dim$legacy_performance_code"]) @@ -151,10 +151,10 @@ pull_bio <- function(common_name = NULL, if (survey %in% c("Triennial", "AFSC.Slope")) { - url_text <- get_url(data_table = "trawl.triennial_length_fact", - project_long = project_long, - add_species = add_species, - years = years, + url_text <- get_url(data_table = "trawl.triennial_length_fact", + project_long = project_long, + add_species = add_species, + years = years, vars_long = vars_long) len_pull <- try(get_json(url = url_text)) @@ -167,15 +167,15 @@ pull_bio <- function(common_name = NULL, } good_tows <- len_pull[, "operation_dim$legacy_performance_code"] != 8 len_pull <- len_pull[good_tows, ] - + len_pull$weight_kg <- NA - len_pull$date_formatted <- chron::chron(format(as.POSIXlt(len_pull$datetime_utc_iso, format = "%Y-%m-%dT%H:%M:%S"), "%Y-%m-%d"), format = "y-m-d", out.format = "YYYY-m-d") + len_pull$date <- chron::chron(format(as.POSIXlt(len_pull$datetime_utc_iso, format = "%Y-%m-%dT%H:%M:%S"), "%Y-%m-%d"), format = "y-m-d", out.format = "YYYY-m-d") len_pull$trawl_id <- as.character(len_pull$trawl_id) } } if (nrow(bio_pull) > 0) { - bio_pull$date_formatted <- chron::chron(format(as.POSIXlt(bio_pull$datetime_utc_iso, format = "%Y-%m-%dT%H:%M:%S"), "%Y-%m-%d"), format = "y-m-d", out.format = "YYYY-m-d") + bio_pull$date <- chron::chron(format(as.POSIXlt(bio_pull$datetime_utc_iso, format = "%Y-%m-%dT%H:%M:%S"), "%Y-%m-%d"), format = "y-m-d", out.format = "YYYY-m-d") bio_pull$trawl_id <- as.character(bio_pull$trawl_id) bio <- bio_pull @@ -203,7 +203,7 @@ pull_bio <- function(common_name = NULL, } if(convert) { - bio$data <- bio$date_formatted + bio$age <- bio$age_years bio$weight <- bio$weight_kg firstup <- function(x) { diff --git a/R/pull_catch.R b/R/pull_catch.R index 4ad3652..a48a718 100644 --- a/R/pull_catch.R +++ b/R/pull_catch.R @@ -24,9 +24,9 @@ #' @template sci_name #' @template years #' @template survey -#' @template dir +#' @template dir #' @template convert -#' @template verbose +#' @template verbose #' #' @author Chantel Wetzel #' @export @@ -54,23 +54,23 @@ #' "vermilion and sunset rockfish"), survey = "NWFSC.Combo") #' #' catch_data <- pull_catch(sci_name = c("Sebastes miniatus", -#' "Sebastes sp. (crocotulus)", +#' "Sebastes sp. (crocotulus)", #' "Sebastes sp. (miniatus / crocotulus)"), #' survey = "NWFSC.Combo") #' } #' -pull_catch <- function(common_name = NULL, - sci_name = NULL, - years = c(1980, 2050), - survey = NULL, - dir = NULL, +pull_catch <- function(common_name = NULL, + sci_name = NULL, + years = c(1980, 2050), + survey = NULL, + dir = NULL, convert = TRUE, verbose = TRUE) { if (survey %in% c("NWFSC.Shelf.Rockfish", "NWFSC.Hook.Line")) { stop("The catch pull currently does not work for NWFSC Hook & Line Survey data.", "\nA subset of the data is available on the data warehouse https://www.webapp.nwfsc.noaa.gov/data", - "\nContact John Harms (john.harms@noaa.gov) for the full data set.") + "\nContact John Harms (john.harms@noaa.gov) for the full data set.") } check_dir(dir = dir, verbose = verbose) @@ -86,7 +86,7 @@ pull_catch <- function(common_name = NULL, if (is.null(sci_name) & is.null(common_name)) { var_name <- "common_name" species <- "pull all" - } + } # Survey options available in the data warehouse project_long <- check_survey(survey = survey) @@ -97,17 +97,17 @@ pull_catch <- function(common_name = NULL, # Pull data for the specific species for the following variables # Can only pull the nested fields (legacy performance and statistical partition) if - # the main table fields are specified. Could pull separate and then join which + # the main table fields are specified. Could pull separate and then join which # would allow us to eliminate vars_long form the main pull perf_codes <- c( - "operation_dim$legacy_performance_code", + "operation_dim$legacy_performance_code", "statistical_partition_dim$statistical_partition_type" ) vars_long <- c( - "common_name", "scientific_name", "project", "year", "vessel", "tow", - "total_catch_numbers", "total_catch_wt_kg", + "common_name", "scientific_name", "project", "year", "vessel", "tow", + "total_catch_numbers", "total_catch_wt_kg", "subsample_count", "subsample_wt_kg", "cpue_kg_per_ha_der", perf_codes ) @@ -128,7 +128,7 @@ pull_catch <- function(common_name = NULL, } } add_species <- paste0("field_identified_taxonomy_dim$", var_name, "|=[", species_str,"]") - + if (any(species == "pull all")) { add_species <- "" } @@ -170,8 +170,8 @@ pull_catch <- function(common_name = NULL, positive_tows <- positive_tows[, vars_short] # Pull all tow data including tows where the species was not observed - vars_long <- c("project", "year", "vessel", "pass", "tow", "datetime_utc_iso", - "depth_m", "longitude_dd", "latitude_dd", "area_swept_ha_der", + vars_long <- c("project", "year", "vessel", "pass", "tow", "datetime_utc_iso", + "depth_m", "longitude_dd", "latitude_dd", "area_swept_ha_der", "trawl_id", "operation_dim$legacy_performance_code") vars_short <- vars_long[vars_long != "operation_dim$legacy_performance_code"] @@ -181,7 +181,7 @@ pull_catch <- function(common_name = NULL, years = years, vars_long = vars_long) - all_tows <- try(get_json(url = url_text)) + all_tows <- try(get_json(url = url_text)) # Remove water hauls water_hauls <- is.na(all_tows[, "operation_dim$legacy_performance_code"]) @@ -194,7 +194,7 @@ pull_catch <- function(common_name = NULL, all_tows <- all_tows[ !duplicated(paste(all_tows$year, all_tows$pass, all_tows$vessel, all_tows$tow)), - c("project", "trawl_id", "year", "pass", "vessel", "tow", "datetime_utc_iso", "depth_m", + c("project", "trawl_id", "year", "pass", "vessel", "tow", "datetime_utc_iso", "depth_m", "longitude_dd", "latitude_dd", "area_swept_ha_der" ) ] @@ -202,17 +202,17 @@ pull_catch <- function(common_name = NULL, # Link each data set together based on trawl_id if (any(species == "pull all")) { grid <- expand.grid( - "trawl_id" = unique(all_tows$trawl_id), + "trawl_id" = unique(all_tows$trawl_id), "common_name" = unique(positive_tows$common_name), stringsAsFactors = FALSE - ) + ) } else { grid <- expand.grid( - "trawl_id" = unique(all_tows$trawl_id), + "trawl_id" = unique(all_tows$trawl_id), "common_name" = unique(positive_tows$common_name), "scientific_name" = unique(positive_tows$scientific_name), stringsAsFactors = FALSE - ) + ) } catch_data <- dplyr::left_join( @@ -240,20 +240,20 @@ pull_catch <- function(common_name = NULL, catch[no_area, "area_swept_ha_der"] <- mean(catch$area_swept_ha_der, trim = 0.05, na.rm = TRUE) } - # Fill in zeros where needed + # Fill in zeros where needed catch[is.na(catch)] <- 0 - catch$date_formatted <- chron::chron( - format(as.POSIXlt(catch$datetime_utc_iso, format = "%Y-%m-%dT%H:%M:%S"), "%Y-%m-%d"), + catch$date <- chron::chron( + format(as.POSIXlt(catch$datetime_utc_iso, format = "%Y-%m-%dT%H:%M:%S"), "%Y-%m-%d"), format = "y-m-d", out.format = "YYYY-m-d") catch$trawl_id <- as.character(catch$trawl_id) # kg / km2 <- (100 hectare / 1 *km2) * (kg / hectare) catch$cpue_kg_km2 <- catch$cpue_kg_per_ha_der * 100 + colnames(catch)[which(colnames(catch) == "area_swept_ha_der")] <- "area_swept_ha" if(convert) { - catch$Area_Swept_ha <- catch$area_swept_ha_der - catch$date <- catch$date_formatted + firstup <- function(x) { substr(x, 1, 1) <- toupper(substr(x, 1, 1)) x From 71afff0f08c8d3c2443b0405122d7b6eb0ea70ec Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Thu, 14 Mar 2024 14:25:56 -0700 Subject: [PATCH 04/26] deprecate the older pull fxns The PullCatch.fn and PullBio.fn function still work but now call the new pull_catch and pull_bio functions with a soft deprecate warning for the user. --- R/PullBio.fn.R | 288 +++++++---------------------------------------- R/PullCatch.fn.R | 270 +++++--------------------------------------- 2 files changed, 71 insertions(+), 487 deletions(-) diff --git a/R/PullBio.fn.R b/R/PullBio.fn.R index c5fac49..72a4932 100644 --- a/R/PullBio.fn.R +++ b/R/PullBio.fn.R @@ -9,8 +9,11 @@ #' @param SurveyName survey to pull the data for the options are: #' Triennial, AFSC.Slope, NWFSC.Combo, NWFSC.Slope, NWFSC.Shelf, NWFSC.Hypoxia, #' NWFSC.Santa.Barb.Basin, NWFSC.Shelf.Rockfish (NWFSC.Hook.Line but both are not working), NWFSC.Video#' -#' @param SaveFile option to save the file to the directory -#' @param Dir directory where the file should be saved +#' @param SaveFile Deprecated with {nwfscSurvey} 2.3. Output will be save automatically +#' if the Dir input is specified. +#' @param Dir The directory where you want the output file to be saved. +#' The name of the file within `Dir` will start with Catch_ and end with .rdata. +#' Default NULL which will not save an output file. #' @template verbose #' #' @author Chantel Wetzel based on code by John Wallace @@ -23,265 +26,54 @@ #' @examples #' \dontrun{ #' # SurveyName is only arg that has to be specified -#' bio_dat <- PullBio.fn(SurveyName = "NWFSC.Combo") +#' bio_dat <- PullBio.fn(SurveyName = "NWFSC.Combo") #' #' # Example with specified common name -#' bio_dat <- PullBio.fn(Name = "vermilion rockfish", -#' SurveyName = "NWFSC.Combo") +#' bio_dat <- PullBio.fn(Name = "vermilion rockfish", +#' SurveyName = "NWFSC.Combo") #' #' # Example with specified scientific name -#' bio_dat <- PullBio.fn(SciName = "Eopsetta jordani", -#' SurveyName = "NWFSC.Combo") +#' bio_dat <- PullBio.fn(SciName = "Eopsetta jordani", +#' SurveyName = "NWFSC.Combo") #' #' # Example with multiple names -#' bio_dat <- PullBio.fn(SciName = c("Sebastes aurora","Eopsetta jordani"), -#' SurveyName = "NWFSC.Combo") -# bio_dat <- PullBio.fn(Name = c("Sunset rockfish", "vermilion rockfish", -# "vermilion and sunset rockfish"), SurveyName = "NWFSC.Combo") +#' bio_dat <- PullBio.fn(SciName = c("Sebastes aurora","Eopsetta jordani"), +#' SurveyName = "NWFSC.Combo") +# bio_dat <- PullBio.fn(Name = c("Sunset rockfish", "vermilion rockfish", +# "vermilion and sunset rockfish"), SurveyName = "NWFSC.Combo") #' } #' -PullBio.fn <- function(Name = NULL, SciName = NULL, YearRange = c(1980, 5000), SurveyName = NULL, SaveFile = FALSE, Dir = NULL, verbose = TRUE) { - # increase the timeout period to avoid errors when pulling data - options(timeout = 4000000) - if (SurveyName %in% c("NWFSC.Shelf.Rockfish", "NWFSC.Hook.Line")) { - stop("The bio pull currently does not work for hook & line data. Pull directly from the warehouse https://www.webapp.nwfsc.noaa.gov/data") - } - - - if (SaveFile) { - if (is.null(Dir)) { - stop("The Dir input needs to be specified in order to save output file.") - } - if (!file.exists(Dir)) { - stop( - "The Dir argument leads to a location", - ",\ni.e., ", Dir, ", that doesn't exist." - ) - } - } - - if (is.null(Name)) { - var.name <- "scientific_name" - Species <- SciName - new.name <- "Scientific_name" - outName <- Name - } - if (is.null(SciName)) { - var.name <- "common_name" - Species <- Name - new.name <- "Common_name" - outName <- SciName - outName <- "All" - } - if (is.null(SciName) & is.null(Name)) { - var.name <- c("scientific_name", "common_name") - Species <- "pull all" - new.name <- c("Scientific_name", "Common_name") - } # stop("Need to specifiy Name or SciName to pull data!")} - - surveys <- createMatrix() - - if (!SurveyName %in% surveys[, 1]) { - stop(cat("The SurveyName does not match one of the available options:", surveys[, 1])) - } - - for (i in 1:dim(surveys)[1]) { - if (SurveyName == surveys[i, 1]) { - project <- surveys[i, 2] - projectShort <- surveys[i, 1] - } - } - - if (length(YearRange) == 1) { - YearRange <- c(YearRange, YearRange) - } - - - if (projectShort != "NWFSC.Hook.Line") { - Vars <- c( - "project", "trawl_id", var.name, "year", "vessel", "pass", - "tow", "datetime_utc_iso", "depth_m", "weight_kg", "ageing_laboratory_dim$laboratory", - "length_cm", "width_cm", "sex", "age_years", "otosag_id", "latitude_dd", "longitude_dd", - "standard_survey_age_indicator", - "standard_survey_length_or_width_indicator", - "standard_survey_weight_indicator", - "operation_dim$legacy_performance_code" - ) - - Vars.short <- c( - "project", "trawl_id", var.name, "year", "vessel", "pass", - "tow", "datetime_utc_iso", "depth_m", "weight_kg", "ageing_lab", "otosag_id", - "length_cm", "width_cm", "sex", "age_years", "latitude_dd", "longitude_dd" - ) - } else { - Vars <- Vars.short <- c(var.name, "age_years", "drop_latitude_dim$latitude_in_degrees", ) - } - - # symbols here are generally: %22 = ", %2C = ",", %20 = " " - species_str <- paste0("%22",stringr::str_replace_all(Species[1]," ","%20"),"%22") - if(length(Species) > 1) { - for(i in 2:length(Species)) { - species_str <- paste0(species_str, "%2C", paste0("%22",stringr::str_replace_all(Species[i]," ","%20"),"%22")) - } - } - UrlText <- paste0( - "https://www.webapps.nwfsc.noaa.gov/data/api/v1/source/trawl.individual_fact/selection.json?filters=project=", paste(strsplit(project, " ")[[1]], collapse = "%20"), ",", - "station_invalid=0,", - "performance=Satisfactory,", - "depth_ftm>=30,depth_ftm<=700,", - "field_identified_taxonomy_dim$", var.name, "|=[", species_str, "]", - ",year>=", YearRange[1], ",year<=", YearRange[2], - "&variables=", paste0(Vars, collapse = ",") +PullBio.fn <- function( + Name = NULL, + SciName = NULL, + YearRange = c(1980, 5000), + SurveyName = NULL, + SaveFile = lifecycle::deprecated(), + Dir = NULL, + verbose = TRUE) { + + lifecycle::deprecate_soft( + when = "2.3", + what = "nwfscSurvey::PullBio.fn()", + details = "Please switch to pull_bio()." ) - if (any(Species == "pull all")) { - UrlText <- paste0( - "https://www.webapps.nwfsc.noaa.gov/data/api/v1/source/trawl.individual_fact/selection.json?filters=project=", paste(strsplit(project, " ")[[1]], collapse = "%20"), ",", - "station_invalid=0,", - "performance=Satisfactory,", "depth_ftm>=30,depth_ftm<=700,", - "year>=", YearRange[1], ",year<=", YearRange[2], - "&variables=", paste0(Vars, collapse = ",") - ) - } - - DataPull <- NULL - if (verbose) { - message("Pulling biological data. This can take up to ~ 30 seconds (or more).") - } - DataPull <- try(get_json(url = UrlText)) - - if (is.data.frame(DataPull)) { - if (SurveyName == "NWFSC.Combo") { - # Filter out non-standard samples - keep <- DataPull[, "standard_survey_length_or_width_indicator"] %in% c("NA", "Standard Survey Length or Width") - DataPull <- DataPull[keep, ] - remove <- DataPull[, "standard_survey_age_indicator"] == "Not Standard Survey Age" - if (sum(remove) != 0) { - DataPull[remove, "age_years"] <- NA - } - remove <- DataPull[, "standard_survey_weight_indicator"] == "Not Standard Survey Weight" - if (sum(remove) != 0) { - DataPull[remove, "weight_kg"] <- NA - } - } - - if (SurveyName == "Triennial") { - # Remove water hauls - fix <- is.na(DataPull[, "operation_dim$legacy_performance_code"]) - if (sum(fix) > 0) { - DataPull[fix, "operation_dim$legacy_performance_code"] <- -999 - } - keep <- DataPull[, "operation_dim$legacy_performance_code"] != 8 - DataPull <- DataPull[keep, ] - } - - find <- colnames(DataPull) == "ageing_laboratory_dim$laboratory" - colnames(DataPull)[find] <- "ageing_lab" - # Remove the extra columns now that they are not needed - DataPull <- DataPull[, Vars.short] - } - - - if (SurveyName %in% c("Triennial", "AFSC.Slope")) { - UrlText <- paste0( - "https://www.webapps.nwfsc.noaa.gov/data/api/v1/source/trawl.triennial_length_fact/selection.json?filters=project=", - paste(strsplit(project, " ")[[1]], collapse = "%20"), ",", - "station_invalid=0,", - "performance=Satisfactory,", - "field_identified_taxonomy_dim$", var.name, "=", paste(strsplit(Species, " ")[[1]], collapse = "%20"), - ",year>=", YearRange[1], ",year<=", YearRange[2], - "&variables=", paste0(Vars, collapse = ",") - ) - - LenPull <- try(get_json(url = UrlText)) - - # Remove water hauls - if (is.data.frame(LenPull)) { - fix <- is.na(LenPull[, "operation_dim$legacy_performance_code"]) - if (sum(fix) > 0) { - LenPull[fix, "operation_dim$legacy_performance_code"] <- -999 - } - keep <- LenPull[, "operation_dim$legacy_performance_code"] != 8 - LenPull <- LenPull[keep, ] - - colnames(LenPull)[2] <- "Date" - LenPull$Weight <- NA - LenPull$Age <- NA - Len <- dplyr::rename(LenPull, - Trawl_id = trawl_id, Year = year, Vessel = vessel, Project = project, - Pass = pass, Tow = tow, Depth_m = depth_m, Length_cm = length_cm, - Width_cm = width_cm, Sex = sex, Latitude_dd = latitude_dd, Longitude_dd = longitude_dd - ) - names(Len)[which(names(Len) == "scientific_name")] <- "Scientific_name" - names(Len)[which(names(Len) == "common_name")] <- "Common_name" - - Len$Date <- chron::chron(format(as.POSIXlt(Len$Date, format = "%Y-%m-%dT%H:%M:%S"), "%Y-%m-%d"), format = "y-m-d", out.format = "YYYY-m-d") - Len$Trawl_id <- as.character(Len$Trawl_id) - Len$Project <- projectShort - Len$Depth_m <- as.numeric(as.character(Len$Depth_m)) - Len$Length_cm <- as.numeric(as.character(Len$Length_cm)) - Len$Age <- as.numeric(as.character(Len$Age)) - } - } - - if (!is.data.frame(DataPull) & !SurveyName %in% c("Triennial", "AFSC.Slope")) { - stop(cat("\nNo data returned by the warehouse for the filters given. - Make sure the year range is correct for the project selected and the input name is correct, - otherwise there may be no data for this species from this project.\n")) - } - - - Data <- NULL - if (length(DataPull) > 0) { - Data <- dplyr::rename(DataPull, - Trawl_id = trawl_id, Year = year, Vessel = vessel, Project = project, Pass = pass, - Tow = tow, Date = datetime_utc_iso, Depth_m = depth_m, Weight = weight_kg, - Length_cm = length_cm, Width_cm = width_cm, Sex = sex, Age = age_years, Oto_id = otosag_id, - Ageing_Lab = ageing_lab, - Latitude_dd = latitude_dd, Longitude_dd = longitude_dd + if (lifecycle::is_present(SaveFile)) { + lifecycle::deprecate_warn( + when = "2.3", + what = "nwfscSurvey::PullBio.fn(SaveFile =)" ) - - names(Data)[which(names(Data) == "scientific_name")] <- "Scientific_name" - names(Data)[which(names(Data) == "common_name")] <- "Common_name" - Data$Date <- chron::chron(format(as.POSIXlt(Data$Date, format = "%Y-%m-%dT%H:%M:%S"), "%Y-%m-%d"), format = "y-m-d", out.format = "YYYY-m-d") - Data$Trawl_id <- as.character(Data$Trawl_id) - Data$Project <- projectShort - Data$Depth_m <- as.numeric(as.character(Data$Depth_m)) - Data$Length_cm <- as.numeric(as.character(Data$Length_cm)) - Data$Age <- as.numeric(as.character(Data$Age)) - } - - Ages <- NULL - if (SurveyName %in% c("Triennial", "AFSC.Slope")) { - if (!is.null(Data) & sum(is.na(Data$Age)) != length(Data$Age)) { - Ages <- Data - } - - Data <- list() - if (is.data.frame(LenPull)) { - Data$Lengths <- Len - } else { - Data$Lengths <- "no_lengths_available" - } - if (!is.null(Ages)) { - Data$Ages <- Ages - } else { - Data$Ages <- "no_ages_available" - } - if (verbose) { - message("Triennial & AFSC Slope data returned as a list: Data$Lengths and Data$Ages\n") - } } - if (SaveFile) { - time <- Sys.time() - time <- substring(time, 1, 10) - # save(Data, file = paste0(Dir, "/Bio_", outName, "_", SurveyName, "_", time, ".rda")) - save(Data, file = file.path(Dir, paste("Bio_", outName, "_", SurveyName, "_", time, ".rda", sep = ""))) - if (verbose) { - message(paste("Biological data file saved to following location:", Dir)) - } - } + Data <- pull_bio( + common_name = Name, + sci_name = SciName, + years = YearRange, + survey = SurveyName, + dir = Dir, + convert = TRUE, + verbose = TRUE + ) return(Data) } diff --git a/R/PullCatch.fn.R b/R/PullCatch.fn.R index 854d7db..c8c77c1 100644 --- a/R/PullCatch.fn.R +++ b/R/PullCatch.fn.R @@ -49,14 +49,14 @@ #' allowing for a vector of survey names and #' `NWFSC.Shelf.Rockfish` and `NWFSC.Hook.Line` are not supported. #' The default of `NULL` is a placeholder that must be replaced with an entry. -#' @param SaveFile A logical value specifying whether or not the the data should -#' be saved to a file in `Dir`. Must change from the default of `FALSE` to save a file. -#' @param Dir If `SaveFile = TRUE`, then one must specify the directory where you want -#' the resulting file to be saved. The directory where the file should be saved. -#' The name of the file within `Dir` will start with Catch_ and end with .rda. +#' @param SaveFile Deprecated with {nwfscSurvey} 2.3. Output will be save automatically +#' if the Dir input is specified. +#' @param Dir The directory where you want the output file to be saved. +#' The name of the file within `Dir` will start with Catch_ and end with .rdata. +#' Default NULL which will not save an output file. #' @template verbose #' -#' @author Chantel Wetzel based on code by John Wallace +#' @author Chantel Wetzel (maintainer) based on code by John Wallace #' @export #' #' @import chron @@ -85,244 +85,36 @@ # SurveyName = "NWFSC.Combo") #' } #' -PullCatch.fn <- function(Name = NULL, SciName = NULL, YearRange = c(1980, 5000), SurveyName = NULL, SaveFile = FALSE, Dir = NULL, verbose = TRUE) { - if (SurveyName %in% c("NWFSC.Shelf.Rockfish", "NWFSC.Hook.Line")) { - stop("The catch pull currently does not work for hook & line data.", - "\nPull directly from the warehouse https://www.webapp.nwfsc.noaa.gov/data") - } - - if (SaveFile) { - if (is.null(Dir)) { - stop("The Dir input needs to be specified in order to save output file.") - } - if (!file.exists(Dir)) { - stop( - "The Dir argument leads to a location", - ",\ni.e., ", Dir, ", that doesn't exist." - ) - } - } - - if (is.null(Name)) { - var.name <- "scientific_name" - Species <- SciName - new.name <- "Scientific_name" - outName <- Name - } - if (is.null(SciName)) { - var.name <- "common_name" - Species <- Name - new.name <- "Common_name" - outName <- SciName - } - if (is.null(SciName) & is.null(Name)) { - var.name <- "common_name" - Species <- "pull all" - new.name <- "Common_name" - } # stop("Need to specifiy Name or SciName to pull data!")} - - # Survey options available in the data warehouse - surveys <- createMatrix() - - # Check the input survey name against available options - if (!SurveyName %in% surveys[, 1]) { - stop( - "The SurveyName argument does not match one of the available options:\n", - paste(surveys[, 1], collapse = "\n") - ) - } - - # Find the long project name to extract data from the warehouse - for (i in 1:dim(surveys)[1]) { - if (SurveyName == surveys[i, 1]) { - project <- surveys[i, 2] - projectShort <- surveys[i, 1] - } - } - - if (length(YearRange) == 1) { - YearRange <- c(YearRange, YearRange) - } - - - # Pull data for the specific species for the following variables - Vars <- c( - var.name, "year", "subsample_count", "subsample_wt_kg", "project", "cpue_kg_per_ha_der", - "total_catch_numbers", "total_catch_wt_kg", "vessel", "tow", "operation_dim$legacy_performance_code", - "statistical_partition_dim$statistical_partition_type" - ) - - Vars.short <- c( - var.name, "year", "subsample_count", "subsample_wt_kg", "project", "cpue_kg_per_ha_der", - "total_catch_numbers", "total_catch_wt_kg", "vessel", "tow" - ) - - # symbols here are generally: %22 = ", %2C = ",", %20 = " " - species_str <- paste0("%22",stringr::str_replace_all(Species[1]," ","%20"),"%22") - if(length(Species) > 1) { - for(i in 2:length(Species)) { - species_str <- paste0(species_str, "%2C", paste0("%22",stringr::str_replace_all(Species[i]," ","%20"),"%22")) - } - } - - UrlText <- paste0( - "https://www.webapps.nwfsc.noaa.gov/data/api/v1/source/trawl.catch_fact/selection.json?filters=project=", paste(strsplit(project, " ")[[1]], collapse = "%20"), ",", - "station_invalid=0,", - "performance=Satisfactory,", "depth_ftm>=30,depth_ftm<=700,", - "field_identified_taxonomy_dim$", var.name, "|=[", species_str,"]", - ",date_dim$year>=", YearRange[1], ",date_dim$year<=", YearRange[2], - "&variables=", paste0(Vars, collapse = ",") +PullCatch.fn <- function( + Name = NULL, + SciName = NULL, + YearRange = c(1980, 5000), + SurveyName = NULL, + SaveFile = lifecycle::deprecated(), + Dir = NULL, + verbose = TRUE) { + + lifecycle::deprecate_soft( + when = "2.3", + what = "nwfscSurvey::PullCatch.fn()", + details = "Please switch to pull_catch()." ) - if (any(Species == "pull all")) { - UrlText <- paste0( - "https://www.webapps.nwfsc.noaa.gov/data/api/v1/source/trawl.catch_fact/selection.json?filters=project=", paste(strsplit(project, " ")[[1]], collapse = "%20"), ",", - "station_invalid=0,", - "performance=Satisfactory,", "depth_ftm>=30,depth_ftm<=700,", - "date_dim$year>=", YearRange[1], ",date_dim$year<=", YearRange[2], - "&variables=", paste0(Vars, collapse = ",") + if (lifecycle::is_present(SaveFile)) { + lifecycle::deprecate_warn( + when = "2.3", + what = "nwfscSurvey::PullCatch.fn(SaveFile =)" ) } - if (verbose) { - message("Pulling catch data. This can take up to ~ 30 seconds (or more).") - } - # Pull data from the warehouse - DataPull <- try(get_json(url = UrlText)) - - # Remove water hauls - fix <- is.na(DataPull[, "operation_dim$legacy_performance_code"]) - if (sum(fix) > 0) { - DataPull[fix, "operation_dim$legacy_performance_code"] <- -999 - } - # Whether values are NA or "NA" varies based on the presence of "Life Stage" samples - if (sum(is.na(DataPull[, "statistical_partition_dim$statistical_partition_type"])) != dim(DataPull)[1]) { - keep <- DataPull[, "statistical_partition_dim$statistical_partition_type"] == "NA" - DataPull <- DataPull[keep, ] - } - - keep <- DataPull[, "operation_dim$legacy_performance_code"] != 8 - DataPull <- DataPull[keep, ] - DataPull <- DataPull[, Vars.short] - - Data <- dplyr::rename(DataPull, - Year = year, Subsample_count = subsample_count, - Subsample_wt_kg = subsample_wt_kg, Project = project, - CPUE_kg_per_ha = cpue_kg_per_ha_der, Subsample_count = subsample_count, - Subsample_wt_kg = subsample_wt_kg, Vessel = vessel, Tow = tow - ) - - names(Data)[which(names(Data) == "scientific_name")] <- "Scientific_name" - names(Data)[which(names(Data) == "common_name")] <- "Common_name" - - # Pull all tow data (includes tows where the species was not observed) - Vars <- c("project", "year", "vessel", "pass", "tow", "datetime_utc_iso", "depth_m", "longitude_dd", "latitude_dd", "area_swept_ha_der", "trawl_id", "operation_dim$legacy_performance_code") - Vars.short <- c("project", "year", "vessel", "pass", "tow", "datetime_utc_iso", "depth_m", "longitude_dd", "latitude_dd", "area_swept_ha_der", "trawl_id") - - UrlText <- paste0( - "https://www.webapps.nwfsc.noaa.gov/data/api/v1/source/trawl.operation_haul_fact/selection.json?filters=project=", paste(strsplit(project, " ")[[1]], collapse = "%20"), ",", - "station_invalid=0,", - "performance=Satisfactory,", - "depth_ftm>=30,depth_ftm<=700,", - "date_dim$year>=", YearRange[1], ",date_dim$year<=", YearRange[2], - "&variables=", paste0(Vars, collapse = ",") - ) - All.Tows <- try(get_json(url = UrlText)) - - # Remove water hauls - fix <- is.na(All.Tows[, "operation_dim$legacy_performance_code"]) - if (sum(fix) > 0) { - All.Tows[fix, "operation_dim$legacy_performance_code"] <- -999 - } - keep <- All.Tows[, "operation_dim$legacy_performance_code"] != 8 - All.Tows <- All.Tows[keep, ] - All.Tows <- All.Tows[, Vars.short] - - All.Tows <- dplyr::rename(All.Tows, - Project = project, Trawl_id = trawl_id, Year = year, - Pass = pass, Vessel = vessel, Tow = tow, Date = datetime_utc_iso, - Depth_m = depth_m, Longitude_dd = longitude_dd, Latitude_dd = latitude_dd, - Area_Swept_ha = area_swept_ha_der - ) - - All.Tows <- All.Tows[ - !duplicated(paste(All.Tows$Year, All.Tows$Pass, All.Tows$Vessel, All.Tows$Tow)), - c("Project", "Trawl_id", "Year", "Pass", "Vessel", "Tow", "Date", "Depth_m", "Longitude_dd", "Latitude_dd", "Area_Swept_ha") - ] - - # Link each data set together based on trawl_id - if ("Common_name" %in% names(Data)) { - grid <- expand.grid( - "Trawl_id" = unique(All.Tows$Trawl_id), "Common_name" = unique(Data$Common_name), - stringsAsFactors = FALSE - ) - } else { - grid <- expand.grid( - "Trawl_id" = unique(All.Tows$Trawl_id), "Scientific_name" = unique(Data$Scientific_name), - stringsAsFactors = FALSE - ) - } - - Out <- dplyr::left_join( - grid, - All.Tows, - by = intersect(colnames(grid), colnames(All.Tows)), - multiple = "all" - ) - Out <- dplyr::left_join( - Out, - Data, - by = intersect(colnames(Out), colnames(Data)), - multiple = "all" - ) - - # Fill in zeros where needed - Out$total_catch_wt_kg[is.na(Out$total_catch_wt_kg)] <- 0 - - Out$CPUE_kg_per_ha[is.na(Out$CPUE_kg_per_ha)] <- 0 - - Out$Subsample_count[is.na(Out$Subsample_count)] <- 0 - - Out$Subsample_wt_kg[is.na(Out$Subsample_wt_kg)] <- 0 - - Out$total_catch_numbers[is.na(Out$total_catch_numbers)] <- 0 - - # Need to check what this is doing - noArea <- which(is.na(Out$Area_Swept_ha)) - if (length(noArea) > 0) { - if (verbose) { - print(cat("\nThere are", length(noArea), "records with no area swept calculation. These record will be filled with the mean swept area across all tows.\n")) - print(Out[noArea, c("Trawl_id", "Year", "Area_Swept_ha", "CPUE_kg_per_ha", "total_catch_numbers")]) - } - Out[noArea, "Area_Swept_ha"] <- mean(Out$Area_Swept_ha, trim = 0.05, na.rm = TRUE) - } - - # Scientific Name is missing after the matching when Total_sp_wt_kg is zero - # if (!is.null(Name)) { - # Out$Common_name <- Species - # } - # if (!is.null(SciName)) { - # Out$Scientific_name <- Species - # } - - Out$Date <- chron::chron(format(as.POSIXlt(Out$Date, format = "%Y-%m-%dT%H:%M:%S"), "%Y-%m-%d"), format = "y-m-d", out.format = "YYYY-m-d") - - Out$Project <- projectShort - - Out$Trawl_id <- as.character(Out$Trawl_id) - - # Convert the CPUE into km2 - Out$cpue_kg_km2 <- Out$CPUE_kg_per_ha * 100 - - if (SaveFile) { - time <- Sys.time() - time <- substring(time, 1, 10) - # save(Out, file = paste0(Dir, "/Catch_", outName, "_", SurveyName, "_", time, ".rda")) - save(Out, file = file.path(Dir, paste("Catch_", outName, "_", SurveyName, "_", time, ".rda", sep = ""))) - if (verbose) { - message(paste("Catch data file saved to following location:", Dir)) - } - } + Out <- pull_catch( + common_name = Name, + sci_name = SciName, + years = YearRange, + survey = SurveyName, + dir = Dir, + convert = TRUE, + verbose = verbose) return(Out) } From 00a60a19dcbf186f7697a7af91a95e475874d943 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Fri, 15 Mar 2024 12:34:19 -0700 Subject: [PATCH 05/26] deprecate pullHaul.fn and replace with newer pull_haul --- R/PullHaul.fn.R | 111 ++++++++++-------------------------------------- 1 file changed, 23 insertions(+), 88 deletions(-) diff --git a/R/PullHaul.fn.R b/R/PullHaul.fn.R index 6ff684a..5298290 100644 --- a/R/PullHaul.fn.R +++ b/R/PullHaul.fn.R @@ -6,7 +6,8 @@ #' @param SurveyName survey to pull the data for the options are: #' Triennial, AFSC.Slope, NWFSC.Combo, NWFSC.Slope, NWFSC.Shelf, NWFSC.Hypoxia, #' NWFSC.Santa.Barb.Basin, NWFSC.Shelf.Rockfish (NWFSC.Hook.Line but both are not working), NWFSC.Video#' -#' @param SaveFile option to save the file to the directory +#' @param SaveFile Deprecated with {nwfscSurvey} 2.3. Output will be save automatically +#' if the Dir input is specified. #' @param Dir directory where the file should be saved #' @template verbose #' @@ -22,97 +23,31 @@ #' haul_dat <- PullHaul.fn() #' } #' -PullHaul.fn <- function(YearRange = c(1980, 5000), SurveyName = NULL, SaveFile = FALSE, Dir = NULL, verbose = TRUE) { - # increase the timeout period to avoid errors when pulling data - options(timeout = 4000000) - - if (SaveFile) { - if (is.null(Dir)) { - stop("The Dir input needs to be specified in order to save output file.") - } - if (!file.exists(Dir)) { - stop( - "The Dir argument leads to a location", - ",\ni.e., ", Dir, ", that doesn't exist." - ) - } - } - - surveys <- createMatrix() - - if (is.null(SurveyName)) { - SurveyName <- surveys[, 1] - } - - if (length(SurveyName) == 1) { - if (!SurveyName %in% surveys[, 1]) { - stop(cat("The SurveyName does not match one of the available options:", surveys[, 1])) - } - } else { - if (length(which(SurveyName %in% surveys[, 1])) != length(SurveyName)) { - stop(cat("One or more of the SurveyName fields does not match one of the available options:", surveys[, 1])) - } - } - - project <- "" - for (i in 1:dim(surveys)[1]) { - if (length(which(SurveyName %in% surveys[i, 1]) > 0)) { - project <- c(project, surveys[i, 2]) - } - } - project <- project[which(project %in% c("", "NA") == FALSE)] - - if (length(YearRange) == 1) { - YearRange <- c(YearRange, YearRange) - } - - - Vars <- c( - "area_swept_ha_der", "date_dim.year", "date_yyyymmdd", - "depth_hi_prec_m", "door_width_m_der", "fluorescence_at_surface_mg_per_m3_der", - "gear_end_latitude_dd", "gear_end_longitude_dd", "gear_start_latitude_dd", - "gear_start_longitude_dd", "invertebrate_weight_kg", "latitude_dd", "leg", - "longitude_dd", "net_height_m_der", "net_width_m_der", "nonspecific_organics_weight_kg", - "o2_at_gear_ml_per_l_der", "pass", "performance", "project", "salinity_at_gear_psu_der", - "sampling_end_hhmmss", "sampling_start_hhmmss", - "target_station_design_dim.stn_invalid_for_trawl_date_whid", - "temperature_at_gear_c_der", "temperature_at_surface_c_der", - "trawl_id", "turbidity_ntu_der", "vertebrate_weight_kg", "vessel", - "vessel_end_latitude_dd", "vessel_end_longitude_dd", - "vessel_start_latitude_dd", "vessel_start_longitude_dd" +PullHaul.fn <- function( + YearRange = c(1980, 5000), + SurveyName = NULL, + SaveFile = lifecycle::deprecated(), + Dir = NULL, + verbose = TRUE) { + + lifecycle::deprecate_soft( + when = "2.3", + what = "nwfscSurvey::PullHaul.fn()", + details = "Please switch to pull_haul()." ) - project_str <- NA - for (i in 1:length(project)) { - project_str[i] <- paste(strsplit(project, " ")[[i]], collapse = "%20") + if (lifecycle::is_present(SaveFile)) { + lifecycle::deprecate_warn( + when = "2.3", + what = "nwfscSurvey::PullHaul.fn(SaveFile =)" + ) } - # Note: this string grabs data from all projects. Projects filtered below - UrlText <- paste0( - "https://www.webapps.nwfsc.noaa.gov/data/api/v1/source/trawl.operation_haul_fact/selection.json?filters=", - "station_invalid=0,", - "performance=Satisfactory,", - "year>=", YearRange[1], ",year<=", YearRange[2], - "&variables=", paste0(Vars, collapse = ",") - ) - - DataPull <- NULL - if (verbose) { - message("Pulling haul data. This can take up to ~ 30 seconds.") - } - Data <- try(get_json(url = UrlText)) - - # filter projects - Data <- Data[which(Data$project %in% project == TRUE), ] - - if (SaveFile) { - time <- Sys.time() - time <- substring(time, 1, 10) - save(Data, file = file.path(Dir, paste("Haul_", SurveyName, "_", time, ".rda", sep = ""))) - if (verbose) { - message(paste("Haul data file saved to following location:", Dir)) - } - } + Data <- pull_haul( + years = YearRange, + survey = SurveyName, + dir = Dir, + verbose = verbose) return(Data) } From ce4698f966362bb2c001c2b85b961a8d9e99a1f2 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Fri, 15 Mar 2024 12:35:00 -0700 Subject: [PATCH 06/26] convert trawl_id to character string --- R/pull_haul.R | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/R/pull_haul.R b/R/pull_haul.R index 8534cb6..15d0391 100644 --- a/R/pull_haul.R +++ b/R/pull_haul.R @@ -2,10 +2,10 @@ #' The website is: https://www.webapps.nwfsc.noaa.gov/data. #' This function can be used to pull haul data and associated covariates. #' -#' @template years -#' @template survey -#' @template dir -#' @template verbose +#' @template years +#' @template survey +#' @template dir +#' @template verbose #' #' @return Returns a data frame of haul characteristics for satisfactory hauls #' @author Eric Ward, Chantel Wetzel @@ -19,15 +19,15 @@ #' haul_data <- pull_haul() #' } #' -pull_haul <- function(years= c(1980, 2050), - survey = NULL, - dir = NULL, +pull_haul <- function(years= c(1980, 2050), + survey = NULL, + dir = NULL, verbose = TRUE) { # increase the timeout period to avoid errors when pulling data options(timeout = 4000000) - check_dir(dir = dir, verbose = verbose) + check_dir(dir = dir, verbose = verbose) project_long <- check_survey(survey = survey) @@ -50,10 +50,10 @@ pull_haul <- function(years= c(1980, 2050), "vessel_start_latitude_dd", "vessel_start_longitude_dd" ) - url_text <- get_url(data_table = "trawl.operation_haul_fact", - years = years, + url_text <- get_url(data_table = "trawl.operation_haul_fact", + years = years, project_long = project_long, - vars_long = var_str) + vars_long = var_str) if (verbose) { @@ -61,10 +61,12 @@ pull_haul <- function(years= c(1980, 2050), } haul_data <- try(get_json(url = url_text)) - haul_data$date_formatted <- - chron::chron(format(as.POSIXlt(haul_data$datetime_utc_iso, format = "%Y-%m-%dT%H:%M:%S"), "%Y-%m-%d"), + haul_data$date_formatted <- + chron::chron(format(as.POSIXlt(haul_data$datetime_utc_iso, format = "%Y-%m-%dT%H:%M:%S"), "%Y-%m-%d"), format = "y-m-d", out.format = "YYYY-m-d") + haul_data$trawl_id <- as.character(haul_data$trawl_id) + save_rdata( x = haul_data, dir = dir, From 3d882c6a24c1e0a9524a8b3205732a9ad5bcf6a0 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Fri, 15 Mar 2024 12:35:52 -0700 Subject: [PATCH 07/26] fixes to Triennial and AFSC.Slope data returned correctly --- R/pull_bio.R | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/R/pull_bio.R b/R/pull_bio.R index 351e775..2189abf 100644 --- a/R/pull_bio.R +++ b/R/pull_bio.R @@ -184,18 +184,20 @@ pull_bio <- function(common_name = NULL, if (survey %in% c("Triennial", "AFSC.Slope")) { if (!is.null(bio_pull) & sum(is.na(bio_pull$age_years)) != length(bio_pull$age_years)) { age_data <- bio_pull + } else { + age_data <- NULL } bio <- list() if (is.data.frame(len_pull)) { - bio$length_data <- len_pull + bio$Lengths <- len_pull } else { - bio$length_data <- "no_lengths_available" + bio$Lengths <- "no_lengths_available" } if (!is.null(age_data)) { - bio$age_data <- age_data + bio$Ages <- age_data } else { - bio$age_data <- "no_ages_available" + bio$Ages <- "no_ages_available" } if (verbose) { message("Triennial & AFSC Slope data returned as a list: bio_data$length_data and bio_data$age_data\n") @@ -203,7 +205,6 @@ pull_bio <- function(common_name = NULL, } if(convert) { - bio$age <- bio$age_years bio$weight <- bio$weight_kg firstup <- function(x) { @@ -211,8 +212,14 @@ pull_bio <- function(common_name = NULL, x } if(survey %in% c("Triennial", "AFSC.Slope")){ + bio[[1]][, "weight"] <- bio[[1]][, "weight_kg"] colnames(bio[[1]]) <- firstup(colnames(bio[[1]])) - colnames(bio[[2]]) <- firstup(colnames(bio[[2]])) + + if(!is.null(nrow(bio[[2]]))){ + bio[[2]][, "age"] <- bio[[2]][, "age_years"] + bio[[2]][, "weight"] <- bio[[2]][, "weight_kg"] + colnames(bio[[2]]) <- firstup(colnames(bio[[2]])) + } } else { colnames(bio) <- firstup(colnames(bio)) } From 38fe71831d72ee26abcd5af4445a42b13c4e9133 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Fri, 15 Mar 2024 12:37:33 -0700 Subject: [PATCH 08/26] new pull_spp function to be consistent with other pull fxns This function performs the same as the PullSpp.fn. I thought some additional testing was warrented prior to deprecated the original function. --- R/pull_spp.R | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) create mode 100644 R/pull_spp.R diff --git a/R/pull_spp.R b/R/pull_spp.R new file mode 100644 index 0000000..a303a28 --- /dev/null +++ b/R/pull_spp.R @@ -0,0 +1,22 @@ +#' Pull species names from the warehouse +#' +#' Pull common name and scientific name information from the +#' data warehouse. +#' The website is https://www.webapps.nwfsc.noaa.gov/data +#' +#' @author Kelli Faye Johnson +#' @export +#' +#' @examples +#' \dontrun{ +#' spp <- pull_spp() +#' } +#' +pull_spp <- function() { + # Get the data from saved .rda file + PullSpp <- NULL + newenv <- new.env(hash = TRUE, parent = parent.frame()) + utils::data(species, package = "nwfscSurvey", envir = newenv) + species <- get("species", envir = newenv) + return(species) +} From 04f6235ba869bf90b294d6341787a4e75b9fff61 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Fri, 15 Mar 2024 12:37:51 -0700 Subject: [PATCH 09/26] update documentation --- man/PullBio.fn.Rd | 23 +++++++++++++---------- man/PullCatch.fn.Rd | 14 +++++++------- man/PullHaul.fn.Rd | 5 +++-- man/pull_catch.Rd | 2 +- man/pull_spp.Rd | 22 ++++++++++++++++++++++ 5 files changed, 46 insertions(+), 20 deletions(-) create mode 100644 man/pull_spp.Rd diff --git a/man/PullBio.fn.Rd b/man/PullBio.fn.Rd index 95c5654..16797de 100644 --- a/man/PullBio.fn.Rd +++ b/man/PullBio.fn.Rd @@ -12,7 +12,7 @@ PullBio.fn( SciName = NULL, YearRange = c(1980, 5000), SurveyName = NULL, - SaveFile = FALSE, + SaveFile = lifecycle::deprecated(), Dir = NULL, verbose = TRUE ) @@ -28,9 +28,12 @@ PullBio.fn( Triennial, AFSC.Slope, NWFSC.Combo, NWFSC.Slope, NWFSC.Shelf, NWFSC.Hypoxia, NWFSC.Santa.Barb.Basin, NWFSC.Shelf.Rockfish (NWFSC.Hook.Line but both are not working), NWFSC.Video#'} -\item{SaveFile}{option to save the file to the directory} +\item{SaveFile}{Deprecated with {nwfscSurvey} 2.3. Output will be save automatically +if the Dir input is specified.} -\item{Dir}{directory where the file should be saved} +\item{Dir}{The directory where you want the output file to be saved. +The name of the file within \code{Dir} will start with Catch_ and end with .rdata. +Default NULL which will not save an output file.} \item{verbose}{A logical that specifies if you want to print messages and warnings to the console. The default is \code{TRUE}.} @@ -44,19 +47,19 @@ In order to pull all species leave Name = NULL and SciName = NULL \examples{ \dontrun{ # SurveyName is only arg that has to be specified -bio_dat <- PullBio.fn(SurveyName = "NWFSC.Combo") + bio_dat <- PullBio.fn(SurveyName = "NWFSC.Combo") # Example with specified common name -bio_dat <- PullBio.fn(Name = "vermilion rockfish", -SurveyName = "NWFSC.Combo") + bio_dat <- PullBio.fn(Name = "vermilion rockfish", + SurveyName = "NWFSC.Combo") # Example with specified scientific name -bio_dat <- PullBio.fn(SciName = "Eopsetta jordani", -SurveyName = "NWFSC.Combo") + bio_dat <- PullBio.fn(SciName = "Eopsetta jordani", + SurveyName = "NWFSC.Combo") # Example with multiple names -bio_dat <- PullBio.fn(SciName = c("Sebastes aurora","Eopsetta jordani"), -SurveyName = "NWFSC.Combo") + bio_dat <- PullBio.fn(SciName = c("Sebastes aurora","Eopsetta jordani"), + SurveyName = "NWFSC.Combo") } } diff --git a/man/PullCatch.fn.Rd b/man/PullCatch.fn.Rd index 8d05ba3..595140f 100644 --- a/man/PullCatch.fn.Rd +++ b/man/PullCatch.fn.Rd @@ -9,7 +9,7 @@ PullCatch.fn( SciName = NULL, YearRange = c(1980, 5000), SurveyName = NULL, - SaveFile = FALSE, + SaveFile = lifecycle::deprecated(), Dir = NULL, verbose = TRUE ) @@ -50,12 +50,12 @@ allowing for a vector of survey names and The default of \code{NULL} is a placeholder that must be replaced with an entry. }} -\item{SaveFile}{A logical value specifying whether or not the the data should -be saved to a file in \code{Dir}. Must change from the default of \code{FALSE} to save a file.} +\item{SaveFile}{Deprecated with {nwfscSurvey} 2.3. Output will be save automatically +if the Dir input is specified.} -\item{Dir}{If \code{SaveFile = TRUE}, then one must specify the directory where you want -the resulting file to be saved. The directory where the file should be saved. -The name of the file within \code{Dir} will start with Catch_ and end with .rda.} +\item{Dir}{The directory where you want the output file to be saved. +The name of the file within \code{Dir} will start with Catch_ and end with .rdata. +Default NULL which will not save an output file.} \item{verbose}{A logical that specifies if you want to print messages and warnings to the console. The default is \code{TRUE}.} @@ -102,5 +102,5 @@ catch_dat <- PullBio.fn(Name = c("vermilion rockfish", } \author{ -Chantel Wetzel based on code by John Wallace +Chantel Wetzel (maintainer) based on code by John Wallace } diff --git a/man/PullHaul.fn.Rd b/man/PullHaul.fn.Rd index 496dc8d..6937165 100644 --- a/man/PullHaul.fn.Rd +++ b/man/PullHaul.fn.Rd @@ -9,7 +9,7 @@ This function can be used to pull haul data and associated covariates} PullHaul.fn( YearRange = c(1980, 5000), SurveyName = NULL, - SaveFile = FALSE, + SaveFile = lifecycle::deprecated(), Dir = NULL, verbose = TRUE ) @@ -21,7 +21,8 @@ PullHaul.fn( Triennial, AFSC.Slope, NWFSC.Combo, NWFSC.Slope, NWFSC.Shelf, NWFSC.Hypoxia, NWFSC.Santa.Barb.Basin, NWFSC.Shelf.Rockfish (NWFSC.Hook.Line but both are not working), NWFSC.Video#'} -\item{SaveFile}{option to save the file to the directory} +\item{SaveFile}{Deprecated with {nwfscSurvey} 2.3. Output will be save automatically +if the Dir input is specified.} \item{Dir}{directory where the file should be saved} diff --git a/man/pull_catch.Rd b/man/pull_catch.Rd index 60ee071..29259cd 100644 --- a/man/pull_catch.Rd +++ b/man/pull_catch.Rd @@ -110,7 +110,7 @@ catch_data <- pull_catch(common_name = c("vermilion rockfish", "vermilion and sunset rockfish"), survey = "NWFSC.Combo") catch_data <- pull_catch(sci_name = c("Sebastes miniatus", - "Sebastes sp. (crocotulus)", + "Sebastes sp. (crocotulus)", "Sebastes sp. (miniatus / crocotulus)"), survey = "NWFSC.Combo") } diff --git a/man/pull_spp.Rd b/man/pull_spp.Rd new file mode 100644 index 0000000..ff7df7d --- /dev/null +++ b/man/pull_spp.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pull_spp.R +\name{pull_spp} +\alias{pull_spp} +\title{Pull species names from the warehouse} +\usage{ +pull_spp() +} +\description{ +Pull common name and scientific name information from the +data warehouse. +The website is https://www.webapps.nwfsc.noaa.gov/data +} +\examples{ +\dontrun{ +spp <- pull_spp() +} + +} +\author{ +Kelli Faye Johnson +} From 1793940c42239feab6e98c0733ce22ce4180172a Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Fri, 15 Mar 2024 12:37:59 -0700 Subject: [PATCH 10/26] update tests The dimensions need to be updated which was unrelated to the revisions in the pull functions --- tests/testthat/test-codify_sex.R | 9 +++--- tests/testthat/test-data.R | 55 ++++---------------------------- 2 files changed, 11 insertions(+), 53 deletions(-) diff --git a/tests/testthat/test-codify_sex.R b/tests/testthat/test-codify_sex.R index ba95c06..4a2d7b0 100644 --- a/tests/testthat/test-codify_sex.R +++ b/tests/testthat/test-codify_sex.R @@ -2,11 +2,10 @@ test_that("AFSC Slope pull biological table of Pacific ocean perch sexes", { skip_on_cran() - dat <- PullBio.fn( - Name = "Pacific ocean perch", - SciName = NULL, YearRange = c(1910, 2020), - SurveyName = "AFSC.Slope", SaveFile = FALSE, - Dir = NULL, verbose = TRUE + dat <- pull_bio( + common_name = "Pacific ocean perch", + years = c(1910, 2020), + survey = "AFSC.Slope" ) originaltable <- table(dat[["Lengths"]][["Sex"]]) testthat::expect_equal( diff --git a/tests/testthat/test-data.R b/tests/testthat/test-data.R index df3d5b0..50f67ac 100644 --- a/tests/testthat/test-data.R +++ b/tests/testthat/test-data.R @@ -4,21 +4,6 @@ if (interactive()) options(mc.cores = parallel::detectCores()) # devtools::test() set.seed(1) -test_that("PullCatch", { - skip_on_cran() - - set.seed(123) - dat <- PullCatch.fn( - Name = "lingcod", - SciName = NULL, YearRange = c(2003, 2018), - SurveyName = "NWFSC.Combo", SaveFile = FALSE, - Dir = NULL, verbose = TRUE - ) - expect_is(dat, "data.frame") - expect_equal(nrow(dat), 10365) - expect_equal(length(which(dat$cpue_kg_km2 == 0)), 6894) -}) - test_that("pull_catch", { skip_on_cran() @@ -30,21 +15,7 @@ test_that("pull_catch", { verbose = TRUE ) expect_is(dat, "data.frame") - expect_equal(nrow(dat), 10365) -}) - -test_that("PullCatch-multispecies", { - skip_on_cran() - - set.seed(123) - dat <- PullCatch.fn( - SciName = NULL, YearRange = 2017, - SurveyName = "NWFSC.Combo", SaveFile = FALSE, - Dir = NULL, verbose = TRUE - ) - expect_is(dat, "data.frame") - expect_equal(nrow(dat), 351124) - expect_equal(length(which(dat$cpue_kg_km2 == 0)), 331903) + expect_equal(nrow(dat), 10361) }) test_that("pull_catch-multispecies", { @@ -53,11 +24,12 @@ test_that("pull_catch-multispecies", { set.seed(123) dat <- pull_catch( years = 2017, - survey = "NWFSC.Combo", + survey = "NWFSC.Combo", verbose = TRUE ) expect_is(dat, "data.frame") - expect_equal(nrow(dat), 351124) + expect_equal(nrow(dat), 350126) + expect_equal(length(which(dat$cpue_kg_km2 == 0)), 330971) }) test_that("PullHaul", { @@ -66,26 +38,13 @@ test_that("PullHaul", { set.seed(123) dat <- PullHaul.fn( YearRange = c(2003, 2018), - SurveyName = "NWFSC.Combo", SaveFile = FALSE, + SurveyName = "NWFSC.Combo", Dir = NULL, verbose = TRUE ) expect_is(dat, "data.frame") - expect_equal(nrow(dat), 10375) + expect_equal(nrow(dat), 10361) }) -test_that("PullBio", { - skip_on_cran() - - set.seed(123) - dat <- PullBio.fn( - Name = "lingcod", - SciName = NULL, YearRange = c(2016, 2017), - SurveyName = "NWFSC.Combo", SaveFile = FALSE, - Dir = NULL, verbose = TRUE - ) - expect_is(dat, "data.frame") - expect_equal(nrow(dat), 3379) -}) test_that("pull_bio", { skip_on_cran() @@ -98,7 +57,7 @@ test_that("pull_bio", { verbose = TRUE ) expect_is(dat, "data.frame") - expect_equal(nrow(dat), 3379) + expect_equal(nrow(dat), 3363) }) test_that("pull_bio_triennial", { From 09b1cb64b4ffe44429fb665272783f6736a8993e Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Fri, 15 Mar 2024 12:38:32 -0700 Subject: [PATCH 11/26] add species.rda file This fill is the same as the existing PullSpp.rda file --- data/species.rda | Bin 0 -> 22336 bytes 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 data/species.rda diff --git a/data/species.rda b/data/species.rda new file mode 100644 index 0000000000000000000000000000000000000000..ea53f84108b44ada65bbc1a4712b1849eef42bb9 GIT binary patch literal 22336 zcmbTdcTiJr)CPzh6#_v(O6W~W5JImaJya6O}zT|Z^wXzWBijxEN3QI&IJ#0AMquLLk;*?SoGH3 zS$_3BWpQr1tK#VaKKY{R1dD7^#oVC%)F}hS(;gld6931CWna~MKu^`CV_it61s_`{ z2-;-18a^k)=o#kTpJ34_IJGnz+f-{uyiFl&UcEZP7wGqcP{77l~V(`ElfYy!f+ zy_M@>5l|m;Fz`+}pZs3ye1&5tP%4wz3Xm(psv5WPUXei6ch`d>`a_Z^H zg_Itbu_X6vgW9_9)~Y}1S5yyfIMOyA=N#x+pQ<=na7HwnVR4U@PAs0N%|_Weh)%Gu z#opXF@nm7SC~J&VI*V3TeQ(N%rpKY_6r2{Ix4Wqm^9IFvB@_m1)J8|m-$e`HuCpXsJ*F!-No$`hJ^swG~4 zEOOM$0OE{HH^tp@^R~!{<|PuxzZ6Ym@B5r0br&xb3BZR%C1e~@8iv%v+-X38N;;1g zjp+@_qce$G-4bygvC~Uh{3znoW;_A#e72dE6Kuo|uS-EpZBWmrEA@$!;3Pi=o%e^C z^tWQ(`G2a&>_NqnFyXT1gHta*k50qbAZ%t6i*3L0bn+t(=ulfbS%? zYgLY+8YT-iAUHpP{&Ds!|^vc=AF< ztGubZowK6}a+E$wU@tW9yz?(}7@iRny4jG3;H3*WJ88)ndnGgYO!-{=v>~0ACIo3` zk5qCFtVArqMG4V5ObBh{oUib7)G$Wn@c@C$WqNGFH@j?acQ;jZDw)6_$Tk#p;{Ar7 z&XZ((q|?_s-BeM2tsP`^yP?EoSJovVe)JBbBG0YB(G}j%oCf3}jpCW8%f>DVmrcL{ zwLU(SrU+HD(6Nyl8|Zm{t+`yBbb}Dng`@zXN+L&ji2Mz-6>KnkeRX+*8GrIzuOK5M zj>`d5(WHsOGsdFvVmX#@?n+5HP~Hx8lpV;=+wLZQ#eV8R^l*U&O;)QQ$zx458lMfC zSM+AX3DKzRdCY`W!RB2vwk-ebs;tI$NCxNwn9rnLqUbslvXgGriBXC^U08jsY|k>z zWT{&7o{jMHmoM*xOov6vGG~GfcDTjXtFI7D+xYr>1t7z$iNlJZlz=Wa-8t~!6ts=V z3`kGa`4$$|f}xW_5vs_Xi9UkDVYU^`Pt{C)pm8*d8Bb=$j2|3k=XuSOU`pxc$nJ$i zk_EnoceS%Y41oTIMa4&DRVp#>*;iZfxlk`?MB)RwOyeo7X&hz=P3q(Vcxj0&b9pnK zbN43RJYJVGx|f$~bh*DEq5+c_ltor zOH!bcAJSF{0UBarv6sPNQkdnb<>mNhCL_BCRxCzxiVL7RqKD;;;a}0cG(Ka~x{S-7 z?FGo(@ORcFkWG4CY6qsn)kO-{t%f9-rhU*NfXBS<_&!s}j9%V*Q8R)@;@gc()A-C1NvCtai$r8w#3$87`}SRSUZ-6UpsW9Dxb9rv#Fv zfIl1KbO5rnbCLx&W#h^Ib9BVB;D{dWF3e`SAGuQVCIct!qOB1?2Hg(W1~foYOtKO_ zkTo;idD{Sb#7{g;hoN++Y(5K zdETu_V+;emPBnwfRyO5i(Gvz;6+W5EJg;IHwWQc^$@8B3;h2zAGXil`yK^n;fpiVL zGcAiw>t><|I5Qvh^fBIfT*6jzBNX=SqOAM#sxiq#RkJWuA0V>Sj1Ym$mI|%9rN(` zhFtsyS*aX+YpxWO43l;Bm1ctdy(WvMm~!|IC}uKOiYx`YE7_iB>7NURB4*?f68FGR zU&(ry-QC%D(0h{j$zuQW?+~5Y9(a;uF4RRKw^~;H162CMJxj@)oE!oCta1m`t1j8n z9)Y*8^djF=LxUZ~{4EgHH>ISY9p|K=USxbuCj*bS7zRs8wfY9CB77Pn0)IP6X z*3$PLxLzKPua~o*vKWHdBi{MPkfezCs?Mqgygj_tRjSj_;5wYuprP5^fOXR2qNLb| zb&sVb9-Wok%kFFJE^~t9>?E7I5+UC3z0v;D~9nyH4Ja zVvDK5(Ic;4XiR+W>h@@Vu@Qqc}-wo;zUI9DLzze@36rLfnTIdZKdV*JLxH$KcB&@gDlg5duu z&6yB+f+cIw6xQ3mVQYzCTVmqpoV)+*r~PMmR#Tc2OP%QH$;&uI*_`+EcV zD`WD>#UJJEHX_L5kb6hQn^%5h9@|cZ-*Bp4d(t-A_^&eQanRj39_hz1m$`31{WnJ@ z0v-q51cCTJsC&=-IXh-lpw363^uFv-QD0phFdlywa5L+{RbV>QTe-es#8bScW?+^5 zt-SHm!NI1B-dgooF}Zi&J2ev%6O#oBS$ho;T+iPApirLs`o1~=I$>t;%^&y~%;tP7 z$5sdgG-qw;}}2UCz69f9!=&IlsTNiN` zbO<-jkd{h{9{$Py6?ddvy^Z(Mv(>i} zSnvLz2#S8WO}hE7b`5OAv(Vr$Y{2Hk(#PJ3mXV6ymcm#g(RB~dh-ZBTWxO=q(K6Pv zYR3B`rMLIBPsvqaZ%fPI_!uGB=JO3m9Dk9}S**g%f@A>>nmfct8sk=9p`y|Wy;&G5 zHVQB)l>r3iJ9s)It&V&s_0ApcLxA`+6}`18tcqq^wA$A`lHbzj!Uic7g~fnPt&ZTR z`VaHa{De_@4>grWC~h0g|MBb~`_XcjOakZfI&voxvNS5hz!BI51+T;rB_z&YED}ak zpX;<>2gE3Oy#8EpjlXD=Su}6~Sa{~Mj?}aY#xT)BG#O*CELJg-l#_oZI_qPo_P4WD z!CUw%)Sjx?u{X5O7nuQD%k%GBi(kg_UGww9__6tUJNHuT`{HUmVqL>yAo$K3suR@Jt9r17k%wE07i390HuU77SVs;+uFKtU7M$J=vU` zEf{kSLsaPjtUj zk|F?58h9%<{_1D1$0Vht!a>|KK}V|a?bn7y#bRA!UE^S(i9A%Vz*S&0AXH9F;0oW} z=%4swtE&(N5D4HgQy*Jsi}^t@iVc<%Hrj7<&<-k986~gba}*CTja}c%EC(4o&-`rE zORpEZ>N!^UCJ?8N*6@>zpTMjM^24pI?W|bO-oe^D|FHX?SI12W9kORfFQ_X-00KQ) zzH0NTYZdUk8=Pzr+!>h#cn5l{YA$p7InM=F7%kj7_F<1Ec91XSVKYw!^X8jXGG?MA5>L4tS`gI4pr%~Ucw`WPMj!uAnAP zyS8@W!r)2leOw?qF)^`&@$(3(SX3-Q39>3Z zya4L0Fzi#)1hBEW6*`>vY4@a@mJSG3(_Xw97B&(jHmELVRhP;O0Xi5)w?wD2DtRea zj8%3cH69-c2ntEFs=nJl9=*J4Se9(`?dV_9 zpF}&34@SRbpLqUOIe6u(`Q^v`gO`jKe_#CNBeOrcraYkjAVJSW>1=tscXjPO`JE)JeS8A-EaJhn5?%(IhAq0<~6U~ zne6BgQ2CA1bm|qgkHa0taLFV&)xA^3CVSeXXt8TBQ~^{V|M1<`9zqXr^T!7+mKgIL zJD#C|!Jzj`63GvnLA3{kBwpn*tiXmF=AB|(!+)(&^iUVnq07<-e%~7Q3nd!5-~btr`ujuvJkH+vprDYym2;3^wW^&gl2+~U_0M`Q2)NqX=~!Q%l>$}ijC=3WL=cD zhh9pmAq_)p>~9@L`{iCVeWKTROY`OX!8N@_n0C|;|J%|vlmo4|z=u~Pni)2={5G!Q zNA0PE6sy*3@juz1IGg8l3e`Ai8Q51YzSO&?dcSzavQXY$Slj?UVH>;PV@G{CreG=> zzqxSlS#;-fmx0Jl)OSkla&w9V>wiF&OujeXUn1L@Fm~wX-C&~J6=FT*^E7@GF9*<(%xq8MC;i(;L2QjPvks4}mEG?OZGOc#gsDj%j;$=U-q*EB zNR()_DUiix*9huWJ0|srJ+DvxgnSn-d!y|CL2OO$erfN2d1&1nq7P_3ZzEvn`N`!* zY$tz{wdo$qm4vfsmpRQeiHl-)&i(&IY|p&{W#Y+z>O^frO&iM!w*^bbda_@$t_(VC zcBx=hwo}c1OtXIZ+5Dm!=dq7i0CGcpJD#ef9aX@VgA&)2L0?L11)~MpqCVO55RzKt z+XAagT71`3f266UMIxl|qrfmINaw}+)^M12y1+BEsWY-$RsG3Md*IGI2>_g@M4$1H*pTMpPeU}s(?*G?02noxLPwr!lkNkn36@O`w zyqpmf|4g{7d{@Z`r_AwZysovGZrzz(a412%P*p8i@z19v-`f;#o+OD2%Qjm_8F~n!1A)sS;+3+%bJz1$u=W;sS6Nv(dwZxX)B+BLO6B6;RabS$BA~M1 zDq^P@o=v>@zjhcbaCzs+>SLq7V1BGyPfzk8IF`fKN~xj#_NS7(C>>rDpI*rWnRwIz z@9IoCi6Y;-{5c&bx-|M-X~`n>f#v9n`E{3@0^l7=bhw4z7OrRXxum&draAuA4_NuW?x@>_Mb;f>rZ`qN_d9semaoB+uR{|S^fn0nM6&@)%My^*OB+7nW|i1DMz-pW*?Dr#{rTVl$puJ2vz+y zBm=k5XiK&<5r3sKae!`oxbIHeeAL7a+p(xNcg&^wQ)DNjGWNS%IVv8NB(698H_X<} zhdw~${5Fe~Sw+H7>W(m+3XPE)*>!(9@31f%JT<2J{t5&&$lQ;N^y}H|rQ5zVe9m_ajO&51dFv1Hz9(dwKW`mOe6Xr&5YuUh+G}NIo(`b;6K6 z|7hoQvn*)K56g4|)G-Gk!s!+%dfb0xvW`aCtvQk^<-KoP>Ze&VcHm?ocyI4+M8rcr zyQ4)J`q$e|VWDdlc;aK9PrHb^pZe4F)D_s4`SLN(Aqng%sLe4Id34nCO1o2cZdRNy zu|C-{KUsgtyy~%M-}Cu-Uc9ZUZrN>ns3iXJ6wVtr+4%O&`lF19tSyuP7{1g^2TV&< zii^wTt~Uw@GVFGxf8!8X@7T@G<1xWBV6bOsZ)L%1&-6QSqv5?00!jQx|Z2-C>WQ z664N|l5*^Jv6)oiSQxvQ*kvFpBVShk4S8lYUouHD^B>`t9VSuGZpx z&32ya8ptu0AaEmS{f*O%UmThWr`b!+9lazY zie)*BjXY&uOfEk8uLo~!`AU2n*S3H;7P9q`42gUe>d}Fm_kxOaOZj)s9j^h#r8A9; zHA7|2?xIxNkvM?=Z8EIh8aQcoAw#gcEE%_{j|%v3Ujru{lsi{G)knf@31`euvtIt? zgC_?t0iz3}DTcDyeM6CNE^=iHzYkm%_{o3=pl3`o=f@63> z4#7Tdh%vVIN&9&9bI;!;j}H8u1N22Q|KW_>;G3%)AvU+3)`L z`J7z&>@T(V`0Y=`2mz6eAmMSmtS|WPc=WHwTv2T@(v22>nmT?|sy*>#v?}4u=%Wd4 zIjhcTg>YxD4bZP9Wr?PZwWHGce|D3#apd3{tC5nK8SMiokGO6!e#_>b*2sn6##=_+ zcT%-DgF#`IhmRkZP&8VayS@N7zvVep7fUlyIi@ZT=M_Jx4xJBJy`wC9E~WAoKrTt@ z?UaC9?amkHu;Ys5ho<_X8xiNiTQ|aop6m3iP5sH29p`q4oeNgcD#L|ZK8=Eg=zAYM zKGVFFYcx?86NI%9(y)vXlYDv%Qt(l4&>I?y>~Ns-&}zzgl#YecM?;`}m)MkNmX$tw z$UEXKr&P42U+MJp91TrNh$pN?j}9>;@t)W3^h|AS*CVRe-PT!KCbQOghz`=;VLD}t z_P3(UIjSHuh1i>1y*v~9zD=!vUTA+w^~?v#yjlO5+HGf%DAK|XbT%(1+xAX3Cfvci z5V+?js0s`D^>DdtPxlw>WZb6doVLALBR1T?Zf5$uIBYVe_dHd>xpWt{@YHyq8B`v25pDPHkURadCYOJ`_EmiKcN- zTp_Hpe(|6>QbsD04igLSe4BrAwO> z_NK@e#L(oS2v2w6LkF1Nx*gCl43oG%x4rlqq3#sM+L+G%Emm~Ipm&`M$z6F%fS)Fn zW#OjiF{qc<j+AC@+ds9uG+)Y1(r$UCjZ3S{@&Vg z-wR~GFz|G!>tyb)#fb*lUvm^_y!#*DSNLtG4Ue2En|o5b{Oufp+aF_aw`Rn-<~Bs@ z=dvuMzJacZWn}$vzq83-4EqS7rBh#ej2_Z5Qr!2Q9D%U!_B#3jW?M#&4kNDZsg$9# z_1qmw5{h-NhfW*#p?4oaeXp=ol3$w^M)Fhw~jw;44A zolOkr2M!<-qr@D^f|cFDN7`!Wy7*wf*4Cksgd}5Fzsc=m*qzKjGCt2Xzcy`%s67a3 zZCq|^vtwJ6ejCywaj6efz-=vdR`rtTac@76*Zes~k!LV3OHk~;noGcQJRmclPlwy; z;%DCb#>n&QYz6dhQ7a7|oHb$cc3i!*Y-ygB`P$(eYfN&w1a0hRG4Rxvj$WSB(w`c4 z!y{nZMXIo5j^Lg2;*-o@oBt_e9F=Zv20o_$(txPztwIW2BA!p~ zM3_TOg6}^syBe-r&|i#=!(aKSUwh|9?)>jkM*>j}B){&`1F+S=1ULcP7o)^CJiS{yBMY^DqS+$)U^_- z4o~kQZY!)gu{IU1QdwsZWIASZF+x+1uOAQHq+a(~IOYq!u<$3jH4|4Xr$g#dcq!LX zSx+$52|d)?ybG1Gz(XZ>F=`5wGkasVLUm zLFU2Z3zvUJ{PBHh3-CO+ah}5|ENs)@mv}pddd3(=*q1j+t*rOYBZ6~@bjSEg1xFJ{ z(c#N5OseRxX#$YDLH;2)-q`Lwo`E2+!Z|y6>yj~jWQ)%DI1~PxE++6n$S(zUS+=DM z?>|7tcIKv!%gZ8mo>d9g#?JM`P}SZF?Z_buPm@1ZEBobVC{*+M{pGjM(D-60ZcZcG z1WpuEm-^UBV}i0d{aGJhRmY1c8|RA@=F&LZILa5uvYFeA5p=J&&)DcywR%I=&`9sJMDFhS2?@+`W7!V(XawQcTiyiYLatW9< z8GBDs6s;<@!ytb@6DZ#w-iE~`3~b*WGZ^xOjEnO74;WoSGWrkz(NgsVzB~ZUA`Q%%%c+o$ zR6xMm&tmn6dJ&a5c)vZwK*5RZ1WL!RJ_Q!Q+ptlPcn1*GGo#+&i-}* z-xSpAx?0;goU*U0hF}rjeV^aR+S1cgMgC;BEfnI|fuWPTWLo$gM#sz28{?tIxoz*V zr^lDaf=ZJoc{hjjFoqUCg1^kxw-e17fbqZ98OH;lB6TBATE5TE)-aA)++l~`uZG4; zOQWuGS={L&4mkQe!KYGh5Gg#E?r${rGwNm91l=D&(Rz74;cZr}{(o}Y*>EzT(H6@% zko{5g!%HpvyZ2VzUlUh4<4|mA>1h5AuWS;w@y;&+kxWdRrz3L9Yj~(INe#@oyW7_R z`6)zS!qgcwVyFdl+c&UtfhR=FBBFU{p{e)a`FP}_j7jUJkq_a*?4iVY z!IvGKs$T8rF7+*cepmdAAw3?07y*l%MbUXX;q*KpmA$wyN6yO`RF512XfCN3f!jMh z#W+VK!`@DeFGbzqcTMKM$F;MpK*)lxPTvcgEe8Q~gSuH`#6+RrAF1p=zvJ@%tZ-eu z|7h#@=ZmPr;793o6nhv^-Q%b1W|yj5*^04aq?Qh@xbT?unB9hFvkF!J#G(C|#n_+Cq$D0!PNWZvP^%1d2iud;ghc>5T!Y(_9F&feF_`H@} z70g8bQnFuo5Ef-NxF-aw@CV6eD@zo0Ms_-l=JtR;E+gb;HqwQ%xN?%r(*)E^d8{fW zzG@)jz?TujjvAq^tPK^QJdzP>?F;VCVYmP|CqjwJ%78P0c>!epG|q3MSZ?0WvA1?t z8&&hJ_50G?VAF~ZC|Wk&szxQ#VmAXc)c_PynpCo~z?c8Mr5ivRvcujvmCkX>W7CUA zRF$J}dsH@cWMtN78(H*=-;Bs0N}6Z9d+bnLDIlP3G{5DuY?qYd7|DItd(CLD!r}*W zeo=hsqg1AFlH~eUq(+eb6xlh1UEqdn7EkZwAGt)`#jA4&3XxR2ja6!_a>CC-^0^{k zq%DlPme2gDxt)Q+5SvDSRjmi10?5S`0qLnq%*tU5?Yf(Cs^4!`K??RqzybMzpakFur9_5R~a3qY*! z-s_2qNTJBT0Io)w^PlWp-o@W{27lei{ZVFYwsZegJ)QVUT;5u;tC%`72h`%q)C}g6 zLhPtWHIFJ6D&lPP1er^JvV(TTe%abgxYcYn_1Mm;2-GB`O(Bgt=hMv})z+dF9nj?3 z|F!-SY1d~7TX=h>!XqIR8yun|F7M?U9FRuuVbiYy(`h8?Nok2Xm%K_Ru!;FkDH&>2 z4v(DZwt`F&lXv}E+f6V_ZP{V$h|j(~sjVrz3|>R=itef5xsJ-_6qf*Cr65h!uagW9 zF?Def5TBKR^QMaRDGkXEQsL~Zed=axU}0f?ub~^G;VX@yA2Q5?TykZJ;-Y_g^}_E1 z*Nh}yK?7{{g@l~%D^tpa<9)~Wr-hND59Ayijc@MSmV-wkCI zyVoRN*?yH743qi7=P?46{EubybL7U+efPy@QC~4Hk6xw>^#0Des-#nuKWQ;5wL`o9 zjBH=%NqK5t&bcnyDS&u2rq5sCdl;D$sDG$w7HT)5%dN3^xd)zRPS}prQJN#e&D2U# z#dxa|1IO@c3t<%cE}g79o+ZYO;-6#nI)*g?CC1V_o;zUG2)qKAn-(kftsZWK z4OF(|zSkOMHcF-czirizLzGO%zrqt>xeiC%@s(P8*$YF;NlJfX@g0w=mHKoSY!{es zxezZufeOdjh`E2Q0UOlOKXNBjst%G1rqXBLEG z6M=XQPTo-(xzPiP}H6 zuz~{DmOGHW-j+taK%Ts>#&~Dv)rW8ooK3le_(|yG8SKyz`=M97jo-2iG6^sQyM157 z{+mvDGu#i0f~soi%EFzz)X`~k0`fA?nYNh;G5q#jH=TvquDQIC%=Cs@P|scK1=96A_nPybuhmQ}xgaYhsIzTU)-4W)hd2aUTO5o+7`m;Pu+&R4&X! z^D~$y)6bB^TJ1o=9O;$l*Dmyd;VEYLsbK{rqftL460Eg1fzRY+r?VK}lZp!m672BK z?d;1&=RqGjyy%g%1ZU^JKHkK&s!XlZrwN4sn@AP4OMqMTP8L;TeRAq~-uJTQ3~-!j zmY-5bRi>03D0ge4Q&V_{6Sn%%^!Rpkgm$MN1I>I`wb>So^<(0UwUo9_YT@*RZvd+{ zZK+|a*0eb=jSaXY#D`fQl7JAO9nghmLf1IIj0_(1=_!2~6PvkZ(MIDFkYHo4su$w! zXb*M4eV1So;`J`VUp#Qhf{dL^v|KYuzbQB}UnRd|Y6yesv5+!H$tuHM(t#Mp$-FELW_eQ*GBX>`3ow?GY=OUiVpT8X`d*}SOQS*>Ur6so3g?gBjTsKAOhhGyG z?5o5eu+JcuL;MmNo`ZJ+muM)8R&yVbbU6y=Gl7ZGDh8#cz(^;8+m!Htn&hq3zESmT z!+~Mg&DayngXtr_XfCl=9!8Baq2Jhh$ug%G)aoQNsOV9NmF&s@7HWJ$wP*KFsG?y0*dXFd4<{mZ&y1 zFu`=Rh;X7F)hqfR#p-!f0GTL{mOFEEuF?i);A5?-4+RP)-Z3Ygy{7a|Gp zaT$115PbXrdv2RgD}>?N+yLoJ6VOpdRjdzHLekM{CMa&Y&4t%TT9C9nCmKB&DmpB8 zaIoCCzR}@IuPJxgx=~+3`;LtO)TL-q3PVg|rf5_JO*1wD3Yku*`SWhQ?wc7O(hFTunRiB*E#zDzZ!j( zFsa+tZ+SLQqfc-?M$ zRglC(#hrnhQlj`uLOT(Ls9ZTcZErF7=Q>--gC3cDS-Ck~E$wFd=5DZY()`_7CEN#l z3;C?pxw3<@q2C#1E5ST{@&v-d9|<CWB5t#>E7Qz;7eX+dncn_<8s5+HdU+S+imz#<^8xIcAnOf2U36cnLCJ1y<&fQi^arP zgrFK0-hYzHL0qVimPxK#>5 z`=!lB;1&@Rp*w!?JZG5pq2t9!=R=|4D28998v9QwD>~O?s9b549D=tkUOjwHUxMN8 z&}3!@*N3{)XRX<^ut!%z<$IZSR%=XJ-oSyBErFJ4v`CCD0kKi*AvT<%&zg;m7`$Gw z_5u>}?rUtGd{GIe*1){f!cbQf@^_ry1(;PS#M#T5#A@XPR0(#rr$5G@FL?O$ zUUT}3Cn{;#;VW|QFFr_ex;v3*UX@&zDktmf*U_BV4mY(TiO%EgGviJR*vGSqi_5&e zq<=mU9p^#6WzY^&xfpF@%6n8!X0{<)0G1(Ndt()cdh6po{@gwDs`CBD?Gfel-!_g95l%z1W=1Z}n^04(F)SQ|zmrpZZHqA8B>?>TBALUXv}7 zA?%&?hH-2n_Y}`STt2@&U4BJ{^*CD}Kr7lng<3^dK3oQfi68dM zR;yNxe@;^Ef1g(7vU_l^n>0cqIU7fa!{UP5(y63xqBkeze}F^|zR9%ooP`U5TPtA% zKzgZU*Y=}^RjA}Yp1J?ohQLD!+zX?&Pw5TC+ZaEny;;Jh_)BxRd#+=cs*|x3$g8hg zthn1-IGwe!;341v3>L|=0n;uwZc5{>oZZdlk;uL}aVz0T_}3;gqrJuz0#!yY8HT}xJ!%G(Rm$WDiu462k=b2c~$W=2OvEgVN}QR=$0l|vE+ zOHW+R{eQW*IPflK%%uVIL$c7Fz*aC%46C_KePkfLUOnGUH3~pY;J4~^H-SAGq*vgz z2)|#|c6!mje3NM{E(4HnqYc_FdvpXt8sr%4tjT>OEQ39E(y6|&;)b99;?^@%oyEG2@tlx()%(tvmt4Mlpd)eMRC`o^@ttoa-AxSU>v8X2x(E5#rCC zgT#vl26m?M8O{T7FO<K87|*aLv)&F`MQo^ zlp4AZsNWyE>^*jg`}t2_m1g{@T8oEG#BN(BJo{0(QI|yayBl|@$IQC8x_7?rvnvZ( zQ5>NdF?oJIMP-S4NjA-pjkgV+0_9vhmCti+$;-=)2xuKLM$8U~?x=jZdYRpvUg3*r zMo<1eHGxig0Tuqr%W^6Wuig@LQ4Sh{bq22RgCAP}K*y_az3V9y!rU*Wd zM6-$HhRUZW?S)t;n*#OV5ctMC&&Xu*F>kAqE0H&iwUyI`v(iqP3nW{85}{bVzZ#Sz zSap83^j34u>#He7oSpF+4p8m%geCc1=a|>e)K*#rT}cx_@)ej4g}CIJXYre^lFj#` zQk6YhDt?^@2G!4aP*lzoP8RzAo_qKWk#nze#?!w&%dihcIU9XmwE{s9JtXA z!COLb)Fs?rD;=KV&{Oe;B;Mg*5~*86nw*)pwwPHvzH!I(x#x8={6v>pmn)4)IQDfW zD~Bobg!k-)JV62k<;JYEgR{flyL1&LW0O#GHMcpuX=ukNHiqF-y8n)l=?u5ENKL@8I2 zDl2ZjE8j*;!x-lx)LjCu263%yFcUI%CBlBmhcVKGla=1nF8*TWA_zKlBwc=Ee^PFDIGFja4T4x%>Q2C35cQ;0E3O z&LI6`GQrXKNmOhsX@SbRn&DF{EkN!O=r2!xH5D2m@nxUR`197Z*50k1Vut%3bt85G zwLbGC`cFc}N!C9}KWTIL9cRcFh!9?WmVNyNf!!L;xQrM(#ir&UN4Imi)}bo@u_=XJ z*68=DD~_GVS)6~^<_HEj#NoUv}5Rq8`@nu+FkA^ z+W#g9C>`g-Vc0Fkd00uRk3%OjM2!9L_A7VqI&iggKMO&*Ja?b-+l6mm+Hy08O2#E! zl+26?9Xp?bcndkmk|<1 zB25Q&1TrnPnqOm0lOLWR_ZH|@!y@MN{hcfC3EV4@vKj~~(FSSpW9ESR=?@4%tqgC-pluM-!B~^NU5|+WBXblaF&Z!;K#U z{_IY!ul|S>nlXWaa@`)}@vKh}8;QN{<|ZLdMuT*-W6X2tJS-l**2;_f>+VIYCPJ?r zQWV++Nee`?wp>Ln3=?bh7#694c#c9&5CkXScMCg zjq+8$8FF(oa%g)h!L+kLi?!h#l{(xc3wq-4+ib+*xTZcu*qilAMvjxrU|Tmi?2Y?; zkUVR0G|+Iu*l6^katiX~hHvMr61C&7tShc9SxPWy=bg_4%({j&p>CpO|sxx z{K#rex=oE)lbxYqmq-AeT+)gp+=&rJhRG00slh>m!|cKC;u5IU)p^0qxj#MO7}2Pp z=!u9A_kN%IFkO4Crn@Wb@6)BrRX40G>Qg1;utT=jIm_to;=c7nV$mstmJ1_eR<_Vv38F(a42z1zwXjc*ZlF-YL-&p z7Qo}!GlujpZ$ct%3%~nSJ#I2pwc~%dZjc}Y-{Vj&=1GdLp6mq)^(5ydk+{YHC%GRa z|HZ}0d?=6+Hjc18f@)0JsK)HHR7ZdilTh1 z%3VIK*YscS+3ym)xOlzd?YNaf`>=yKF1whqTHdWMD&TxKi*fgrBZ_FZ~CP$T3BPl{Q_H-=tLQ`i{Q(wUk=k68!upC5>4;>`s=e%*NPEDdp~%(<59 zY(gA5Jy@}yDr8JLWv6rxVeFCg<5>&8aaIWqE+Bvq0Kh?I1^^q%D5`6zc#PimWp@DX z@^wqEYu-A*`Ex+1_1yP?PL7qA;nA6q6Rn?7#5Q^N zT{OvelA**jVh~^KDK*6aJGlpkK7VHEy8LQ}N64n($qMF-;leyq+$$IK%_h*+G|bu0 z6$iqlU93A~s~`!1NvKhd5Axtz)mJgXMkNysjrp2Tq)SP5&$p`$tU{_{<5xx5npCJs zZT)_?+sb`8BW#abUZ{@d$959zN=sm}tzu(d6`?6Ai_t^!akEJ)B_T?rpqLgOY5)vP zvVh0eExMU4!He!C6NYhsuC7 zDIn{JFR5!0aJo`LB=&QA`;irD(%)%y2gTP7^W2!R-I-|zso+Pb0GuGg8v8=p6c3{&>e1CM(SNrL>wW+br zqxB&=n&f?J0Iicb@L8_WcdYvd(jidaWGDLL!A)$}(F((5o_v%1<>N1B79+xXB^t4? zubcQO@x?}wVT=u~=v4G*H%3#c;*cF_{K~uzQKv*QT16h8OffhKKq=o~Lq}wR5*LU= z3H(V4!_7{qO3up%(aSiv?s&pwP+>urs9@{NR}IXTUlkORG2npGG%nFFq{cUS`k`~2 zypza=i?C%vRm3&}uO%zxtWdu+K(JU&d}w_$n4I`@9W^WXUOqX0!rxNjiL2tKqLczh zmq4~1_2?E4#jjFcMv3{^bdw;x6*8h|dK)d^4Q|e4L`{1%A)IqYJOfZu)Oe|B)HD?B z4fDh#HJ8eA;2{JfO&PvewkKy{stJ$QEz)ve%7STisdiG;>?n0~j$o>zn%ykaGrlUA zjO0-EVKai9rJb{vWHaE4moEhHCVm<@fv%zm_$4H{IKW`wH~??*IsfN>Czs2c%Sw4m zDf^6q$%wi#Q+B6>K{|0v4gRjUoXy|RLq#6OEK`M5Py6*w#36-HCCWk5NLv8^BFB4U zAs!0gby8E=DOW?DVOfLY$=PpJ3@Sxy3@Q`3riP_>;*2#=vl_~cifBdNr@+W77i_us zv%&;!o$O7fOuAm?bDhjEyDHBXA<6NM?>s*&sfjrHs2bAIJSpAIQIdBd#6(F|o{cSk z#T&2s+W#1=&jesOQwuS=%?`_!F$6ci$GsDV^;t@CED$c(0xra9%X0zGWNF?u(v(a} z%5(Ta<5!F?J9XJWEP7_rn?CDd%I7JhZel@9bxkc`FM~R|gu~6OxmuwC*4p;oh&NIA z4A_8A0CA~GdM6K-4nMgC-0i zDu=2Bsyw2)1<_AY8jGOYB`%Ib6I2IMwV*J0%6f&5W00Lai=5Z}bi~bF$UO3&5;&WvsH#pG~fd zvjWxZ(P0svALmk`+jFXk@XIj~^iO9L1a!(9?OPQS+8?mXI6o1`z4zo&xa87$UA?9e z*sAz*@JF|zLM)a* zqRDZM+>`u~dOvBRbyb!5M)2c!gq{TEYf2?6bjL_;?l!7A9a;%1iu=BVjBF)b-CWZv z{x~>YE0;s?*u#w9zl<$OZ3C@#;Mv&-IACbk3jD?=7Y$U^vOinWxh)%&IL6+trnKn zS|-+hb^tVL?S!Ba=8k@tR2S^#Zt(vQ*N8;n{RJ75g_}k|Au1ah`$M(j7CNh&Cmi1$B z2&d*rX7L!_YQVz$U!3u6TYqmgs+B+b@sD-&>pCkZo)dXCao87SG+?4vaMRqT{0nCb?{wj>=UgYjVq~v3)H?wK zeShvc9-|UnX#F6j(Rbo8QCAdyUjOSVsLkBcADGr_wZ|&gT&G{ z-$5a-rG=HXO06=hFgcy{I}1C8uqW@9hpye%AlPB|B>=Cdzb8#Hu1$M^3iCJYuAQ35 zA*Xf4eq9rAs!mC(Qbe^NN7wydy!4qYOAh1l1%V!ABAl8u>=fA{#wMro4D_yA^l!Hy zzw7X?D{sN~xf!LHS66bQHL~SaL-kmq0_Godx2m#3>YBZ)t`R)fp56Yu)CG=850W=0 zDaO_v&^*ZUb`Bq$^*A`1w87PPDA<5DP|{XR3S;7VMW`Th);SJ2x^h|uZekM!)#-M} zVh2PuLY)5IkzQIF{qnI4W&jWy<<;$PFTY#fqvFZrl_n2wUPm1Sf9USiIq}cj!Z8VK z)TX;J$%~niBs$Tn@SgWZ&2l?Ae}EU>ySdj{j`^{IX^~;V6Ng2y1w)7;D zF{@b$b1-<=!*R~;^y6}Xr26jt(3R_zdRw>LzFa97Aa$Kt%C~Q1d>xzI!ZHaK@vn~! z@^v+^E}O$@si_dl0Re2K+QDLrSk1>rn3il@FI= z9qy?J8XJ9HlPf5+EP1!0j(WPomJB-|SQ^;L?e#Z93@3Zh9F!lrA}D1G8m~okUrJ3_ z5}Kg>tSM~hXh96^lh{h3$x>yYEW11Q8Ble^ZA3LoxqunrK4FpqNy-Mr1vTZ{%Ub4C ziM_S3IPwMD4686Szjd+PfsQfee!sn2-yg`qxxy+v0@a$@2 z^ArujMnnWhc9&Q8RH9yfcQjMZw`qDOCVKAPF&*)*4Zv`h(Am&$NHgLONG5Iu2n`GK z%t@;nxx^(DOhEzKwSh%2|3+h?sFvo!XV-8qq6y*TF?6?XVwPZfE%Hmq?GB)r>U&W4gi#-8Cr5?rEbA$%$ zT7Ww(JcA^%7+VpJoiIeGU@!EJrXNLA%#x-gK0gE2V|(-{B?E@=z#r#YL>&xj=yDox z1RY*K?jNlt`RTAvu|Y-i^5R%HHNfLJo`U?_56Gq9=v3hsr2F~e{jAf&$Z?YO0R zK9A~I9)O_EN#1FIIhe=k;G`g1(&-RR&W{G=-2<`n>B@+stml4tV$x({wPgzqu7UYU zq;Ek2mluocMQ^dfOX38*1n58H7-O}<#hG$Ifb`~`OiEMe$xbjs#|ca2G$tTJQa}m@ zt3O`ZCtBg|wXOu$dUvPhmd~`^b$7pd+*Gmf#3vGmmy-0QbYpt$++qi(D}=&7Vq8@s zbxIVXVq|Xcx<+Bi?4Zvg_`hSC}i#S_Lc`-%_GfvKR!jNfg)(OlMpp+?2MLI%PP zdQFhSqREt)b!G0+y9!SV^oxbnz?o9ODkJ->_RK@6!964Vwo&6ZT>`OaRboy54H-YT z{=iQfr^xN=;NXx28rSwj%F#W|y)xq)Ae>0^pdsg?=qS9JCZ;mdsa>3tohV-jkYXSGGgx z#vpO6aPI-j;dU2lDpJg{1|(uPnPD;fWid4t&<~U?N5_Wm?x8zft)$8SjVb@{1Y+$U z9l!dYtN&+tSALS|NO`+6lzrP###q?pjNF^{4eO@*N4z!t znnO{ub<31e5)!EO?302+kEft$aqRIo<^mUOV!a+iRM3sG!l+p-$YP_iNSZRFk+dbjgk#lQQ z#kj_vjT>M&TjUol&!G%9&y@52iazm$k7y#r9S2AaVX^c%&W~J$N2V7* z7AfR(Da$NsFYS&g7f_IFB0x?UPbYvAIcFc97agrXUB==5#rcW6UV3;Woe$p7AC|B< z6>OB?@rGMzDm5jbyI6~z#5E(!fbx3TgPB%*eLc($Nf&#b04Q&ey|#e0XrX+9Byqh% z^%gK(wDToRboJakizzx2kbFARw$P+}f!vok?6Q`acpZF|m`f%8MAy95vV*BJI z?|9C_=K4!4Fg{{udn596&wDFkZgBdPSQ32=E0^%`;6A8Zu1~PE6*)IoMEZ$=3nfk? z%JS9)%BpJ8WT#NXql3}D79Xm(>{>pm#6!@+Ezbe^B_7VUWdn(;SCGMr4q7M%FKfzs zekQa=R_$na&Z-5@RXb#EsYh|M>%<$%J219VBf?>3Sr}qCn7F(vxPuvS(9t3hh|^$7 z@i(L!_h4;t$Cqz(>>mpB&HA*Mw5QkQ)m<9$z(;QP)9I_V_N5=npXv;$CT>b}XU5b% zeAe>UZceT5!^>C`a-)($^9RBP9Mt?#7NuIqp`SX+q_dRPwu8w6yk!peU26Zq(^&q{ zy57w_lcDy`l5hmq47;tbKo@c_?3}1^29=fn;BNZ*^LKuJ%iL}ZYkZYU(XG8S|L6BH z&SI%qVi{+`k1b#;C-=_ST~A87HXjMZ6CA;3@=9Z+?%~%i@SEGRofXF20~$7h+VZe7 zRa}C#rk^xLdCIhpeLs#rrw<289}I|kVo94}S^$x%=4Xe0ahLwH_;Y&_PaoqTLd7gCi)Jbei`$9$;m(!heZ}5tv)V0Wx#G$^ z_8|4pPCvkUtZFZ^P>lPOKB{=Kmq^K}g4)vr4&Sn~>kf~MM(Nsw_yvl8z7HRz{S^4g zd~uT1%5a^n>p_>4m6%JqCRND`#5*k}j`ZcIV?4;qH5;qoYWEw%wfj#w6ypit8YYq$ z2_ZoR)hLejzSQ|Af%DdvbfPPMjW3l$&aaox3Hs fz Date: Fri, 15 Mar 2024 12:38:50 -0700 Subject: [PATCH 12/26] documentation --- DESCRIPTION | 2 +- NAMESPACE | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 490894f..884390c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -49,6 +49,6 @@ Remotes: github::haleyjeppson/ggmosaic Encoding: UTF-8 VignetteBuilder: knitr -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 LazyData: true Roxygen: list(markdown = TRUE) diff --git a/NAMESPACE b/NAMESPACE index bb0fd1d..217758b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -57,6 +57,7 @@ export(pull_biological_samples) export(pull_catch) export(pull_gemm) export(pull_haul) +export(pull_spp) export(wh_plot_proportion) import(chron) import(cowplot) From 754fb84384125307b974b56bda82795cb63f849a Mon Sep 17 00:00:00 2001 From: kellijohnson-NOAA Date: Thu, 28 Mar 2024 12:28:26 -0700 Subject: [PATCH 13/26] test(pull_data): Tests for vector of common name @chantelwetzel-noaa this test is currently failing because when you use a vector of common names the number of entries is doubled for a single species. For example, lingcod has 705 rows but when I pull for lingcod and sablefish I am getting 1410 rows of lingcod. I haven't delved into this further as of yet. --- tests/testthat/test-data.R | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/tests/testthat/test-data.R b/tests/testthat/test-data.R index b485152..12d6701 100644 --- a/tests/testthat/test-data.R +++ b/tests/testthat/test-data.R @@ -31,6 +31,30 @@ test_that("pull_catch-multispecies", { expect_equal(nrow(dat), 350126) expect_equal(length(which(dat$cpue_kg_km2 == 0)), 330971) + dat_lingcod <- pull_catch( + common_name = "lingcod", + years = c(2017), + survey = "NWFSC.Combo", + verbose = TRUE + ) + dat_lingcod_sablefish <- pull_catch( + common_name = c("lingcod", "sablefish"), + years = c(2017), + survey = "NWFSC.Combo", + verbose = TRUE + ) + expect_equal( + NROW(dplyr::filter(dat, Common_name == "lingcod")), + NROW(dat_lingcod), + label = "entries of all species filtered for lingcod", + expected.label = "entries of lingcod" + ) + expect_equal( + NROW(dplyr::filter(dat_lingcod_sablefish, Common_name == "lingcod")), + NROW(dat_lingcod), + label = "entries of 2 species filtered for lingcod", + expected.label = "entries of lingcod" + ) }) test_that("PullHaul", { From 1d6a613fc823ab35f2f4d82552dd842b94cfae53 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Mon, 1 Apr 2024 15:00:05 -0700 Subject: [PATCH 14/26] fix: grid for joining positive and zero tows Grid was doubling records due to both common and scientific names were used. This also required a fix to fill in the scientific name for the zero tows. --- R/pull_catch.R | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/R/pull_catch.R b/R/pull_catch.R index a48a718..fa5b2cf 100644 --- a/R/pull_catch.R +++ b/R/pull_catch.R @@ -200,20 +200,11 @@ pull_catch <- function(common_name = NULL, ] # Link each data set together based on trawl_id - if (any(species == "pull all")) { - grid <- expand.grid( - "trawl_id" = unique(all_tows$trawl_id), - "common_name" = unique(positive_tows$common_name), - stringsAsFactors = FALSE - ) - } else { - grid <- expand.grid( - "trawl_id" = unique(all_tows$trawl_id), - "common_name" = unique(positive_tows$common_name), - "scientific_name" = unique(positive_tows$scientific_name), - stringsAsFactors = FALSE - ) - } + grid <- expand.grid( + "trawl_id" = unique(all_tows$trawl_id), + "common_name" = unique(positive_tows$common_name), + stringsAsFactors = FALSE + ) catch_data <- dplyr::left_join( grid, @@ -228,6 +219,15 @@ pull_catch <- function(common_name = NULL, multiple = "all" ) + # Fill in the scientific name for tows with 0 catch by species + # could not find a way to do this via tidyr::complete + if (sum(is.na(catch[, "scientific_name"])) > 0) { + for(cn in unique(catch[, "common_name"])){ + add_name <- unique(catch[which(catch$common_name == cn & !is.na(catch$scientific_name)), "scientific_name"]) + catch[which(catch$common_name == cn), "scientific_name"] <- add_name + } + } + # Need to check what this is doing no_area <- which(is.na(catch$area_swept_ha_der)) if (length(no_area) > 0) { From d371e6f4f6474ff436c53b02c8f6cafa3f76ba7d Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Mon, 1 Apr 2024 15:18:15 -0700 Subject: [PATCH 15/26] update test based on data warehouse changes --- tests/testthat/test-data.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-data.R b/tests/testthat/test-data.R index 12d6701..7478309 100644 --- a/tests/testthat/test-data.R +++ b/tests/testthat/test-data.R @@ -67,7 +67,7 @@ test_that("PullHaul", { Dir = NULL, verbose = TRUE ) expect_is(dat, "data.frame") - expect_equal(nrow(dat), 10361) + expect_equal(nrow(dat), 10351) }) test_that("pull_bio", { From 20e12f6e57691f99b3aa3ad303389e259d327093 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Wed, 3 Apr 2024 11:57:44 -0700 Subject: [PATCH 16/26] fix: pulls data correctly when both common and sci name given #125 --- R/pull_bio.R | 3 +- R/pull_biological_samples.R | 105 ++++++++++++++++++------------------ R/pull_catch.R | 3 +- 3 files changed, 54 insertions(+), 57 deletions(-) diff --git a/R/pull_bio.R b/R/pull_bio.R index 2189abf..5b4a01d 100644 --- a/R/pull_bio.R +++ b/R/pull_bio.R @@ -58,8 +58,7 @@ pull_bio <- function(common_name = NULL, if (is.null(common_name)) { var_name <- "scientific_name" species <- sci_name - } - if (is.null(sci_name)) { + } else { var_name <- "common_name" species <- common_name } diff --git a/R/pull_biological_samples.R b/R/pull_biological_samples.R index ad3488d..2ff81ba 100644 --- a/R/pull_biological_samples.R +++ b/R/pull_biological_samples.R @@ -1,18 +1,18 @@ #' Pull biological sample information from the NWFSC data warehouse for biological -#' collections taken at sea. Generally these are samples that require lab processing. -#' Generally, these types of biological sample are maturity, stomach, fin clips, and -#' tissue samples. This function returns collection information for these samples -#' include the sample numbers which allows the lab analysis to be linked back to +#' collections taken at sea. Generally these are samples that require lab processing. +#' Generally, these types of biological sample are maturity, stomach, fin clips, and +#' tissue samples. This function returns collection information for these samples +#' include the sample numbers which allows the lab analysis to be linked back to #' the sampled fish. #' The website is: https://www.webapps.nwfsc.noaa.gov/data. #' #' @template common_name #' @template sci_name -#' @template years -#' @template survey -#' @template dir -#' @template verbose +#' @template years +#' @template survey +#' @template dir +#' @template verbose #' #' @return Returns a data frame of special biological samples with sample number #' @author Chantel Wetzel @@ -21,17 +21,17 @@ #' @import glue #' #' -pull_biological_samples <- function(common_name = NULL, +pull_biological_samples <- function(common_name = NULL, sci_name = NULL, - years= c(1980, 2050), - survey = "NWFSC.Combo", - dir = NULL, + years= c(1980, 2050), + survey = "NWFSC.Combo", + dir = NULL, verbose = TRUE) { # increase the timeout period to avoid errors when pulling data options(timeout = 4000000) - check_dir(dir = dir, verbose = verbose) + check_dir(dir = dir, verbose = verbose) project_long <- check_survey(survey = survey) @@ -42,8 +42,7 @@ pull_biological_samples <- function(common_name = NULL, if (is.null(common_name)) { var_name <- "scientific_name" species <- sci_name - } - if (is.null(sci_name)) { + } else { var_name <- "common_name" species <- common_name } @@ -60,56 +59,56 @@ pull_biological_samples <- function(common_name = NULL, } } add_species <- paste0("field_identified_taxonomy_dim$", var_name, "|=[", species_str,"]") - + if (any(species == "pull all")) { add_species <- "" } vars_str <- c( - "common_name", "scientific_name", - "age_years", + "common_name", "scientific_name", + "age_years", #"best_available_taxonomy_observation_detail_dim$method_description", "best_available_taxonomy_observation_detail_whid", - "date_yyyymmdd", - "depth_m", + "date_yyyymmdd", + "depth_m", "individual_tracking_id", "lab_maturity_detail_dim", - "latitude_dd", - "left_pectoral_fin_id", - "leg", - "length_cm", + "latitude_dd", + "left_pectoral_fin_id", + "leg", + "length_cm", "length_type", - "longitude_dd", + "longitude_dd", "max_depth_m", - "min_depth_m", - "most_recent_age_update", + "min_depth_m", + "most_recent_age_update", "most_recent_maturity_update_date_whid", - "most_recent_taxon_update", - "otosag_id", + "most_recent_taxon_update", + "otosag_id", "ovary_id", - "ovary_proportion_atresia", - "partition", - "pass", - "performance", - "program", - "project", - "reason_stn_invalid", - "sex", + "ovary_proportion_atresia", + "partition", + "pass", + "performance", + "program", + "project", + "reason_stn_invalid", + "sex", "species_category", "species_subcategory", - "stomach_id", - "taxon_rank", - "taxon_source", - "tissue_id", + "stomach_id", + "taxon_rank", + "taxon_source", + "tissue_id", "tow", - "trawl_id", - "vessel", - "vessel_id", - "weight_kg", - "width_cm", + "trawl_id", + "vessel", + "vessel_id", + "weight_kg", + "width_cm", "width_type", - "year", - "year_stn_invalid", + "year", + "year_stn_invalid", "lab_maturity_detail_dim$biologically_mature_certain_indicator", "lab_maturity_detail_dim$biologically_mature_indicator" ) @@ -120,9 +119,9 @@ pull_biological_samples <- function(common_name = NULL, "/selection.json?filters=", paste0("project=",paste(strsplit(project_long, " ")[[1]], collapse = "%20")), ",", add_species, - ",year>", years[1], ",year<", years[2], + ",year>", years[1], ",year<", years[2], #",ovary_id>0&", - "&variables=", + "&variables=", glue::glue_collapse(vars_str, sep = ",") ) @@ -130,17 +129,17 @@ pull_biological_samples <- function(common_name = NULL, message("Pulling maturity, stomach, fin clip, and tissue sample data.") } bio_samples <- try(get_json(url = url_text)) - + keep <- which(bio_samples$ovary_id > 0 | bio_samples$stomach_id > 0 | bio_samples$tissue_id > 0 | bio_samples$left_pectoral_fin_id > 0) bio_samples <- bio_samples[keep, ] rename_columns <- which( - colnames(bio_samples) %in% + colnames(bio_samples) %in% c("lab_maturity_detail_dim$biologically_mature_certain_indicator", "lab_maturity_detail_dim$biologically_mature_indicator")) - colnames(bio_samples)[rename_columns] <- + colnames(bio_samples)[rename_columns] <- c("biologically_mature_certain_indicator", "biologically_mature_indicator") diff --git a/R/pull_catch.R b/R/pull_catch.R index fa5b2cf..aa6ecfa 100644 --- a/R/pull_catch.R +++ b/R/pull_catch.R @@ -78,8 +78,7 @@ pull_catch <- function(common_name = NULL, if (is.null(common_name)) { var_name <- "scientific_name" species <- sci_name - } - if (is.null(sci_name)) { + } else { var_name <- "common_name" species <- common_name } From 26f89a96161531d7ef0793cd874ecae259f764e6 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Thu, 4 Apr 2024 06:07:22 -0700 Subject: [PATCH 17/26] refactor: add function to create species string #126 --- R/utilities.R | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) create mode 100644 R/utilities.R diff --git a/R/utilities.R b/R/utilities.R new file mode 100644 index 0000000..3d5beed --- /dev/null +++ b/R/utilities.R @@ -0,0 +1,33 @@ +#' Utility function used throughout the package +#' +#' @details +#' Function that converts a string to a hex string +#' for common name or scientific name when pulling +#' data. This function is used within the pull_* +#' functions that retrive species specific data +#' +#' @param x A string of either common_name or +#' sci_name +#' @author Kelli Johnson +#' +#' @examples +#' \dontrun{ +#' common_name <- c("lingcod", "sablefish", "Pacific cod") +#' convert_to_hex_string(common_name) +#' } +#' +convert_to_hex_string <- function(x) { + hex_comma <- toupper(paste0("%", charToRaw(","))) + hex_quote <- paste0("%", charToRaw('"')) + hex_space <- paste0("%", charToRaw(" ")) + stopifnot(inherits(x, "character")) + + # Convert spaces to %20 + x_no_spaces <- gsub(pattern = " ", replacement = hex_space, x) + + # Wrap each string in quotes with %22 and + # separate strings with %2C, which is a comma + out <- paste0(hex_quote, x_no_spaces, hex_quote, collapse = hex_comma) + + return(out) +} From e949cb4ea6ef470fbebcc9bfd57447f565d9702f Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Thu, 4 Apr 2024 07:33:06 -0700 Subject: [PATCH 18/26] refactor: add function to create species string #126 --- R/pull_bio.R | 7 +------ R/pull_biological_samples.R | 7 +------ R/pull_catch.R | 12 +----------- man/convert_to_hex_string.Rd | 31 +++++++++++++++++++++++++++++++ 4 files changed, 34 insertions(+), 23 deletions(-) create mode 100644 man/convert_to_hex_string.Rd diff --git a/R/pull_bio.R b/R/pull_bio.R index 5b4a01d..331867a 100644 --- a/R/pull_bio.R +++ b/R/pull_bio.R @@ -88,12 +88,7 @@ pull_bio <- function(common_name = NULL, ) # symbols here are generally: %22 = ", %2C = ",", %20 = " " - species_str <- paste0("%22",stringr::str_replace_all(species[1]," ","%20"),"%22") - if(length(species) > 1) { - for(i in 2:length(species)) { - species_str <- paste0(species_str, "%2C", paste0("%22",stringr::str_replace_all(species[i]," ","%20"),"%22")) - } - } + species_str <- convert_to_hex_string(species) add_species <- paste0("field_identified_taxonomy_dim$", var_name, "|=[", species_str,"]") if (any(species == "pull all")) { diff --git a/R/pull_biological_samples.R b/R/pull_biological_samples.R index 2ff81ba..07e0755 100644 --- a/R/pull_biological_samples.R +++ b/R/pull_biological_samples.R @@ -52,12 +52,7 @@ pull_biological_samples <- function(common_name = NULL, } # symbols here are generally: %22 = ", %2C = ",", %20 = " " - species_str <- paste0("%22",stringr::str_replace_all(species[1]," ","%20"),"%22") - if(length(species) > 1) { - for(i in 2:length(species)) { - species_str <- paste0(species_str, "%2C", paste0("%22",stringr::str_replace_all(species[i]," ","%20"),"%22")) - } - } + species_str <- convert_to_hex_string(species) add_species <- paste0("field_identified_taxonomy_dim$", var_name, "|=[", species_str,"]") if (any(species == "pull all")) { diff --git a/R/pull_catch.R b/R/pull_catch.R index aa6ecfa..f0b7956 100644 --- a/R/pull_catch.R +++ b/R/pull_catch.R @@ -115,17 +115,7 @@ pull_catch <- function(common_name = NULL, vars_short <- vars_long[!vars_long %in% perf_codes] # symbols here are generally: %22 = ", %2C = ",", %20 = " " - species_str <- paste0( - "%22",stringr::str_replace_all(species[1]," ","%20"),"%22" - ) - - if(length(species) > 1) { - for(i in 2:length(species)) { - species_str <- paste0( - species_str, "%2C", paste0( - "%22",stringr::str_replace_all(species[i]," ","%20"),"%22")) - } - } + species_str <- convert_to_hex_string(species) add_species <- paste0("field_identified_taxonomy_dim$", var_name, "|=[", species_str,"]") if (any(species == "pull all")) { diff --git a/man/convert_to_hex_string.Rd b/man/convert_to_hex_string.Rd new file mode 100644 index 0000000..9530aba --- /dev/null +++ b/man/convert_to_hex_string.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities.R +\name{convert_to_hex_string} +\alias{convert_to_hex_string} +\title{Utility function used throughout the package} +\usage{ +convert_to_hex_string(x) +} +\arguments{ +\item{x}{A string of either common_name or +sci_name} +} +\description{ +Utility function used throughout the package +} +\details{ +Function that converts a string to a hex string +for common name or scientific name when pulling +data. This function is used within the pull_* +functions that retrive species specific data +} +\examples{ +\dontrun{ +common_name <- c("lingcod", "sablefish", "Pacific cod") +convert_to_hex_string(common_name) +} + +} +\author{ +Kelli Johnson +} From 90367b6e6d8cc4464ff634fe9b97dcfc7b694bc4 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Fri, 5 Apr 2024 09:05:16 -0700 Subject: [PATCH 19/26] fix: combine all and positive tows for multi-species --- R/pull_catch.R | 74 +++++++++++++++++++++++++++++++------------------- 1 file changed, 46 insertions(+), 28 deletions(-) diff --git a/R/pull_catch.R b/R/pull_catch.R index f0b7956..0ce63ad 100644 --- a/R/pull_catch.R +++ b/R/pull_catch.R @@ -158,6 +158,11 @@ pull_catch <- function(common_name = NULL, positive_tows <- positive_tows[good_tows, ] positive_tows <- positive_tows[, vars_short] + if(sum(is.na(positive_tows[, "common_name"])) > 0) { + replace <- which(is.na(positive_tows[, "common_name"])) + positive_tows[replace, "common_name"] <- positive_tows[replace, "scientific_name"] + } + # Pull all tow data including tows where the species was not observed vars_long <- c("project", "year", "vessel", "pass", "tow", "datetime_utc_iso", "depth_m", "longitude_dd", "latitude_dd", "area_swept_ha_der", @@ -183,39 +188,52 @@ pull_catch <- function(common_name = NULL, all_tows <- all_tows[ !duplicated(paste(all_tows$year, all_tows$pass, all_tows$vessel, all_tows$tow)), - c("project", "trawl_id", "year", "pass", "vessel", "tow", "datetime_utc_iso", "depth_m", - "longitude_dd", "latitude_dd", "area_swept_ha_der" - ) + #c("project", "trawl_id", "year", "pass", "vessel", "tow", "datetime_utc_iso", "depth_m", + # "longitude_dd", "latitude_dd", "area_swept_ha_der" + #) ] - # Link each data set together based on trawl_id - grid <- expand.grid( - "trawl_id" = unique(all_tows$trawl_id), - "common_name" = unique(positive_tows$common_name), - stringsAsFactors = FALSE + positive_tows_grouped <- dplyr::group_by( + .data = positive_tows, + common_name, scientific_name ) + # Split positive_tows into 1 data frame for each combination of common_name + # and scientific_name and store in a named list for purrr::map() + positive_tows_split <- dplyr::group_split(positive_tows_grouped) + group_names <- dplyr::group_keys(positive_tows_grouped) + names(positive_tows_split) <- tidyr::unite(group_names, col = "groups") |> + dplyr::pull(groups) + + # For each data frame in the large list, find the tows that are not present + # in positive_tows and join them into a single data frame + # Give them the appropriate common and scientific names using .id then split + # the concatenated column out into the two original columns + names_intersect <- intersect(colnames(all_tows), colnames(positive_tows)) + zero_tows <- purrr::map_df( + .x = positive_tows_split, + .f = \(y) dplyr::anti_join(x = all_tows, y = y, by = names_intersect), + .id = "groups" + ) |> + tidyr::separate_wider_delim( + cols = "groups", + delim = "_", + names = colnames(group_names) + ) - catch_data <- dplyr::left_join( - grid, - all_tows, - by = intersect(colnames(grid), colnames(all_tows)), - multiple = "all" + # Join the positive tows with the tow information + positive_tows_with_tow_info <- dplyr::left_join( + x = positive_tows, + y = all_tows, + by = intersect(colnames(all_tows), colnames(positive_tows)) ) - catch <- dplyr::left_join( - catch_data, - positive_tows, - by = intersect(colnames(catch_data), colnames(positive_tows)), - multiple = "all" - ) - - # Fill in the scientific name for tows with 0 catch by species - # could not find a way to do this via tidyr::complete - if (sum(is.na(catch[, "scientific_name"])) > 0) { - for(cn in unique(catch[, "common_name"])){ - add_name <- unique(catch[which(catch$common_name == cn & !is.na(catch$scientific_name)), "scientific_name"]) - catch[which(catch$common_name == cn), "scientific_name"] <- add_name - } - } + # Join the augmented positive tow information with the zero tows + # arrange by common_name and tow_id + catch <- dplyr::full_join( + x = positive_tows_with_tow_info, + y = zero_tows, + by = c(colnames(group_names), colnames(all_tows)) + ) |> + dplyr::arrange(common_name, trawl_id) # Need to check what this is doing no_area <- which(is.na(catch$area_swept_ha_der)) From 33668a39c9e74422f01bb6ce90d7982751ca973e Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Fri, 5 Apr 2024 09:09:03 -0700 Subject: [PATCH 20/26] update test based on fixed multi-species catch pull --- tests/testthat/test-data.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-data.R b/tests/testthat/test-data.R index 7478309..7868526 100644 --- a/tests/testthat/test-data.R +++ b/tests/testthat/test-data.R @@ -28,8 +28,8 @@ test_that("pull_catch-multispecies", { verbose = TRUE ) expect_is(dat, "data.frame") - expect_equal(nrow(dat), 350126) - expect_equal(length(which(dat$cpue_kg_km2 == 0)), 330971) + expect_equal(nrow(dat), 392705) + expect_equal(length(which(dat$cpue_kg_km2 == 0)), 373550) dat_lingcod <- pull_catch( common_name = "lingcod", From 8bc2143d8917b1b0ea35ba51199307383ae1e519 Mon Sep 17 00:00:00 2001 From: kellijohnson-NOAA Date: Thu, 18 Apr 2024 06:33:53 -0700 Subject: [PATCH 21/26] Adds test for combo of sci and common --- tests/testthat/test-data.R | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/tests/testthat/test-data.R b/tests/testthat/test-data.R index 7868526..7fbffdf 100644 --- a/tests/testthat/test-data.R +++ b/tests/testthat/test-data.R @@ -55,6 +55,16 @@ test_that("pull_catch-multispecies", { label = "entries of 2 species filtered for lingcod", expected.label = "entries of lingcod" ) + dat_lingcod_anoplopoma <- pull_catch( + common_name = "lingcod", + sci_name = "Anoplopoma fimbria", + survey = "NWFSC.Combo", + years = 2017 + ) + expect_equal( + NROW(dat_lingcod_sablefish), + NROW(dat_lingcod_anoplopoma) + ) }) test_that("PullHaul", { From 582206eb005386968c63b28199ca12c2d54ec125 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Thu, 18 Apr 2024 09:28:04 -0700 Subject: [PATCH 22/26] refactor: improve error message when no data returned --- R/get_json.R | 17 ++++++++++++----- R/pull_catch.R | 6 ++---- 2 files changed, 14 insertions(+), 9 deletions(-) diff --git a/R/get_json.R b/R/get_json.R index b04b637..3e165b0 100644 --- a/R/get_json.R +++ b/R/get_json.R @@ -3,7 +3,7 @@ #' Get information stored on the web in .json format using a URL. The content #' is first pulled from the web as text with UTF-8 encoding. Then the text #' is passed to [jsonlite::fromJSON()]. This workflow ensures that the URL -#' is not mistaken for a file name rather than web content. +#' is not mistaken for a file name rather than web content. #' #' @param url A string containing a valid URL to pull the data from the data #' warehouse. @@ -12,14 +12,21 @@ #' @export #' @return A data frame. #' @seealso See all the `pull_*` functions for examples where this function is -#' used, e.g., [pull_catch()]. +#' used, e.g., [pull_catch()]. #' get_json <- function(url) { - out <- httr::GET(url) %>% - httr::content(as = "text", encoding = "UTF-8") %>% + + out <- httr::GET(url) |> + httr::content(as = "text", encoding = "UTF-8") |> jsonlite::fromJSON() + if (!(is.data.frame(out) && NROW(out) > 0)) { - stop(glue::glue("No data returned by the warehouse using {url}")) + stop(glue::glue( + "\n No data returned by the warehouse for the filters given. + \n Make sure the year range is correct for the project selected and the input name is correct, + \n otherwise there may be no data for this species from this project. + URL: {url}") + ) } return(out) } diff --git a/R/pull_catch.R b/R/pull_catch.R index 0ce63ad..ffe4d9e 100644 --- a/R/pull_catch.R +++ b/R/pull_catch.R @@ -134,10 +134,8 @@ pull_catch <- function(common_name = NULL, # Pull data from positive tows for selected species positive_tows <- try(get_json(url = url_text)) - if (!is.data.frame(positive_tows)) { - stop(cat("\nNo data returned by the warehouse for the filters given. - \n Make sure the year range is correct for the project selected and the input name is correct, - \n otherwise there may be no data for this species from this project.\n")) + if(!is.data.frame(positive_tows)){ + stop() } # Remove water hauls From 3ed55824212b69d874e3677b5e6beb679da0ce04 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Thu, 18 Apr 2024 09:48:46 -0700 Subject: [PATCH 23/26] refactor: add checks for passed names, clarify years, and require survey 1. Add check and error message when both the common_name and sci_name are provided. 2. Add to documentation that -Inf and Inf cannot be used in the years vector. 3. Remove the NULL from the survey input requiring users to specify a survey. --- R/get_json.R | 4 ++-- R/pull_bio.R | 10 ++++++++-- R/pull_biological_samples.R | 5 +++++ R/pull_catch.R | 9 +++++++-- R/pull_haul.R | 4 ++-- man-roxygen/survey.R | 24 ++++++++++++------------ man-roxygen/years.R | 3 ++- 7 files changed, 38 insertions(+), 21 deletions(-) diff --git a/R/get_json.R b/R/get_json.R index 3e165b0..7c860e0 100644 --- a/R/get_json.R +++ b/R/get_json.R @@ -23,8 +23,8 @@ get_json <- function(url) { if (!(is.data.frame(out) && NROW(out) > 0)) { stop(glue::glue( "\n No data returned by the warehouse for the filters given. - \n Make sure the year range is correct for the project selected and the input name is correct, - \n otherwise there may be no data for this species from this project. + \n Make sure the year range is correct (cannot include -Inf or Inf) for the project selected and the input name is correct, + \n otherwise there may be no data for this species from this project.\n URL: {url}") ) } diff --git a/R/pull_bio.R b/R/pull_bio.R index 331867a..5eb359e 100644 --- a/R/pull_bio.R +++ b/R/pull_bio.R @@ -40,8 +40,8 @@ #' pull_bio <- function(common_name = NULL, sci_name = NULL, - years = c(1980, 2050), - survey = NULL, + years = c(1970, 2050), + survey, dir = NULL, convert = TRUE, verbose = TRUE) { @@ -53,6 +53,12 @@ pull_bio <- function(common_name = NULL, "\nContact John Harms (john.harms@noaa.gov) for the full data set.") } + if(length(c(common_name, sci_name)) != max(c(length(common_name), length(sci_name)))){ + stop("Can not pull data using both the common_name or sci_name together. + \n Please retry using only one." ) + } + + check_dir(dir = dir, verbose = verbose) if (is.null(common_name)) { diff --git a/R/pull_biological_samples.R b/R/pull_biological_samples.R index 07e0755..4936cba 100644 --- a/R/pull_biological_samples.R +++ b/R/pull_biological_samples.R @@ -31,6 +31,11 @@ pull_biological_samples <- function(common_name = NULL, # increase the timeout period to avoid errors when pulling data options(timeout = 4000000) + if(length(c(common_name, sci_name)) != max(c(length(common_name), length(sci_name)))){ + stop("Can not pull data using both the common_name or sci_name together. + \n Please retry using only one." ) + } + check_dir(dir = dir, verbose = verbose) project_long <- check_survey(survey = survey) diff --git a/R/pull_catch.R b/R/pull_catch.R index ffe4d9e..1d00e4b 100644 --- a/R/pull_catch.R +++ b/R/pull_catch.R @@ -61,8 +61,8 @@ #' pull_catch <- function(common_name = NULL, sci_name = NULL, - years = c(1980, 2050), - survey = NULL, + years = c(1970, 2050), + survey, dir = NULL, convert = TRUE, verbose = TRUE) { @@ -73,6 +73,11 @@ pull_catch <- function(common_name = NULL, "\nContact John Harms (john.harms@noaa.gov) for the full data set.") } + if(length(c(common_name, sci_name)) != max(c(length(common_name), length(sci_name)))){ + stop("Can not pull data using both the common_name or sci_name together. + \n Please retry using only one." ) + } + check_dir(dir = dir, verbose = verbose) if (is.null(common_name)) { diff --git a/R/pull_haul.R b/R/pull_haul.R index 15d0391..4c29222 100644 --- a/R/pull_haul.R +++ b/R/pull_haul.R @@ -19,8 +19,8 @@ #' haul_data <- pull_haul() #' } #' -pull_haul <- function(years= c(1980, 2050), - survey = NULL, +pull_haul <- function(years= c(1970, 2050), + survey, dir = NULL, verbose = TRUE) { diff --git a/man-roxygen/survey.R b/man-roxygen/survey.R index c8ea461..2f4c0ec 100644 --- a/man-roxygen/survey.R +++ b/man-roxygen/survey.R @@ -11,23 +11,23 @@ #' * NWFSC.Hook.Line (not yet working), #' * NWFSC.Video, #' * Triennial.Canada -#' +#' #' The National Marine Fishery Service Alaska Fisheries Science Center (AFSC) #' Triennial survey was conducted between 1977 - 2004 occurring every 3rd year. -#' The initial year, 1977, survey is not traditionally used in calculating -#' indices of abundance. The Triennial survey sampled areas within the Canadian -#' EEZ on the West Coast of Vancouver Island in 1980 - 2001 but these data are +#' The initial year, 1977, survey is not traditionally used in calculating +#' indices of abundance. The Triennial survey sampled areas within the Canadian +#' EEZ on the West Coast of Vancouver Island in 1980 - 2001 but these data are #' associated with a different survey name "Triennial.Canada". -#' The AFSC Slope Survey (AFSC.Slope) along the west coast of the U.S. began in 1984 and occurred -#' annually from 1988-2001, with the exception of 1994 and 1998, when surveys were not conducted. -#' Prior to 1997, only a limited portion of the coast was covered in each year. -#' U.S. West Coast groundfish stock assessments only use the four years of consistent +#' The AFSC Slope Survey (AFSC.Slope) along the west coast of the U.S. began in 1984 and occurred +#' annually from 1988-2001, with the exception of 1994 and 1998, when surveys were not conducted. +#' Prior to 1997, only a limited portion of the coast was covered in each year. +#' U.S. West Coast groundfish stock assessments only use the four years of consistent #' and complete survey coverage (1997, 1999-2001). The Northwest Fisheries Science -#' Center (NWFSC) Slope survey (NWFSC.Slope) was conducted between 1998 - 2001. -#' The NWFSC West Coast Groundfish Bottom Trawl survey (NWFSC.Combo) is conducted +#' Center (NWFSC) Slope survey (NWFSC.Slope) was conducted between 1998 - 2001. +#' The NWFSC West Coast Groundfish Bottom Trawl survey (NWFSC.Combo) is conducted #' annualy starting in 2003 (excluding 2020) and samples both the U.S. west coast -#' shelf and slope between 55 - 1,280 meters. +#' shelf and slope between 55 - 1,280 meters. #' Data can only be pulled from one survey at a time, though we are working on #' allowing for a vector of survey names. #' Currently, `NWFSC.Shelf.Rockfish` and `NWFSC.Hook.Line` are not supported. -#' The default of `NULL` is a placeholder that must be replaced with an entry. + diff --git a/man-roxygen/years.R b/man-roxygen/years.R index ea4fe00..2a7540f 100644 --- a/man-roxygen/years.R +++ b/man-roxygen/years.R @@ -1,2 +1,3 @@ #' @param years An integer vector of length two with the -#' range of years to pull data for. +#' range of years to pull data for (e.g., c(2003, 2024)). +#' Vector can not contain -Inf or Inf. From 04c04ba6411ba3b9875a9ddc694447c68f324993 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Thu, 18 Apr 2024 09:48:59 -0700 Subject: [PATCH 24/26] remove test --- tests/testthat/test-data.R | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/tests/testthat/test-data.R b/tests/testthat/test-data.R index 7fbffdf..7868526 100644 --- a/tests/testthat/test-data.R +++ b/tests/testthat/test-data.R @@ -55,16 +55,6 @@ test_that("pull_catch-multispecies", { label = "entries of 2 species filtered for lingcod", expected.label = "entries of lingcod" ) - dat_lingcod_anoplopoma <- pull_catch( - common_name = "lingcod", - sci_name = "Anoplopoma fimbria", - survey = "NWFSC.Combo", - years = 2017 - ) - expect_equal( - NROW(dat_lingcod_sablefish), - NROW(dat_lingcod_anoplopoma) - ) }) test_that("PullHaul", { From 7a4951275c3cc89c097446b9f4153667cc9ce056 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Thu, 18 Apr 2024 10:01:54 -0700 Subject: [PATCH 25/26] documentation --- man/check_survey.Rd | 3 +-- man/get_url.Rd | 3 ++- man/pull_bio.Rd | 10 +++++----- man/pull_biological_samples.Rd | 6 +++--- man/pull_catch.Rd | 10 +++++----- man/pull_gemm.Rd | 3 ++- man/pull_haul.Rd | 8 ++++---- 7 files changed, 22 insertions(+), 21 deletions(-) diff --git a/man/check_survey.Rd b/man/check_survey.Rd index 6f7b0d2..0f91caa 100644 --- a/man/check_survey.Rd +++ b/man/check_survey.Rd @@ -40,8 +40,7 @@ annualy starting in 2003 (excluding 2020) and samples both the U.S. west coast shelf and slope between 55 - 1,280 meters. Data can only be pulled from one survey at a time, though we are working on allowing for a vector of survey names. -Currently, \code{NWFSC.Shelf.Rockfish} and \code{NWFSC.Hook.Line} are not supported. -The default of \code{NULL} is a placeholder that must be replaced with an entry.} +Currently, \code{NWFSC.Shelf.Rockfish} and \code{NWFSC.Hook.Line} are not supported.} } \description{ Check and create survey string diff --git a/man/get_url.Rd b/man/get_url.Rd index 32269bb..8d1309e 100644 --- a/man/get_url.Rd +++ b/man/get_url.Rd @@ -16,7 +16,8 @@ trawl.catch_fact, trawl.operation_haul_fact} functions.} \item{years}{An integer vector of length two with the -range of years to pull data for.} +range of years to pull data for (e.g., c(2003, 2024)). +Vector can not contain -Inf or Inf.} \item{vars_long}{string of fields to pull from the data warehouse} } diff --git a/man/pull_bio.Rd b/man/pull_bio.Rd index 352dbaa..4d99df5 100644 --- a/man/pull_bio.Rd +++ b/man/pull_bio.Rd @@ -10,8 +10,8 @@ In order to pull all species leave common_name or sci_name as NULL} pull_bio( common_name = NULL, sci_name = NULL, - years = c(1980, 2050), - survey = NULL, + years = c(1970, 2050), + survey, dir = NULL, convert = TRUE, verbose = TRUE @@ -33,7 +33,8 @@ e.g., vermilion rockfish (see the example below). Use the \code{common_name} argument if you know the common name.} \item{years}{An integer vector of length two with the -range of years to pull data for.} +range of years to pull data for (e.g., c(2003, 2024)). +Vector can not contain -Inf or Inf.} \item{survey}{A character entry from one of the following options that specifies which survey to pull the data for. The input options are: @@ -68,8 +69,7 @@ annualy starting in 2003 (excluding 2020) and samples both the U.S. west coast shelf and slope between 55 - 1,280 meters. Data can only be pulled from one survey at a time, though we are working on allowing for a vector of survey names. -Currently, \code{NWFSC.Shelf.Rockfish} and \code{NWFSC.Hook.Line} are not supported. -The default of \code{NULL} is a placeholder that must be replaced with an entry.} +Currently, \code{NWFSC.Shelf.Rockfish} and \code{NWFSC.Hook.Line} are not supported.} \item{dir}{directory where ouptut will be saved. The directory where the file should be saved. If dir = NULL no output will be saved.} diff --git a/man/pull_biological_samples.Rd b/man/pull_biological_samples.Rd index 4206054..7900d80 100644 --- a/man/pull_biological_samples.Rd +++ b/man/pull_biological_samples.Rd @@ -35,7 +35,8 @@ e.g., vermilion rockfish (see the example below). Use the \code{common_name} argument if you know the common name.} \item{years}{An integer vector of length two with the -range of years to pull data for.} +range of years to pull data for (e.g., c(2003, 2024)). +Vector can not contain -Inf or Inf.} \item{survey}{A character entry from one of the following options that specifies which survey to pull the data for. The input options are: @@ -70,8 +71,7 @@ annualy starting in 2003 (excluding 2020) and samples both the U.S. west coast shelf and slope between 55 - 1,280 meters. Data can only be pulled from one survey at a time, though we are working on allowing for a vector of survey names. -Currently, \code{NWFSC.Shelf.Rockfish} and \code{NWFSC.Hook.Line} are not supported. -The default of \code{NULL} is a placeholder that must be replaced with an entry.} +Currently, \code{NWFSC.Shelf.Rockfish} and \code{NWFSC.Hook.Line} are not supported.} \item{dir}{directory where ouptut will be saved. The directory where the file should be saved. If dir = NULL no output will be saved.} diff --git a/man/pull_catch.Rd b/man/pull_catch.Rd index ed849eb..be004ec 100644 --- a/man/pull_catch.Rd +++ b/man/pull_catch.Rd @@ -7,8 +7,8 @@ pull_catch( common_name = NULL, sci_name = NULL, - years = c(1980, 2050), - survey = NULL, + years = c(1970, 2050), + survey, dir = NULL, convert = TRUE, verbose = TRUE @@ -30,7 +30,8 @@ e.g., vermilion rockfish (see the example below). Use the \code{common_name} argument if you know the common name.} \item{years}{An integer vector of length two with the -range of years to pull data for.} +range of years to pull data for (e.g., c(2003, 2024)). +Vector can not contain -Inf or Inf.} \item{survey}{A character entry from one of the following options that specifies which survey to pull the data for. The input options are: @@ -65,8 +66,7 @@ annualy starting in 2003 (excluding 2020) and samples both the U.S. west coast shelf and slope between 55 - 1,280 meters. Data can only be pulled from one survey at a time, though we are working on allowing for a vector of survey names. -Currently, \code{NWFSC.Shelf.Rockfish} and \code{NWFSC.Hook.Line} are not supported. -The default of \code{NULL} is a placeholder that must be replaced with an entry.} +Currently, \code{NWFSC.Shelf.Rockfish} and \code{NWFSC.Hook.Line} are not supported.} \item{dir}{directory where ouptut will be saved. The directory where the file should be saved. If dir = NULL no output will be saved.} diff --git a/man/pull_gemm.Rd b/man/pull_gemm.Rd index f187cf0..13612eb 100644 --- a/man/pull_gemm.Rd +++ b/man/pull_gemm.Rd @@ -23,7 +23,8 @@ e.g., vermilion rockfish (see the example below). Use the \code{sci_name} argument if you know the latin name.} \item{years}{An integer vector of length two with the -range of years to pull data for.} +range of years to pull data for (e.g., c(2003, 2024)). +Vector can not contain -Inf or Inf.} \item{dir}{directory where ouptut will be saved. The directory where the file should be saved. If dir = NULL no output will be saved.} diff --git a/man/pull_haul.Rd b/man/pull_haul.Rd index f773048..741d098 100644 --- a/man/pull_haul.Rd +++ b/man/pull_haul.Rd @@ -6,11 +6,12 @@ The website is: https://www.webapps.nwfsc.noaa.gov/data. This function can be used to pull haul data and associated covariates.} \usage{ -pull_haul(years = c(1980, 2050), survey = NULL, dir = NULL, verbose = TRUE) +pull_haul(years = c(1970, 2050), survey, dir = NULL, verbose = TRUE) } \arguments{ \item{years}{An integer vector of length two with the -range of years to pull data for.} +range of years to pull data for (e.g., c(2003, 2024)). +Vector can not contain -Inf or Inf.} \item{survey}{A character entry from one of the following options that specifies which survey to pull the data for. The input options are: @@ -45,8 +46,7 @@ annualy starting in 2003 (excluding 2020) and samples both the U.S. west coast shelf and slope between 55 - 1,280 meters. Data can only be pulled from one survey at a time, though we are working on allowing for a vector of survey names. -Currently, \code{NWFSC.Shelf.Rockfish} and \code{NWFSC.Hook.Line} are not supported. -The default of \code{NULL} is a placeholder that must be replaced with an entry.} +Currently, \code{NWFSC.Shelf.Rockfish} and \code{NWFSC.Hook.Line} are not supported.} \item{dir}{directory where ouptut will be saved. The directory where the file should be saved. If dir = NULL no output will be saved.} From c630ed7a3b46f9efc69220536acfee57ef470a5e Mon Sep 17 00:00:00 2001 From: kellijohnson-NOAA Date: Thu, 18 Apr 2024 12:25:21 -0700 Subject: [PATCH 26/26] doc: Fix typo in details of pull_catch() --- R/pull_catch.R | 2 +- man/pull_catch.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/pull_catch.R b/R/pull_catch.R index 1d00e4b..80bfc25 100644 --- a/R/pull_catch.R +++ b/R/pull_catch.R @@ -6,7 +6,7 @@ #' by leaving both `common_name = NULL` and `sci_name = NULL`. #' #' @details -#' The data available in the warehouse are cleaned pior to being downloaded +#' The data available in the warehouse are cleaned prior to being downloaded #' with the intent that they provide the best available information for use #' in an index-standardization procedure. The removed samples may be of use #' to others with a less-restrictive goal than producing an index of abundance. diff --git a/man/pull_catch.Rd b/man/pull_catch.Rd index be004ec..8b95eda 100644 --- a/man/pull_catch.Rd +++ b/man/pull_catch.Rd @@ -84,7 +84,7 @@ for a single species or all observed species, where the latter is specified by leaving both \code{common_name = NULL} and \code{sci_name = NULL}. } \details{ -The data available in the warehouse are cleaned pior to being downloaded +The data available in the warehouse are cleaned prior to being downloaded with the intent that they provide the best available information for use in an index-standardization procedure. The removed samples may be of use to others with a less-restrictive goal than producing an index of abundance.