added simulation section to vigA

noaa-afsc · Sep 14, 2022 · 2c93143 · 2c93143
1 parent f103035
commit 2c93143
Show file tree

Hide file tree

Showing 57 changed files with 866 additions and 348 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -19,6 +19,7 @@ export(get_surveyidx_aic)
 export(get_surveyidx_resid)
 export(get_surveyidx_sim)
 export(get_surveyidx_stratmean)
+export(plot_simulation_list)
 export(plot_surveyidx)
 export(plot_surveyidx_grid)
 export(qres_tweedie)

diff --git a/R/functions.R b/R/functions.R
@@ -1127,6 +1127,97 @@ get_surveyidx_sim <- function(
               prob0=out_mu0))
 }
 
+
+##' Plot survey index list (e.g. retrospective analysis)
+##'
+##' @title Plot survey index list (e.g. retrospective analysis)
+##' @param x (named) list of "surveyIdx" objects for example from "retro.surveyIdx" or "leaveout.surveyIdx"
+##' @param base Either index of x that should considered the "base run" (integer), OR object of class "surveyIdx". Confidence bounds will be shown for this model only.
+##' @param rescale Should indices be rescaled to have mean 1 (over the set of intersecting years)? Default: FALSE
+##' @param lwd line width argument to plot
+##' @param main if not NULL override main plotting default title of "Age group a"
+##' @param allCI show 95\% confidence lines for all indices? Default FALSE.
+##' @param includeCI Show confidence intervals? Default TRUE.
+##' @param ylim Y axis range. If NULL (default) then determine automatically.
+##' @return nothing
+##' @export
+plot_simulation_list<-function(x, base=1, rescale=FALSE,lwd=1.5,main=NULL,allCI=FALSE,includeCI=TRUE,ylim=NULL){
+  if(class(base)=="surveyIdx"){
+    x = c( list(base), x)
+    base = 1
+  }
+  stopifnot(is.numeric(base))
+  nx = length(x)
+  mainwasnull = is.null(main)
+  n = ncol(x[[base]]$idx)
+  if(n>1){
+    op <- par(mfrow=n2mfrow(n))
+    on.exit(par(op))
+  }
+
+  cols = rainbow(nx)
+  if(nx==2) cols = 2:3
+  cols[base] = "black"
+  allyears = lapply(x, function(x) rownames(x$idx))
+  rsidx = 1:nrow(x[[nx]]$idx)
+  if(rescale){
+    commonyears = allyears[[1]]
+    if(nx>1){
+      for(i in 2:nx){
+        commonyears = intersect(commonyears,allyears[[i]])
+      }
+      if(length(commonyears)==0) stop("rescaling not possible because the set of common years is empty")
+    }
+  }
+
+  ss <- ssbase <- 1
+
+  for(aa in 1:n){
+
+    rangevec = x[[1]]$idx[,aa]
+    for(xx in 2:nx) rangevec = c(rangevec,x[[xx]]$idx[,aa])
+    if(includeCI){
+      for(xx in 1:nx) rangevec = c(rangevec,x[[xx]]$lo[,aa],x[[xx]]$up[,aa])
+    }
+
+    yl = range(rangevec)
+    if(rescale){
+      rsidx = which(rownames(x[[base]]$idx) %in% commonyears )
+      ssbase =  mean( x[[base]]$idx[rsidx,aa], na.rm=TRUE)
+      yl = yl/ssbase
+    }
+    if(!is.null(ylim)) yl = ylim
+
+    if(mainwasnull) main <- paste("Age group", colnames(x[[base]]$idx)[aa])
+    y = as.numeric(rownames(x[[base]]$idx))
+    plot(y,x[[base]]$idx[,aa]/ssbase,type="b",ylim=yl,main=main,xlab="Year",ylab="Index")
+
+    if(includeCI)
+      polygon(c(y, rev(y)), c(x[[base]]$lo[,aa], rev(x[[base]]$up[,aa]))/ssbase, col = "lightgrey", border = NA)
+
+    for(i in 1:length(x)){
+      y = as.numeric(rownames(x[[i]]$idx))
+      if(rescale){
+        rsidx = which(rownames(x[[i]]$idx) %in% commonyears )
+        ss = mean( x[[i]]$idx[rsidx,aa], na.rm=TRUE)
+      }
+      lines(y,x[[i]]$idx[,aa]/ss,col=cols[i],type="b", lwd=lwd)
+
+      if(includeCI && allCI && i!=base){
+        lines(y,x[[i]]$lo[,aa]/ss,col=cols[i],lwd=lwd*0.6,lty=2)
+        lines(y,x[[i]]$up[,aa]/ss,col=cols[i],lwd=lwd*0.6,lty=2)
+      }
+
+    }
+    y = as.numeric(rownames(x[[base]]$idx))
+    lines(y,x[[base]]$idx[,aa]/ssbase,type="b",lwd=lwd)
+
+  }
+  if(!is.null(names(x))){
+    legend("topleft",legend=names(x),col=cols,lty=1,lwd=lwd,pch=1)
+  }
+}
+
 # Randomized quantile residuals ------------------------------------------------
 
 #' Randomized quantile residuals for class 'surveyIndex'

