Modify project to read in any assessment data from the GitHub

hake-assessment repository
* Working towards no more local CSV files and update to 2024 RDS structure

DESCRIPTION

@@ -26,6 +26,7 @@ Imports:
     gfutilities,
     gridExtra,
     here,
+    httr,
     kableExtra,
     knitr,
     PNWColors,
@@ -56,6 +57,4 @@ ByteCompile: true
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.1.1
-
-
+RoxygenNote: 7.2.3

NAMESPACE

@@ -2,7 +2,6 @@
 
 export(apply_hcr_om)
 export(calc_catch_seas_country)
-export(calc_mcmc)
 export(calc_mean_age)
 export(calc_quantiles)
 export(calc_quantiles_by_group)
@@ -20,13 +19,13 @@ export(conv_d)
 export(conv_p)
 export(conv_vec_to_mse_df)
 export(create_plot_objects)
-export(create_rds_file)
 export(create_tmb_data)
 export(extract_age_comp_data)
 export(extract_age_comps)
 export(extract_catch_country)
 export(extract_initial_values)
 export(fetch_extra_mcmc)
+export(files_exist)
 export(get_age_dat)
 export(get_args)
 export(get_em_outputs)
@@ -101,7 +100,6 @@ importFrom(dplyr,lag)
 importFrom(dplyr,lead)
 importFrom(dplyr,left_join)
 importFrom(dplyr,mutate)
-importFrom(dplyr,mutate_all)
 importFrom(dplyr,mutate_at)
 importFrom(dplyr,n)
 importFrom(dplyr,pull)
@@ -161,6 +159,7 @@ importFrom(graphics,points)
 importFrom(graphics,polygon)
 importFrom(grid,grid.draw)
 importFrom(here,here)
+importFrom(httr,HEAD)
 importFrom(kableExtra,add_header_above)
 importFrom(kableExtra,collapse_rows)
 importFrom(kableExtra,kable_styling)
@@ -180,7 +179,6 @@ importFrom(purrr,partial)
 importFrom(purrr,set_names)
 importFrom(r4ss,SS_output)
 importFrom(r4ss,SS_readdat)
-importFrom(r4ss,SSgetMCMC)
 importFrom(readr,col_double)
 importFrom(readr,cols)
 importFrom(readr,read_csv)
@@ -210,7 +208,6 @@ importFrom(tictoc,toc)
 importFrom(tidyr,complete)
 importFrom(tidyselect,contains)
 importFrom(tidyselect,matches)
-importFrom(tidyselect,starts_with)
 importFrom(utils,read.csv)
 importFrom(utils,read.table)
 importFrom(utils,tail)

R/calc_catch_seas_country.R

@@ -49,7 +49,9 @@ calc_catch_seas_country <- function(data_csv_dir = NULL,
           red(paste0("The data file ", fn, " does not exist.\n")))
       return(NULL)
     }
-    read_csv(fn, col_types = cols())
+    k <- read_csv(fn, col_types = cols())
+browser()
+    k
   }
   fns_can <- list("can-ft-catch-by-month.csv",
                   "can-ss-catch-by-month.csv")
