Skip to content

Commit

Permalink
Fixed pstar and readme
Browse files Browse the repository at this point in the history
Fixed some lines in the p-star code, including some more comments throughout. Added a readme with table to explain all functions in folder
  • Loading branch information
emilyliljestrand committed Jul 23, 2024
1 parent a91f0ca commit c409dbb
Show file tree
Hide file tree
Showing 3 changed files with 27 additions and 60 deletions.
4 changes: 4 additions & 0 deletions Reference-Points-and-Projections/P-star.basic.model.R
Original file line number Diff line number Diff line change
Expand Up @@ -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<projyr)
{
catch.proj[i+1] <- catch
Expand All @@ -63,6 +66,7 @@ pstarmodel <- function(mod=NULL,SSBmsy=NULL,catch.year1=NULL,projyr=3,CV=1.5,avg
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)

# Return the final projection model
return(mod.proj)

}
70 changes: 10 additions & 60 deletions Reference-Points-and-Projections/P-star.basic.table.R
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,6 @@
#' @param CV the level of uncertainty
#' @param avg.abc average ABC, if using, specify, otherwise don't specify
#'
#'
#' @return A table containing:
#' \itemize{
#' \item{Year - projection Year}
Expand All @@ -31,32 +30,26 @@
#' pstar60 <- pstar(mod,SSBmsy,catch.year1,CV=CV)
#' write.csv(pstar60, "Projections/Pstar60.csv", row.names = FALSE)


pstartable <- function(mod=NULL,SSBmsy=NULL,catch.year1=NULL,projyr=3,CV=1.5,avg.abc=NULL)
{
# Have to source additional functions:
source("abccalc.R")
source("invabccalc.R")
source("pstarcalc.R")

# Specify the model and projection years
model.years <- mod$years
proj.years <- c((tail(model.years,1)+1):(tail(model.years,1)+projyr))

# Empty variables to collect catch and pstar values
# Empty variables to collect catch and pstar values for table
catch.proj <- rep(0,projyr)
ratio.proj <- rep(0,projyr-1)
pstar.proj <- rep(0,projyr-1)
<<<<<<< Updated upstream
ofl.proj <- rep(0,projyr)
=======
ofl.proj <- rep(0,projyr-1)
>>>>>>> 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))
Expand All @@ -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<projyr)
{
catch.proj[i+1] <- catch
if(!is.null(avg.abc)) catch.proj[i+1] <- avg.abc
>>>>>>> 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

}
}
13 changes: 13 additions & 0 deletions Reference-Points-and-Projections/README.md
Original file line number Diff line number Diff line change
@@ -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 |

0 comments on commit c409dbb

Please sign in to comment.