Merge remote-tracking branch 'origin'

DESCRIPTION

@@ -31,11 +31,14 @@ LazyData: true
 Depends:
     R (>= 3.5.0),
 Imports:
+    ggplot2,
     ggdist,
     ggh4x,
     reshape2,
-    dplyr,
-    ggplot2
+    dplyr
+Suggests:
+    knitr,
+    rmarkdown
 DevPackage:
     Craig44/SpatialSablefishAssessment
     BenWilliams-NOAA/afscOM

NAMESPACE

@@ -1,24 +1,71 @@
 # Generated by roxygen2: do not edit by hand
 
+export(aav)
 export(abi)
 export(as_scalar_threshold_f)
+export(average_abi)
 export(average_age)
+export(average_annual_catch_variation)
+export(average_annual_dynamic_value)
+export(average_annual_value)
+export(average_catch)
+export(average_proportion_biomass_old)
+export(average_proportion_catch_large)
+export(average_ssb)
+export(beverton_holt)
 export(bind_mse_outputs)
+export(biomass_crash_time)
+export(biomass_recovery_time)
+export(calculate_joint_selret)
+export(calculate_npfmc_ref_points)
 export(calculate_ref_points)
+export(compute_average_age)
 export(compute_bx)
 export(compute_sbpr)
 export(compute_spr)
 export(constant_F)
+export(extend_3darray_last_dim)
+export(extend_vec_last_val)
+export(filter_hcr_om)
+export(filter_times)
 export(fit_TMB_model)
 export(format_em_data)
+export(generate_annual_frequency)
+export(get_atage_groups)
+export(get_b40_timeseries)
+export(get_big_recruitment_filter)
+export(get_fishing_mortalities)
+export(get_hcrphase_data)
+export(get_landed_catch)
+export(get_management_quantities)
+export(get_phaseplane_catch_data)
+export(get_phaseplane_data)
+export(get_recruits)
+export(get_reference_points)
+export(get_saved_model_runs)
+export(get_ssb_biomass)
+export(inf_max)
 export(npfmc_tier3_F)
+export(performance_metric_summary)
 export(prop_fully_mature)
+export(prop_low_biomass)
 export(prop_mature)
+export(prop_years_catch)
+export(recruits_crash)
 export(reformat_ggdist_long)
+export(resample_recruits)
+export(resample_regime_recruits)
+export(round_to_zero)
+export(run_EM)
 export(run_mse)
 export(run_mse_multiple)
+export(scale_and_rank)
+export(setup_hcr_options)
+export(setup_mse_options)
 export(shannon_diversity)
 export(simulate_TAC)
 export(spr_x)
+export(stairstep_attainment)
 export(threshold_cap)
 export(threshold_f)
+export(total_catch)

R/plotting.R

