Add the get_all_* functions (#23)

* return species code with length types to allow for use with multi spp calls

* new get_all* functions and all supporting code

* document new functions

* untested draft light-weight comparison functions and example script

* updated with load_all() and subfolders

* updated with missing package::

* get all vignette

* fix bug in comparison functions

* vignette edits

* fixed precautionary object resets

* make remove duplicates the default for get_all_survey_sets

* move the dropping of all zeros and make it optional

* update default args

* vignette formatting

* draft version flexible to argument changes

* working for any argument and using function defaults when not provided

* and grouping_area_km2 to event data returned for both functions

* functionize area swept calc

* minor clean up/style

* vignette edits from LR and add design-based section

* fix error in compare samples function; make both compare functions robust to Null results

* more vignette edits

* better way of checking for gear type differences

* more vignette edits

* minor vignette and comparison edits

* more minor edits

* more vignette edits

* fix problem with missing sublevel data for ssid 14--now only gets sublevel data for events with gear differences

* update vignette to match change in when skate level data is returned

* add warning in case situations arise where skate-level counts are inconsistent with counts for events with gear differences

* minor fixes to last change

* for samples, add checks to make sure counts are coming in currectly when at the set level

* more vignette edits

* fix for edge case of missing sub level id for some gear comparision specimens

* tiny edit

* Improve messages to include the filtering options used.

* document and fixes for passing devtools::check

* better message placement; filter ssid 0 when a duplication of data from other ssid

* minor vignette edits

* more minor edits

* fixing vignette check issues

* precompile option for get-all vignette

* update ignore and precompiled version

* test commit

* implement precompile option for orginal vignette

* document

* buildignore knitr-cache

---------

Co-authored-by: Rogers <Luke.Rogers@dfo-mpo.gc.ca>

.Rbuildignore

@@ -4,3 +4,5 @@
 ^NEWS\.md$
 ^\.github$
 ^data-raw$
+^vignettes/get-all-cache
+^vignettes/knitr-cache

DESCRIPTION

@@ -24,7 +24,7 @@ Imports:
   tibble,
   tidyr,
   rlang
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Suggests:
     usethis,
     testthat,

NAMESPACE

@@ -6,6 +6,8 @@ export(get_active_survey_blocks)
 export(get_age_methods)
 export(get_age_precision)
 export(get_all_stomachs)
+export(get_all_survey_samples)
+export(get_all_survey_sets)
 export(get_catch)
 export(get_catch_spatial)
 export(get_comm_gear_types)
@@ -58,6 +60,7 @@ importFrom(dplyr,as_tibble)
 importFrom(dplyr,bind_rows)
 importFrom(dplyr,case_when)
 importFrom(dplyr,contains)
+importFrom(dplyr,distinct)
 importFrom(dplyr,filter)
 importFrom(dplyr,full_join)
 importFrom(dplyr,group_by)
@@ -66,12 +69,15 @@ importFrom(dplyr,left_join)
 importFrom(dplyr,mutate)
 importFrom(dplyr,n)
 importFrom(dplyr,pull)
+importFrom(dplyr,relocate)
 importFrom(dplyr,rename)
 importFrom(dplyr,right_join)
 importFrom(dplyr,select)
 importFrom(dplyr,semi_join)
 importFrom(dplyr,summarise)
 importFrom(dplyr,tibble)
 importFrom(dplyr,ungroup)
+importFrom(dplyr,where)
 importFrom(magrittr,"%>%")
 importFrom(rlang,.data)
+importFrom(stats,na.omit)

R/correct-ssids.R

@@ -0,0 +1,35 @@
+#' Custom fixes for problem surveys with shared trip ids resulting in assignment to wrong ssid
+#'
+#' @param dat df containing these columns: fishing_event_ids, survey_series_id, survey_id,
+#'  major_stat_area_code, minor_stat_area_code
+#' @param specimens Defaults to FALSE where checks for duplication of fishing_event_ids
+#'
+correct_ssids <- function(dat, specimens = FALSE) {
+  try(dat[dat$survey_series_id %in% c(6, 7), ]$survey_id <- NA, silent = TRUE)
+  try(dat[((dat$survey_series_id == 6 & dat$major_stat_area_code %in% c("03", "04"))), ]$survey_series_id <- 7, silent = TRUE)
+  try(dat[((dat$survey_series_id == 7 & dat$major_stat_area_code %in% c("05", "06"))), ]$survey_series_id <- 6, silent = TRUE)
+  try(dat[((dat$survey_series_og == 6 & dat$major_stat_area_code %in% c("03", "04"))), ]$survey_series_og <- 7, silent = TRUE)
+  try(dat[((dat$survey_series_og == 7 & dat$major_stat_area_code %in% c("05", "06"))), ]$survey_series_og <- 6, silent = TRUE)
+
+  # SABLE doesn't work with SSIDs, use reason_desc and or grouping codes instead?
+  try(dat[dat$survey_series_id %in% c(35, 41, 42, 43), ]$survey_id <- NA, silent = TRUE) # this throws a warning when others don't
+  try(dat[dat$survey_series_id %in% c(35, 41, 42, 43), ]$survey_series_id <- 35, silent = TRUE)
+  try(dat[dat$survey_series_og %in% c(35, 41, 42, 43), ]$survey_series_og <- 35, silent = TRUE)
+  # try(dat[ ((dat$survey_series_id %in% c(35, 41, 42, 43) & dat$reason_desc == "EXPLORATORY")), ]$survey_series_id <- 35, silent = TRUE)
+  # try(dat[ ((dat$survey_series_id %in% c(35, 41, 42, 43) & dat$reason_desc == "SABLEFISH STANDARDIZED OFFSHORE SURVEY")), ]$survey_series_id <- 42, silent = TRUE)
+
+  # Jig surveys are split into too many separate survey series, so we'll assume all were assigned correctly and drop everything that doesn't match
+  dat <- dat[(!(dat$survey_series_id == 82 & !(dat$minor_stat_area_code %in% c("12")))), ]
+  dat <- dat[(!(dat$survey_series_id == 83 & !(dat$minor_stat_area_code %in% c("13")))), ]
+  dat <- dat[(!(dat$survey_series_id == 84 & !(dat$minor_stat_area_code %in% c("15")))), ]
+  dat <- dat[(!(dat$survey_series_id == 85 & !(dat$minor_stat_area_code %in% c("16")))), ]
+  dat <- dat[(!(dat$survey_series_id == 86 & !(dat$minor_stat_area_code %in% c("18")))), ]
+  dat <- dat[(!(dat$survey_series_id == 87 & !(dat$minor_stat_area_code %in% c("19")))), ]
+
+  # for IPHC station specific ssids, drop everything that doesn't match
+  dat <- dat[(!(dat$survey_series_id == 17 & !(dat$minor_stat_area_code %in% c("3")))), ] # 3CD
+  dat <- dat[(!(dat$survey_series_id == 18 & !(dat$minor_stat_area_code %in% c("6")))), ] # 5AB
+  dat <- dat[(!(dat$survey_series_id == 19 & !(dat$minor_stat_area_code %in% c("7")))), ] # 5CD
+
+  dat |> dplyr::distinct()
+}