diff --git a/README.Rmd b/README.Rmd
@@ -6,7 +6,6 @@ output:
 
 ```{r setup, include=FALSE}
 knitr::opts_chunk$set(echo = TRUE)
-link_foss <- "https://github.com/EmilyMarkowitz-NOAA/surveyIndex"
 ```
 
 <!-- README.md is generated from README.Rmd. Please edit that file -->
@@ -36,13 +35,19 @@ cat(
 )
 ```
 
-> Code is still in development
+> Code is still in development at https://github.com/EmilyMarkowitz-NOAA/surveyIndex
 
-Code was originally developed by: **Casper W. Berg** (@casperwberg)
+*Code was originally developed by:*
 
-> Berg et al. (2014): "Evaluation of alternative age-based methods for estimating relative abundance from survey data in relation to assessment models", Fisheries Research 151(2014) 91-99.
+**Casper W. Berg** (@casperwberg)
 
-And then modified and adapted for the AFSC by:
+National Institute of Aquatic Resources, 
+
+Technical University of Denmark
+
+[**Berg et al. (2014): "Evaluation of alternative age-based methods for estimating relative abundance from survey data in relation to assessment models", Fisheries Research 151(2014) 91-99.**](https://doi.org/10.1016/j.fishres.2013.10.005)
+
+*And then modified and adapted for the AFSC by:*
 
 **Emily Markowitz** (@EmilyMarkowitz-noaa; Emily.Markowitz AT noaa.gov)
 

diff --git a/README.md b/README.md
@@ -7,15 +7,23 @@ data.
 
 [![](https://img.shields.io/github/last-commit/EmilyMarkowitz-NOAA/surveyIndex.svg)](https://github.com/EmilyMarkowitz-NOAA/surveyIndex/commits/main)
 
-> Code is still in development
+> Code is still in development at
+> <https://github.com/EmilyMarkowitz-NOAA/surveyIndex>
 
-Code was originally developed by: **Casper W. Berg** (@casperwberg)
+*Code was originally developed by:*
 
-> Berg et al. (2014): “Evaluation of alternative age-based methods for
-> estimating relative abundance from survey data in relation to
-> assessment models”, Fisheries Research 151(2014) 91-99.
+**Casper W. Berg** (@casperwberg)
 
-And then modified and adapted for the AFSC by:
+National Institute of Aquatic Resources,
+
+Technical University of Denmark
+
+[**Berg et al. (2014): “Evaluation of alternative age-based methods for
+estimating relative abundance from survey data in relation to assessment
+models”, Fisheries Research 151(2014)
+91-99.**](https://doi.org/10.1016/j.fishres.2013.10.005)
+
+*And then modified and adapted for the AFSC by:*
 
 **Emily Markowitz** (@EmilyMarkowitz-noaa; Emily.Markowitz AT noaa.gov)
 
@@ -65,20 +73,20 @@ This package was last produced using:
     ## [1] parallel  stats     graphics  grDevices utils     datasets  methods   base     
     ## 
     ## other attached packages:
-    ##  [1] surveyIndex_0.1.0 marmap_1.0.6      RANN_2.6.1        maptools_1.1-4    sp_1.5-0          mapdata_2.3.0    
-    ##  [7] maps_3.4.0        mgcv_1.8-40       nlme_3.1-157      DATRAS_1.01       RODBC_1.3-19      roxygen2_7.2.1   
-    ## [13] devtools_2.4.4    knitr_1.40        badger_0.2.1      pkgdown_2.0.6     usethis_2.1.6     here_1.0.1       
+    ##  [1] surveyIndex_0.1.0  pkgdown_2.0.6.9000 knitr_1.40         badger_0.2.1       marmap_1.0.6       RANN_2.6.1        
+    ##  [7] maptools_1.1-4     sp_1.5-0           mapdata_2.3.0      maps_3.4.0         mgcv_1.8-40        nlme_3.1-157      
+    ## [13] DATRAS_1.01        RODBC_1.3-19       roxygen2_7.2.1     devtools_2.4.4     usethis_2.1.6      here_1.0.1        
     ## 
     ## loaded via a namespace (and not attached):
-    ##   [1] colorspace_2.0-3    ellipsis_0.3.2      gitcreds_0.1.2      rprojroot_2.0.3     fs_1.5.2           
+    ##   [1] colorspace_2.0-3    gitcreds_0.1.2      ellipsis_0.3.2      rprojroot_2.0.3     fs_1.5.2           
     ##   [6] rstudioapi_0.14     remotes_2.4.2       gh_1.3.1            bit64_4.0.5         fansi_1.0.3        
     ##  [11] xml2_1.3.3          codetools_0.2-18    splines_4.2.1       ncdf4_1.19          cachem_1.0.6       
-    ##  [16] pkgload_1.3.0       jsonlite_1.8.0      icesDatras_1.4.0    shiny_1.7.2         BiocManager_1.30.18
-    ##  [21] compiler_4.2.1      httr_1.4.4          rvcheck_0.2.1       assertthat_0.2.1    Matrix_1.5-0       
+    ##  [16] pkgload_1.3.0       jsonlite_1.8.0      icesDatras_1.4.0    shiny_1.7.2         httr_1.4.4         
+    ##  [21] BiocManager_1.30.18 compiler_4.2.1      rvcheck_0.2.1       assertthat_0.2.1    Matrix_1.4-1       
     ##  [26] fastmap_1.1.0       cli_3.4.0           later_1.3.0         htmltools_0.5.3     prettyunits_1.1.1  
     ##  [31] tools_4.2.1         gtable_0.3.1        glue_1.6.2          reshape2_1.4.4      dplyr_1.0.10       
     ##  [36] Rcpp_1.0.9          raster_3.5-29       vctrs_0.4.1         xfun_0.32           stringr_1.4.1      
-    ##  [41] brio_1.1.3          ps_1.7.1            testthat_3.1.4      mime_0.12           miniUI_0.1.1.1     
+    ##  [41] ps_1.7.1            brio_1.1.3          testthat_3.1.4      mime_0.12           miniUI_0.1.1.1     
     ##  [46] lifecycle_1.0.2     dlstats_0.1.5       sys_3.4             terra_1.6-17        MASS_7.3-57        
     ##  [51] scales_1.2.1        promises_1.2.0.1    credentials_1.3.2   RColorBrewer_1.1-3  gert_1.8.0         
     ##  [56] yaml_2.3.5          curl_4.3.2          memoise_2.0.1       ggplot2_3.3.6       yulab.utils_0.0.5  

diff --git a/docs/404.html b/docs/404.html
diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html