Merge pull request #10 from emilyliljestrand/pstarproj

Fixed pstar and readme

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<projyr)
       {
         catch.proj[i+1] <- catch
@@ -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)
 
 }

Reference-Points-and-Projections/P-star.basic.table.R

@@ -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}
@@ -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))
@@ -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
-
-}
+}

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 |
+