@@ -63,7 +65,7 @@ calc_catch_seas_country <- function(data_csv_dir = NULL,
     summarize_all(sum) %>%
     ungroup()
   df_can <- helper(df_can)
-
+browser()
   # USA data is in long format, so use dcast() first to make it the same as the Canadian data
   df_usa <- map(fns_usa, helper_load_file) %>%
     map_dfr(~{.x}) %>%

R/extract_catch_country.R

@@ -1,42 +1,43 @@
 #' Extract the catch by country using the assessment landings file
 #'
-#' @param data_csv_dir The directory in which the assessment csv files containing catch by month are located
+#' @param ss_model_data_csv_dir The directory in which the assessment csv
+#' files containing catch by month are located. Can be a URL
+#' @param ... Ansorbs arguments meant for other functions
 #'
 #' @return A data frame with three columns, the year, the Canadian catch and the US catch
 #' @export
 #' @importFrom readr read_csv
-extract_catch_country <- function(data_csv_dir = NULL){
+extract_catch_country <- function(ss_model_data_csv_dir = NULL,
+                                  ...){
 
-  fn <- file.path(data_csv_dir, "landings-tac-history.csv")
-  if(!file.exists(fn)){
+  fn <- file.path(ss_model_data_csv_dir, "landings-tac-history.csv")
+
+  if(!files_exist(fn)){
     cat(red(symbol$cross),
-        red(paste0("The data file ", fn, " does not exist. catch_country object is NULL\n")))
+        red(paste0("The data file:\n`", fn, "`\n does not exist. ",
+                   "`catch_country` object is NULL")))
     return(NULL)
   }
   d <- read_csv(fn, col_types = cols())
 
-  can <- d %>%
-    select(Year, CAN_forgn, CAN_JV, CAN_Shoreside) %>%
-    mutate(can = CAN_forgn + CAN_JV + CAN_Shoreside) %>%
+  can <- d |>
+    mutate(can = `Canada Foreign` +
+             `Canada Joint-venture` +
+             `Canada Shoreside` +
+             `Canada Freezer-trawler`) |>
     select(year = Year, can)
-  usa <- d %>%
-    select(Year, US_foreign, US_JV, atSea_US_MS, atSea_US_CP, US_shore, USresearch) %>%
-    mutate(usa = US_foreign + US_JV + atSea_US_MS + atSea_US_CP + US_shore + USresearch) %>%
+
+  usa <- d |>
+    mutate(usa = `U.S. Foreign` +
+             `U.S. Joint-venture` +
+             `U.S. Mothership` +
+             `U.S. Catcher-processor` +
+             `U.S. Shore-based` +
+             `U.S. Research`) |>
     select(year = Year, usa)
 
-  j <- can %>%
+  out <- can |>
     left_join(usa, by = "year")
 
-  # TODO: This is hardwired to try to match the output of Nis' code. The data in the catch_per_country.csv
-  # file are the same as in the landings-tac-history.csv file up to 2005, when they diverge. Nis used
-  # catch_per_country.csv. To return to correct, comment the statement below out and return j
-  k <- read_csv(system.file("extdata/csv-data/catch_per_country.csv",
-                                        package = "pacifichakemse",
-                                        mustWork = TRUE),
-                            col_types = cols()) %>%
-    rename(can = Can, us = US) %>%
-    select(year, can, us)
-
-  #df$Catch.country <- as.matrix(Catch.country[,2:3])[,c(2,1)]
-  as.matrix(k)
+  out
 }

R/run_mses.R

@@ -1,7 +1,7 @@
 #' Run the MSE for a number of runs for any scenarios
 #'
-#' @details Saves the output of the MSE runs to the files specified in `fns`, in the directories
-#' specified in `results_root_dir` and `results_dir`
+#' @details Saves the output of the MSE runs to the files specified in `fns`,
+#' in the directories specified in `results_root_dir` and `results_dir`
 #'
 #' @param n_runs Then number of runs to do for each simulation
 #' @param n_sim_yrs The number of years to simulate into the future
@@ -88,15 +88,15 @@ run_mses <- function(n_runs = 10,
   tacs <- fill_vec(tacs)
   attains <- fill_vec(attains)
 
-  if(any(map_lgl(tacs, ~{length(.x) == 1 && .x != 0})) && is.null(catch_floor)){
-    stop("`catch_floor` argument is NULL with at least one of the `tac` argument list ",
-         "values having length 1, and being not equal to zero (which signifies no tac application). ",
-         "Provide a catch_floor value to use when applying tac value of 1.",
-         call. = FALSE)
+  if(any(map_lgl(tacs, ~{length(.x) == 1 && .x != 0})) &&
+     is.null(catch_floor)){
+    stop("`catch_floor` argument is NULL with at least one of the `tac` ",
+         "argument list values having length 1, and being not equal to ",
+         "zero (which signifies no tac application). Provide a ",
+         "`catch_floor` value to use when applying tac value of 1.")
   }
   if(!all(map_lgl(tacs, ~{if(length(.x) %in% 1:2) TRUE else FALSE}))){
-    stop("List elements of `tacs` must be either length 1 or length 2.",
-         call. = FALSE)
+    stop("List elements of `tacs` must be either length 1 or length 2.")
   }
 
   tic()