@@ -29,8 +29,7 @@ plot_ssb <- function(data, v1="hcr", v2=NA, v3=NA, show_est=FALSE, common_trajec
         scale_y_continuous(limits=c(0, 500))+
         labs(x="Year", y="SSB")+
         coord_cartesian(expand=0)+
-        guides(color=guide_legend(title="HCR", nrow=2), fill="none")+
-        theme_bw()
+        guides(color=guide_legend(title="HCR", nrow=2), fill="none")
 
     if(show_est){
         plot <- plot + geom_pointrange(data = d %>% filter(L1 == "naa_est"), aes(x=time, y=median, ymin=lower, ymax=upper, color=hcr), alpha=0.35)
@@ -100,8 +99,7 @@ plot_fishing_mortalities <- function(data, v1="hcr", v2=NA, v3=NA, show_est=FALS
         scale_color_manual(values=hcr_colors)+
         scale_y_continuous(limits=c(0, 0.20))+
         coord_cartesian(expand=0)+
-        guides(fill="none")+
-        theme_bw()
+        guides(fill="none")
 
     if(show_est){
         plot <- plot + geom_pointrange(data = f %>% filter(L1 == "faa_est"), aes(x=time, y=median, ymin=lower, ymax=upper, color=hcr), alpha=0.35)
@@ -135,8 +133,7 @@ plot_recruitment <- function(data, v1="hcr", v2=NA, show_est=FALSE, common_traje
         scale_fill_brewer(palette="Blues")+
         scale_color_manual(values=hcr_colors)+
         scale_y_continuous(limits=c(0, 120))+
-        coord_cartesian(expand=0)+
-        theme_bw()
+        coord_cartesian(expand=0)
 
     if(show_est){
         plot <- plot + geom_pointrange(data = f %>% filter(L1 == "naa_est"), aes(x=time, y=median, ymin=lower, ymax=upper, color=hcr), alpha=0.35)
@@ -182,8 +179,7 @@ plot_landed_catch <- function(data, v1="hcr", v2=NA, v3=NA, by_fleet=FALSE, comm
         # scale_y_continuous(limits=c(0, 60))+
         labs(x="Year", y="Catch (mt)", color="HCR")+
         coord_cartesian(expand=0, ylim=c(0, 60))+
-        guides(color=guide_legend(title="HCR", nrow=2), fill="none")+
-        theme_bw()
+        guides(color=guide_legend(title="HCR", nrow=2), fill="none")
 
     if(!is.na(v2) && is.na(v3)){
         plot <- plot + facet_wrap(~.data[[v2]])+guides(fill="none")
@@ -199,7 +195,6 @@ plot_landed_catch <- function(data, v1="hcr", v2=NA, v3=NA, by_fleet=FALSE, comm
 
 }
 
-
 plot_ssb_catch <- function(ssb_data, catch_data, v1="hcr", v2=NA, v3=NA, common_trajectory=64, base_hcr="F40"){
 
     group_columns <- colnames(ssb_data)
@@ -253,7 +248,6 @@ plot_ssb_catch <- function(ssb_data, catch_data, v1="hcr", v2=NA, v3=NA, common_
         labs(x="Year", y="1000s Metric Tons")+
         coord_cartesian(expand=0)+
         guides(color=guide_legend("HCR", nrow=2), fill="none")+
-        theme_bw()+
         facet_grid(rows=vars(L1), cols=vars(.data[[v2]]), scales="free_y")+
         ggh4x::facetted_pos_scales(
             y = list(
@@ -264,7 +258,6 @@ plot_ssb_catch <- function(ssb_data, catch_data, v1="hcr", v2=NA, v3=NA, common_
     return(plot+custom_theme)
 }
 
-
 plot_atage_trajectory_ternary <- function(data, segments, col_names){
     axis_names = names(data)[6:8]
     return(
@@ -390,8 +383,7 @@ plot_abc_tac <- function(data, v1="hcr", v2=NA, common_trajectory=64, base_hcr="
         geom_vline(data=common, aes(xintercept=common), linetype="dashed")+
         scale_fill_brewer(palette="Blues")+
         scale_color_manual(values=hcr_colors)+
-        coord_cartesian(expand=0)+
-        theme_bw()
+        coord_cartesian(expand=0)
 
     if(!is.na(v2)){
         plot <- plot + facet_grid(rows=vars(L1), cols=vars(.data[[v2]]), scales="free_y")
@@ -408,7 +400,7 @@ plot_abc_tac <- function(data, v1="hcr", v2=NA, common_trajectory=64, base_hcr="
             )
         )
 
-    return(plot)
+    return(plot+custom_theme)
 }
 
 plot_phase_diagram <- function(data, ref_pts, v1="hcr", v2=NA, common_trajectory=64){
@@ -531,7 +523,6 @@ plot_hcr_phase_diagram <- function(data, ref_pts, v1="hcr", v2=NA, common_trajec
 
 }
 
-
 plot_mse_summary <- function(model_runs, extra_columns, dem_params, hcr_filter, om_filter, common_trajectory=64){
     all_data <- bind_rows(
         get_ssb_biomass(model_runs, extra_columns, dem_params, hcr_filter, om_filter) %>% select(time, sim, L1, om, hcr, value=spbio),
@@ -574,10 +565,9 @@ plot_mse_summary <- function(model_runs, extra_columns, dem_params, hcr_filter,
         scale_x_continuous(limits=c(0, ad %>% pull(time) %>% max))+
         scale_color_manual(values=hcr_colors)+
         labs(y="", x="Year", color="HCR")+
-        coord_cartesian(expand=0)+
-        theme_bw()
+        coord_cartesian(expand=0)
 
-    return(plot)
+    return(plot+custom_theme)
 }
 
 plot_performance_metric_summary <- function(perf_data, v1="hcr", v2="om", is_relative=FALSE, summary_hcr="F40"){
@@ -595,8 +585,7 @@ plot_performance_metric_summary <- function(perf_data, v1="hcr", v2="om", is_rel
                 # facet_wrap(vars(name), scales="free_x")+
                 labs(y="", x="", shape="OM", color="Performance Order")+
                 coord_cartesian(expand=0)+
-                guides(shape="none", color=guide_legend(nrow=1))+
-                theme_bw()+
+                guides(shape="none", color=guide_legend(nrow=1))
                 theme(
                     plot.margin = margin(0.25, 1, 0.25, 0.25, "cm"),
                     panel.spacing.x = unit(5, "cm"),
@@ -679,8 +668,7 @@ plot_ssb_paginate <- function(data, v1="hcr", v2=NA, v3=NA, show_est=FALSE, comm
             facet_wrap(~ hcr, ncol=4, nrow=7)+
             labs(x="Year", y="SSB", title=o)+
             coord_cartesian(expand=0)+
-            guides(fill="none", color="none")+
-            theme_bw()+
+            guides(fill="none", color="none")
             custom_theme+
             theme(
                 plot.title = element_text(size=20)
@@ -732,8 +720,7 @@ plot_catch_paginate <- function(data, v1="hcr", v2=NA, v3=NA, show_est=FALSE, co
             facet_wrap(~ hcr, ncol=4, nrow=7)+
             labs(x="Year", y="Catch (mt)", title=o)+
             coord_cartesian(expand=0, ylim=c(0, 60))+
-            guides(fill="none", color="none")+
-            theme_bw()+
+            guides(fill="none", color="none")
             custom_theme+
             theme(
                 plot.title = element_text(size=20)
@@ -788,13 +775,12 @@ rank_colors <- c(
     "#0072B2"
 )
 
-
-custom_theme <- theme_bw()+theme(
-    panel.spacing.y = unit(0.5, "cm"),
-    panel.grid.minor = element_blank(),
-    axis.title = element_text(size=14),
-    axis.text = element_text(size=14),
-    strip.text = element_text(size=14),
-    legend.text = element_text(size=14),
+custom_theme <- ggplot2::theme_bw()+ggplot2::theme(
+    panel.spacing.y = ggplot2::unit(0.5, "cm"),
+    panel.grid.minor = ggplot2::element_blank(),
+    axis.title = ggplot2::element_text(size=14),
+    axis.text = ggplot2::element_text(size=14),
+    strip.text = ggplot2::element_text(size=14),
+    legend.text = ggplot2::element_text(size=14),
     legend.position = "bottom"
 )

R/recruitment_utils.R

@@ -6,7 +6,7 @@
 #' @param nyears total number of years to resample
 #' @param seed random seed for reproducability
 #'
-#' @export resanple_recruits
+#' @export resample_recruits
 #'
 #' @example
 #'

R/setup_mse_options.R

@@ -10,7 +10,7 @@ setup_mp_options <- function(){
 
     return(
         list(
-            hcr = NULL,
+            hcr = setup_hcr_options(),
             ref_points = list(
                 spr_target = 0.40
             ),
@@ -25,6 +25,26 @@ setup_mp_options <- function(){
 
 }
 
+#' Setup HCR Objects
+#' 
+#' Set HCR object list items to NULL defaults
+#' 
+#' @export setup_hcr_options
+#' 
+setup_hcr_options <- function(){
+    return(
+        list(
+            func = NULL,
+            extra_pars = NA,
+            extra_options = list(
+                max_stability = NA,
+                harvest_cap = NA
+            ),
+            units = NULL
+        )
+    )
+}
+
 setup_mse_options <- function(){
     return(
         list(

vignettes/00_sablefish_example.Rmd

@@ -2,7 +2,7 @@
 title: "Sablefish MSE Example"
 output: rmarkdown::html_vignette
 vignette: >
-  %\VignetteIndexEntry{Estimation Method}
+  %\VignetteIndexEntry{Sablefish MSE Example}
   %\VignetteEngine{knitr::rmarkdown}
   %\VignetteEncoding{UTF-8}
 ---