├── ADMB-TMB-Announcement.pdf ├── README.md ├── TMB_experiments ├── .gitignore ├── MakeADFun_windows_debug │ ├── MakeADFun_windows_debug.R │ └── test_MakeADFun_windows_debug.R ├── README.md ├── experiment_with_SCALE │ ├── experiment_involving_SCALE.R │ ├── linear_model.cpp │ └── linear_model_using_scale.cpp ├── experiment_with_oneStepPredict │ ├── linear_mixed_model.R │ └── linear_mixed_model.cpp ├── experiment_with_parallel_accumulator │ ├── Benchmark.png │ ├── linreg_parallel.R │ └── linreg_parallel.cpp ├── linear_algebra_operations │ ├── eigen_testing.R │ └── eigen_testing_V1.cpp ├── passing_lists │ ├── passing_lists.R │ └── passing_lists_V1.cpp └── windows_debugger │ ├── problem.R │ ├── problem.cpp │ └── windows_debugger.R ├── examples ├── andre │ ├── AndreLecture.ppt │ ├── README.md │ ├── ex1.cpp │ ├── ex1.dat │ ├── schaefer.R │ ├── schaefer.cpp │ ├── schaefer.dat │ └── ttt.R ├── bevholt │ ├── bevholt.R │ ├── bevholt.cpp │ ├── bevholt.dat │ ├── bh.R │ ├── bh.cpp │ ├── bh2.R │ └── bh2.cpp ├── catage │ ├── README.md │ ├── fsa.RData │ ├── fsa2.R │ └── fsa2.cpp ├── linreg-debug │ ├── Makefile │ ├── linreg.R │ ├── linreg.cpp │ ├── linreg.dat │ └── readme.md ├── linreg-triple │ ├── Makefile │ ├── linreg.R │ ├── linreg.cpp │ ├── linreg.dat │ ├── readme.md │ ├── triple.cpp │ └── triple.h ├── linreg │ ├── linreg.R │ ├── linreg.cpp │ └── linreg.dat ├── mcmc │ └── MCMC_in_TMB.R ├── mini │ ├── README.md │ ├── mini.R │ ├── mini.cpp │ ├── mini_a.dat │ └── mini_a.tpl ├── poll │ ├── pmature.dat │ ├── poll.R │ ├── poll.cpp │ ├── pollM.dat │ ├── pollcatno.dat │ ├── polldat.R │ ├── surveyNage.dat │ └── wtage.dat ├── ricker │ ├── ricker.R │ ├── ricker.cpp │ └── ricker.dat ├── rrm │ ├── Chinook_reconst_ln_rev3.tpl │ ├── Kusko_estimates2015_Dec22.csv │ ├── rrm.R │ └── rrm.cpp ├── sam │ ├── sam.RData │ ├── samtmb.R │ └── samtmb.cpp ├── scalar │ ├── scalar.R │ └── scalar.cpp ├── schaefer │ ├── schaefer.R │ ├── schaefer.cpp │ └── schaefer.dat ├── srw │ ├── README.md │ ├── observed.dat │ ├── rw.R │ ├── rw.cpp │ ├── rw.dat │ ├── srw.R │ ├── srw.cpp │ ├── srw.o │ ├── srw.pptx │ ├── srw.so │ ├── srw2.pptx │ ├── srw_sim.R │ └── srw_sim.pptx ├── state space Schaefer models │ ├── schaefer_r │ │ ├── schaefer.dat │ │ ├── schaefer_r.R │ │ └── schaefer_r.cpp │ ├── schaefer_r_Millar │ │ ├── schaefer.dat │ │ ├── schaefer_r.R │ │ └── schaefer_r.cpp │ └── schaefer_r_posfun │ │ ├── schaefer.dat │ │ ├── schaefer_r.R │ │ └── schaefer_r.cpp ├── vonbert │ └── vonbert.dat └── wt │ ├── README.md │ ├── wt.dat │ ├── wt.tpl │ ├── wtmb.R │ ├── wtmb.cpp │ ├── wtmb.dat │ └── wtmbcv.dat ├── images ├── ADMBTMB_Logo.png ├── IMG_0893.jpg └── IMG_0896.jpg ├── projects ├── cpplibrary.txt ├── debugging.txt ├── examples.txt ├── mcmc.txt ├── models.md ├── vignette.Rnw ├── vignette.md └── vignette.pdf └── slides ├── README.md ├── day1 ├── data.pdf ├── par.pdf └── software.pdf ├── day2 └── nonlinear.pdf └── day3 ├── Intro_to_random_effects.pptx └── MCMC_in_TMB.pptx /ADMB-TMB-Announcement.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/TMB-ADMB-Workshops/Feb2016/c0ccb76b036f072ee2815f74a5cc6d8a710bbe6b/ADMB-TMB-Announcement.pdf -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Introductory TMB (and ADMB comparison) workshop 2 | ![ADMB/TMB is Awesome!](images/ADMBTMB_Logo.png "ADMB-TMB is awesome and magical...") 3 | ![ADMB/TMB is Awesome!](images/IMG_0893.jpg "The crowd!") 4 | ![ADMB/TMB is Awesome!](images/IMG_0896.jpg "at work...") 5 | 6 | [Link to original announcement](https://github.com/TMB-ADMB-Workshops/Feb2016/blob/master/ADMB-TMB-Announcement.pdf) 7 | 8 | Feb 8-12th 2016 9 | 9AM - 5PM each day, breaks occasionally 10 | 11 | Room 106 12 | School of Aquatic and Fisheries Sciences 13 | 1122 NE Boat St, Seattle, WA 98105 14 | 15 | 16 | ## Summary 17 | Template Model Builder (TMB) advances practices developed in ADMB by improving ways to deal with random effects and 18 | a wider range of contributed libraries. This introductory workshop will help familiarize participants with approaches 19 | to model development in TMB. Contrasts with ADMB will be covered, though participants are not required to be proficient in ADMB. Participants are assumed to have a background in applied statistics and statistical computing. Specifically, some experience fitting nonlinear models to data (in stock assessment or elsewhere) and basic programming skills. 20 | **Arni Magnusson** and **Jim Thorson** will guide the workshop; participation is be open to NOAA staff who are able to attend, UW students, and other interested scientists depending on space availability. Workshop facilitation by Jim Ianelli and any other volunteers. UW Spring Quarter 4-credit course: “Spatio-temporal models for ecologists” will use TMB extensively. 21 | 22 | ###Activities 23 | 1. Overview of different ways to install and update TMB, incl. GitHub repository access 24 | 2. Overview of TMB workflow and alternative working environments 25 | 3. Demonstrations and exercises, starting with simple models and gradually adding complexity 26 | 4. Statistical techniques to evaluate uncertainty and the use of random effects, as well as debugging 27 | 5. User-specific applications 28 | 6. Identify areas where enhancements to TMB documentation and training are needed 29 | 30 | Dates 31 | : February 8-12, 2016 32 | 33 | Contact 34 | : Jim.Ianelli@noaa.gov for registration and questions. 35 | 36 | ## Format 37 | The general structure of the workshop is that mornings will be lectures and demonstrations (how to build TMB models), while afternoons 38 | will be explorations of different software components (how to contribute to TMB development). Throughout the workshop, we will get an overview of the existing TMB documentation and identify where enhancements are needed. 39 | 40 | People who are unable to attend the whole workshop are encouraged to drop in whenever they can. 41 | 42 | The afternoons will not follow a rigid structure, so participants can focus on a particular software component in their area of expertise and interest. In particular, from Wednesday afternoon it is planned that users will be able to implement their model of interest for their own research. 43 | 44 | ## Schedule 45 | | Day | AM/PM | Activity | 46 | |-----|-------|----------| 47 | |Mon|am| Intro to TMB, building simple models | 48 | |Mon|pm| Closer look at installation, GitHub, RStudio/Emacs/other | 49 | |Tue |am| Working with parameters, nonlinear models | 50 | |Tue |pm| Anatomy of the TMB package, objects, and overall design, group projects (breakouts?)| 51 | |Tue (Fat) |ppm| Some sort of Mardi gras celebration... | 52 | |Wed|am| Group project updates, Stock assessment models, debugging, uncertainty estimates, MCMC developments (Cole) | 53 | |Wed|pm| Debugging in TMB, contributing to the development, working on projects from groups| 54 | |Thu|am| Group project updates, Random effects, geostatistical methods | 55 | |Thu|pm| Related C++ libraries and R packages, CppAD, glmmTMB | 56 | |Fri|am| Group project updates, Geostatistical and spatio-temporal models continued | 57 | |Fri|pm| TBD (one degree of freedom) | 58 | 59 | ## Topics to consider for breakout groups 60 | Below are some case studies that might be of interest for different groups (**please consider submitting your topic of interest!**) 61 | 62 | * Random effects for estimating future fishery weights at age (Jim I.) 63 | * Time series modeling (building from examples) 64 | 65 | ## Remote access 66 | 1. Please join my meeting. https://global.gotomeeting.com/join/534027645 67 | 68 | 2. Use your microphone and speakers (VoIP) - a headset is recommended. Or, call in using your telephone. 69 | 70 | * Dial +1 (224) 501-3312 71 | * Access Code: 534-027-645 72 | * Audio PIN: Shown after joining the meeting 73 | 74 | * Meeting ID: 534-027-645 75 | 76 | 77 | Arni, did you have an updated sense of how to structure the workshop given then exchanges we had yesterday? I think we had settled on a morning-lecture, afternoon-workshop format with 2 days devoted to the geostatistical index standardization tool and spatio-temporal models. do you have ideas for teh remaining 3 days? 78 | 79 | ## TMB Improvement efforts 80 | Below is a list provided from the core developer (Kasper Kristiansen) on ways the workshop may contribute to the TMB work. 81 | 82 | 1. Documentation. Some example tasks: 83 | * Create text versions of Latex displaymath formulas (so that formulas show up nicely not only in the pdf docs). 84 | * Doxygen documentation clean up. 85 | * Roxygen documentation clean up. 86 | 87 | 2. More streamlined testing workflow. Could be something like travis 88 | (Ben Bolker set it up for glmmTMB). But travis might not be sufficient. 89 | The ideal setup should run *all* tests on *all* combinations of 90 | * Operating system 91 | * With/without precompile 92 | * CRAN version / not CRAN version 93 | It should further be able to detect performance regressions - both 94 | in terms of runtime, compilation time and memory usage. 95 | (BTW we should keep an eye on https://github.com/r-hub/proposal ) 96 | 97 | 3. Make debugging work on windows. 98 | 99 | 4. Make good consistent test scripts of e.g. the TMB array class, 100 | matrices etc. Purpose is to demonstrate syntax and test for 101 | correctness. There are some tests in "adcomp/tmb_syntax" but it 102 | needs improvement. 103 | 104 | # Participants 105 | 106 | | name | email | notes | N | 107 | | --- | --- | --- | --- | 108 | |Arni Magnusson |arnima@hafro.is |Hafro, Instructor! |1| 109 | |Jim Thorson |James.Thorson@noaa.gov |NOAA, Instructor! |2| 110 | |Jim Ianelli |jim.ianelli@noaa.gov |NOAA Uber Excel User| 3| 111 | |Kirstin Holsman |Kirstin.Holsman@noaa.gov|NOAA|4| 112 | |Martin Dorn |martin.dorn@noaa.gov |NOAA, limited experience |5| 113 | |Steve Martell |Martell.Steve@gmail.com |SeaState, Mac fanboy |6| 114 | |Lee Qi |leeqi@uw.edu |UW |7| 115 | |Teresa A’mar |teresa.amar@noaa.gov |NOAA Off of Sci and Tech. |8| 116 | |Gwladys Lambert |gwladys.lambert@noaa.gov |NOAA Post doc |9| 117 | |Johnoel Ancheta |johnoel@hawaii.edu |Univ of Hawaii, ADMB dude |10| 118 | |Felipe Carvalho |felipe.carvalho@noaa.gov |JIMAR/NOAA |11| 119 | |Yi-Jay Chang |yi-jay.chang@noaa.gov |JIMAR |12| 120 | |Marc Nadon |marc.nadon@noaa.gov |JIMAR |13| 121 | |Jessica Hale |jrh33@uw.edu |UW |14| 122 | |Paul Spencer |Paul.Spencer@noaa.gov |NOAA |15| 123 | |Anne Hollowed |Anne.Hollowed@noaa.gov |NOAA First day or 2 |16| 124 | |Marie Ferguson |marie.ferguson@noaa.gov |NOAA |17| 125 | |Andre Punt |aepunt@uw.edu |UW |18| 126 | |Brandon Chasco |brandon.chasco@gmail.com |UW/OSU |19| 127 | |Jin Gao|jingao@uw.edu | |20| 128 | |Cole Monnahan|monnahc@uw.edu | |21| 129 | |Bill Clark| | | 22| 130 | |Kelli Johnson |kfjohns@uw.edu | |23| 131 | |Allan Hicks |Allan.Hicks@noaa.gov | |24| 132 | |Noble Hendrix | | |25| 133 | |Elizabeth Phillips |emp11@uw.edu| |26 | 134 | 135 | ## Remote access participants 136 | SEFSC Beaufort lab 137 | 138 | NEFSC Legault/Brooks/Shank 139 | 140 | (D)UMASS Gavin Fay, Megan Winton (mwinton@umassd.edu) 141 | 142 | NWFSC / Newport lab 143 | 144 | SWFSC (Huihua, 5-10 people) 145 | -------------------------------------------------------------------------------- /TMB_experiments/.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | *.dll 3 | *.so -------------------------------------------------------------------------------- /TMB_experiments/MakeADFun_windows_debug/MakeADFun_windows_debug.R: -------------------------------------------------------------------------------- 1 | 2 | MakeADFun_windows_debug = function( cpp_name, data, parameters, random=NULL, dir=getwd(), overwrite=FALSE, recompile=TRUE, ... ){ 3 | 4 | # Set local working directory 5 | orig_dir = getwd() 6 | setwd( dir ) 7 | on.exit( setwd(orig_dir) ) 8 | 9 | # Recompile 10 | if( recompile==TRUE ){ 11 | unlink( dynlib(cpp_name) ) 12 | compile( paste0(cpp_name,".cpp"), "-O1 -g", DLLFLAGS="") 13 | dyn.load( dynlib(cpp_name) ) 14 | message( "Recompiling .cpp file with appropriate compiler flags" ) 15 | } 16 | 17 | # Get and save inputs 18 | Other_inputs = list(...) 19 | All_inputs = list( "data"=data, "parameters"=parameters, "random"=random, "Other_inputs"=Other_inputs ) 20 | save( All_inputs, file="All_inputs.RData") 21 | 22 | # Write file to source 23 | if( (paste0(cpp_name,".R") %in% list.files()) & overwrite==FALSE ){ 24 | message( "By default, we don't overwrite existing file ",cpp_name,".R") 25 | Return = "Didn't attempt running" 26 | }else{ 27 | sink( paste0(cpp_name,".R") ) 28 | cat(" 29 | library( TMB ) 30 | dyn.load( dynlib('",cpp_name,"') ) 31 | setwd('",dir,"') 32 | load( 'All_inputs.RData' ) 33 | Obj = MakeADFun(data=All_inputs[['data']], parameters=All_inputs[['parameters']], random=All_inputs[['random']], All_inputs[['Other_inputs']]) 34 | save( Obj, file='Obj.RData') 35 | ",fill=FALSE,sep="") 36 | sink() 37 | 38 | # Try running 39 | Bdg_output = gdbsource(paste0(cpp_name,".R")) 40 | 41 | # Sort out outcomes 42 | if( length(grep("#0",Bdg_output))==0 ){ 43 | Return = MakeADFun(data=All_inputs[['data']], parameters=All_inputs[['parameters']], random=All_inputs[['random']], All_inputs[['Other_inputs']]) 44 | message("Compiled fine, and returning output from MakeADFun") 45 | }else{ 46 | Return = Bdg_output 47 | message("Did not compile, and returning output from bdbsource") 48 | #print( Bdg_output ) 49 | } 50 | } 51 | 52 | # Return 53 | return( Return ) 54 | } 55 | -------------------------------------------------------------------------------- /TMB_experiments/MakeADFun_windows_debug/test_MakeADFun_windows_debug.R: -------------------------------------------------------------------------------- 1 | 2 | File = "C:/Users/James.Thorson/Desktop/Project_git/TMB_experiments/windows_debugger" 3 | setwd( File ) 4 | source( "MakeADFun_windows_debug.R" ) 5 | 6 | ##################### 7 | # Simulate data 8 | ###################### 9 | 10 | Factor = rep( 1:10, each=10) 11 | Z = rnorm( length(unique(Factor)), mean=0, sd=1) 12 | 13 | X0 = 0 14 | 15 | Y = Z[Factor] + X0 + rnorm( length(Factor), mean=0, sd=1) 16 | 17 | ###################### 18 | # Experiment with debugger 19 | ###################### 20 | 21 | library(TMB) 22 | cpp_name = "problem" 23 | #compile( paste0(cpp_name,".cpp"), "-O1 -g", DLLFLAGS="") 24 | compile( paste0(cpp_name,".cpp") ) 25 | 26 | data = list( "n_data"=length(Y), "n_factors"=length(unique(Factor)), "Factor"=Factor-1, "Y"=Y) 27 | parameters = list( "X0"=-10, "log_SD0"=2, "log_SDZ"=2, "Z"=rep(0,data$n_factor) ) 28 | random = c("Z") 29 | 30 | #dyn.load( dynlib(cpp_name) ) 31 | Output = MakeADFun_windows_debug( data=data, cpp_name=cpp_name, dir=File, parameters=parameters, random=random, overwrite=TRUE ) 32 | -------------------------------------------------------------------------------- /TMB_experiments/README.md: -------------------------------------------------------------------------------- 1 | # TMB_experiments 2 | Experiments involving TMB 3 | -------------------------------------------------------------------------------- /TMB_experiments/experiment_with_SCALE/experiment_involving_SCALE.R: -------------------------------------------------------------------------------- 1 | 2 | library(TMB) 3 | 4 | mu_b = 2 5 | sigma_b = 2 6 | sigma_c = 1 7 | 8 | b_g = rnorm(10, mean=mu_b, sd=sigma_b) 9 | g_i = rep(1:10,each=10) 10 | y_i = b_g[g_i] + rnorm(length(g_i), mean=0, sd=sigma_c) 11 | 12 | # sanity check 13 | library(lme4) 14 | Lm = lmer( y_i ~ 1 + 1|g_i ) 15 | summary(Lm) 16 | 17 | # compile both models 18 | compile( "linear_model.cpp" ) 19 | compile( "linear_model_using_scale.cpp" ) 20 | 21 | # Build inputs (same for both models) 22 | Data = list( "g_i"=g_i-1, "y_i"=y_i) 23 | Parameters = list( "mu"=-10, "logsigma_y"=2, "logsigma_g"=2, "b_g"=rep(0,length(unique(g_i))) ) 24 | Random = c("b_g") 25 | 26 | 27 | ################ 28 | # In TMB, without using scale 29 | # WORKS CORRECTLY 30 | ################ 31 | 32 | # Build object 33 | dyn.load( dynlib("linear_model") ) 34 | Obj = MakeADFun(data=Data, parameters=Parameters, random=Random) 35 | 36 | # Optimize 37 | Opt = nlminb( start=Obj$par, objective=Obj$fn, gradient=Obj$gr, control=list("trace"=1) ) 38 | Report = Obj$report() 39 | exp( unlist(Report[c('logsigma_g','logsigma_y')]) ) 40 | 41 | ################ 42 | # In TMB, using scale 43 | # DOES NOT WORK CORRECTLY 44 | ################ 45 | 46 | # Build object 47 | dyn.load( dynlib("linear_model_using_scale") ) 48 | Obj = MakeADFun(data=Data, parameters=Parameters, random=Random) 49 | 50 | # Optimize 51 | Opt = nlminb( start=Obj$par, objective=Obj$fn, gradient=Obj$gr, control=list("trace"=1) ) 52 | Report = Obj$report() 53 | exp( unlist(Report[c('logsigma_g','logsigma_y')]) ) 54 | 55 | -------------------------------------------------------------------------------- /TMB_experiments/experiment_with_SCALE/linear_model.cpp: -------------------------------------------------------------------------------- 1 | // Space time 2 | #include 3 | template 4 | Type objective_function::operator() () 5 | { 6 | using namespace density; 7 | 8 | // Data 9 | DATA_VECTOR( y_i ); 10 | DATA_FACTOR( g_i ); 11 | 12 | // Parameters 13 | PARAMETER( mu ); 14 | PARAMETER( logsigma_y ); 15 | PARAMETER( logsigma_g ); 16 | PARAMETER_VECTOR( b_g ); 17 | 18 | int n_data = y_i.size(); 19 | int n_factors = b_g.size(); 20 | 21 | // Objective funcction 22 | Type jnll = 0; 23 | 24 | // Probability of random coefficients 25 | matrix Cov_gg(n_factors, n_factors); 26 | Cov_gg.setIdentity(); 27 | Cov_gg = exp(2*logsigma_g) * Cov_gg; 28 | MVNORM_t nll_mvnorm(Cov_gg); 29 | jnll += nll_mvnorm( b_g ); 30 | 31 | // Probability of data conditional on fixed and random effect values 32 | for( int i=0; i 3 | template 4 | Type objective_function::operator() () 5 | { 6 | using namespace density; 7 | 8 | // Data 9 | DATA_VECTOR( y_i ); 10 | DATA_FACTOR( g_i ); 11 | 12 | // Parameters 13 | PARAMETER( mu ); 14 | PARAMETER( logsigma_y ); 15 | PARAMETER( logsigma_g ); 16 | PARAMETER_VECTOR( b_g ); 17 | 18 | int n_data = y_i.size(); 19 | int n_factors = b_g.size(); 20 | 21 | // Objective funcction 22 | Type jnll = 0; 23 | 24 | // Rescale 25 | vector beta_g(n_factors); 26 | beta_g = b_g * exp(logsigma_g); 27 | 28 | // Probability of random coefficients 29 | matrix Cov_gg(n_factors, n_factors); 30 | Cov_gg.setIdentity(); 31 | MVNORM_t nll_mvnorm(Cov_gg); 32 | jnll += SCALE(nll_mvnorm, exp(logsigma_g))( beta_g ); 33 | 34 | // Probability of data conditional on fixed and random effect values 35 | for( int i=0; i 3 | template 4 | Type objective_function::operator() () 5 | { 6 | // Data 7 | DATA_INTEGER( n_data ); 8 | DATA_INTEGER( n_factors ); 9 | DATA_FACTOR( Factor ); 10 | DATA_VECTOR( Y ); 11 | DATA_VECTOR_INDICATOR(keep, Y); 12 | 13 | // Parameters 14 | PARAMETER( X0 ); 15 | PARAMETER( log_SD0 ); 16 | PARAMETER( log_SDZ ); 17 | PARAMETER_VECTOR( Z ); 18 | 19 | // Objective funcction 20 | Type jnll = 0; 21 | 22 | // Probability of data conditional on fixed and random effect values 23 | for( int i=0; i 2 | template 3 | Type objective_function::operator() () 4 | { 5 | DATA_VECTOR(Y); 6 | DATA_VECTOR(x); 7 | PARAMETER(a); 8 | PARAMETER(b); 9 | PARAMETER(logSigma); 10 | parallel_accumulator nll(this); 11 | for(int i=0;i 3 | /** \brief Matrix exponential: matrix of arbitrary dimension. */ 4 | template 5 | struct matexp_mod{ 6 | typedef Matrix matrix; 7 | typedef Matrix ,dim,dim> cmatrix; 8 | typedef Matrix ,dim,1> cvector; 9 | cmatrix V; 10 | cmatrix iV; 11 | cvector lambda; 12 | EigenSolver< matrix > eigensolver; 13 | matexp(){}; 14 | matexp(matrix A_){ 15 | eigensolver.compute(A_); 16 | V=eigensolver.eigenvectors(); 17 | lambda=eigensolver.eigenvalues(); 18 | iV=V.inverse(); 19 | } 20 | matrix operator()(scalartype t){ 21 | cmatrix tmp; 22 | tmp.setZero(); 23 | matrix ans; 24 | for(int i=0;i 37 | Type objective_function::operator() () 38 | { 39 | // Data 40 | DATA_VECTOR( c_i ); 41 | 42 | // Parameters 43 | PARAMETER( beta ); 44 | PARAMETER( rho ); 45 | PARAMETER( sigma2 ); 46 | 47 | // Probability of random effects 48 | int n_y = c_i.size(); 49 | matrix Q_yy( n_y, n_y ); 50 | Q_yy.setZero(); 51 | for(int y=0; y Qsparse_yy = asSparseMatrix( Q_yy ); 60 | Type Q_yy_determinant = Q_yy.determinant(); 61 | REPORT( Qsparse_yy ); 62 | REPORT( Q_yy_determinant ); 63 | 64 | // LDLT operations 65 | // https://github.com/kaskr/adcomp/blob/master/TMB/inst/include/Eigen/src/Cholesky/LDLT.h 66 | matrix L = Q_yy.ldlt().matrixL(); 67 | vector diagD = Q_yy.ldlt().vectorD(); 68 | vector V = Q_yy.jacobiSvd().computeV(); 69 | REPORT( L ); 70 | REPORT( diagD ); 71 | REPORT( V ); 72 | 73 | // Eigenvalues 74 | // EXAMPLE AT: https://github.com/kaskr/adcomp/blob/master/TMB/inst/include/tmbutils/matexp.hpp 75 | //Eigen::EigenSolver< Eigen::SparseMatrix > eigensolver; 76 | //eigensolver.compute( Qsparse_yy, true ); 77 | Eigen::EigenSolver< matrix > eigensolver; 78 | Eigen::Matrix< Type, Eigen::Dynamic, Eigen::Dynamic > Tmp_yy = Q_yy; 79 | //Eigen::EigenSolver< matrix > eigensolver( Tmp_yy ); 80 | //eigensolver.compute( Q_yy ); 81 | //matrix V = eigensolver.eigenvectors(); 82 | //vector lambda = eigensolver.eigenvalues(); 83 | //Q_yy.doComputeEigenvectors(); 84 | vector< std::complex< Type > > eigenvalues_Q_yy = Q_yy.eigenvalues(); 85 | vector< Type > real_eigenvalues_Q_yy = eigenvalues_Q_yy.real(); 86 | vector< Type > imag_eigenvalues_Q_yy = eigenvalues_Q_yy.imag(); 87 | REPORT( real_eigenvalues_Q_yy ); 88 | REPORT( imag_eigenvalues_Q_yy ); 89 | 90 | // Eigenvectors 91 | // http://eigen.tuxfamily.org/dox-devel/classEigen_1_1EigenSolver.html#a8c287af80cfd71517094b75dcad2a31b 92 | using namespace Eigen; 93 | // WORKS 94 | MatrixXf A = MatrixXf::Random(4,4); 95 | EigenSolver es(A); 96 | //es.compute(A); 97 | es.eigenvectors(); 98 | // TESTING 99 | EigenSolver< matrix > es_type( ); 100 | //MatrixXf A = MatrixXf::Random(4,4); 101 | //es.compute(Q_yy); 102 | //es.eigenvectors(); 103 | 104 | // QR decomposition 105 | 106 | // Schur decomposition 107 | // https://github.com/kaskr/adcomp/blob/master/TMB/inst/include/Eigen/src/Eigenvalues/RealSchur.h 108 | Eigen::RealSchur< matrix > realschur; 109 | //realschur.compute( Q_yy, true ); 110 | 111 | // SVD experiments 112 | Q_yy.jacobiSvd(); 113 | Q_yy.jacobiSvd().computeV(); 114 | 115 | // Kroenecker 116 | matrix QQ_yy = kronecker(Q_yy, Q_yy); 117 | Eigen::SparseMatrix QQsparse_yy = asSparseMatrix( QQ_yy ); 118 | REPORT( QQ_yy ); 119 | REPORT( QQsparse_yy ); 120 | //REPORT( QQsparse_yy ); 121 | 122 | // Probability of data conditional on random effects 123 | Type Total_Abundance = 0; 124 | Type jnll = 0; 125 | for( int i=0; i 3 | 4 | using namespace Eigen; 5 | using namespace tmbutils; 6 | 7 | /* List of sparse matrices */ 8 | template 9 | struct LOSM_t : vector > { 10 | LOSM_t(SEXP x){ /* x = List passed from R */ 11 | (*this).resize(LENGTH(x)); 12 | for(int i=0; i(sm); 17 | } 18 | } 19 | }; 20 | 21 | template 22 | Type objective_function::operator() () 23 | { 24 | // Data 25 | DATA_STRUCT( LOSM, LOSM_t); 26 | DATA_VECTOR( c_i ); 27 | 28 | // Parameters 29 | PARAMETER( beta ); 30 | SparseMatrix LOSM_0 = LOSM(0); 31 | REPORT( LOSM_0 ); 32 | 33 | // Probability of data conditional on random effects 34 | Type jnll = 0; 35 | for( int i=0; i 3 | template 4 | Type objective_function::operator() () 5 | { 6 | // Data 7 | DATA_INTEGER( n_data ); 8 | DATA_INTEGER( n_factors ); 9 | DATA_FACTOR( Factor ); 10 | DATA_VECTOR( Y ); 11 | 12 | // Parameters 13 | PARAMETER( X0 ); 14 | PARAMETER( log_SD0 ); 15 | PARAMETER( log_SDZ ); 16 | PARAMETER_VECTOR( Z ); 17 | 18 | // Objective funcction 19 | Type jnll = 0; 20 | 21 | // Probability of data conditional on fixed and random effect values 22 | for( int i=0; i 2 | 3 | template 4 | Type objective_function::operator()() 5 | { 6 | DATA_FACTOR(Sex); 7 | DATA_VECTOR(Age); 8 | DATA_VECTOR(Length); 9 | int n = Length.size(); 10 | 11 | // These are the parameters (three are vectors; one is a scalar) 12 | PARAMETER_VECTOR(Linf); 13 | PARAMETER_VECTOR(Kappa); 14 | PARAMETER_VECTOR(t0); 15 | PARAMETER(LogSigma); 16 | Type Sigma = exp(LogSigma); 17 | vector LengthPred(n); 18 | 19 | // Provide the standard error of Sigma 20 | ADREPORT(Sigma); 21 | 22 | // Predictions and likelihoods 23 | for(int i=0;iLenPred(2,50); 36 | for (int Isex=0;Isex<2;Isex++) 37 | for (int Iage=1;Iage<=50;Iage++) 38 | { 39 | Temp = Kappa(Isex)*(Iage*1.0-t0(Isex)); 40 | LenPred(Isex,Iage-1) = Linf(Isex)*(1.0-exp(-Temp)); 41 | } 42 | REPORT(LenPred); 43 | 44 | return nll; 45 | } 46 | -------------------------------------------------------------------------------- /examples/andre/ex1.dat: -------------------------------------------------------------------------------- 1 | Sex,Age,Length 2 | 1,7,57.51808 3 | 1,33,87.04459 4 | 2,7,74.32241 5 | 2,1,29.69207 6 | 2,31,120.2029 7 | 1,30,78.25303 8 | 1,10,67.2168 9 | 2,13,101.0358 10 | 2,7,78.1776 11 | 2,35,132.3061 12 | 1,27,107.0326 13 | 2,8,77.16505 14 | 1,24,83.04295 15 | 1,46,119.7604 16 | 1,38,113.0029 17 | 1,19,80.52408 18 | 2,36,104.8487 19 | 2,28,119.7076 20 | 1,1,6.475671 21 | 2,27,113.8016 22 | 1,2,38.43588 23 | 2,41,112.3848 24 | 1,21,96.28514 25 | 1,46,121.6375 26 | 1,32,101.7448 27 | 2,9,83.63897 28 | 1,46,101.4904 29 | 2,34,98.63283 30 | 1,13,71.50858 31 | 1,25,113.6704 32 | 2,2,49.66876 33 | 2,28,119.8914 34 | 2,42,95.61052 35 | 2,22,120.5452 36 | 2,5,77.92243 37 | 1,31,95.91126 38 | 1,18,66.74442 39 | 1,7,52.52602 40 | 1,10,71.25958 41 | 2,34,106.7729 42 | 1,25,112.8934 43 | 2,19,122.4076 44 | 2,23,101.3863 45 | 2,2,41.9311 46 | 1,26,94.29129 47 | 2,41,135.6038 48 | 1,25,95.57814 49 | 1,33,104.3382 50 | 2,15,101.8061 51 | 2,32,121.6869 52 | 1,38,101.1677 53 | 1,14,62.28548 54 | 2,34,108.2428 55 | 1,19,85.79378 56 | 1,25,92.4545 57 | 2,45,114.577 58 | 1,4,45.1176 59 | 1,28,95.66213 60 | 2,26,99.59947 61 | 1,44,87.65075 62 | 2,9,92.35214 63 | 2,28,142.4652 64 | 1,41,83.07737 65 | 1,39,99.94956 66 | 1,40,97.02499 67 | 1,4,40.53681 68 | 1,34,101.1599 69 | 1,35,95.71634 70 | 1,40,106.7924 71 | 2,9,79.3135 72 | 1,43,127.7615 73 | 1,7,43.42769 74 | 2,2,27.59027 75 | 2,36,125.6934 76 | 2,17,96.83629 77 | 2,23,99.07826 78 | 2,13,92.69389 79 | 1,29,86.92906 80 | 2,10,95.15312 81 | 1,3,25.10526 82 | 2,43,125.7784 83 | 2,12,91.56149 84 | 1,33,102.4311 85 | 2,12,95.06821 86 | 1,4,37.63437 87 | 1,27,97.1271 88 | 1,6,28.55416 89 | 1,14,76.73969 90 | 1,6,56.3901 91 | 1,1,14.21677 92 | 1,39,104.6974 93 | 1,2,2.977991 94 | 2,12,85.98545 95 | 1,27,93.84375 96 | 2,13,94.07341 97 | 1,2,15.32432 98 | 1,43,103.6852 99 | 2,37,129.132 100 | 1,15,88.08342 101 | 2,44,126.1878 102 | -------------------------------------------------------------------------------- /examples/andre/schaefer.R: -------------------------------------------------------------------------------- 1 | setwd("~/_mymods/tmb/Feb2016/examples/andre") 2 | hake <- read.table("schaefer.dat", header=TRUE) 3 | names(hake) <- c("t", "C", "I") 4 | Nyear <- length(hake$C) 5 | parameters <- list(logR=-1.1, logK=8.0, logQ=-7.9, logSigma=-2.3,FF=rep(-2,Nyear)) 6 | print(parameters) 7 | 8 | require(TMB) 9 | compile("schaefer.cpp") 10 | dyn.load(dynlib("schaefer")) 11 | 12 | ################################################################################ 13 | 14 | model <- MakeADFun(hake, parameters,DLL="schaefer") 15 | # Added some options for nlminb 16 | fit <- nlminb(model$par, model$fn, model$gr,control=list(iter.max=1000,eval.max=1000)) 17 | names(fit) 18 | fit$iterations 19 | 20 | # Do some extra minimizations 21 | for (i in 1:3) 22 | fit <- nlminb(model$env$last.par.best , model$fn, model$gr) 23 | model$gr(fit$par) 24 | rep <- sdreport(model) 25 | 26 | print(summary(rep)) 27 | 28 | ################################################################################ 29 | 30 | hake$B <- model$report()$B[1:Nyear] 31 | hake$Ihat <- model$report()$Ihat 32 | 33 | par(mfrow=c(1,2)) 34 | matplot(hake$t, hake[c("C","B")], type="l", 35 | xlab="Year", ylab="Biomass and Catch (kt)") 36 | plot(I~t, hake, ylim=c(0,1.1*max(hake$I)), yaxs="i") 37 | lines(Ihat~t, hake) 38 | 39 | -------------------------------------------------------------------------------- /examples/andre/schaefer.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | 4 | template 5 | Type posfun(Type x, Type eps, Type &pen) 6 | { 7 | if ( x >= eps ){ 8 | return x; 9 | } else { 10 | pen += Type(0.01) * pow(x-eps,2); 11 | return eps/(Type(2.0)-x/eps); 12 | } 13 | } 14 | 15 | template 16 | Type objective_function::operator() () 17 | { 18 | DATA_VECTOR(C); 19 | DATA_VECTOR(I); 20 | int n = C.size(); 21 | 22 | PARAMETER(logR); 23 | PARAMETER(logK); 24 | PARAMETER(logQ); 25 | PARAMETER(logSigma); 26 | PARAMETER_VECTOR(FF); 27 | Type r = exp(logR); 28 | Type k = exp(logK); 29 | Type q = exp(logQ); 30 | Type sigma = exp(logSigma); 31 | int n1 = 0; 32 | n1 = n + 1; 33 | vector B(n1); 34 | vector Ihat(n); 35 | vector Chat(n); 36 | vector ExpOut(n); 37 | Type f; 38 | B(0) = k; 39 | for(int t=0; t=eps) { 66 | // return x; 67 | // } else { 68 | // pen+=.01*square(x-eps); 69 | // return eps/(2-x/eps); 70 | // } } 71 | 72 | 73 | -------------------------------------------------------------------------------- /examples/andre/schaefer.dat: -------------------------------------------------------------------------------- 1 | Year Catch Index 2 | 1965 93.510 1.78 3 | 1966 212.444 1.31 4 | 1967 195.032 0.91 5 | 1968 382.712 0.96 6 | 1969 320.430 0.88 7 | 1970 402.467 0.90 8 | 1971 365.557 0.87 9 | 1972 606.084 0.72 10 | 1973 377.642 0.57 11 | 1974 318.836 0.45 12 | 1975 309.374 0.42 13 | 1976 389.020 0.42 14 | 1977 276.901 0.49 15 | 1978 254.251 0.43 16 | 1979 170.006 0.40 17 | 1980 97.181 0.45 18 | 1981 90.523 0.55 19 | 1982 176.532 0.53 20 | 1983 216.181 0.58 21 | 1984 228.672 0.64 22 | 1985 212.177 0.66 23 | 1986 231.179 0.65 24 | 1987 136.942 0.61 25 | 1988 212.000 0.63 26 | -------------------------------------------------------------------------------- /examples/andre/ttt.R: -------------------------------------------------------------------------------- 1 | setwd("F:\\") 2 | TheD <- read.csv("Ex1.Dat") 3 | print(TheD) 4 | 5 | data <- list() 6 | data$Sex <- TheD[,1]-1 7 | data$Age <- TheD[,2] 8 | data$Length <- TheD[,3] 9 | 10 | param <- list() 11 | param$Linf <- c(100,100) 12 | param$Kappa <- c(0.1,0.1) 13 | param$t0 <- c(0,0) 14 | param$LogSigma <- 0.1 15 | 16 | require(TMB) 17 | compile("ex1.cpp") 18 | dyn.load(dynlib("ex1")) 19 | 20 | # Model #1 21 | obj1 <- MakeADFun(data, param, DLL="ex1",map=list(t0=factor(c(NA,NA))),silent=T) 22 | opt1 <- nlminb(obj1$par, obj1$fn, obj1$gr) 23 | AIC1 <- 2*opt1$objective + 2*length(opt1$par) 24 | summary(sdreport(obj1)) 25 | 26 | # Model #2 27 | obj2 <- MakeADFun(data, param, DLL="ex1",map=list(Kappa=factor(c(1,1)))) 28 | opt2 <- nlminb(obj2$par, obj2$fn, obj2$gr) 29 | AIC2 <- 2*opt2$objective + 2*length(opt2$par) 30 | summary(sdreport(obj2)) 31 | 32 | # Model #3 33 | obj3 <- MakeADFun(data, param, DLL="ex1",map=list(Linf=factor(c(1,1)),Kappa=factor(c(1,1)),t0=factor(c(1,1)))) 34 | opt3 <- nlminb(obj3$par, obj3$fn, obj3$gr) 35 | AIC3 <- 2*opt2$objective + 2*length(opt3$par) 36 | summary(sdreport(obj3)) 37 | 38 | # Report the AIC values 39 | cat(AIC1,AIC2,AIC3,"\n") 40 | 41 | # Plot the best fir (sadly model 3) 42 | par(mfrow=c(2,2)) 43 | for (Isex in 1:2) 44 | { 45 | plot(TheD[data$Sex==(Isex-1),2],TheD[data$Sex==(Isex-1),3],pch=16,xlab="Age",ylab="Length") 46 | lines(1:50,obj3$report()$LenPred[Isex,]) 47 | } 48 | 49 | 50 | -------------------------------------------------------------------------------- /examples/bevholt/bevholt.R: -------------------------------------------------------------------------------- 1 | data <- read.table("bevholt.dat", header=TRUE) 2 | ## plot(R~S, data, xlim=c(0,400), ylim=c(0,200)) 3 | 4 | parameters <- list(logRmax=log(400), logS50=log(100), logSigma=0) 5 | 6 | require(TMB) 7 | compile("bevholt.cpp") 8 | dyn.load(dynlib("bevholt")) 9 | 10 | ################################################################################ 11 | 12 | model <- MakeADFun(data, parameters, DLL="bevholt") 13 | fit <- nlminb(model$par, model$fn, model$gr) 14 | 15 | best <- model$env$last.par.best 16 | rep <- sdreport(model) 17 | 18 | print(best) 19 | print(rep) 20 | summary(rep) 21 | 22 | Svec <- seq(0, 4000, 20) 23 | Rmax <- exp(best[["logRmax"]]) 24 | S50 <- exp(best[["logS50"]]) 25 | Rvec <- Rmax * Svec / (Svec + S50) 26 | ## lines(Rvec~Svec) 27 | -------------------------------------------------------------------------------- /examples/bevholt/bevholt.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | template 4 | Type objective_function::operator() () 5 | { 6 | DATA_VECTOR(R); 7 | DATA_VECTOR(S); 8 | int n = R.size(); 9 | 10 | PARAMETER(logRmax); 11 | PARAMETER(logS50); 12 | PARAMETER(logSigma); 13 | Type Rmax = exp(logRmax); 14 | Type S50 = exp(logS50); 15 | Type sigma = exp(logSigma); 16 | vector Rhat(n); 17 | 18 | Type neglogL = 0; 19 | 20 | Rhat = Rmax * S / (S + S50); 21 | ADREPORT(Rhat); 22 | neglogL = -sum(dnorm(R, Rhat, sigma, true)); 23 | 24 | return neglogL; 25 | } 26 | -------------------------------------------------------------------------------- /examples/bevholt/bevholt.dat: -------------------------------------------------------------------------------- 1 | Year R S 2 | 1968 430.3 234.0 3 | 1969 370.9 222.7 4 | 1970 354.1 208.8 5 | 1971 306.7 184.2 6 | 1972 240.0 199.0 7 | 1973 264.8 212.0 8 | 1974 322.3 263.0 9 | 1975 432.1 339.5 10 | 1976 506.9 355.6 11 | 1977 303.7 326.9 12 | 1978 293.4 379.2 13 | 1979 479.0 579.7 14 | 1980 829.4 696.7 15 | 1981 615.4 666.1 16 | 1982 425.9 670.9 17 | 1983 689.8 645.3 18 | 1984 693.6 657.7 19 | 1985 472.4 544.9 20 | 1986 302.9 399.4 21 | 1987 253.1 320.5 22 | 1988 260.2 299.3 23 | 1989 368.1 240.3 24 | 1990 224.3 216.0 25 | 1991 122.5 151.6 26 | 1992 128.4 92.9 27 | 1993 82.8 112.7 28 | 1994 136.4 191.7 29 | 1995 182.0 237.0 30 | 1996 127.2 163.7 31 | 1997 119.6 135.5 32 | 1998 115.5 109.0 33 | 1999 88.1 90.2 34 | 2000 149.2 115.9 35 | 2001 152.3 104.2 36 | 2002 174.9 83.1 37 | 2003 135.8 80.4 38 | 2004 122.5 79.5 39 | 2005 112.7 65.6 40 | 2006 115.1 83.5 41 | 2007 164.2 101.7 42 | 2008 131.0 119.4 43 | 2009 143.8 184.0 44 | 2010 158.5 208.2 45 | 2011 161.8 211.3 -------------------------------------------------------------------------------- /examples/bevholt/bh.R: -------------------------------------------------------------------------------- 1 | # bh.R 2 | # Beverton-Holt Model R = aS/(1+bS)*exp(-epsilon*sigR) 3 | library(TMB) 4 | 5 | data <- read.table("bevholt.dat",header=TRUE) 6 | data <- list(R =data$R,S=data$S) 7 | pars <- list(log_a= log(2.1), log_b = 0, log_sig = 0, log_tau = log(0.1), 8 | u = rep(0,length=length(data$S))) 9 | 10 | compile("bh.cpp") 11 | dyn.load(dynlib("bh")) 12 | 13 | # f <- MakeADFun(data,parameters=pars,random=c("u"),ADreport = FALSE) 14 | f <- MakeADFun(data,parameters=pars,map=list(log_tau=factor(c(NA)))) 15 | fit <- nlminb(f$par,f$fn,f$gr) 16 | 17 | 18 | 19 | mle <- f$env$last.par.best 20 | rep <- sdreport(f) 21 | 22 | print(mle) 23 | print(summary(rep)) 24 | 25 | plot(data$S,data$R,pch=20,col=1) 26 | points(f$report(),pch =20,col=2) -------------------------------------------------------------------------------- /examples/bevholt/bh.cpp: -------------------------------------------------------------------------------- 1 | // bh.cpp 2 | #include 3 | 4 | template 5 | Type objective_function::operator()() 6 | { 7 | // DATA 8 | DATA_VECTOR(R) 9 | DATA_VECTOR(S) 10 | 11 | // PARAMETERS 12 | PARAMETER(log_a); 13 | PARAMETER(log_b); 14 | PARAMETER(log_sig); 15 | PARAMETER(log_tau); 16 | PARAMETER_VECTOR(u); 17 | 18 | Type a = exp(log_a); 19 | Type b = exp(log_b); 20 | Type sig = exp(log_sig); 21 | Type tau = exp(log_tau); 22 | 23 | vector x = S * exp(u); 24 | vector y = a * x / ( Type(1.0) + b * x ); 25 | vector epsi = log(R) - log(y); 26 | Type nll = 0; 27 | nll -= sum(dnorm(epsi,Type(0.0),sig,true)); 28 | nll -= sum(dnorm(u,Type(0.0),tau,true)); 29 | 30 | 31 | REPORT(x); 32 | REPORT(y); 33 | REPORT(epsi); 34 | ADREPORT(y); 35 | 36 | return nll; 37 | } 38 | 39 | -------------------------------------------------------------------------------- /examples/bevholt/bh2.R: -------------------------------------------------------------------------------- 1 | # bh.R 2 | # Beverton-Holt Model R = aS/(1+bS)*exp(epsilon*sigR) 3 | library(TMB) 4 | 5 | data <- read.table("bevholt.dat",header=TRUE) 6 | pars <- list(log_a=0, 7 | log_b = 0, 8 | log_sig = log(0.1), 9 | log_tau = log(0.1), 10 | u=rep(0,length=length(data$S)) 11 | ) 12 | 13 | compile("bh2.cpp") 14 | dyn.load(dynlib("bh2")) 15 | 16 | f <- MakeADFun(data,parameters=pars,random=c("u"),ADreport = FALSE) 17 | # f <- MakeADFun(data,parameters=pars,map=list(log_tau=factor(c(NA)))) 18 | fit <- nlminb(f$par,f$fn,f$gr) 19 | 20 | 21 | 22 | mle <- f$env$last.par.best 23 | rep <- sdreport(f) 24 | 25 | print(mle) 26 | print(summary(rep)) 27 | 28 | plot(data$S,data$R,pch=20,col=1) 29 | points(f$report(),pch =20,col=2) 30 | 31 | 32 | # Simulator 33 | set.seed(1234) 34 | n <- length(data$S) 35 | tau <- 0.35 36 | sig <- 0.20 37 | rmax <- 1200 38 | epi <- rnorm(n,0,sig) 39 | psi <- rnorm(n,0,tau) 40 | a <- 5.0 41 | b <- a/rmax 42 | X <- data$S 43 | S <- X * exp(psi-0.5*tau^2) 44 | R <- a*X / (1+b*X) * exp(epi-0.5*sig^2) 45 | xx <- seq(0,max(c(S,X,a/b)),length=n) 46 | plot(xx,a*xx/(1+b*xx),col=1,lwd=2,type="l") 47 | points(S,R); abline(a=0,b=1) 48 | 49 | # Estimation 50 | simdata <- list(R=R,S=S) 51 | simpars <- list(log_a=log(a), 52 | log_b = log(b), 53 | log_sig = log(sig), 54 | log_tau = log(tau), 55 | u=rep(0,length=n) 56 | ) 57 | ff <- MakeADFun(simdata,parameters=simpars,random=c("u"),ADreport = FALSE) 58 | fit2 <- nlminb(ff$par,ff$fn,ff$gr) 59 | 60 | rep2 <- sdreport(ff,getJointPrecision=TRUE) 61 | 62 | # Hessian 63 | H <- rep2$jointPrecision 64 | V <- solve(H) 65 | sd <- sqrt(diag(V)) 66 | R <- V / (sd %o% sd) 67 | 68 | points(ff$rep(),col=2,pch=20) 69 | 70 | # ---------------------------------------------------------------------------- # 71 | # Graphics 72 | # ---------------------------------------------------------------------------- # 73 | library(ggplot2) 74 | library(plyr) 75 | 76 | # ---------------------------------------------------------------------------- # 77 | # ---------------------------------------------------------------------------- # 78 | 79 | 80 | 81 | -------------------------------------------------------------------------------- /examples/bevholt/bh2.cpp: -------------------------------------------------------------------------------- 1 | // bh.cpp 2 | #include 3 | 4 | template 5 | Type objective_function::operator()() 6 | { 7 | // DATA 8 | DATA_VECTOR(R) 9 | DATA_VECTOR(S) 10 | 11 | // PARAMETERS 12 | PARAMETER(log_a); 13 | PARAMETER(log_b); 14 | PARAMETER(log_sig); 15 | PARAMETER(log_tau); 16 | PARAMETER_VECTOR(u); 17 | 18 | Type a = exp(log_a); 19 | Type b = exp(log_b); 20 | Type sig = exp(log_sig); 21 | Type tau = exp(log_tau); 22 | 23 | vector x = S * exp(u); 24 | vector r = a * x / ( Type(1.0) + b * x ); 25 | vector epsi = log(R) - log(r); 26 | vector y = r * exp(epsi); 27 | Type nll = 0; 28 | nll -= sum(dnorm(epsi,Type(0.0),sig,true)); 29 | nll -= sum(dnorm(u,Type(0.0),tau,true)); 30 | 31 | 32 | REPORT(x); 33 | REPORT(y); 34 | REPORT(epsi); 35 | ADREPORT(y); 36 | 37 | return nll; 38 | } 39 | 40 | -------------------------------------------------------------------------------- /examples/catage/README.md: -------------------------------------------------------------------------------- 1 | # Catage example 2 | EBS pollock data added (abbreviated model, 1991-2015) 3 | ` source("polldat.R") ` 4 | -------------------------------------------------------------------------------- /examples/catage/fsa.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/TMB-ADMB-Workshops/Feb2016/c0ccb76b036f072ee2815f74a5cc6d8a710bbe6b/examples/catage/fsa.RData -------------------------------------------------------------------------------- /examples/catage/fsa2.R: -------------------------------------------------------------------------------- 1 | setwd("~/_mymods/tmb/Feb2016/examples/catage/") 2 | load("fsa.RData") # gets "dat" 3 | 4 | library(TMB) 5 | compile("fsa2.cpp") 6 | dyn.load(dynlib("fsa2")) 7 | 8 | parameters <- list( 9 | logN1Y=rep(0,nrow(dat$catchNo)), 10 | logN1A=rep(0,ncol(dat$catchNo)-1), 11 | logFY=rep(0,ncol(dat$catchNo)), 12 | logFA=rep(0,nrow(dat$catchNo)), 13 | logVarLogCatch=c(0,0), 14 | logQ=rep(0,nrow(dat$Q1)), 15 | logVarLogSurvey=0 16 | ) 17 | obj <- MakeADFun(dat,parameters,DLL="fsa2", map=list(logFA=factor(c(1:4,NA,NA,NA))), silent=TRUE) 18 | opt <- nlminb(obj$par, obj$fn, obj$gr, control=list(iter.max=1000,eval.max=1000)) 19 | rep <- sdreport(obj) 20 | srep<-summary(sdreport(obj)) 21 | ssb<-srep[rownames(srep)=="ssb",] 22 | 23 | plot(ssb[,1], type="l", lwd=5, col="red", ylim=c(0,550000)) 24 | lines(ssb[,1]-2*ssb[,2], type="l", lwd=1, col="red") 25 | lines(ssb[,1]+2*ssb[,2], type="l", lwd=1, col="red") 26 | 27 | summary(rep) 28 | 29 | 30 | 31 | -------------------------------------------------------------------------------- /examples/catage/fsa2.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | template 4 | Type objective_function::operator() () 5 | { 6 | DATA_INTEGER(minAge); 7 | DATA_INTEGER(maxAge); 8 | DATA_INTEGER(minYear); 9 | DATA_INTEGER(maxYear); 10 | DATA_ARRAY(catchNo); 11 | DATA_ARRAY(stockMeanWeight); 12 | DATA_ARRAY(propMature); 13 | DATA_ARRAY(M); 14 | DATA_INTEGER(minAgeS); 15 | DATA_INTEGER(maxAgeS); 16 | DATA_INTEGER(minYearS); 17 | DATA_INTEGER(maxYearS); 18 | DATA_SCALAR(surveyTime); 19 | DATA_ARRAY(Q1); 20 | 21 | PARAMETER_VECTOR(logN1Y); 22 | PARAMETER_VECTOR(logN1A); 23 | PARAMETER_VECTOR(logFY); 24 | PARAMETER_VECTOR(logFA); 25 | PARAMETER_VECTOR(logVarLogCatch); 26 | PARAMETER_VECTOR(logQ); 27 | PARAMETER(logVarLogSurvey); 28 | 29 | int na=maxAge-minAge+1; 30 | int ny=maxYear-minYear+1; 31 | int nas=maxAgeS-minAgeS+1; 32 | int nys=maxYearS-minYearS+1; 33 | 34 | // setup F 35 | matrix F(na,ny); 36 | for(int a=0; a logN(na,ny); 43 | for(int a=0; a predLogC(na,ny); 56 | for(int a=0; a predLogS(nas,nys); 74 | for(int a=0; a ssb(ny); 84 | ssb.setZero(); 85 | for(int y=0; y $@ 12 | 13 | clean: 14 | rm -f linreg.Rout 15 | rm -f linreg.o 16 | rm -f linreg.so 17 | rm -f readme.html 18 | rm -f .RData 19 | rm -f .Rhistory 20 | -------------------------------------------------------------------------------- /examples/linreg-debug/linreg.R: -------------------------------------------------------------------------------- 1 | data <- read.table("linreg.dat", header=TRUE) 2 | parameters <- list(b0=0, b1=0, logSigma=0) 3 | 4 | require(TMB) 5 | compile("linreg.cpp", "-g") 6 | dyn.load(dynlib("linreg")) 7 | 8 | ################################################################################ 9 | 10 | model <- MakeADFun(data, parameters, DLL="linreg") 11 | fit <- nlminb(model$par, model$fn, model$gr) 12 | 13 | best <- model$env$last.par.best 14 | rep <- sdreport(model) 15 | 16 | print(best) 17 | print(rep) 18 | -------------------------------------------------------------------------------- /examples/linreg-debug/linreg.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #ifdef NDEBUG 4 | #undef NDEBUG 5 | #endif 6 | #include 7 | 8 | extern "C" void myabort(int signal) 9 | { 10 | std::cerr << "Error(signal" << signal << "): linbcg aborted.\n"; 11 | } 12 | 13 | template 14 | Type objective_function::operator() () 15 | { 16 | signal(SIGABRT, &myabort); //overide abort in assert. 17 | 18 | DATA_VECTOR(x); 19 | DATA_VECTOR(y); 20 | assert(x.size() != y.size()); 21 | 22 | int n = y.size(); 23 | 24 | PARAMETER(b0); 25 | PARAMETER(b1); 26 | PARAMETER(logSigma); 27 | vector yfit(n); 28 | 29 | Type neglogL = 0.0; 30 | 31 | yfit = b0 + b1*x; 32 | neglogL = -sum(dnorm(y, yfit, exp(logSigma), true)); 33 | 34 | // JIM THORSON JUST ROCK'N TMB 35 | std::cout << b0<<" "< source('linreg.R')` 16 | 17 | > *Note* Debug flags __"-O0 -g"__ should be added to function compile parameter in *linreg.R* for symbol information. 18 | > 19 | > `compile("linreg.cpp", flags="-O0 -g")` 20 | > 21 | 22 | The output will show error at _file_ and _line_. 23 | 24 | `Assertion failed: (x.size() != y.size()), function operator(), file linreg.cpp, line 20.` 25 | 26 | The R shell will exit and return to the (lldb) shell. 27 | 28 | 4. In (lldb) command shell, set a breakpoint at file and line where the assertion failed. 29 | 30 | `(lldb) breakpoint set --file linreg.cpp --line 20` 31 | 32 | Repeat steps 2 then 3. 33 | 34 | The run output will point to the breakpoint in the code where it paused. 35 | 36 | 18 DATA_VECTOR(x); 37 | 19 DATA_VECTOR(y); 38 | -> 20 assert(x.size() != y.size()); 39 | 21 40 | 22 int n = y.size(); 41 | 23 42 | 43 | For information on lldb, read [tutorial](http://lldb.llvm.org/tutorial.html) on how to use debugger. 44 | -------------------------------------------------------------------------------- /examples/linreg-triple/Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | $(MAKE) linreg.so 3 | $(MAKE) run 4 | 5 | run: 6 | R CMD BATCH linreg.R 7 | cat linreg.Rout 8 | 9 | linreg.so: linreg.o 10 | clang++ -dynamiclib -Wl,-headerpad_max_install_names -undefined dynamic_lookup -single_module -multiply_defined suppress -L/Library/Frameworks/R.framework/Resources/lib -L/usr/local/lib -o linreg.so linreg.o /Library/Frameworks/R.framework/Versions/3.2/Resources/library/TMB/libs/libTMBdbg.o -F/Library/Frameworks/R.framework/.. -framework R -Wl,-framework -Wl,CoreFoundation 11 | 12 | linreg.o: linreg.cpp 13 | clang++ -I/Library/Frameworks/R.framework/Resources/include -DNDEBUG -I/Library/Frameworks/R.framework/Versions/3.2/Resources/library/TMB/include -I/Library/Frameworks/R.framework/Versions/3.2/Resources/library/RcppEigen/include -DTMB_SAFEBOUNDS -DLIB_UNLOAD=R_unload_linreg -DWITH_LIBTMB -I/usr/local/include -I/usr/local/include/freetype2 -I/opt/X11/include -fPIC -O0 -g -c linreg.cpp -o linreg.o 14 | 15 | debug: clean 16 | R --debugger=lldb 17 | 18 | html: readme.html 19 | 20 | readme.html: readme.md 21 | markdown_py $^ > $@ 22 | 23 | clean: 24 | rm -f linreg.Rout 25 | rm -f *.o 26 | rm -f linreg.so 27 | rm -f readme.html 28 | rm -f .RData 29 | rm -f .Rhistory 30 | -------------------------------------------------------------------------------- /examples/linreg-triple/linreg.R: -------------------------------------------------------------------------------- 1 | data <- read.table("linreg.dat", header=TRUE) 2 | parameters <- list(b0=0, b1=0, logSigma=0) 3 | 4 | require(TMB) 5 | dyn.load(dynlib("linreg")) 6 | 7 | ################################################################################# 8 | 9 | model <- MakeADFun(data, parameters, DLL="linreg") 10 | fit <- nlminb(model$par, model$fn, model$gr) 11 | 12 | best <- model$env$last.par.best 13 | rep <- sdreport(model) 14 | 15 | print(best) 16 | print(rep) 17 | -------------------------------------------------------------------------------- /examples/linreg-triple/linreg.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | //#include "utils.h" 5 | 6 | #ifdef NDEBUG 7 | #undef NDEBUG 8 | #endif 9 | #include 10 | 11 | template 12 | Type objective_function::operator() () 13 | { 14 | DATA_VECTOR(x); 15 | DATA_VECTOR(y); 16 | 17 | int n = y.size(); 18 | 19 | PARAMETER(b0); 20 | PARAMETER(b1); 21 | PARAMETER(logSigma); 22 | vector yfit(n); 23 | 24 | Type neglogL = 0.0; 25 | 26 | //Call triple function 27 | yfit = b0 + b1*x; 28 | neglogL = -sum(dnorm(y, yfit, exp(logSigma), true)); 29 | 30 | // JIM THORSON JUST ROCK'N TMB 31 | std::cout << b0<<" "< 2 | #include "triple.h" 3 | 4 | template 5 | Type triple(Type x) 6 | { 7 | Type ret = x * Type(3); 8 | std::cout << __FILE__ << ':' << __LINE__ << ' ' << ret << std::endl; 9 | return ret; 10 | } 11 | -------------------------------------------------------------------------------- /examples/linreg-triple/triple.h: -------------------------------------------------------------------------------- 1 | /** 2 | Multiplies the value of x by 3. 3 | \param value x 4 | \return computed value * 3. 5 | */ 6 | template 7 | Type triple(Type x); 8 | -------------------------------------------------------------------------------- /examples/linreg/linreg.R: -------------------------------------------------------------------------------- 1 | data <- read.table("linreg.dat", header=TRUE) 2 | parameters <- list(b0=0, b1=0, logSigma=0) 3 | 4 | require(TMB) 5 | compile("linreg.cpp") 6 | dyn.load(dynlib("linreg")) 7 | 8 | ################################################################################ 9 | 10 | model <- MakeADFun(data, parameters, DLL="linreg") 11 | fit <- nlminb(model$par, model$fn, model$gr) 12 | 13 | best <- model$env$last.par.best 14 | rep <- sdreport(model) 15 | 16 | print(best) 17 | print(rep) 18 | -------------------------------------------------------------------------------- /examples/linreg/linreg.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | template 4 | Type objective_function::operator() () 5 | { 6 | DATA_VECTOR(x); 7 | DATA_VECTOR(y); 8 | int n = y.size(); 9 | 10 | PARAMETER(b0); 11 | PARAMETER(b1); 12 | PARAMETER(logSigma); 13 | vector yfit(n); 14 | 15 | Type neglogL = 0.0; 16 | 17 | yfit = b0 + b1*x; 18 | neglogL = -sum(dnorm(y, yfit, exp(logSigma), true)); 19 | 20 | return neglogL; 21 | } 22 | -------------------------------------------------------------------------------- /examples/linreg/linreg.dat: -------------------------------------------------------------------------------- 1 | x y 2 | -1 1.4 3 | 0 4.7 4 | 1 5.1 5 | 2 8.3 6 | 3 9.0 7 | 4 14.5 8 | 5 14.0 9 | 6 13.4 10 | 7 19.2 11 | 8 18.0 12 | -------------------------------------------------------------------------------- /examples/mcmc/MCMC_in_TMB.R: -------------------------------------------------------------------------------- 1 | ## A VERY quick demo of MCMC capabilities in TMB. Note these are in beta form 2 | ## and use the latest Github development version for up-to-date 3 | ## code.... Started 2/8/2016 -- Cole Monnahan 4 | 5 | ## Bottom line: Use these algorithms with caution. Stan is a better option 6 | ## if you're only doing Bayesian models. NUTS is typically the best option. 7 | 8 | ## Note: bounded parameters not currently supported, so do those internally 9 | ## if needed. 10 | setwd("~/_mymods/tmb/Feb2016/examples/mcmc/") 11 | 12 | library(TMB) 13 | ?mcmc 14 | 15 | ## This runs the simple and loads that model object in the workspace. 16 | runExample("simple") 17 | 18 | ## Make model with random effects on 'u'. Note the starting values. 19 | obj <- MakeADFun(data=list(x=x, B=B, A=A), 20 | parameters=list(u=u*0, beta=beta*0, logsdu=1, logsd0=1), 21 | random="u", 22 | DLL="simple", 23 | silent=TRUE) 24 | opt <- optim(obj$par, obj$fn, obj$gr, hessian=TRUE) 25 | opt$par 26 | par.names <- names(opt$par) 27 | 28 | ## Run RWM and two gradient based algorithms, using fixed step size (eps) 29 | ## for each. Start from the MLE. 30 | N <- 500 31 | rwm <- mcmc(obj=obj, nsim=N*8, algorithm='RWM', params.init=opt$par, 32 | alpha=.08, diagnostic=TRUE) 33 | ## Thin it to better approximate the gradient methods 34 | rwm$par <- rwm$par[seq(1, nrow(rwm$par), by=8),] 35 | names(rwm) 36 | str(rwm) 37 | hmc <- mcmc(obj=obj, nsim=N, algorithm='HMC', L=8, params.init=opt$par, 38 | diagnostic=TRUE, eps=.1) 39 | hmc2 <- mcmc(obj=obj, nsim=N, algorithm='HMC', L=8, params.init=opt$par, 40 | diagnostic=TRUE, eps=.9) 41 | names(hmc) 42 | str(hmc) 43 | nuts <- mcmc(obj=obj, nsim=N, algorithm='NUTS', params.init=opt$par, 44 | diagnostic=TRUE, eps=.1, max_doubling=7) 45 | names(nuts) 46 | str(nuts) 47 | 48 | pairs(nuts$par[-(1:(N/2)),]) 49 | 50 | ## See how they compare via ACF 51 | par(mfrow=c(3,4)) 52 | for(i in par.names) acf(rwm$par[-(1:(N/2)),i], main=i) 53 | for(i in par.names) acf(hmc$par[-(1:(N/2)),i], main=i) 54 | for(i in par.names) acf(nuts$par[-(1:(N/2)),i], main=i) 55 | ## End(Not run) 56 | 57 | ## Same object but no random effects this time! Have to use better starting 58 | ## values or it crashes big time. 59 | obj2 <- MakeADFun(data=list(x=x, B=B, A=A), 60 | parameters=list(u=u, beta=beta, logsdu=1, logsd0=1), 61 | DLL="simple", 62 | silent=TRUE) 63 | opt2 <- optim(obj2$par, obj2$fn, obj2$gr, hessian=TRUE) 64 | str(opt2$par) 65 | covar <- solve(opt2$hessian) 66 | 67 | rwm2 <- mcmc(obj=obj2, nsim=N*8, algorithm='RWM', params.init=opt2$par, 68 | alpha=.01 , diagnostic=TRUE, covar=covar) 69 | ## Thin it to better approximate the gradient methods 70 | rwm2$par <- rwm2$par[seq(1, N*8, by=8),] 71 | hmc2 <- mcmc(obj=obj2, nsim=N, algorithm='HMC', L=8, 72 | diagnostic=TRUE, eps=NULL) 73 | nuts2 <- mcmc(obj=obj2, nsim=N, algorithm='NUTS', params.init=opt2$par, 74 | diagnostic=TRUE, max_doubling=7, eps=NULL) 75 | nuts3 <- mcmc(obj=obj2, nsim=N, algorithm='NUTS', params.init=opt2$par, 76 | diagnostic=TRUE, max_doubling=7, eps=NULL,delta=.9) 77 | 78 | ## See how they compare via ACF 79 | par(mfrow=c(3,4)) 80 | for(i in par.names) acf(rwm2$par[,i], main=i) 81 | for(i in par.names) acf(hmc2$par[,i], main=i) 82 | for(i in par.names) acf(nuts2$par[,i], main=i) 83 | 84 | pairs(nuts2$par[-(1:(N/2)),]) 85 | ?mcmc.nuts 86 | sdreport(obj) 87 | names(hmc2$par) 88 | mean(hmc2$par[,115]) 89 | sd(hmc2$par[,115]) 90 | -------------------------------------------------------------------------------- /examples/mini/README.md: -------------------------------------------------------------------------------- 1 | # Simple example to get rolling... 2 | -------------------------------------------------------------------------------- /examples/mini/mini.R: -------------------------------------------------------------------------------- 1 | data <- list(x=rivers) 2 | parameters <- list(mu=0,logSigma=0) 3 | 4 | require(TMB) 5 | compile('mini.cpp') #,'-fno-gnu-unique -O0 -Wall') 6 | 7 | dyn.load(dynlib('mini')) 8 | 9 | ################## 10 | model <- MakeADFun(data,parameters) 11 | fit <- nlminb(model$par, model$fn, model$gr) 12 | rep <- sdreport(model) 13 | rep 14 | -------------------------------------------------------------------------------- /examples/mini/mini.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | template 4 | Type objective_function::operator() () 5 | { 6 | DATA_VECTOR(x); 7 | PARAMETER(mu); 8 | PARAMETER(logSigma); 9 | 10 | 11 | Type f; 12 | f = -sum(dnorm(x,mu,exp(logSigma), true)); 13 | return f; 14 | } 15 | -------------------------------------------------------------------------------- /examples/mini/mini_a.dat: -------------------------------------------------------------------------------- 1 | 141 2 | 735 320 325 392 524 450 1459 135 465 600 330 336 3 | 280 315 870 906 202 329 290 1000 600 505 1450 840 4 | 1243 890 350 407 286 280 525 720 390 250 327 230 5 | 265 850 210 630 260 230 360 730 600 306 390 420 6 | 291 710 340 217 281 352 259 250 470 680 570 350 7 | 300 560 900 625 332 2348 1171 3710 2315 2533 780 280 8 | 410 460 260 255 431 350 760 618 338 981 1306 500 9 | 696 605 250 411 1054 735 233 435 490 310 460 383 10 | 375 1270 545 445 1885 380 300 380 377 425 276 210 11 | 800 420 350 360 538 1100 1205 314 237 610 360 540 12 | 1038 424 310 300 444 301 268 620 215 652 900 525 13 | 246 360 529 500 720 270 430 671 1770 14 | -------------------------------------------------------------------------------- /examples/mini/mini_a.tpl: -------------------------------------------------------------------------------- 1 | DATA_SECTION 2 | init_int nobs 3 | init_vector x(1,nobs) 4 | PARAMETER_SECTION 5 | init_number mu; 6 | init_number logSigma; 7 | objective_function_value f; 8 | PROCEDURE_SECTION 9 | f = dnorm(x,mu,exp(logSigma)); 10 | -------------------------------------------------------------------------------- /examples/poll/pmature.dat: -------------------------------------------------------------------------------- 1 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 2 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 3 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 4 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 5 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 6 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 7 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 8 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 9 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 10 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 11 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 12 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 13 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 14 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 15 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 16 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 17 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 18 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 19 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 20 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 21 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 22 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 23 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 24 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 25 | 0 0.008 0.289 0.641 0.842 0.901 0.947 0.963 0.97 1 1 1 1 1 1 26 | -------------------------------------------------------------------------------- /examples/poll/poll.R: -------------------------------------------------------------------------------- 1 | setwd("~/_mymods/tmb/Feb2016/examples/poll/") 2 | #load("fsa.RData") # gets "dat" 3 | source("polldat.R") 4 | library(TMB) 5 | compile("poll.cpp","-O0 -g") 6 | dyn.load(dynlib("poll")) 7 | 8 | parameters <- list( 9 | logN1Y=rep(0,ncol(data$catchNo)), 10 | logN1A=rep(0,nrow(data$catchNo)-1), 11 | logFY=rep(0,nrow(data$catchNo)), 12 | logFA=rep(0,ncol(data$catchNo)), 13 | logVarLogCatch=c(0,0), 14 | logQ=rep(0,ncol(data$Q1)), 15 | logVarLogSurvey=0 16 | ) 17 | names(parameters) 18 | names(data) 19 | data$propMature 20 | (data$Q1) 21 | (data$catchNo <- data$catchNo + 1e-3) 22 | data$catchNo 23 | (parameters$logQ) 24 | obj <- MakeADFun(data,parameters,DLL="poll", map=list(logFA=factor(c(1:12,NA,NA,NA)))) 25 | opt <- nlminb(obj$par, obj$fn, obj$gr, control=list(iter.max=1000,eval.max=1000)) 26 | obj$gr() 27 | rep <- sdreport(obj,bias.correct=TRUE) 28 | rep <- sdreport(obj,bias.correct=FALSE) 29 | rm(rep) 30 | rep 31 | args(sdreport) 32 | srep<-summary(sdreport(obj)) 33 | ssb<-srep[rownames(srep)=="ssb",] 34 | 35 | plot(ssb[,1], type="l", lwd=5, col="red" , ylim=c(0,1.5e7)) 36 | lines(ssb[,1]-2*ssb[,2], type="l", lwd=1, col="red") 37 | lines(ssb[,1]+2*ssb[,2], type="l", lwd=1, col="red") 38 | 39 | summary(rep) 40 | 41 | 42 | 43 | -------------------------------------------------------------------------------- /examples/poll/poll.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | template 4 | Type objective_function::operator() () 5 | { 6 | DATA_INTEGER(minAge); 7 | DATA_INTEGER(maxAge); 8 | DATA_INTEGER(minYear); 9 | DATA_INTEGER(maxYear); 10 | DATA_ARRAY(catchNo); 11 | DATA_ARRAY(stockMeanWeight); 12 | DATA_ARRAY(propMature); 13 | DATA_ARRAY(M); 14 | DATA_INTEGER(minAgeS); 15 | DATA_INTEGER(maxAgeS); 16 | DATA_INTEGER(minYearS); 17 | DATA_INTEGER(maxYearS); 18 | DATA_SCALAR(surveyTime); 19 | DATA_ARRAY(Q1); 20 | 21 | PARAMETER_VECTOR(logN1Y); 22 | PARAMETER_VECTOR(logN1A); 23 | PARAMETER_VECTOR(logFY); 24 | PARAMETER_VECTOR(logFA); 25 | PARAMETER_VECTOR(logVarLogCatch); 26 | PARAMETER_VECTOR(logQ); 27 | PARAMETER(logVarLogSurvey); 28 | 29 | int na=maxAge-minAge+1; 30 | int ny=maxYear-minYear+1; 31 | int nas=maxAgeS-minAgeS+1; 32 | int nys=maxYearS-minYearS+1; 33 | 34 | // setup F 35 | matrix F(ny,na); 36 | for(int y=0; y logN(ny,na); 43 | for(int a=0; a predLogC(ny,na); 56 | for(int y=0; y predLogS(nys,nas); 74 | for(int y=0; y ssb(ny); 84 | ssb.setZero(); 85 | for(int y=0; y<=ny; ++y){ 86 | for(int a=0; a 2 | 3 | template 4 | Type objective_function::operator() () 5 | { 6 | DATA_VECTOR(R); 7 | DATA_VECTOR(S); 8 | int n = R.size(); 9 | 10 | PARAMETER(loga); 11 | PARAMETER(logb); 12 | PARAMETER(logSigma); 13 | Type a = exp(loga); 14 | Type b = exp(logb); 15 | Type sigma = exp(logSigma); 16 | vector Rhat(n); 17 | 18 | Type neglogL = 0; 19 | 20 | Rhat = a * S * exp(-b*S); 21 | ADREPORT(Rhat); 22 | neglogL = -sum(dnorm(R, Rhat, sigma, true)); 23 | 24 | return neglogL; 25 | } 26 | -------------------------------------------------------------------------------- /examples/ricker/ricker.dat: -------------------------------------------------------------------------------- 1 | Year R S 2 | 1968 430.3 234.0 3 | 1969 370.9 222.7 4 | 1970 354.1 208.8 5 | 1971 306.7 184.2 6 | 1972 240.0 199.0 7 | 1973 264.8 212.0 8 | 1974 322.3 263.0 9 | 1975 432.1 339.5 10 | 1976 506.9 355.6 11 | 1977 303.7 326.9 12 | 1978 293.4 379.2 13 | 1979 479.0 579.7 14 | 1980 829.4 696.7 15 | 1981 615.4 666.1 16 | 1982 425.9 670.9 17 | 1983 689.8 645.3 18 | 1984 693.6 657.7 19 | 1985 472.4 544.9 20 | 1986 302.9 399.4 21 | 1987 253.1 320.5 22 | 1988 260.2 299.3 23 | 1989 368.1 240.3 24 | 1990 224.3 216.0 25 | 1991 122.5 151.6 26 | 1992 128.4 92.9 27 | 1993 82.8 112.7 28 | 1994 136.4 191.7 29 | 1995 182.0 237.0 30 | 1996 127.2 163.7 31 | 1997 119.6 135.5 32 | 1998 115.5 109.0 33 | 1999 88.1 90.2 34 | 2000 149.2 115.9 35 | 2001 152.3 104.2 36 | 2002 174.9 83.1 37 | 2003 135.8 80.4 38 | 2004 122.5 79.5 39 | 2005 112.7 65.6 40 | 2006 115.1 83.5 41 | 2007 164.2 101.7 42 | 2008 131.0 119.4 43 | 2009 143.8 184.0 44 | 2010 158.5 208.2 45 | 2011 161.8 211.3 46 | -------------------------------------------------------------------------------- /examples/rrm/Chinook_reconst_ln_rev3.tpl: -------------------------------------------------------------------------------- 1 | //============================================================================================================== 2 | // Chinook_reconst_ln_rev2.TPL 3 | // This model is the latest version of the Kuksokwim Run Reconstruction model based on Escapement. 4 | // Variance estimated separately for each project 5 | //============================================================================================================== 6 | 7 | //=============================================================================================================== 8 | // 1.0 Data Entry 9 | //=============================================================================================================== 10 | DATA_SECTION 11 | init_int ny; // number of years in the model 12 | init_int nweek; // number of weeks in catch - effort model 13 | init_vector tcatch(1,ny); // Sum of all Catches 14 | init_vector minesc(1,ny); // Sum of all escapements 15 | init_vector minrun(1,ny); // Sum of all counts (minimum observable run size) 16 | // Read Inriver data 17 | init_vector inrvr(1,ny); // Observations for Inriver Estimates 18 | init_vector inrvrsd(1,ny); // Observations for standard deviation 19 | // Read Weir data 20 | init_matrix w_esc(1,6,1,ny); 21 | // Read Aerial data 22 | init_matrix a_esc(1,14,1,ny); 23 | // Read Weekly Commercial data 24 | init_matrix testf(1,nweek,1,ny); // proportion of run by week and year 25 | init_matrix ccat(1,nweek,1,ny); // harvest by week and year 26 | init_matrix ceff(1,nweek,1,ny); // effort by week and year 27 | init_matrix creg(1,nweek,1,ny); 28 | // Read contorl parameters 29 | init_number cvw; 30 | init_number cva; 31 | init_number cvf; 32 | init_vector wlike(1,6); 33 | init_vector alike(1,14); 34 | init_vector flike(1,3); 35 | 36 | !! cout << "Data Section Completed" << endl; 37 | 38 | //=============================================================================================================== 39 | // 2.0 Define parameters 40 | //=============================================================================================================== 41 | PARAMETER_SECTION 42 | init_bounded_vector log_esc(1,ny,10.0,13.5,1); // log drainage-wise escapement 43 | init_bounded_vector log_wesc(1,6,2.0,7.0,1); // log transformed slope for weir model 44 | init_bounded_vector log_aesc(1,14,1.0,10.0,1); // log transformed slope for aerial model 45 | init_bounded_vector log_rwesc(1,6,-10.0,1.0,2); // log transformed sd for weir model 46 | init_bounded_vector log_raesc(1,14,-10.0,1.0,2); // log transformed sd for aerial model 47 | init_bounded_vector log_q(1,3,-12.0,-9.0,1); // log transformed cpue model1 48 | init_bounded_vector log_rq(1,3,-10.0,2.0,2); // log transformed sd cpue model1 49 | 50 | // Transformed numbers 51 | 52 | vector wesc(1,6); // slope for weir model 53 | vector aesc(1,14); // slope for aerial model 54 | vector rwesc(1,6); // sd for weir model 55 | vector raesc(1,14); // sd for aerial model 56 | vector q(1,3); // slope catchability for catch 57 | vector rq(1,3); // sd catchability for catch 58 | 59 | vector tot_run(1,ny); // vector of total run 60 | vector esc(1,ny); // vector of escapement obtained from Total run - Total Catch 61 | number fpen; 62 | vector tfw(1,6); // Likelihood for weir model 63 | vector tfa(1,14); // likelihood for aerial model 64 | vector tfc(1,3); // likelihood for catch model 65 | number tfr; // likelihood for inriver model 66 | matrix cpue(1,3,1,ny); 67 | matrix testp(1,3,1,ny); 68 | objective_function_value f 69 | 70 | //=============================================================================================================== 71 | // 3.0 Initialization 72 | //=============================================================================================================== 73 | 74 | INITIALIZATION_SECTION 75 | log_wesc 5.0; // log transformed slope for Kwethluk weir model 76 | log_aesc 4.0; // log transformed slope for Kwethluk aerial model 77 | log_rwesc 1.0; // log transformed slope for Kwethluk weir model 78 | log_raesc 1.0; // log transformed slope for Kwethluk aerial model 79 | log_esc 11.5; // log transformed esc 80 | log_q -10.0; // log transformed catchability coefficient 1; 81 | log_rq 1.0; // log transformed catchability coefficient 1; 82 | 83 | PRELIMINARY_CALCS_SECTION 84 | int i,j,k; 85 | for (i=1;i<=ny;i++) 86 | { 87 | for (j=1;j<=nweek;j++) 88 | { 89 | // Unrestricted mesh catch 90 | if(creg(j,i)==1) 91 | { 92 | cpue(1,i) += ccat(j,i)/ceff(j,i); 93 | testp(1,i) += testf(j,i); 94 | } 95 | // Restricted mesh catch 96 | if(creg(j,i)==2) 97 | { 98 | cpue(2,i) += ccat(j,i)/ceff(j,i); 99 | testp(2,i) += testf(j,i); 100 | } 101 | // Monofilament mesh catch 102 | if(creg(j,i)==3 or creg(j,i)==5) 103 | { 104 | cpue(3,i) += ccat(j,i)/ceff(j,i); 105 | testp(3,i) += testf(j,i); 106 | } 107 | } 108 | } 109 | 110 | 111 | // ========================================================================================================================= 112 | PROCEDURE_SECTION 113 | 114 | f=0.0; 115 | q=exp(log_q); // slope for catchability 116 | rq=exp(log_rq); // SD for catchability 117 | wesc=exp(log_wesc); // slope for weir model 118 | aesc=exp(log_aesc); // slope for aerial model 119 | rwesc=exp(log_rwesc); // SD for weir model 120 | raesc=exp(log_raesc); // SD for aerial model 121 | esc=exp(log_esc); // escapement 122 | 123 | evaluate_the_objective_function(); 124 | 125 | RUNTIME_SECTION 126 | maximum_function_evaluations 200000000 127 | convergence_criteria 1.e-20 128 | 129 | //=========================================================================================================================== 130 | 131 | //=========================================================================================================================== 132 | FUNCTION evaluate_the_objective_function 133 | int i,j,k; 134 | dvariable var1, var2, var3, var4, var5; 135 | tfw = 0.0; // initialilze to 0 136 | tfa = 0.0; // initialilze to 0 137 | tfc = 0.0; // initialilze to 0 138 | tfr = 0.0; // initialilze to 0 139 | 140 | //=== Inriver model calculation ============================================================================= 141 | tot_run = esc + tcatch; 142 | for (i=1;i<=ny;i++) 143 | { 144 | if(inrvr(i) >0) 145 | { 146 | // tfr += square(inrvr(i)-tot_run(i))/square(inrvrsd(i)); //Noraml likelihood 147 | tfr += 0.5*square(log(inrvr(i))-log(tot_run(i)))/log(square(inrvrsd(i)/inrvr(i))+1); //log-noraml likelihood 148 | } 149 | //============= Weir likelihood Calculation ================================================================ 150 | for(j=1;j<=6;j++) 151 | { 152 | if(w_esc(j,i)>0) 153 | { 154 | var1 = log(square(cvw)+1)+square(rwesc(j)); 155 | tfw(j) += wlike(j)*(log(sqrt(var1))+0.5*square(log(w_esc(j,i))-log(esc(i)/wesc(j)))/var1); 156 | } 157 | } 158 | //=== Aerial survey based likelihood calculation ============================================================================ 159 | for(k=1;k<=14;k++) 160 | { 161 | if(a_esc(k,i)>0) 162 | { 163 | var2 = log(square(cva)+1)+square(raesc(k)); 164 | tfa(k) += alike(k)*(log(sqrt(var2))+0.5*square(log(a_esc(k,i))-log(esc(i)/aesc(k)))/var2); 165 | } 166 | } 167 | //=== Calculate Predicted Effort ============================================================================= 168 | if(cpue(1,i)>0) 169 | { 170 | var3 = log(square(cvf)+1)+square(rq(1)); 171 | tfc(1) += flike(1)*(log(sqrt(var3))+0.5*square(log(cpue(1,i)/testp(1,i))-log(q(1)*tot_run(i)))/var3); 172 | } 173 | if(cpue(2,i)>0) 174 | { 175 | var4 = log(square(cvf)+1)+square(rq(2)); 176 | tfc(2) += flike(2)*(log(sqrt(var4))+0.5*square(log(cpue(2,i)/testp(2,i))-log(q(2)*tot_run(i)))/var4); 177 | } 178 | if(cpue(3,i)>0) 179 | { 180 | var5 = log(square(cvf)+1)+square(rq(3)); 181 | tfc(3) += flike(3)*(log(sqrt(var5))+0.5*square(log(cpue(3,i)/testp(3,i))-log(q(3)*tot_run(i)))/var5); 182 | } 183 | } 184 | // Sum all likelihood =========================================================================================== 185 | 186 | f = tfr+sum(tfw)+sum(tfa)+sum(tfc); 187 | 188 | // ========================================================================== 189 | 190 | REPORT_SECTION 191 | // ============================================================================ 192 | report <<"Total Run"<< endl; 193 | report << tot_run << endl; 194 | report << "Escapement" << endl; 195 | report << esc < 213 | #include 214 | #include 215 | #include 216 | #include 217 | 218 | time_t start,finish; 219 | long hour,minute,second; 220 | double elapsed_time; 221 | 222 | TOP_OF_MAIN_SECTION 223 | arrmblsize = 100000000; 224 | gradient_structure::set_MAX_NVAR_OFFSET(30000000); 225 | gradient_structure::set_GRADSTACK_BUFFER_SIZE(3000000); 226 | gradient_structure::set_CMPDIF_BUFFER_SIZE(100000000); 227 | time(&start); 228 | 229 | FINAL_SECTION 230 | // Output summary stuff 231 | time(&finish); 232 | elapsed_time = difftime(finish,start); 233 | hour = long(elapsed_time)/3600; 234 | minute = long(elapsed_time)%3600/60; 235 | second = (long(elapsed_time)%3600)%60; 236 | cout << endl << endl << "Starting time: " << ctime(&start); 237 | cout << "Finishing time: " << ctime(&finish); 238 | cout << "This run took: " << hour << " hours, " << minute << " minutes, " << second << " seconds." << endl << endl; 239 | -------------------------------------------------------------------------------- /examples/rrm/Kusko_estimates2015_Dec22.csv: -------------------------------------------------------------------------------- 1 | Year,H.Com,H.Sub,H.Sports,H.Test,In.river,In.river.sd,w.kwe,w.tul,w.geo,w.kog,w.tat,w.tak,a.kwe,a.kis,a.tul,a.sla,a.kip,a.ank,a.hlk,a.osk,a.hlt,a.che,a.gag,a.pit,a.ber,a.slp,rpw.1,rpw.2,rpw.3,rpw.4,rpw.5,rpw.6,rpw.7,rpw.8,rpw.9,rpw.10,chw.3,cew.3,cfw.3,chw.4,cew.4,cfw.4,chw.5,cew.5,cfw.5,chw.6,cew.6,cfw.6,chw.7,cew.7,cfw.7,chw.8,cew.8,cfw.8,chw.9,cew.9,cfw.9 2 | 1976,30735,58606,,1206,,,,,,5638,,,,,,,,,,,2571,,,,182,,,,,,,,,,,,0,0,0,20010,5724,1,4143,2088,2,1550,2490,2,1238,4548,2,236,1590,2,0,0,0 3 | 1977,35830,56580,33,1264,,,,,,,,,2075,,424,,,,,,,2407,897,,,1930,,,,,,,,,,,12458,2802,1,16227,2904,1,1841,4722,2,673,4194,2,153,2310,2,0,0,0,0,0,0 4 | 1978,45641,36270,116,1445,,,,,,14533,,,1722,2417,,289,,,,,2766,268,504,,227,1100,,,,,,,,,,,18483,3972,1,10066,2004,1,3723,5346,2,2354,8676,2,987,7668,2,0,0,0,0,0,0 5 | 1979,38966,56283,74,979,,,,,,11393,,,,,,,,,,,,,,,,682,,,,,,,,,,,24633,6432,1,5651,3012,2,3860,6438,2,1233,3252,2,470,3120,2,0,0,0,0,0,0 6 | 1980,35881,59892,162,1033,,,,,,,,,,,975,1186,,,,,,,,,,,,,,,,,,,,,9891,2814,1,21698,5364,4,1460,2448,2,498,2298,2,445,2586,2,0,0,0,0,0,0 7 | 1981,47663,61329,189,1218,,,,,,16089,,,,,,,,9074,,,,,,,93,,,,,,,,,,,,29882,6180,1,3830,3066,2,4563,5952,2,2795,5520,2,941,2640,2,0,0,0,0,0,0 8 | 1982,48234,58018,207,542,,,,,,13126,,,,81,,126,,,,,521,,,,127,413,,,,,,,,,,,4912,2784,1,24628,5970,1,12555,5176,4,1970,3968,2,1055,4734,2,0,0,0,0,0,0 9 | 1983,33174,47412,420,1139,,,,,,,,,471,,186,231,,1909,,,1069,173,,,,572,,,,,,,,,,,13406,5634,1,8063,5544,2,4925,5958,2,2415,5634,2,633,2796,2,0,0,0,0,0,0 10 | 1984,31742,56930,273,231,,,,,,4922,,,,,,,,,,,,1177,,,,545,0.004232609,0.039602503,0.224328303,0.290283401,0.148803828,0.163305116,0.050938535,0.052226721,0.009017298,0.017261686,0,0,0,17181,5562,1,5643,5616,2,3206,5454,2,2069,5592,2,744,2238,2,0,0,0 11 | 1985,37889,43874,85,79,,,,,,4442,,,,63,142,,,,,,,1002,,,,620,0,0,0,0.093045442,0.242730394,0.430598046,0.150444234,0.02465132,0.017527671,0.041002892,0,0,0,6519,2538,3,19204,5880,3,9942,5844,3,0,0,0,0,0,0,0,0,0 12 | 1986,19414,51019,49,130,,,,,,,,,,,,336,,424,,,650,,,,,,0,0.057688482,0.150338174,0.403869107,0.165605729,0.139894569,0.048786553,0.009697633,0.024119753,0,0,0,0,0,0,0,11986,6540,3,5029,6852,3,1156,3192,3,0,0,0,0,0,0 13 | 1987,36179,67325,355,384,,,,,,,,,,,,516,193,,,193,,317,,,,,0,0.065930076,0.198784786,0.307022492,0.236778765,0.11365844,0.020980751,0.034433727,0.013016897,0.009394066,0,0,0,19126,4734,3,0,0,0,9606,6948,3,1910,3582,3,2758,6720,3,0,0,0 14 | 1988,55716,70943,528,576,,,,,,8028,,,622,869,195,244,,954,,80,,,,,,474,0.008209654,0.113962455,0.208012443,0.308638807,0.178608344,0.085164117,0.02183551,0.041870233,0.014525545,0.019172893,12640,4816,3,11708,3672,3,15060,7518,3,5871,6954,3,5270,10794,3,1728,6636,3,662,6276,3 15 | 1989,43217,81175,1218,543,,,,,,,,,1157,152,,631,1598,2109,,,,,,,,452,0,0.032017728,0.176938066,0.278015512,0.3474382,0.097581477,0.02580904,0.019046345,0.011920682,0.01123295,0,0,0,15215,5208,3,11094,6144,3,7911,7092,3,6043,10962,3,868,2622,3,210,3372,3 16 | 1990,53502,109778,394,512,,,,,,10093,,,,631,200,596,537,1255,,113,,,,,,,0.004721011,0.033856391,0.143406322,0.209522953,0.332539005,0.149206421,0.060946001,0.013556045,0.026639989,0.025605863,0,0,0,16690,3780,3,25459,7536,3,4071,3546,3,4931,8534,3,0,0,0,0,0,0 17 | 1991,37778,74820,401,149,,,,697,,6835,,,,217,358,583,885,1564,,,,,,,,,0,0.073837209,0.059302326,0.296511628,0.294186047,0.199418605,0.03372093,0.043023256,0,0,0,0,0,13813,3606,3,12612,3696,3,8068,7308,3,904,3426,3,452,3408,3,419,7522,3 18 | 1992,46872,82654,367,1380,,,9675,1083,,6563,,,,,,335,670,2284,,91,2022,1050,328,,,2536,0,0.031276901,0.346628407,0.179053085,0.213199426,0.108464849,0.054232425,0.055380201,0,0.011764706,0,0,0,24334,9488,3,16307,8628,3,3250,4696,3,0,0,0,0,0,0,0,0,0 19 | 1993,8735,87674,587,2515,,,,2218,,12377,,,,,,1082,1248,2687,233,103,1573,678,419,,,1010,0.014287226,0.156841994,0.214837549,0.417187004,0.126997566,0.032807705,0.027304477,0.00973648,0,0,0,0,0,0,0,0,8184,4976,3,0,0,0,0,0,0,0,0,0,0,0,0 20 | 1994,16211,103343,1139,1937,,,,2918,,,,,,1243,,1218,1520,,,,,1206,807,,,1010,0.013266998,0.116086235,0.288280818,0.30983969,0.139579878,0.100884467,0.01381979,0.012161415,0,0.006080708,0,0,0,0,0,0,14221,4608,3,0,0,0,578,1984,3,441,3000,3,538,6348,3 21 | 1995,30846,102110,541,1421,,,,,,20662,,,,1243,,1446,1215,3171,,326,1887,1565,1193,,,1911,0.013473817,0.074336123,0.156600411,0.30661282,0.300521174,0.098820026,0.030006994,0.004963563,0.009701509,0.004963563,0,0,0,6895,2276,3,14424,4532,3,4368,3824,3,1452,3716,3,568,3488,3,0,0,0 22 | 1996,7419,96413,1432,247,,,,,7770,13771,,423,,,,985,,,,,,,,,,,0.028390478,0.200698843,0.40074252,0.21380214,0.096309238,0.028827255,0.021402053,0,0.006551649,0.003275824,0,0,0,4091,1056,3,666,360,3,861,836,3,408,896,3,251,1195,3,307,6398,3 23 | 1997,10441,79381,1227,332,,,,,7810,13190,,1197,,439,,980,855,2187,,1470,2093,345,364,,,,0,0.044941472,0.191262542,0.529473244,0.119565217,0.053302676,0.035744147,0.011914716,0.007943144,0.005852843,0,0,0,10023,2118,3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 24 | 1998,17359,81213,1434,210,,,,,,,,,,457,,425,443,1930,,,,,,,,,0,0.070680628,0.11663758,0.219895288,0.386561955,0.151250727,0.037812682,0.011634671,0.005526469,0,0,0,0,0,0,0,12771,4584,3,2277,1780,3,1127,1668,3,0,0,0,816,4296,3 25 | 1999,4705,72775,252,98,,,,,,5543,1484,,,,,,,,,98,741,,,,,,0,0.011041618,0.135974056,0.134893058,0.246853525,0.146166319,0.190255579,0.029727434,0.075360976,0.029727434,0,0,0,0,0,0,4668,2454,3,0,0,0,0,0,0,0,0,0,0,0,0 26 | 2000,444,67620,105,64,,,3547,,2959,3242,807,345,,,,238,182,714,,,301,,,,,362,0,0.122556233,0.208850116,0.389636325,0.153037629,0.046142527,0.020496111,0.040992222,0,0.018288838,0,0,0,0,0,0,0,0,0,357,896,3,0,0,0,0,0,0,0,0,0 27 | 2001,90,78009,290,86,,,,997,3277,7475,1978,718,,,,598,,,52,,4156,,143,151,175,1033,0,0.045578588,0.079053074,0.41565984,0.250992208,0.103588789,0.052823314,0.036673778,0,0.01563041,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 28 | 2002,72,80982,319,288,,,8502,1346,2443,10025,2237,316,1795,1727,,1236,1615,,513,295,733,730,,,211,,0.003572139,0.084239043,0.354687809,0.224515739,0.160054748,0.103407777,0.033704992,0.01367549,0.008917679,0.013224585,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 29 | 2003,158,67134,401,409,241617,36605,14474,1064,,12008,,390,2661,654,94,1242,1493,3514,1096,844,,810,1093,165,176,,0.01949018,0.143880448,0.276427281,0.27480799,0.143263618,0.066164442,0.03505017,0.025548611,0.011162327,0.004204933,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 30 | 2004,2305,96788,857,691,422657,71241,28605,1475,5488,19819,2833,461,6801,5157,1196,2177,1868,5362,539,293,4051,918,670,197,206,1138,0.003876871,0.057572065,0.212975226,0.292690113,0.251261988,0.069269676,0.040572344,0.053698258,0.016008073,0.002075387,0,0,0,0,0,0,520,104,3,1107,446,3,0,0,0,0,0,0,127,360,3 31 | 2005,4784,85090,572,557,345814,46672,,2653,3845,21819,2864,499,5059,2206,672,4097,1679,,510,582,1760,,,290,367,1801,0,0.033930586,0.233460679,0.285144749,0.187563249,0.160120271,0.076769226,0.00622005,0,0.016791189,0,0,0,0,0,0,3531,1189,3,874,604,3,0,0,0,0,0,0,0,0,0 32 | 2006,2777,90085,444,352,396248,62850,17619,1043,4355,20205,1700,541,,4734,,,1618,5639,705,386,1866,1015,531,744,347,862,0,0.014040663,0.129933493,0.305412718,0.293495157,0.167494171,0.053488793,0.011416627,0.014212934,0.010505444,0,0,0,0,0,0,2493,1038,3,0,0,0,0,0,0,0,0,0,0,0,0 33 | 2007,179,96155,1478,305,266219,32950,12927,374,4011,,2032,412,,692,173,1458,2147,3984,,,,,1035,170,165,943,0,0.022240196,0.099618183,0.199970546,0.311355876,0.247171919,0.075400606,0.031587787,0.009471143,0.003183745,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 34 | 2008,8865,98103,708,420,,,5276,701,2563,9750,1075,413,487,1074,,589,1061,3222,418,213,,290,177,131,245,1033,0.004584655,0.027231771,0.152437603,0.293124279,0.305684734,0.1182636,0.043145568,0.033401132,0.008265797,0.01386086,0,0,0,6415,1026,3,2362,783,3,19,4,3,1,6,3,0,6,0,0,12,0 35 | 2009,6664,78231,904,470,,,5744,362,3663,9528,1071,311,,,,,,,565,379,,323,303,248,209,632,0,0.046627466,0.195455972,0.283012691,0.346021219,0.075270888,0.032264799,0.016413732,0,0.004933235,0,0,0,3003,668,3,2539,752,3,762,519,3,113,436,3,83,672,3,58,752,3 36 | 2010,2732,66056,354,292,,,1667,201,1498,5812,546,181,,235,,,,,229,,,,62,187,75,135,0.006124895,0.018450259,0.219030569,0.375496868,0.151667906,0.133525937,0.05555775,0.018524206,0.011293356,0.010328255,0,0,0,0,0,0,1724,1324,5,290,522,3,271,686,3,186,958,3,176,1632,3 37 | 2011,747,62368,579,337,,,4079,284,1547,6731,992,136,,,,79,116,,61,26,,249,96,67,145,767,0.00827152,0.108224893,0.118806876,0.297634908,0.199604493,0.169544769,0.081793703,0.012973699,0,0.003145139,0,0,0,0,0,0,0,0,0,361,634,5,227,996,5,129,1226,5,24,1668,5 38 | 2012,627,22544,0,321,,,,555,2201,,1116,228,,588,,49,193,,36,51,,229,178,85,,670,0,0.006232166,0.050792717,0.296415455,0.330809308,0.211443559,0.062748786,0.020092077,0.008771432,0.012694501,0,0,0,0,0,0,0,0,0,0,0,0,45,604,5,195,1616,5,39,1464,5 39 | 2013,174,47113,0,201,,,845,193,1292,1819,495,97,1165,599,83,154,261,754,,38,532,138,74,,64,469,0,0.014357867,0.168106169,0.370822944,0.265387188,0.096279646,0.074278478,0.010767709,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,139,2018,5,21,1556,5 40 | 2014,35,11234,0,497,,,3187,320,2993,3732,1904,,,,,497,1220,3201,80,200,,340,359,,,1865,0.022421416,0.226115846,0.283424262,0.236984858,0.12166341,0.077086033,0.014755758,0.014560557,0,0.002862254,0,0,0,0,0,0,0,0,0,0,0,0,14,584,5,14,2276,5,0,0,0 41 | 2015,8,11446,0,472,,,8162,709,2282,8081,2104,,,709,,810,917,,77,,662,,19,,1381,2016,0.023185465,0.09895198,0.185878934,0.229198444,0.151951681,0.131560709,0.062541028,0.059129179,0.033829165,0.023773416,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 42 | -------------------------------------------------------------------------------- /examples/rrm/rrm.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # --------------------------------------------------------------------------- # 5 | # --------------------------------------------------------------------------- # 6 | # Grab Kuskokwim Chinook data and tailor it to my needs. 7 | data_file <- 'Kusko_estimates2015_Dec22.csv' 8 | kusko.data <- read.csv(data_file,header=T, na.string='NA') 9 | 10 | # Modifications 11 | Year <- as.vector(kusko.data$Year) 12 | nyr <- length(Year) 13 | 14 | # Harvest 15 | harvest <- as.matrix(kusko.data[substr(names(kusko.data),1,2)=="H."]) 16 | tot.harvest <- rowSums(harvest,na.rm=TRUE) 17 | 18 | # Weir counts 19 | weir <- as.matrix(kusko.data[substr(names(kusko.data),1,2)=="w."]) 20 | 21 | # Aerial counts 22 | aerial <- as.matrix(kusko.data[substr(names(kusko.data),1,2)=="a."]) 23 | 24 | # In.river 25 | in.river <- as.matrix(kusko.data[substr(names(kusko.data),1,3)=="In."]) 26 | 27 | 28 | # Number of scaling coefficients. 29 | nq <- dim(weir)[2] + dim(aerial)[2] 30 | i_count <- cbind(weir,aerial) 31 | 32 | # Test fishery weekly cpue 33 | wcpue <- as.matrix(kusko.data[substr(names(kusko.data),1,3)=="rpw"]) 34 | 35 | # --------------------------------------------------------------------------- # 36 | # --------------------------------------------------------------------------- # 37 | 38 | 39 | 40 | 41 | 42 | # --------------------------------------------------------------------------- # 43 | # --------------------------------------------------------------------------- # 44 | # RUN RECONSTRUCTION MODEL. 45 | # AUTHORS: Steven Martell, Hamachan, Haflinger 46 | # - Use a run-timing model to predict arrivals (A_t) and departures (D_t) 47 | # - N_t = E_y \left[ \int_{t=0}^{t} f(\mu_d,\sigma_m)dt 48 | # -\int_{t=0}^{t-s}g(\mu_d,\sigma_m)dt \right] 49 | # - Bethel test fishery starts on June 1, each year and runs through Aug 24. 50 | # - June 1 corresponds to week 22. 51 | # 52 | # - For the beta distribution: 53 | # b = [(E(x)-1)(E(x)^2-E(x)+V(x))]V(x) 54 | # a = (E(x)b)/(1-E(x)) 55 | # TODO LIST: 56 | # [ ] Build Simulation Model. 57 | # [ ] Run simulation testing. 58 | # 59 | # --------------------------------------------------------------------------- # 60 | # --------------------------------------------------------------------------- # 61 | # library(lubridate) 62 | # Mean Escapement 63 | meanRunSize <- 100 64 | days <- seq(1,365,by=1) / 365 65 | 66 | # 67 | # Mean Arrival date (day of year) 68 | mu.aday <- lubridate::yday(as.Date("1978-06-16")) / 365 69 | 70 | # Stdev in Arrival date (days) 71 | sd.aday <- 35 / 365 72 | 73 | # Survey life (s in days) 74 | s <- 42 /365 75 | 76 | # Arrival model parameters 77 | mu = mu.aday 78 | var = sd.aday*sd.aday 79 | b = ( (mu-1)*(mu^2-mu+var) )/var 80 | a = ( mu * b )/(1-mu) 81 | 82 | # Cumulative arrival model 83 | avec <- pbeta(days,a,b) 84 | 85 | # Cumulative death model 86 | dvec <- pbeta(days-s,a,b) 87 | 88 | # Daily run size 89 | nt <- meanRunSize * (avec - dvec) 90 | 91 | # sample dates for geting mean cpue 92 | idate <- seq(lubridate::yday("1970-06-01"),by=7,length=10) 93 | 94 | # test fishery cpue 95 | set.seed(3424) 96 | sig.epsilon <- 0.12 97 | epsilon <- rnorm(length(idate),0,sig.epsilon) 98 | it <- nt[idate]*exp(epsilon) 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | # rrm.R 112 | # R-script for run reconstruction model (rrm) 113 | 114 | n = 100 115 | x = rnorm(n,mean=0,sd=1) 116 | 117 | 118 | library(TMB) 119 | compile("rrm.cpp",flags=" -O0") 120 | dyn.load(dynlib("rrm")) 121 | 122 | print(weir) 123 | # weir[is.na(weir)]<-0 124 | inputData <- list(x=x,tot_harvest=tot.harvest, 125 | i_count=i_count,wcpue=wcpue, 126 | in_river=in.river) 127 | 128 | params <- list(mu=0,sigma=1,log_escapement=rep(0,length=nyr), 129 | log_q=rep(0,length=nq),log_sig_i=rep(0,length=nq)) 130 | 131 | # Construct an R object that represents the C++ function 132 | # f = MakeADFun(inputData,parameters=params)#,random=c("mu")) 133 | f = MakeADFun(inputData,parameters=params,DLL="rrm")#,random=c("mu")) 134 | 135 | # The objective function value 136 | f$fn() 137 | 138 | # The gradient (first order derivatives) 139 | f$gr() 140 | 141 | # The Hessian (second order derivatives) 142 | f$he() 143 | 144 | # Likelihood maximization 145 | fit <- nlminb(f$par,f$fn,f$gr,lower=c(-10.0,0.0),upper=c(10.0,10.0)) 146 | 147 | 148 | 149 | -------------------------------------------------------------------------------- /examples/rrm/rrm.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | 4 | template 5 | bool isNA(Type x){ 6 | return R_IsNA(asDouble(x)); 7 | } 8 | 9 | template 10 | bool isFinite(Type x){ 11 | return R_finite(asDouble(x)); 12 | } 13 | 14 | 15 | 16 | 17 | 18 | 19 | template 20 | Type objective_function::operator() () 21 | { 22 | // DATA SECTION 23 | DATA_VECTOR(x); // log annual escapement. 24 | DATA_VECTOR(tot_harvest); // total harvest (sum over sectors) 25 | DATA_ARRAY(i_count); // weir or aerial count index. 26 | // DATA_MATRIX(aerial); // peak aerial count (year, tributary) 27 | DATA_ARRAY(wcpue); // weekly test fishery cpue (year,week) 28 | DATA_ARRAY(in_river); // in river mark-recapture data. 29 | 30 | // PARAMETER SECTION 31 | PARAMETER(mu); 32 | PARAMETER(sigma); 33 | PARAMETER_VECTOR(log_escapement); 34 | PARAMETER_VECTOR(log_q); 35 | PARAMETER_VECTOR(log_sig_i); 36 | 37 | 38 | int nyrs = tot_harvest.size(); 39 | int nobs = i_count.dim(1); 40 | vector Et = exp(log_escapement); 41 | vector q = exp(log_q); 42 | vector Ct(nyrs); 43 | matrix ihat(nyrs,nobs); 44 | 45 | Type objfun = 0; 46 | Type nll_count = 0; 47 | Type nll_river = 0; 48 | for (int i = 0; i < nyrs; ++i) 49 | { 50 | 51 | // negative loglikelihood for count obs. 52 | for (int j = 0; j < nobs; ++j) 53 | { 54 | if( !isNA(i_count(i,j)) ) 55 | { 56 | Type obs = log(i_count(i,j)); 57 | Type pre = log(q(j) * Et(i)); 58 | Type sig = exp(log_sig_i(j)); 59 | nll_count -= dnorm(obs,pre,sig,true); 60 | 61 | } 62 | } 63 | 64 | // negative loglikeilhood for Inriver MR estimates 65 | if( !isNA(in_river(i,0)) ) 66 | { 67 | Type obs = log(in_river(i,0)); 68 | Type pre = log(Et(i)+tot_harvest(i)); 69 | Type sig = sqrt(1.0+in_river(i,1)/(in_river(i,0)*in_river(i,0))); 70 | nll_river -= dnorm(obs,pre,sig,true); 71 | } 72 | } 73 | 74 | std::cout< 92 | Type arrival_model() 93 | { 94 | 95 | } 96 | 97 | -------------------------------------------------------------------------------- /examples/sam/sam.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/TMB-ADMB-Workshops/Feb2016/c0ccb76b036f072ee2815f74a5cc6d8a710bbe6b/examples/sam/sam.RData -------------------------------------------------------------------------------- /examples/sam/samtmb.R: -------------------------------------------------------------------------------- 1 | load("sam.RData") 2 | 3 | parameters <- list( 4 | logFpar =numeric(max(data$keyLogFpar)+1)-5, 5 | logQpow =numeric(max(data$keyQpow)+1), 6 | logSdLogFsta =numeric(max(data$keyVarF)+1)-.7, 7 | logSdLogN =numeric(max(data$keyVarLogN)+1)-.35, 8 | logSdLogObs =numeric(max(data$keyVarObs)+1)-.35, 9 | rec_loga =if(data$stockRecruitmentModelCode==0){numeric(0)}else{numeric(1)}, 10 | rec_logb =if(data$stockRecruitmentModelCode==0){numeric(0)}else{numeric(1)}, 11 | logit_rho =numeric(1)+.5, 12 | logScale =numeric(data$noScaledYears), 13 | logScaleSSB =if(any(data$fleetTypes%in%c(3,4))){numeric(1)}else{numeric(0)}, 14 | logPowSSB =if(any(data$fleetTypes==4)){numeric(1)}else{numeric(0)}, 15 | logSdSSB =if(any(data$fleetTypes%in%c(3,4))){numeric(1)}else{numeric(0)}, 16 | logF =matrix(0, nrow=max(data$keyLogFsta)+1,ncol=data$noYears), 17 | logN =matrix(0, nrow=data$maxAge-data$minAge+1, ncol=data$noYears), 18 | numdata =Inf 19 | ) 20 | 21 | 22 | library(TMB, quiet=TRUE) 23 | compile("samtmb.cpp") 24 | dyn.load(dynlib("samtmb")) 25 | 26 | map <- list(numdata=factor(NA)) 27 | obj <- MakeADFun(data,parameters,random=c("logN","logF"),DLL="samtmb",map=map) 28 | 29 | opt<-nlminb(obj$par,obj$fn,obj$gr,control=list(trace=1,eval.max=1200,iter.max=900)) 30 | obj$fn(opt$par); 31 | 32 | 33 | model=obj 34 | pl <- obj$env$parList() 35 | rep<-obj$report() 36 | jointrep<-sdreport(obj, getJointPrecision=T) 37 | allsd<-sqrt(diag(solve(jointrep$jointPrecision))) 38 | plsd <- obj$env$parList(par=allsd) 39 | sdrep<-sdreport(obj)k 40 | plsd$logN 41 | names(sdrep) 42 | names(plsd) 43 | pl <- model$env$parList() 44 | jointrep <- sdreport(model, getJointPrecision=TRUE) 45 | allsd <- sqrt(diag(solve(jointrep$jointPrecision))) 46 | plsd <- model$env$parList(par=allsd) -------------------------------------------------------------------------------- /examples/sam/samtmb.cpp: -------------------------------------------------------------------------------- 1 | // -------------------------------------------------------------------------- 2 | // Copyright (c) 2014, Anders Nielsen , 3 | // Casper Berg , and Kasper Kristensen . 4 | // All rights reserved. 5 | // 6 | // Redistribution and use in source and binary forms, with or without 7 | // modification, are permitted provided that the following conditions are met: 8 | // * Redistributions of source code must retain the above copyright 9 | // notice, this list of conditions and the following disclaimer. 10 | // * Redistributions in binary form must reproduce the above copyright 11 | // notice, this list of conditions and the following disclaimer in the 12 | // documentation and/or other materials provided with the distribution. 13 | // * Neither the name of the assessment tool SAM nor the 14 | // names of its contributors may be used to endorse or promote products 15 | // derived from this software without specific prior written permission. 16 | // 17 | // THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 18 | // AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 19 | // IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 20 | // ARE DISCLAIMED. IN NO EVENT SHALL ANDERS NIELSEN, CASPER BERG OR KASPER 21 | // KRISTENSEN BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 22 | // EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 23 | // PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; 24 | // OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 25 | // WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR 26 | // OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF 27 | // ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | // -------------------------------------------------------------------------- 29 | 30 | #include 31 | #include 32 | 33 | 34 | /* Parameter transform */ 35 | template 36 | Type f(Type x){return Type(2)/(Type(1) + exp(-Type(2) * x)) - Type(1);} 37 | 38 | template 39 | Type square(Type x){return x*x;} 40 | 41 | 42 | template 43 | Type objective_function::operator() () 44 | { 45 | DATA_INTEGER(noFleets); 46 | DATA_VECTOR(fleetTypes); 47 | DATA_VECTOR(sampleTimes); 48 | DATA_INTEGER(noYears); 49 | DATA_VECTOR(years); 50 | DATA_INTEGER(nobs); 51 | DATA_VECTOR(idx1); 52 | DATA_VECTOR(idx2); 53 | DATA_ARRAY(obs); 54 | DATA_ARRAY(propMat); 55 | DATA_ARRAY(stockMeanWeight); 56 | DATA_ARRAY(catchMeanWeight); 57 | DATA_ARRAY(natMor); 58 | DATA_ARRAY(landFrac); 59 | DATA_ARRAY(disMeanWeight); 60 | DATA_ARRAY(landMeanWeight); 61 | DATA_ARRAY(propF); 62 | DATA_ARRAY(propM); 63 | DATA_INTEGER(minAge); 64 | DATA_INTEGER(maxAge); 65 | DATA_INTEGER(maxAgePlusGroup); 66 | DATA_IARRAY(keyLogFsta); 67 | DATA_INTEGER(corFlag); 68 | DATA_IARRAY(keyLogFpar); 69 | DATA_IARRAY(keyQpow); 70 | DATA_IARRAY(keyVarF); 71 | DATA_IARRAY(keyVarLogN); 72 | DATA_IARRAY(keyVarObs); 73 | DATA_INTEGER(stockRecruitmentModelCode); 74 | DATA_INTEGER(noScaledYears); 75 | DATA_IVECTOR(keyScaledYears); 76 | DATA_IMATRIX(keyParScaledYA); 77 | DATA_IVECTOR(fbarRange); 78 | DATA_INTEGER(reportMode); 79 | 80 | PARAMETER_VECTOR(logFpar); 81 | PARAMETER_VECTOR(logQpow); 82 | PARAMETER_VECTOR(logSdLogFsta); 83 | PARAMETER_VECTOR(logSdLogN); 84 | PARAMETER_VECTOR(logSdLogObs); 85 | PARAMETER_VECTOR(rec_loga); 86 | PARAMETER_VECTOR(rec_logb); 87 | PARAMETER(logit_rho); 88 | PARAMETER_VECTOR(logScale); 89 | PARAMETER_VECTOR(logScaleSSB); 90 | PARAMETER_VECTOR(logPowSSB); 91 | PARAMETER_VECTOR(logSdSSB); 92 | PARAMETER_ARRAY(logF); 93 | PARAMETER_ARRAY(logN); 94 | PARAMETER(numdata); //number of data points to include (Inf=all) 95 | int timeSteps=logF.dim[1]; 96 | int stateDimF=logF.dim[0]; 97 | int stateDimN=logN.dim[0]; 98 | Type rho=f(logit_rho); 99 | vector sdLogFsta=exp(logSdLogFsta); 100 | vector varLogN=exp(logSdLogN*Type(2.0)); 101 | vector varLogObs=exp(logSdLogObs*Type(2.0)); 102 | vector ssb(timeSteps); 103 | vector logssb(timeSteps); 104 | vector fbar(timeSteps); 105 | vector logfbar(timeSteps); 106 | vector cat(catchMeanWeight.dim(0)); 107 | vector logCatch(catchMeanWeight.dim(0)); 108 | vector tsb(timeSteps); 109 | vector logtsb(timeSteps); 110 | 111 | Type ans=0; //negative log-likelihood 112 | 113 | //initial condition 114 | //Type huge=10; 115 | //for(int i=0; i fvar(stateDimF,stateDimF); 121 | matrix fcor(stateDimF,stateDimF); 122 | vector fsd(stateDimF); 123 | 124 | for(int i=0; i neg_log_densityF(fvar); 162 | for(int i=1;i(-1)){ 170 | ssb(i)+=exp(logN(j,i))*exp(-exp(logF(keyLogFsta(0,j),i))*propF(i,j)-natMor(i,j)*propM(i,j))*propMat(i,j)*stockMeanWeight(i,j); 171 | }else{ 172 | ssb(i)+=exp(logN(j,i))*exp(-natMor(i,j)*propM(i,j))*propMat(i,j)*stockMeanWeight(i,j); 173 | } 174 | } 175 | logssb(i)=log(ssb(i)); 176 | } 177 | 178 | //Now take care of N 179 | matrix nvar(stateDimN,stateDimN); 180 | for(int i=0; i neg_log_densityN(nvar); 186 | vector predN(stateDimN); 187 | for(int i=1;i(-1)){ 204 | predN(j)=logN(j-1,i-1)-exp(logF(keyLogFsta(0,j-1),i-1))-natMor(i-1,j-1); 205 | }else{ 206 | predN(j)=logN(j-1,i-1)-natMor(i-1,j-1); 207 | } 208 | } 209 | if(maxAgePlusGroup==1){ 210 | predN(stateDimN-1)=log(exp(logN(stateDimN-2,i-1)-exp(logF(keyLogFsta(0,stateDimN-2),i-1))-natMor(i-1,stateDimN-2))+ 211 | exp(logN(stateDimN-1,i-1)-exp(logF(keyLogFsta(0,stateDimN-1),i-1))-natMor(i-1,stateDimN-1))); 212 | } 213 | ans+=neg_log_densityN(logN.col(i)-predN); // N-Process likelihood 214 | } 215 | 216 | 217 | // Now finally match to observations 218 | int f, ft, a, y,yy, scaleIdx; // a is no longer just ages, but an attribute (e.g. age or length) 219 | int minYear=CppAD::Integer((obs(0,0))); 220 | Type zz; 221 | vector predObs(nobs); 222 | vector predSd(nobs); 223 | for(int i=0;i(-1)){ 234 | predObs(i)+=logF(keyLogFsta(0,a),y); 235 | } 236 | scaleIdx=-1; 237 | yy=CppAD::Integer(obs(i,0)); 238 | for(int j=0; j=0){ 242 | predObs(i)-=logScale(scaleIdx); 243 | } 244 | break; 245 | } 246 | } 247 | break; 248 | 249 | case 1: 250 | std::cerr<<"Unknown fleet code: "<(-1)){ 257 | predObs(i)*=exp(logQpow(keyQpow(f-1,a))); 258 | } 259 | if(keyLogFpar(f-1,a)>(-1)){ 260 | predObs(i)+=logFpar(keyLogFpar(f-1,a)); 261 | } 262 | 263 | break; 264 | 265 | case 3: 266 | std::cerr<<"Unknown fleet code: "< 2 | template 3 | Type objective_function::operator() () 4 | { 5 | PARAMETER(mu); 6 | Type nll = pow(Type(42)-mu,2); 7 | return nll; 8 | } 9 | -------------------------------------------------------------------------------- /examples/schaefer/schaefer.R: -------------------------------------------------------------------------------- 1 | setwd("~/_mymods/tmb/Feb2016/examples/andre") 2 | hake <- read.table("schaefer.dat", header = TRUE) 3 | names(hake) <- c("t", "C", "I") 4 | parameters <- list(logR=-1.1, logK=8.0, logQ=-7.9, logSigma=-2.3) 5 | 6 | require(TMB) 7 | compile("schaefer.cpp") 8 | dyn.load(dynlib("schaefer")) 9 | 10 | ################################################################################ 11 | 12 | model <- MakeADFun(hake, parameters,DLL="schaefer") 13 | fit <- nlminb(model$par, model$fn, model$gr) 14 | rep <- sdreport(model) 15 | 16 | print(summary(rep)) 17 | 18 | ################################################################################ 19 | 20 | hake$B <- model$report()$B 21 | hake$Ihat <- model$report()$Ihat 22 | 23 | par(mfrow=c(1,2)) 24 | matplot(hake$t, hake[c("C","B")], type="l", 25 | xlab="Year", ylab="Biomass and Catch (kt)") 26 | plot(I~t, hake, ylim=c(0,1.1*max(hake$I)), yaxs="i") 27 | lines(Ihat~t, hake) 28 | args(mcmc) 29 | # Set up some method to getting parameter set (draws of posterior eg) 30 | nuts <- mcmc(model, 500, "NUTS",eps=.003) 31 | names(nuts) 32 | summary(nuts) 33 | # Store some part of ADREPORT() (in this case B) from the model given those parameter vectors 34 | dd = NULL 35 | for (i in 1:nrow(nuts)) { 36 | dd[[i]] <- model$report(nuts[i,])$B 37 | } 38 | dd 39 | boxplot(as.data.frame(t(as.data.frame(dd)))) 40 | 41 | args(model$report ) 42 | str(nuts) 43 | cor(nuts$logR,nuts$logK) 44 | plot(nuts$logR,nuts$logK) 45 | mcmc(model, 500, "RWM",eps=.001) 46 | warnings() -------------------------------------------------------------------------------- /examples/schaefer/schaefer.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | 4 | template 5 | Type posfun(Type x, Type eps, Type &pen) 6 | { 7 | if ( x >= eps ){ 8 | return x; 9 | } else { 10 | pen += Type(0.01) * pow(x-eps,2); 11 | return eps/(Type(2.0)-x/eps); 12 | } 13 | } 14 | 15 | template 16 | Type objective_function::operator() () 17 | { 18 | DATA_VECTOR(C); 19 | DATA_VECTOR(I); 20 | int n = C.size(); 21 | 22 | PARAMETER(logR); 23 | PARAMETER(logK); 24 | PARAMETER(logQ); 25 | PARAMETER(logSigma); 26 | Type r = exp(logR); 27 | Type k = exp(logK); 28 | Type q = exp(logQ); 29 | Type sigma = exp(logSigma); 30 | vector B(n); 31 | vector Ihat(n); 32 | Type f; 33 | Type fpen = 0; 34 | Type tmpB; 35 | B(0) = k; 36 | for(int t=0; t<(n-1); t++) 37 | { 38 | // B(t+1) = abs(B(t) + r*B(t)*(1-B(t)/k) - C(t)); 39 | tmpB = B(t) + r*B(t)*(1-B(t)/k) - C(t); 40 | B(t+1) = posfun(tmpB,Type(0.01),fpen); 41 | } 42 | Ihat = q*B; 43 | f = -sum(dnorm(log(I), log(Ihat), sigma, true)); 44 | f += fpen; 45 | 46 | ADREPORT(log(B)); // uncertainty 47 | REPORT(B); // plot 48 | REPORT(Ihat); // plot 49 | REPORT(fpen); 50 | 51 | return f; 52 | } 53 | 54 | 55 | 56 | 57 | // dvariable posfun(const dvariable&x,const double eps,dvariable& pen) 58 | // { 59 | // if (x>=eps) { 60 | // return x; 61 | // } else { 62 | // pen+=.01*square(x-eps); 63 | // return eps/(2-x/eps); 64 | // } } 65 | 66 | 67 | -------------------------------------------------------------------------------- /examples/schaefer/schaefer.dat: -------------------------------------------------------------------------------- 1 | Year Catch Index 2 | 1965 93.510 1.78 3 | 1966 212.444 1.31 4 | 1967 195.032 0.91 5 | 1968 382.712 0.96 6 | 1969 320.430 0.88 7 | 1970 402.467 0.90 8 | 1971 365.557 0.87 9 | 1972 606.084 0.72 10 | 1973 377.642 0.57 11 | 1974 318.836 0.45 12 | 1975 309.374 0.42 13 | 1976 389.020 0.42 14 | 1977 276.901 0.49 15 | 1978 254.251 0.43 16 | 1979 170.006 0.40 17 | 1980 97.181 0.45 18 | 1981 90.523 0.55 19 | 1982 176.532 0.53 20 | 1983 216.181 0.58 21 | 1984 228.672 0.64 22 | 1985 212.177 0.66 23 | 1986 231.179 0.65 24 | 1987 136.942 0.61 25 | 1988 212.000 0.63 26 | -------------------------------------------------------------------------------- /examples/srw/README.md: -------------------------------------------------------------------------------- 1 | #Simple Random Walk in TMB 2 | ##Premise 3 | You are given a time series of population observations 4 | Can you estimate the population and separate the process and observation errors assuming the population follows a random walk? 5 | ##Data Generator 6 | ` 7 | n.obs <- 35 8 | true.process.error <- 0.2 9 | true.obs.error <- 0.4 10 | true.population <- rep(0,n.obs) 11 | true.population[1] <- rnorm(1,0,true.process.error) 12 | for (i in 2:n.obs){ 13 | true.population[i] <- true.population[i-1] + rnorm(1,0,true.process.error) 14 | } 15 | observed <- round(true.population + rnorm(n.obs,0,true.obs.error), 6) 16 | ` 17 | 18 | -------------------------------------------------------------------------------- /examples/srw/observed.dat: -------------------------------------------------------------------------------- 1 | "observed" "true_population" 2 | -0.098431 0.0204349791375876 3 | -0.188888 -0.0297341134252991 4 | 0.524533 0.218892770657212 5 | 0.66163 0.46917367530839 6 | 0.618028 0.550307401879488 7 | -0.028031 0.597879699505086 8 | 0.601221 0.58506686133413 9 | 0.530695 0.378942918470186 10 | 1.269626 0.573003366578351 11 | 0.61989 0.639622699101125 12 | 0.072918 0.37736889245335 13 | 0.932402 0.437568487264373 14 | 1.423945 0.387564636844873 15 | 0.763217 0.417113623909279 16 | -0.012443 0.379157392161609 17 | -0.037756 0.227510803959993 18 | -0.002363 0.4856495897162 19 | 0.808504 0.657993249626873 20 | 0.596511 0.880235251485118 21 | -0.284476 0.587743963614229 22 | 0.746339 0.383252876598737 23 | 0.581147 0.633211022303799 24 | 0.380347 0.625471984459858 25 | 1.478686 0.514784296950798 26 | 0.545143 0.599625709513929 27 | 0.831198 0.711452236888394 28 | 1.056335 0.937942724446074 29 | 0.544023 0.683206549514874 30 | 0.931244 0.819506406745699 31 | 1.636344 1.05781876416976 32 | 1.467778 1.20626032396122 33 | 1.129036 0.935331948832871 34 | 0.997282 0.789329666008701 35 | 1.290083 0.89601701982733 36 | 0.920465 0.596361912489808 37 | -------------------------------------------------------------------------------- /examples/srw/rw.R: -------------------------------------------------------------------------------- 1 | data <- read.table("rw.dat", header=TRUE) 2 | parameters <- list(predbiom=rep(0.0,24), logSdLam=0.0) 3 | Random = c("predbiom") 4 | 5 | require(TMB) 6 | compile("rw.cpp","-O0 -g") 7 | dyn.load(dynlib("rw")) 8 | 9 | ################################################################################ 10 | 11 | model <- MakeADFun(data, parameters, DLL="rw", random=Random) 12 | model2 <- MakeADFun(data, parameters, DLL="rw") 13 | fit2 <- nlminb(model2$par, model2$fn, model2$gr) 14 | fit <- nlminb(model$par, model$fn, model$gr) 15 | exp(fit2$par) 16 | sdreport(model,bias.correct=TRUE,bias.correct.control = list(sd=TRUE)) 17 | str(sdreport(model,bias.correct=TRUE)) 18 | 19 | best <- model$env$last.par.best 20 | rep <- sdreport(model) 21 | 22 | print(best) 23 | print(rep) 24 | 25 | plot(exp(model$rep()$predbiom), ylim=c(0,400000)) 26 | points(data$biom,col="red") 27 | -------------------------------------------------------------------------------- /examples/srw/rw.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | 4 | template 5 | Type step(Type x1, Type x2, Type var, Type jnll) 6 | { 7 | jnll += Type(0.5)*(log(Type(2.0)*Type(3.14)*var) + ((x2-x1)*(x2-x1))/var); 8 | return jnll; 9 | } 10 | 11 | template 12 | Type obs(Type x2, Type obs, Type yvar, Type yconst, Type jnll) 13 | { 14 | jnll += Type(0.5)*(yconst + ((x2-log(obs))*(x2-log(obs)))/yvar); 15 | return jnll; 16 | } 17 | template 18 | Type objective_function::operator() () 19 | { 20 | DATA_IVECTOR(year); 21 | DATA_VECTOR(biom); 22 | DATA_VECTOR(cv); 23 | PARAMETER_VECTOR(predbiom); 24 | int n = year.size(); 25 | PARAMETER(logSdLam); // The process error sd (log scale) 26 | vector srv_sd(n); 27 | vector yvar(n); // the observation error variances 28 | vector yconst(n); // the observation error variances 29 | for (int i=0;i<=(n-1);i++) // convert SD to CVs 30 | { 31 | if (cv(i) > 0) 32 | { 33 | srv_sd(i) = Type(1.0) + cv(i)*cv(i); 34 | srv_sd(i) = sqrt(log(srv_sd(i))); 35 | yvar(i) = srv_sd(i)*srv_sd(i); 36 | yconst(i) = log(Type(2.0)*Type(3.14)*yvar(i)); 37 | } 38 | else 39 | { 40 | srv_sd(i) = -9; 41 | yvar(i) = -9; 42 | yconst(i) = -9; 43 | } 44 | } 45 | 46 | //PARAMETER(mu); 47 | //PARAMETER(logSigma); 48 | 49 | Type var =exp(Type(2.0)*logSdLam); 50 | Type jnll = 0.0; 51 | 52 | for (int i=1;i<=(n-1);i++) 53 | { 54 | jnll = step(predbiom(i-1),predbiom(i),var, jnll); // process errors 55 | } 56 | 57 | for (int j=0;j<=(n-1);j++) 58 | { 59 | if (yvar(j) >0) 60 | { 61 | jnll = obs(predbiom(j),biom(j),yvar(j),yconst(j), jnll); // observation errors 62 | } 63 | } 64 | 65 | //Type f = 0.0; 66 | //f = -sum(dnorm(biom, mu, exp(logSigma), true)); 67 | 68 | REPORT(yvar); 69 | ADREPORT(predbiom); 70 | REPORT(biom); 71 | REPORT(log(biom)); 72 | return jnll; 73 | } 74 | 75 | -------------------------------------------------------------------------------- /examples/srw/rw.dat: -------------------------------------------------------------------------------- 1 | year biom cv 2 | 1991 144043.4 0.212962921 3 | 1992 -9 -9 4 | 1993 -9 -9 5 | 1994 65843.4 0.650507174 6 | 1995 -9 -9 7 | 1996 -9 -9 8 | 1997 65493.1 0.381595009 9 | 1998 -9 -9 10 | 1999 -9 -9 11 | 2000 143348.3 0.3913898 12 | 2010 -9 -9 13 | 2002 136440 0.326442436 14 | 2003 -9 -9 15 | 2004 146178.6 0.27356883 16 | 2005 -9 -9 17 | 2006 101275.7 0.293583012 18 | 2007 -9 -9 19 | 2008 -9 -9 20 | 2009 -9 -9 21 | 2010 143952.9 0.28786523 22 | 2011 -9 -9 23 | 2012 216324.8 0.654921146 24 | 2013 -9 -9 25 | 2014 346391.5 0.381541633 26 | -------------------------------------------------------------------------------- /examples/srw/srw.R: -------------------------------------------------------------------------------- 1 | #install.packages("Hmisc") 2 | require(TMB) 3 | require(Hmisc) 4 | 5 | # compile cpp code and load dll 6 | compile("srw.cpp") 7 | dyn.load(dynlib("srw")) 8 | 9 | # create new data 10 | create.new.data <- FALSE 11 | if (create.new.data){ 12 | n.obs <- 35 13 | true.process.error <- 0.2 14 | true.obs.error <- 0.4 15 | true.population <- rep(0,n.obs) 16 | true.population[1] <- rnorm(1,0,true.process.error) 17 | for (i in 2:n.obs){ 18 | true.population[i] <- true.population[i-1] + rnorm(1,0,true.process.error) 19 | } 20 | observed <- round(true.population + rnorm(n.obs,0,true.obs.error), 6) 21 | write.table(cbind(observed,true.population),file="new.observed.dat",col.names=c("observed","true_population"),row.names=FALSE) 22 | } 23 | 24 | # read data and true population from file 25 | data <- read.table("observed.dat", header=TRUE) 26 | observed <- data$observed 27 | true.population <- data$true_population 28 | n.obs <- length(observed) 29 | 30 | # set up data and parameters 31 | dat <- list( 32 | observed=observed 33 | ) 34 | 35 | parameters <- list( 36 | population=rep(0,n.obs), 37 | log_process_error=0, 38 | log_obs_error=0 39 | ) 40 | 41 | # now estimate population, process error, and observation error 42 | obj <- MakeADFun(dat,parameters,DLL="srw", random=c("population"), silent=TRUE) 43 | opt <- nlminb(obj$par, obj$fn, obj$gr, control=list(iter.max=1000,eval.max=1000)) 44 | rep <- sdreport(obj) 45 | srep <- summary(sdreport(obj)) 46 | print(srep) 47 | 48 | # get results in a format for plots 49 | est.pop <- srep[rownames(srep) == "population",] 50 | est.process.error <- as.vector(round(srep[rownames(srep) == "process_error",],3)) 51 | est.obs.error <- as.vector(round(srep[rownames(srep) == "obs_error",],3)) 52 | ep <- est.pop[,1] 53 | hi <- est.pop[,1]+2*est.pop[,2] 54 | lo <- est.pop[,1]-2*est.pop[,2] 55 | my.range <- range(c(observed,hi,lo)) 56 | 57 | # make a series of pretty plots 58 | #windows(record=T) # Windows users will want to uncomment this line 59 | od <- paste0(my.dir,"\\plots\\") 60 | saveplots <- FALSE 61 | 62 | # observed data only 63 | plot(1:n.obs,observed,pch=16,ylim=my.range,xlab="Year",ylab="Population") 64 | legend('topleft',legend=c("obs"),pch=c(16),col=c("black")) 65 | if(saveplots) savePlot(paste0(od,"obs.png"), type='png') 66 | 67 | # observed and true population 68 | plot(1:n.obs,observed,pch=16,ylim=my.range,xlab="Year",ylab="Population") 69 | points(1:n.obs,true.population,col="blue") 70 | legend('topleft',legend=c("obs","true"),pch=c(16,1),col=c("black","blue")) 71 | if(saveplots) savePlot(paste0(od,"obs_true.png"), type='png') 72 | 73 | # now with the estimated 74 | plot(1:n.obs,observed,pch=16,ylim=my.range,xlab="Year",ylab="Population") 75 | points(1:n.obs,true.population,col="blue") 76 | errbar(1:n.obs,ep,hi,lo,pch=3,col="red",errbar.col="red",add=TRUE) 77 | legend('topleft',legend=c("obs","true","est"),pch=c(16,1,3),col=c("black","blue","red")) 78 | title(main=paste("process error =",true.process.error,", est=",est.process.error[1]," (",est.process.error[2],") ", 79 | "\nobservation error=",true.obs.error,", est=",est.obs.error[1]," (",est.obs.error[2],") ", sep=""), outer=F) 80 | if(saveplots) savePlot(paste0(od,"obs_true_est.png"), type='png') 81 | 82 | 83 | 84 | -------------------------------------------------------------------------------- /examples/srw/srw.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | template 4 | Type objective_function::operator() () 5 | { 6 | DATA_VECTOR(observed); 7 | 8 | PARAMETER_VECTOR(population); 9 | PARAMETER(log_process_error); 10 | PARAMETER(log_obs_error); 11 | 12 | Type process_error = exp(log_process_error); 13 | Type obs_error = exp(log_obs_error); 14 | 15 | int n_obs = observed.size(); // number of observations 16 | 17 | Type nll = 0; // negative log likelihood 18 | 19 | // likelihood for state transitions 20 | for(int y=1; y (vec[5] + 2 * vec[6])) within <- 0 66 | if (vec[3] < (vec[7] - 2 * vec[8])) within <- 0 67 | if (vec[3] > (vec[7] + 2 * vec[8])) within <- 0 68 | } 69 | return(within) 70 | } 71 | 72 | test.fail <- function(vec){ 73 | fail <- 0 74 | if (vec[5] <= 0.001) fail <- 1 75 | if (vec[7] <= 0.001) fail <- 1 76 | return(fail) 77 | } 78 | 79 | my.col <- rainbow(ncases) 80 | my.x <- range(res[,5], na.rm=T) 81 | my.y <- range(res[,7], na.rm=T) 82 | graphics.off() 83 | windows(record=T) 84 | for (icase in 1:ncases){ 85 | cres <- res[res[,1] == icase,] 86 | plot(cres[,5],cres[,7],col=my.col[icase],xlab="Process Error",ylab="Observation Error",xlim=my.x,ylim=my.y) 87 | abline(v=cres[1,2],lty=2) 88 | abline(h=cres[1,3],lty=3) 89 | prop.in <- 100 * sum(apply(cres, 1, FUN=test.in)) / nloops 90 | prop.fail <- 100 * sum(apply(cres, 1, FUN=test.fail)) / nloops 91 | title(main=paste("Case ",icase," (",prop.in,"% true within CI, ",prop.fail,"% fail)", sep=""),outer=F) 92 | if(saveplots) savePlot(paste0(od,"case",icase,".png"), type='png') 93 | } 94 | 95 | -------------------------------------------------------------------------------- /examples/srw/srw_sim.pptx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/TMB-ADMB-Workshops/Feb2016/c0ccb76b036f072ee2815f74a5cc6d8a710bbe6b/examples/srw/srw_sim.pptx -------------------------------------------------------------------------------- /examples/state space Schaefer models/schaefer_r/schaefer.dat: -------------------------------------------------------------------------------- 1 | Year Catch Index 2 | 1965 93.510 1.78 3 | 1966 212.444 1.31 4 | 1967 195.032 0.91 5 | 1968 382.712 0.96 6 | 1969 320.430 0.88 7 | 1970 402.467 0.90 8 | 1971 365.557 0.87 9 | 1972 606.084 0.72 10 | 1973 377.642 0.57 11 | 1974 318.836 0.45 12 | 1975 309.374 0.42 13 | 1976 389.020 0.42 14 | 1977 276.901 0.49 15 | 1978 254.251 0.43 16 | 1979 170.006 0.40 17 | 1980 97.181 0.45 18 | 1981 90.523 0.55 19 | 1982 176.532 0.53 20 | 1983 216.181 0.58 21 | 1984 228.672 0.64 22 | 1985 212.177 0.66 23 | 1986 231.179 0.65 24 | 1987 136.942 0.61 25 | 1988 212.000 0.63 26 | -------------------------------------------------------------------------------- /examples/state space Schaefer models/schaefer_r/schaefer_r.R: -------------------------------------------------------------------------------- 1 | ################################################ 2 | # State-Space Schaefer Production model 3 | # without posfun() 4 | # 5 | # Group project by: 6 | # 7 | # Yi-Jay Chang 8 | # Felipe Carvalho 9 | # Jin Gao 10 | # Marc Nadon 11 | # 2/9/2016 9:40:46 PM 12 | ################################################ 13 | 14 | setwd("C:\\Users\\Yi-Jay.Chang\\Desktop\\schaefer_r\\") 15 | hake <- read.table("schaefer.dat", header=TRUE) 16 | names(hake) <- c("t", "C", "I") 17 | n = length(hake[,1]) 18 | 19 | # compile and load 20 | library(TMB) 21 | compile("schaefer_r.cpp") 22 | dyn.load(dynlib("schaefer_r")) 23 | 24 | # MakeADFun and output 25 | Random = c("logu") 26 | parameters <- list(logR=-1.1, logK=8.0, logQ=-7.9, logu = rep(log(500),n), logSigmaProc=log(0.5), logSigmaObs=log(0.5)) 27 | model <- MakeADFun(data=hake,parameters=parameters,random=Random) 28 | model$gr(model$par) 29 | 30 | fit <- nlminb(model$par,objective=model$fn, gradient=model$gr,control=list("trace"=1)) 31 | model$gr(fit$par) 32 | 33 | rep <- model$report() 34 | SD = summary(sdreport(model)) 35 | print(summary(rep)) 36 | print(SD) 37 | 38 | # Plot 39 | hake$B <- model$report()$B 40 | hake$Ihat <- model$report()$Ihat 41 | 42 | par(mfrow=c(1,2)) 43 | 44 | plot(hake$t,rep$u,ylim=c(0,5000),type="l",lty=2,col=2,ylab="Catch and Biomass",xlab="Year") 45 | points(hake$t,hake$C,type="l") 46 | points(hake$t,rep$u+1.96*SD[30:53,2],type="l",lty=3,col=2) 47 | points(hake$t,rep$u-1.96*SD[30:53,2],type="l",lty=3,col=2) 48 | 49 | legend("topright", legend = c("Catch", "Biomass"), 50 | pch = c(NA, NA), lty = c(1, 2), lwd = c(1,1), 51 | col = c("black","red"),pt.bg = c(NA,NA)) 52 | 53 | plot(I~t, hake, ylim=c(0,1.1*max(hake$I)), ylab="Index",xlab="Year") 54 | lines(Ihat~t, hake) 55 | 56 | -------------------------------------------------------------------------------- /examples/state space Schaefer models/schaefer_r/schaefer_r.cpp: -------------------------------------------------------------------------------- 1 | 2 | //----------------------------------------------------- 3 | // State-Space Schaefer Production model 4 | // without posfun() 5 | // 6 | // Group project by: 7 | // 8 | // Yi-Jay Chang 9 | // Felipe Carvalho 10 | // Jin Gao 11 | // Marc Nadon 12 | // 2/9/2016 9:40:46 PM 13 | //----------------------------------------------------- 14 | 15 | #include 16 | 17 | template 18 | Type objective_function::operator() () 19 | { 20 | DATA_VECTOR(C); 21 | DATA_VECTOR(I); 22 | int n = C.size(); 23 | 24 | PARAMETER(logR); 25 | PARAMETER(logK); 26 | PARAMETER(logQ); 27 | 28 | // randon effect 29 | PARAMETER_VECTOR(logu); 30 | 31 | PARAMETER(logSigmaProc); 32 | PARAMETER(logSigmaObs); 33 | 34 | Type r = exp(logR); 35 | Type k = exp(logK); 36 | Type q = exp(logQ); 37 | 38 | Type sigmaProc = exp(logSigmaProc); 39 | Type SigmaObs = exp(logSigmaObs); 40 | 41 | vector u(n); 42 | vector B(n); 43 | vector Ihat(n); 44 | vector P(n); 45 | 46 | for(int t=0; t 15 | 16 | template 17 | Type posfun(Type x, Type eps, Type &pen) 18 | { 19 | if ( x >= eps ){ 20 | return x; 21 | } else { 22 | pen += Type(0.01) * pow(x-eps,2); 23 | return eps/(Type(2.0)-x/eps); 24 | } 25 | } 26 | 27 | template 28 | Type objective_function::operator() () 29 | { 30 | DATA_VECTOR(C); 31 | DATA_VECTOR(I); 32 | int n = C.size(); 33 | 34 | PARAMETER(logR); 35 | PARAMETER(logK); 36 | PARAMETER(logQ); 37 | 38 | // randon effect 39 | PARAMETER_VECTOR(P_dev); 40 | 41 | PARAMETER(logSigmaProc); 42 | PARAMETER(logSigmaObs); 43 | 44 | Type r = exp(logR); 45 | Type k = exp(logK); 46 | Type q = exp(logQ); 47 | 48 | Type sigmaProc = exp(logSigmaProc); 49 | Type SigmaObs = exp(logSigmaObs); 50 | 51 | vector P(n); 52 | vector B(n); 53 | vector Ihat(n); 54 | 55 | Type fpen = 0.; 56 | Type f = 0.; 57 | 58 | // initial condition 59 | P(0)=exp(P_dev(0)); 60 | 61 | // process error model 62 | for(int t=1; t 16 | 17 | template 18 | Type posfun(Type x, Type eps, Type &pen) 19 | { 20 | if ( x >= eps ){ 21 | return x; 22 | } else { 23 | pen += Type(0.01) * pow(x-eps,2); 24 | return eps/(Type(2.0)-x/eps); 25 | } 26 | } 27 | 28 | template 29 | Type objective_function::operator() () 30 | { 31 | DATA_VECTOR(C); 32 | DATA_VECTOR(I); 33 | int n = C.size(); 34 | 35 | PARAMETER(logR); 36 | PARAMETER(logK); 37 | PARAMETER(logQ); 38 | 39 | // randon effect 40 | PARAMETER_VECTOR(logu); 41 | 42 | PARAMETER(logSigmaProc); 43 | PARAMETER(logSigmaObs); 44 | 45 | Type r = exp(logR); 46 | Type k = exp(logK); 47 | Type q = exp(logQ); 48 | 49 | Type sigmaProc = exp(logSigmaProc); 50 | Type SigmaObs = exp(logSigmaObs); 51 | 52 | vector u(n); 53 | vector B(n); 54 | vector Ihat(n); 55 | vector P(n); 56 | 57 | for(int t=0; t 1) 14 | { 15 | int on=0; 16 | if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-ret"))>-1) 17 | { 18 | if (on>ad_comm::argc-2 | ad_comm::argv[on+1][0] == '-') 19 | { 20 | cerr << "Invalid number of iseed arguements, command line option -ret ignored" << endl; 21 | } 22 | else 23 | { 24 | ret = atoi(ad_comm::argv[on+1]); 25 | } 26 | } 27 | endyr= endyr - ret; 28 | } 29 | cout < 2 | template 3 | Type objective_function::operator() () 4 | { 5 | DATA_ARRAY(wtage); 6 | DATA_ARRAY(wt_sd); 7 | 8 | // matrix yfit(n); 9 | int nr = wtage.dim(0); 10 | int nc = wtage.dim(1); 11 | 12 | PARAMETER(log_sd_coh); 13 | PARAMETER(log_sd_yr ); 14 | PARAMETER_VECTOR(mnwt ); 15 | PARAMETER_VECTOR(coh_eff); // (styr-nages-age_st+1,endyr-age_st+3,3); 16 | PARAMETER_VECTOR( yr_eff); // yr_eff(styr,endyr+3,3); 17 | 18 | Type nll = 0.0; 19 | 20 | Type sigma_coh = exp(log_sd_coh); 21 | Type sigma_yr = exp(log_sd_yr ); 22 | matrix wt_pre(nr,nc); 23 | matrix chi(nr,nc); 24 | for (int i=0;i 1) 64 | { 65 | int on=0; 66 | if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-ret"))>-1) 67 | { 68 | if (on>ad_comm::argc-2 | ad_comm::argv[on+1][0] == '-') 69 | { 70 | cerr << "Invalid number of iseed arguements, command line option -ret ignored" << endl; 71 | } 72 | else 73 | { 74 | ret = atoi(ad_comm::argv[on+1]); 75 | } 76 | } 77 | endyr= endyr - ret; 78 | } 79 | cout <>= 27 | library(TMB) 28 | opts_chunk$set(fig.path='figdir/fig', debug=TRUE, echo=TRUE) 29 | options(replace.assign = TRUE, width = 60, tidy.opts = list(width.cutoff = 60)) 30 | @ 31 | 32 | \begin{document} 33 | 34 | \section{Technical paper describing the package} 35 | 36 | Kristensen, K. et al. 2015. TMB: Automatic differentiation and Laplace approximation. Submitted to the Journal of Statistical Software. 37 | 38 | Abstract: 39 | 40 | TMB is an open source R package that enables quick implementation of complex nonlinear random effect (latent variable) models in a manner similar to the established AD Model Builder package (ADMB, admb-project.org) (Fournier, Skaug, Ancheta, Ianelli, Magnusson, Maunder, Nielsen, and Sibert 2011). In addition, it offers easy access to parallel computations. The user defines the joint likelihood for the data and the random effects as a C++ template function, while all the other operations are done in R; e.g., reading in the data. The package evaluates and maximizes the Laplace approximation of the marginal likelihood where the random effects are automatically integrated out. This approximation, and its derivatives, are obtained using automatic differentiation (up to order three) of the joint likelihood. The computations are designed to be fast for problems with many random effects (≈ 106) and parameters (≈ 103). Computation times using ADMB and TMB are compared on a suite of examples ranging from simple models to large spatial models where the random effects are a Gaussian random field. Speedups ranging from 1.5 to about 100 are obtained with increasing gains for large problems. The package and examples are available at http://tmb-project.org. 41 | 42 | Full PDF: 43 | 44 | \url{http://arxiv.org/pdf/1509.00660.pdf} 45 | 46 | \section{Introductory tutorials} 47 | 48 | \subsection{PowerPoint from Andre Punt explaining how to prepare the R script and C++ program that do the work.} 49 | 50 | \url{https://github.com/TMB-ADMB-Workshops/Feb2016/blob/master/examples/andre/AndreLecture.ppt} 51 | 52 | \subsection{TMB Wiki} 53 | 54 | The Wiki (\url{https://github.com/kaskr/adcomp/wiki}) contains a variety of resources, including a tutorial similar to Andre's PowerPointthat covers the basics (\url{https://github.com/kaskr/adcomp/wiki/Tutorial}) and a FAQ (\url{https://github.com/kaskr/adcomp/wiki/FAQ}) and code snippets (\url{https://github.com/kaskr/adcomp/wiki/Code--snippets}), both dealing mostly with matters that will be of interest to users that have got past the basics. 55 | 56 | \section{Examples} 57 | 58 | \subsection{Included in TMB package} 59 | 60 | \subsection{On main GitHub site} 61 | 62 | \section{Standard help pages} 63 | 64 | \subsection{R functions} 65 | 66 | \subsection{C++ functions} 67 | 68 | \subsubsection{Doxygen technical reference} 69 | 70 | \section{Syntax references} 71 | 72 | \subsection{template.cpp} 73 | 74 | On GitHub 75 | 76 | \subsection{tmb-syntax} 77 | 78 | R and cpp files that illustrate how to construct and manipulate C++ objects in 79 | TMB. 80 | 81 | \url{https://github.com/kaskr/adcomp/tree/master/tmb_syntax} 82 | 83 | \end{document} 84 | -------------------------------------------------------------------------------- /projects/vignette.md: -------------------------------------------------------------------------------- 1 | ### TMB help sources 2 | 3 | Compiled at the TMB training course, Seattle, Feb. 2016. 4 | 5 | ### Technical paper describing the package 6 | 7 | Kristensen, K. et al. 2015. TMB: Automatic differentiation and Laplace approximation. Submitted to the Journal of Statistical Software. 8 | 9 | *Abstract* 10 | 11 | TMB is an open source R package that enables quick implementation of complex nonlinear random effect (latent variable) models in a manner similar to the established AD Model Builder package (ADMB, admb-project.org) (Fournier, Skaug, Ancheta, Ianelli, Magnusson, Maunder, Nielsen, and Sibert 2011). In addition, it offers easy access to parallel computations. The user defines the joint likelihood for the data and the random effects as a C++ template function, while all the other operations are done in R; e.g., reading in the data. The package evaluates and maximizes the Laplace approximation of the marginal likelihood where the random effects are automatically integrated out. This approximation, and its derivatives, are obtained using automatic differentiation (up to order three) of the joint likelihood. The computations are designed to be fast for problems with many random effects (≈ 106) and parameters (≈ 103). Computation times using ADMB and TMB are compared on a suite of examples ranging from simple models to large spatial models where the random effects are a Gaussian random field. Speedups ranging from 1.5 to about 100 are obtained with increasing gains for large problems. 12 | 13 | [Download the PDF (slow link; takes ~1 min)](http://arxiv.org/pdf/1509.00660.pdf) 14 | 15 | ### Introductory tutorials 16 | 17 | #### PowerPoint from Andre Punt 18 | 19 | A dozen slides that concisely explain how to prepare the matching R script and C++ program, run them, and view the results on the R side by placing REPORT and ADREPORT statements on the C++ side and using the easily confused sdreport(model) and model\$report() statements on the R side. [Link to the .ppt file (click on "View raw" to open)](https://github.com/TMB-ADMB-Workshops/Feb2016/blob/master/examples/andre/AndreLecture.ppt) 20 | 21 | #### TMB Wiki 22 | 23 | The TMB Wiki (https://github.com/kaskr/adcomp/wiki) contains a variety of resources, including a tutorial similar to Andre's PowerPoint that covers the basics (https://github.com/kaskr/adcomp/wiki/Tutorial) and a FAQ (https://github.com/kaskr/adcomp/wiki/FAQ) and code snippets (https://github.com/kaskr/adcomp/wiki/Code--snippets), both dealing mostly with matters that will be of interest to users that have got past the basics. 24 | 25 | ### Examples 26 | 27 | #### TMB repository on GitHub 28 | 29 | The TMB repository (https://github.com/kaskr/adcomp) has a link to a number of .R and corresonding .cpp files at: (https://github.com/kaskr/adcomp/tree/master/tmb_examples) 30 | 31 | #### Examples from the February 2016 Seattle workshop 32 | 33 | (https://github.com/TMB-ADMB-Workshops/Feb2016/tree/master/examples) 34 | 35 | ### TMB syntax 36 | 37 | #### Data types as declared in the C++ program 38 | 39 | On the C++ side, the macros DATA_SCALAR(name), DATA_VECTOR(name), DATA_ARRAY(name) and so on, and the corresponding PARAMETER_ macros read the data and parameters passed in from the R script. Be aware that the ARRAY types are used for matrix algebra operations, while the ARRAY types are used for element-wise operations. Local variables on the C++ side are all declared as class "Type", e.g. "vector coeff(20);" and "Type neglogl = 0.0;". A list of macros, constructors, and operations is posted at 40 | (https://github.com/kaskr/adcomp/blob/master/TMB/inst/template.cpp). 41 | 42 | ### Technical documentation 43 | 44 | #### R functions 45 | 46 | Details on the arguments and return values of the R funcions that make up the TMB package, including MakeADFun(), precompile(), compile(), mcmc(), mcmc.nuts(), and so on. Not for beginners. 47 | 48 | #### C++ functions 49 | 50 | Highly technical Doxygen-generated reference document for the C++ working parts of TMB. Not for beginners, nor most other people. 51 | 52 | ### Miscellany 53 | 54 | The "TMB Documentation" page at (http://kaskr.github.io/adcomp/modules.html) 55 | has a variety of brief introductory information. 56 | 57 | (www.admb-project.org/developers/tmb/tmb_cpp.pdf) 58 | 59 | 60 | 61 | 62 | -------------------------------------------------------------------------------- /projects/vignette.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/TMB-ADMB-Workshops/Feb2016/c0ccb76b036f072ee2815f74a5cc6d8a710bbe6b/projects/vignette.pdf -------------------------------------------------------------------------------- /slides/README.md: -------------------------------------------------------------------------------- 1 | # TMB install 2 | ![ADMB/TMB is Awesome!](../images/ADMBTMB_Logo.png "ADMB-TMB") 3 | [Please go here for TMB install instructions ](https://github.com/kaskr/adcomp/wiki) 4 | 5 | ## git references 6 | [git software: ](http://git-scm.com) 7 | [for Git help reference card: ](http://gitref.org) 8 | [for advanced git: ](http://progit.org) 9 | [Intro to git video (best to watch first, then again after some practice)](https://www.youtube.com/watch?v=ZDR433b0HJY) 10 | 11 | ## Common git commands 12 | | | | 13 | |------------|----------| 14 | |git init | git checkout | 15 | |git clone | git merge | 16 | |git add | git push | 17 | |git status | git fetch | 18 | |git commit | git pull | 19 | |git branch | git log | 20 | 21 | 22 | The above covers the basics of git (use 99% of time) 23 | 24 | ## Remote access 25 | 1. Please join my meeting. https://global.gotomeeting.com/join/534027645 26 | 2. Use your microphone and speakers (VoIP) - a headset is recommended. Or, call in using your telephone. 27 | * Dial +1 (224) 501-3312 28 | * Access Code: 534-027-645 29 | * Audio PIN: Shown after joining the meeting 30 | * Meeting ID: 534-027-645 31 | -------------------------------------------------------------------------------- /slides/day1/data.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/TMB-ADMB-Workshops/Feb2016/c0ccb76b036f072ee2815f74a5cc6d8a710bbe6b/slides/day1/data.pdf -------------------------------------------------------------------------------- /slides/day1/par.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/TMB-ADMB-Workshops/Feb2016/c0ccb76b036f072ee2815f74a5cc6d8a710bbe6b/slides/day1/par.pdf -------------------------------------------------------------------------------- /slides/day1/software.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/TMB-ADMB-Workshops/Feb2016/c0ccb76b036f072ee2815f74a5cc6d8a710bbe6b/slides/day1/software.pdf -------------------------------------------------------------------------------- /slides/day2/nonlinear.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/TMB-ADMB-Workshops/Feb2016/c0ccb76b036f072ee2815f74a5cc6d8a710bbe6b/slides/day2/nonlinear.pdf -------------------------------------------------------------------------------- /slides/day3/Intro_to_random_effects.pptx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/TMB-ADMB-Workshops/Feb2016/c0ccb76b036f072ee2815f74a5cc6d8a710bbe6b/slides/day3/Intro_to_random_effects.pptx -------------------------------------------------------------------------------- /slides/day3/MCMC_in_TMB.pptx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/TMB-ADMB-Workshops/Feb2016/c0ccb76b036f072ee2815f74a5cc6d8a710bbe6b/slides/day3/MCMC_in_TMB.pptx --------------------------------------------------------------------------------