From c409dbb2122321f5146fb7af9e9ea589fb8a9a4b Mon Sep 17 00:00:00 2001 From: Emily Liljestrand Date: Tue, 23 Jul 2024 15:22:26 -0400 Subject: [PATCH] Fixed pstar and readme Fixed some lines in the p-star code, including some more comments throughout. Added a readme with table to explain all functions in folder --- .../P-star.basic.model.R | 4 ++ .../P-star.basic.table.R | 70 +++---------------- Reference-Points-and-Projections/README.md | 13 ++++ 3 files changed, 27 insertions(+), 60 deletions(-) create mode 100644 Reference-Points-and-Projections/README.md diff --git a/Reference-Points-and-Projections/P-star.basic.model.R b/Reference-Points-and-Projections/P-star.basic.model.R index 082ebf9..736a05f 100644 --- a/Reference-Points-and-Projections/P-star.basic.model.R +++ b/Reference-Points-and-Projections/P-star.basic.model.R @@ -45,12 +45,15 @@ pstarmodel <- function(mod=NULL,SSBmsy=NULL,catch.year1=NULL,projyr=3,CV=1.5,avg proj_F_opt <- c(rep(5,i),rep(3,projyr-i)) mod.proj <- project_wham(mod, proj.opts = list(n.yrs = projyr,proj_F_opt = proj_F_opt, proj_Fcatch = catch.proj), check.version = F) + # Get OFL, SSB, and SSB ratio (relative to SSBMSY) ofl <- tail(apply(mod.proj$rep$pred_catch,1,sum),projyr)[i+1] ssb <- tail(apply(mod.proj$rep$SSB,1,sum),projyr)[i] ssbratio <- ssb/SSBmsy + # Calculate catch from p* code catch <- ABC(ofl,ssbratio,CV) + # As long as its not the terminal year, add the abc catch to catch vector and repeat if(i>>>>>> Stashed changes # Catch in the first year of projections is specified catch.proj[1] <- catch.year1 -<<<<<<< Updated upstream if(projyr>1) { for(i in 1:(projyr-1)) @@ -79,79 +72,36 @@ pstartable <- function(mod=NULL,SSBmsy=NULL,catch.year1=NULL,projyr=3,CV=1.5,avg catch.proj[i+1] <- catch if(!is.null(avg.abc)) catch.proj[i+1] <- avg.abc } -======= - for(i in 1:(projyr-1)) - { - # Tell WHAM to do projection based on catch in first i years ('5') and Fmsy proxy ('3') in following years - proj_F_opt <- c(rep(5,i),rep(3,projyr-i)) - mod.proj <- project_wham(mod, proj.opts = list(n.yrs = projyr,proj_F_opt = proj_F_opt, proj_Fcatch = catch.proj), check.version = F) - - ofl <- tail(apply(mod.proj$rep$pred_catch,1,sum),projyr)[i+1] - ssb <- tail(apply(mod.proj$rep$SSB,1,sum),projyr)[i] - ssbratio <- ssb/SSBmsy - catch <- ABC(ofl,ssbratio,CV) - - ratio.proj[i] <- ssbratio - pstar.proj[i] <- inv_ABC(catch, ofl, CV) - ofl.proj[i] <- ofl - - if(i>>>>>> Stashed changes } } - - # Create table for memo -<<<<<<< Updated upstream + + # Initiate table for memo with just year and OFL pstartable.df <- as.data.frame(cbind(c('NA',round(ofl.proj[-projyr],0)))) pstartable.df <- cbind(proj.years, pstartable.df) colnames(pstartable.df) <- c("Year", "OFL") + + # Add ABC pstartable.df <- cbind(pstartable.df, round(catch.proj,0)) colnames(pstartable.df)[3] <- "ABC" - # B/BMSY + # Add B/BMSY ratio.proj <- c('NA',round(as.numeric(ratio.proj),2)) -======= - pstartable <- as.data.frame(cbind(ofl.proj[-projyr])) - pstartable <- cbind(proj.years[-1], pstartable) - colnames(pstartable) <- c("Year", "OFL") - pstartable <- cbind(pstartable, rbind(catch.proj[-1])) - colnames(pstartable)[3] <- "ABC" - - # B/BMSY - bratio <- c(ratio.year2,ratio.year3) - ratio.proj[-projyr] ->>>>>>> Stashed changes # Conduct one last projection to get F and SSB resultant from final ABC proj_F_opt <- c(rep(5,projyr)) mod.proj <- project_wham(mod, proj.opts = list(n.yrs = projyr,proj_F_opt = proj_F_opt, proj_Fcatch = catch.proj), check.version = F) # F -<<<<<<< Updated upstream f.proj <- tail(exp(mod.proj$rep$log_F_tot),(projyr)) # SSB ssb.proj <- tail(apply(mod.proj$rep$SSB,1,sum),projyr) pstartable.df <- cbind(pstartable.df, ratio.proj, f.proj, ssb.proj) colnames(pstartable.df)[4:6] <- c("B/BMSY","F", "SSB") + + # Add P* values pstartable.df <- cbind(pstartable.df, c("NA",pstar.proj)) colnames(pstartable.df)[7] <- "P*" - return(pstartable.df) -======= - f.proj <- tail(exp(mod.proj$rep$log_F_tot),(projyr-1)) - # SSB - ssb.proj <- tail(apply(mod.proj$rep$SSB,1,sum),2) - - pstartable <- cbind(pstartable, ratio.proj[-projyr], f.proj, ssb.proj) - colnames(temp)[4:6] <- c("B/BMSY","F", "SSB") - pstartable <- cbind(pstartable, pstar.proj) - colnames(temp)[7] <- "P*" - return(pstartable) ->>>>>>> Stashed changes - -} +} \ No newline at end of file diff --git a/Reference-Points-and-Projections/README.md b/Reference-Points-and-Projections/README.md new file mode 100644 index 0000000..01aeb0b --- /dev/null +++ b/Reference-Points-and-Projections/README.md @@ -0,0 +1,13 @@ +# READ-PDB-COLLABORATIONS: Reference-Points-and-Projections + +This sub-directory contains specialty functions and using fitted models from the WHAM R package to test the reference point outputs or projections based on ABC, rather than OFL values + +| File | Description | Initial Contributor | +| ---- | ----------- | ------------------- | +| P-star.basic.model.R | Function generates a WHAM projection model based on fitted multiWHAM model and specified P* specifications (calculating ABC from OFL in the MAFMC) |Chuck Adams, adapted by Emily Liljestrand | +| P-star.basic.table.R | Function generates an output table based on fitted multiWHAM model and specified P* specifications (calculating ABC from OFL in the MAFMC) |Chuck Adams, adapted by Emily Liljestrand| +| abccalc.R | Calculates ABC from the OFL, B/BMSY ratio, and OFL CV, supports "P-star.basic" codes | Chuck Adams and Mike Wilberg | +| pstarcalc.R | Calculates Pstar from B/BMSY ratio, supports "P-star.basic" codes | Chuck Adams and Mike Wilberg | +| invabccalc.R | Calculates Pstar value from OFL, ABC, and OFL CV, supports "P-star.basic" codes | Chuck Adams and Mike Wilberg | +| FX_SSBX_Calculation_Series.FIXED.R | Calculate the FX% for a specified number of years from any WHAM output | Cameron Hodgdon | +