├── .checking_tools ├── #check_scripts.R └── README_before_check_scripts.md ├── .gitattributes ├── .github └── ISSUE_TEMPLATE │ └── bug_report.md ├── AHM1_ch01 └── AHM1_01.1.R ├── AHM1_ch02 ├── AHM1_02.2.R ├── AHM1_02.4.R ├── AHM1_02.6.R └── AHM1_02.8.R ├── AHM1_ch03 └── AHM1_03_all_sections.R ├── AHM1_ch04 ├── AHM1_04.2.R ├── AHM1_04.3.R └── AHM1_04.5_Exercises.R ├── AHM1_ch05 ├── AHM1_05.03+04.R ├── AHM1_05.05.R ├── AHM1_05.06+07.R ├── AHM1_05.08.R ├── AHM1_05.09.R ├── AHM1_05.10.R ├── AHM1_05.11.R ├── AHM1_05.12.R ├── AHM1_05.13.R └── AHM1_05.14.R ├── AHM1_ch06 ├── AHM1_06.03.R ├── AHM1_06.04.R ├── AHM1_06.05.R ├── AHM1_06.06.R ├── AHM1_06.07.R ├── AHM1_06.08.R ├── AHM1_06.09+10.R ├── AHM1_06.11.R ├── AHM1_06.12.R ├── AHM1_06.13.R └── AHM1_06.16_Exercises.R ├── AHM1_ch07 ├── AHM1_07.03.R ├── AHM1_07.05.R ├── AHM1_07.06.R ├── AHM1_07.07.R ├── AHM1_07.08.1-4.R ├── AHM1_07.08.5.R └── AHM1_07.09.R ├── AHM1_ch08 ├── AHM1_08.02.R ├── AHM1_08.03.R ├── AHM1_08.04.R └── AHM1_08.05.R ├── AHM1_ch09 ├── AHM1_09.02.R ├── AHM1_09.03.R ├── AHM1_09.04.R ├── AHM1_09.05.R ├── AHM1_09.06.R ├── AHM1_09.07.R └── AHM1_09.08.R ├── AHM1_ch10 ├── AHM1_10.01.R ├── AHM1_10.03.R ├── AHM1_10.04.R ├── AHM1_10.05.R ├── AHM1_10.06.R ├── AHM1_10.07.R ├── AHM1_10.07_Bayes.R ├── AHM1_10.08.R ├── AHM1_10.09.R ├── AHM1_10.10.R ├── AHM1_10.11.R ├── AHM1_10.12.R └── AHM1_10.14.R ├── AHM1_ch11 ├── AHM1_11.02.R ├── AHM1_11.03.R ├── AHM1_11.05.R ├── AHM1_11.06.R ├── AHM1_11.07.R ├── AHM1_11.08.R ├── AHM1_11.09.R └── AHM1_11.10.R ├── AHM2_ch01 ├── AHM2_01.02.R ├── AHM2_01.03.R ├── AHM2_01.04.R ├── AHM2_01.05.1.R ├── AHM2_01.05.2.R ├── AHM2_01.05.3.R ├── AHM2_01.05.4.R ├── AHM2_01.06.R ├── AHM2_01.07.1.R ├── AHM2_01.07.1_sims1-9.R ├── AHM2_01.07.1_sims10.R ├── AHM2_01.07.2.R ├── AHM2_01.07.2extra.R ├── AHM2_01.07.3.R ├── AHM2_01.08.1.R └── AHM2_01.08.2.R ├── AHM2_ch02 ├── AHM2_02.02.R ├── AHM2_02.03.0.R ├── AHM2_02.03.1.R ├── AHM2_02.03.2_#noCode.R ├── AHM2_02.03.3+4.R ├── AHM2_02.04.1+2.R ├── AHM2_02.04.3.R ├── AHM2_02.05.1+2.R ├── AHM2_02.05.3.R ├── AHM2_02.05.4_#noCode.R ├── AHM2_02.05.5_#verySlow.R ├── AHM2_02.05.6+7.R ├── AHM2_02.06_#noCode.R ├── AHM2_02.07.R ├── AHM2_02.08.R ├── AHM2_02.09.R └── AHM2_02.10.R ├── AHM2_ch03 ├── AHM2_03.2.R ├── AHM2_03.3.R ├── AHM2_03.4.1-3.R ├── AHM2_03.4.4__WinBUGS.R ├── AHM2_03.4.4_nimble.R ├── AHM2_03.4.5__WinBUGS#crashProne.R └── AHM2_03.4.5_nimble.R ├── AHM2_ch04 ├── AHM2_04.03.R ├── AHM2_04.04.R ├── AHM2_04.05.R ├── AHM2_04.06.R ├── AHM2_04.07.R ├── AHM2_04.08.R ├── AHM2_04.09.1_Crossbills.R ├── AHM2_04.09.2_Crossbills.R ├── AHM2_04.09.3_Crossbills.R ├── AHM2_04.09.4.R ├── AHM2_04.09.5.R ├── AHM2_04.09.6.R ├── AHM2_04.09.7_#noCode.R ├── AHM2_04.10.1.R ├── AHM2_04.10.2.R ├── AHM2_04.10.3_#noCode.R ├── AHM2_04.11.R ├── AHM2_04.12.R └── AHM2_04.13.R ├── AHM2_ch05 ├── AHM2_05.2.R ├── AHM2_05.3.R ├── AHM2_05.4.R ├── AHM2_05.5.R ├── AHM2_05.6.R └── AHM2_05.7.R ├── AHM2_ch06 ├── AHM2_06.2_#noCode.R ├── AHM2_06.3.R ├── AHM2_06.4.1.R ├── AHM2_06.4.2.R ├── AHM2_06.4.3.R ├── AHM2_06.4.4.R └── AHM2_06.4.5.R ├── AHM2_ch07 ├── AHM2_07.2.R ├── AHM2_07.3.R ├── AHM2_07.4.R ├── AHM2_07.5.R ├── AHM2_07.6.R ├── AHM2_07.7.R └── AHM2_07.8_#no_code.R ├── AHM2_ch08 ├── AHM2_08.2.2.R ├── AHM2_08.2.3.R ├── AHM2_08.2.3_CRIplots.R ├── AHM2_08.3.R ├── AHM2_08.4.R ├── AHM2_08.5.1-3.R └── AHM2_08.5.4.R ├── AHM2_ch09 ├── AHM2_09.2.R ├── AHM2_09.2.R_without_RandomFields.R ├── AHM2_09.3.R ├── AHM2_09.3.R_without_RandomFields.R ├── AHM2_09.4.1__WinBUGS.R ├── AHM2_09.4.1__WinBUGS_without_RandomFields.R ├── AHM2_09.4.1_nimble.R ├── AHM2_09.4.1_nimble.R_without_RandomFields.R ├── AHM2_09.4.2.R ├── AHM2_09.4.2.R_without_RandomFields.R ├── AHM2_09.4.3__WinBUGS.R ├── AHM2_09.4.3__WinBUGS_without_RandomFields.R ├── AHM2_09.4.3_nimble.R ├── AHM2_09.4.3_nimble_without_RandomFields.R ├── AHM2_09.5__WinBUGS.R ├── AHM2_09.5_nimble.R ├── AHM2_09.6.1.R ├── AHM2_09.6.1_without_RandomFields.R └── AHM2_09.6.2.R ├── AHM2_ch10 ├── AHM2_10.2.R ├── AHM2_10.2_without_RandomFields.R ├── AHM2_10.3.R ├── AHM2_10.4.R ├── AHM2_10.5.R ├── AHM2_10.6.R ├── AHM2_10.7.R └── AHM2_10.8.R ├── AHM2_ch11 ├── AHM2_11.02#noCode.R ├── AHM2_11.03.R ├── AHM2_11.04.R ├── AHM2_11.05.R ├── AHM2_11.06.R ├── AHM2_11.07.R ├── AHM2_11.08.R ├── AHM2_11.09.R └── AHM2_11.10.R ├── CHANGES.md ├── README.md ├── TO_DO.md └── install_packages.R /.checking_tools/README_before_check_scripts.md: -------------------------------------------------------------------------------- 1 | 2 | # Checking code in this repository 3 | 4 | When the checking script in this directory is `source`d, it will run every "\*.R" script in R's current directory and subdirectories, except those with "#" in the name. 5 | 6 | It creates a log file in the target directory with the name "#check_.log". For each file, it logs the name of the file, the starting time, any error messages, and the script execution time if greater than 20 secs. When all are done, it records the overall time taken and the output from `sessionInfo()`. 7 | 8 | It checks that graphical parameters are restored to the original values and reports discrepancies. 9 | 10 | It cleans up the workspace and detaches packages between running scripts. 11 | 12 | All graphics produced by the script are saved in a PDF file with the same name. At the end, the workspace is saved in a .RData file, including an object called `sessionInfo` with the output from `sessionInfo()`. These file names end with `#.pdf` or `#.RData` to distinguish them from files generated by the script. 13 | 14 | If there is an appropriately-named `#.RData` file in the folder from a previous run, the script will load it and compare the current output with the last run using `all.equal`. Objects that don't match are listed in the log file. 15 | 16 | ## Installing and updating packages 17 | 18 | Before running the scripts, you may want to check that the necessary packages are installed. See the "install_packages.R" script. 19 | 20 | If you want to install latest devel/patched versions of packages from Github, use or adapt the following code: 21 | ``` 22 | remotes::install_github("mikemeredith/AHMbook") 23 | packageVersion("AHMbook") 24 | remotes::install_github("rbchan/unmarked") 25 | packageVersion("unmarked") 26 | remotes::install_github("kenkellner/jagsUI") 27 | packageVersion("jagsUI") 28 | ``` 29 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/bug_report.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Bug report 3 | about: Create a report to help us improve 4 | title: '' 5 | labels: '' 6 | assignees: '' 7 | 8 | --- 9 | 10 | ## Thank you for reporting a bug in our scripts. 11 | 12 | The code here is based on the book, and we update it to work with current versions of JAGS, R and R packages. Please make sure you have the latest version of the script and software (run `update.packages()`) before reporting an issue. 13 | 14 | File name: 15 | 16 | Lines which produced the error or unexpected output (copy/paste from the console): 17 | 18 | 19 | Do you have a suggested update for the code: 20 | 21 | 22 | Run `sessionInfo()` and paste the output here: 23 | 24 | 25 | Other information that may be helpful to pinpoint the issue, eg, screenshots: 26 | -------------------------------------------------------------------------------- /AHM1_ch01/AHM1_01.1.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch01/AHM1_01.1.R -------------------------------------------------------------------------------- /AHM1_ch02/AHM1_02.2.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch02/AHM1_02.2.R -------------------------------------------------------------------------------- /AHM1_ch02/AHM1_02.4.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch02/AHM1_02.4.R -------------------------------------------------------------------------------- /AHM1_ch02/AHM1_02.6.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch02/AHM1_02.6.R -------------------------------------------------------------------------------- /AHM1_ch02/AHM1_02.8.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch02/AHM1_02.8.R -------------------------------------------------------------------------------- /AHM1_ch03/AHM1_03_all_sections.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch03/AHM1_03_all_sections.R -------------------------------------------------------------------------------- /AHM1_ch04/AHM1_04.2.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch04/AHM1_04.2.R -------------------------------------------------------------------------------- /AHM1_ch04/AHM1_04.3.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch04/AHM1_04.3.R -------------------------------------------------------------------------------- /AHM1_ch04/AHM1_04.5_Exercises.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch04/AHM1_04.5_Exercises.R -------------------------------------------------------------------------------- /AHM1_ch05/AHM1_05.03+04.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch05/AHM1_05.03+04.R -------------------------------------------------------------------------------- /AHM1_ch05/AHM1_05.05.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch05/AHM1_05.05.R -------------------------------------------------------------------------------- /AHM1_ch05/AHM1_05.06+07.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch05/AHM1_05.06+07.R -------------------------------------------------------------------------------- /AHM1_ch05/AHM1_05.08.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch05/AHM1_05.08.R -------------------------------------------------------------------------------- /AHM1_ch05/AHM1_05.09.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch05/AHM1_05.09.R -------------------------------------------------------------------------------- /AHM1_ch05/AHM1_05.10.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch05/AHM1_05.10.R -------------------------------------------------------------------------------- /AHM1_ch05/AHM1_05.11.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch05/AHM1_05.11.R -------------------------------------------------------------------------------- /AHM1_ch05/AHM1_05.12.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch05/AHM1_05.12.R -------------------------------------------------------------------------------- /AHM1_ch05/AHM1_05.13.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch05/AHM1_05.13.R -------------------------------------------------------------------------------- /AHM1_ch05/AHM1_05.14.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch05/AHM1_05.14.R -------------------------------------------------------------------------------- /AHM1_ch06/AHM1_06.03.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch06/AHM1_06.03.R -------------------------------------------------------------------------------- /AHM1_ch06/AHM1_06.04.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch06/AHM1_06.04.R -------------------------------------------------------------------------------- /AHM1_ch06/AHM1_06.05.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch06/AHM1_06.05.R -------------------------------------------------------------------------------- /AHM1_ch06/AHM1_06.06.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch06/AHM1_06.06.R -------------------------------------------------------------------------------- /AHM1_ch06/AHM1_06.07.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch06/AHM1_06.07.R -------------------------------------------------------------------------------- /AHM1_ch06/AHM1_06.08.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch06/AHM1_06.08.R -------------------------------------------------------------------------------- /AHM1_ch06/AHM1_06.09+10.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch06/AHM1_06.09+10.R -------------------------------------------------------------------------------- /AHM1_ch06/AHM1_06.11.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch06/AHM1_06.11.R -------------------------------------------------------------------------------- /AHM1_ch06/AHM1_06.12.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch06/AHM1_06.12.R -------------------------------------------------------------------------------- /AHM1_ch06/AHM1_06.13.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch06/AHM1_06.13.R -------------------------------------------------------------------------------- /AHM1_ch06/AHM1_06.16_Exercises.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch06/AHM1_06.16_Exercises.R -------------------------------------------------------------------------------- /AHM1_ch07/AHM1_07.03.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch07/AHM1_07.03.R -------------------------------------------------------------------------------- /AHM1_ch07/AHM1_07.05.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch07/AHM1_07.05.R -------------------------------------------------------------------------------- /AHM1_ch07/AHM1_07.06.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch07/AHM1_07.06.R -------------------------------------------------------------------------------- /AHM1_ch07/AHM1_07.07.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch07/AHM1_07.07.R -------------------------------------------------------------------------------- /AHM1_ch07/AHM1_07.08.1-4.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch07/AHM1_07.08.1-4.R -------------------------------------------------------------------------------- /AHM1_ch07/AHM1_07.08.5.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch07/AHM1_07.08.5.R -------------------------------------------------------------------------------- /AHM1_ch07/AHM1_07.09.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch07/AHM1_07.09.R -------------------------------------------------------------------------------- /AHM1_ch08/AHM1_08.02.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch08/AHM1_08.02.R -------------------------------------------------------------------------------- /AHM1_ch08/AHM1_08.03.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch08/AHM1_08.03.R -------------------------------------------------------------------------------- /AHM1_ch08/AHM1_08.04.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch08/AHM1_08.04.R -------------------------------------------------------------------------------- /AHM1_ch08/AHM1_08.05.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch08/AHM1_08.05.R -------------------------------------------------------------------------------- /AHM1_ch09/AHM1_09.02.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch09/AHM1_09.02.R -------------------------------------------------------------------------------- /AHM1_ch09/AHM1_09.03.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch09/AHM1_09.03.R -------------------------------------------------------------------------------- /AHM1_ch09/AHM1_09.04.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch09/AHM1_09.04.R -------------------------------------------------------------------------------- /AHM1_ch09/AHM1_09.05.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch09/AHM1_09.05.R -------------------------------------------------------------------------------- /AHM1_ch09/AHM1_09.06.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch09/AHM1_09.06.R -------------------------------------------------------------------------------- /AHM1_ch09/AHM1_09.07.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch09/AHM1_09.07.R -------------------------------------------------------------------------------- /AHM1_ch09/AHM1_09.08.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch09/AHM1_09.08.R -------------------------------------------------------------------------------- /AHM1_ch10/AHM1_10.01.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch10/AHM1_10.01.R -------------------------------------------------------------------------------- /AHM1_ch10/AHM1_10.03.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch10/AHM1_10.03.R -------------------------------------------------------------------------------- /AHM1_ch10/AHM1_10.04.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch10/AHM1_10.04.R -------------------------------------------------------------------------------- /AHM1_ch10/AHM1_10.05.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch10/AHM1_10.05.R -------------------------------------------------------------------------------- /AHM1_ch10/AHM1_10.06.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch10/AHM1_10.06.R -------------------------------------------------------------------------------- /AHM1_ch10/AHM1_10.07.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch10/AHM1_10.07.R -------------------------------------------------------------------------------- /AHM1_ch10/AHM1_10.07_Bayes.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch10/AHM1_10.07_Bayes.R -------------------------------------------------------------------------------- /AHM1_ch10/AHM1_10.08.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch10/AHM1_10.08.R -------------------------------------------------------------------------------- /AHM1_ch10/AHM1_10.09.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch10/AHM1_10.09.R -------------------------------------------------------------------------------- /AHM1_ch10/AHM1_10.10.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch10/AHM1_10.10.R -------------------------------------------------------------------------------- /AHM1_ch10/AHM1_10.11.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch10/AHM1_10.11.R -------------------------------------------------------------------------------- /AHM1_ch10/AHM1_10.12.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch10/AHM1_10.12.R -------------------------------------------------------------------------------- /AHM1_ch10/AHM1_10.14.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch10/AHM1_10.14.R -------------------------------------------------------------------------------- /AHM1_ch11/AHM1_11.02.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch11/AHM1_11.02.R -------------------------------------------------------------------------------- /AHM1_ch11/AHM1_11.03.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch11/AHM1_11.03.R -------------------------------------------------------------------------------- /AHM1_ch11/AHM1_11.05.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch11/AHM1_11.05.R -------------------------------------------------------------------------------- /AHM1_ch11/AHM1_11.06.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch11/AHM1_11.06.R -------------------------------------------------------------------------------- /AHM1_ch11/AHM1_11.07.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch11/AHM1_11.07.R -------------------------------------------------------------------------------- /AHM1_ch11/AHM1_11.08.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch11/AHM1_11.08.R -------------------------------------------------------------------------------- /AHM1_ch11/AHM1_11.09.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch11/AHM1_11.09.R -------------------------------------------------------------------------------- /AHM1_ch11/AHM1_11.10.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/AHM_code/7f01bba14d24560a7335071a8ec6cbaf91ce30a6/AHM1_ch11/AHM1_11.10.R -------------------------------------------------------------------------------- /AHM2_ch01/AHM2_01.02.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 1 : RELATIVE ABUNDANCE MODELS FOR POPULATION DYNAMICS 6 | # ============================================================= 7 | # Code from proofs dated 2020-08-18 8 | 9 | library(AHMbook) 10 | 11 | # 1.2 Risks in the naive interpretation of relative abundance 12 | # =========================================================== 13 | 14 | # Choose constants 15 | set.seed(1) # 'freeze' RNGs 16 | M <- 250 # Number of sites 17 | T <- 20 # Number of years 18 | lambda <- 100 # Expected abundance at t = 1 19 | gamma <- 1.02 # Population growth rate 20 | p <- 0.6 # Detection probability 21 | 22 | # Create array for true abundance and for counts 23 | N <- C <- array(NA, dim = c(M, T)) 24 | 25 | # Simulate initial conditions of system: true state at t=1 26 | N[,1] <- rpois(M, lambda) 27 | table(N[,1]) # Summarize 28 | 29 | # Simulate later true states 30 | for(t in 2:T){ 31 | N[,t] <- rpois(M, N[,t-1] * gamma) 32 | } 33 | 34 | # Simulate binomial observation process and generate actual counts 35 | for(t in 1:T){ 36 | C[,t] <- rbinom(M, N[,t], p) 37 | } 38 | 39 | op <- par(mfrow = c(1, 3)) # not shown 40 | hist(N, breaks = 100, main = 'N', col = 'grey') 41 | hist(C, breaks = 100, main = 'C', col = 'grey') 42 | plot(N, C, xlab = 'True N', ylab = 'Observed C', frame = FALSE) 43 | abline(0,1) 44 | lm(c(C) ~ c(N)) # Check slope corresponds to p .... OK ! 45 | par(op) 46 | 47 | op <- par(mfrow = c(2, 2)) # not shown 48 | ylim <- range(N) 49 | matplot(t(N), type = 'l', lty = 1, main = 'Trajectories of true N', frame = FALSE, 50 | ylim = ylim) 51 | matplot(t(C), type = 'l', lty = 1, main = 'Trajectories of observed C', frame = FALSE, 52 | ylim = ylim) 53 | plot(table(N[,1]), main = 'Initial N', frame = FALSE) 54 | plot(table(N[,T]), main = 'Final N', frame = FALSE) 55 | par(op) 56 | 57 | library(AHMbook) 58 | str(tmp <- simNpC()) 59 | str(tmp <- simNpC(T = 20, expN = c(100, 75), dp = c(0.5, 0.5))) # Explicit defaults 60 | str(tmp <- simNpC(T = 20, expN = c(100, 75), dp = c(1, 1))) # p = 1 61 | 62 | # Simulate data for Fig. 1.1 63 | set.seed(1) 64 | # Declining population 65 | str(tmp1 <- simNpC(T = 20, expN = c(100, 75), dp = c(1, 0.5))) # p declining 66 | str(tmp2 <- simNpC(T = 20, expN = c(100, 75), dp = c(0.5, 0.5))) # p stable 67 | str(tmp3 <- simNpC(T = 20, expN = c(100, 75), dp = c(0.5, 1))) # p increasing 68 | # Stable population 69 | str(tmp4 <- simNpC(T = 20, expN = c(75, 75), dp = c(1, 0.5))) # p declining 70 | str(tmp5 <- simNpC(T = 20, expN = c(75, 75), dp = c(0.5, 0.5))) # p stable 71 | str(tmp6 <- simNpC(T = 20, expN = c(75, 75), dp = c(0.5, 1))) # p increasing 72 | # Increasing population 73 | str(tmp7 <- simNpC(T = 20, expN = c(75, 100), dp = c(1, 0.5))) # p declining 74 | str(tmp8 <- simNpC(T = 20, expN = c(75, 100), dp = c(0.5, 0.5))) # p stable 75 | str(tmp9 <- simNpC(T = 20, expN = c(75, 100), dp = c(0.5, 1))) # p increasing 76 | 77 | -------------------------------------------------------------------------------- /AHM2_ch01/AHM2_01.03.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 1 : RELATIVE ABUNDANCE MODELS FOR POPULATION DYNAMICS 6 | # ============================================================= 7 | # Code from proofs dated 2020-08-18 8 | 9 | # 1.3 Crested tit count data from the Swiss MHB Breeding Bird Survey 10 | # ================================================================== 11 | 12 | # Get Crested Tit data and look at summaries 13 | library(AHMbook) 14 | data(crestedTit) 15 | str(dat <- crestedTit) # Marc prefers short names (comment from Mike) 16 | C <- as.matrix(dat[,6:23]) # grab counts 1999:2016 17 | year <- 1999:2016 18 | 19 | # ~~~~ code to plot figure 1.3 ~~~~~~~~~~ 20 | matplot(year, t(C), main = "", type = "l", lty = 1, xlab = "Year", 21 | ylab = "Territory count", lwd = 3, cex.lab = 1.5, frame = FALSE) 22 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 23 | 24 | # Grab data for survey dates (for 2-3 surveys per year) and for duration 25 | # Put into 3D array first, then summarize over reps within a year 26 | nsite <- nrow(C) 27 | nyear <- length(year) 28 | datetmp <- as.matrix(dat[,24:77]) 29 | datefull <- array(datetmp, dim = c(nsite, 3, nyear)) 30 | durtmp <- as.matrix(dat[,78:131]) 31 | durfull <- array(durtmp, dim = c(nsite, 3, nyear)) 32 | 33 | # Get mean date of survey and mean survey duration for each site and year 34 | date <- apply(datefull, c(1,3), mean, na.rm = TRUE) 35 | dur <- apply(durfull, c(1,3), mean, na.rm = TRUE) 36 | date[date == 'NaN'] <- NA 37 | dur[dur == 'NaN'] <- NA 38 | -------------------------------------------------------------------------------- /AHM2_ch01/AHM2_01.04.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 1 : RELATIVE ABUNDANCE MODELS FOR POPULATION DYNAMICS 6 | # ============================================================= 7 | # Code from proofs dated 2020-08-18 8 | 9 | # Approximate time to execute this code: 4 mins 10 | 11 | # ~~~~~ Need to run 1.3 before this ~~~~~~~ 12 | source("AHM2_01.03.R") 13 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 14 | 15 | library(coda) 16 | 17 | # 1.4 Generalized Linear Models: A site-by-year model 18 | # =================================================== 19 | 20 | # Bundle and summarize data 21 | M <- nrow(C) 22 | T <- ncol(C) 23 | str(bdata <- list(C = C, M = M, T = T) ) 24 | # List of 3 25 | # $ C: int [1:267, 1:18] 1 0 NA 0 3 NA NA 5 0 0 ... 26 | # $ M: int 267 27 | # $ T: int 18 28 | 29 | # Specify model in BUGS language 30 | cat(file = "model1.txt"," 31 | model { 32 | # Priors 33 | for(i in 1:M){ 34 | site[i] ~ dnorm(0, 0.001) # Priors for site effects 35 | } 36 | year[1] <- 0 # Constraint on year effects 37 | for(t in 2:T){ 38 | year[t] ~ dnorm(0, 0.001) # Priors for year effects 2:T 39 | } 40 | # Likelihood 41 | for (i in 1:M){ 42 | for(t in 1:T){ 43 | C[i,t] ~ dpois(lambda[i,t]) 44 | log(lambda[i,t]) <- site[i] + year[t] 45 | } 46 | } 47 | # Derived quantities 48 | for(t in 1:T){ 49 | popindex[t] <- sum(lambda[,t]) 50 | } 51 | } 52 | ") 53 | 54 | # Initial values 55 | inits <- function() list(site = rnorm(nrow(C)), year = c(NA, rnorm(ncol(C)-1))) 56 | 57 | # Parameters monitored 58 | params <- c("site", "year", "popindex") 59 | 60 | # MCMC settings 61 | na <- 1000 ; ni <- 15000; nt <- 10 ; nb <- 5000 ; nc <- 3 62 | 63 | # Call JAGS (ART 5 min), check convergence and summarize posteriors 64 | library(jagsUI) 65 | out1 <- jags(bdata, inits, params, "model1.txt", n.adapt = na, n.chains = nc, 66 | n.thin = nt, n.iter = ni, n.burnin = nb, parallel = TRUE) 67 | 68 | # par(mfrow = c(3,3)) # ~~~ no longer needed 69 | traceplot(out1) 70 | jags.View(out1) ; print(out1, 2) # Two formats for posterior summaries 71 | 72 | # ~~~~~ save output for use in subsequent sections 73 | save(out1, file="AHM2_01.04_out1.RData") 74 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 75 | 76 | # Reformat data for analysis in R using glm 77 | cvec <- c(C) 78 | sitevec <- rep(1:267, 18) 79 | yrvec <- rep(1:18, each = 267) 80 | cbind(sitevec, yrvec, cvec) # Look at data in this format 81 | summary(fm <- glm(cvec ~ as.factor(sitevec) + as.factor(yrvec) - 1, 82 | family = 'poisson')) 83 | 84 | cor(exp(fm$coef[1:nsite]), exp(out1$summary[1:nsite,1])) # > 0.999 85 | cor(fm$coef[268:284], out1$summary[269:285,1]) # > 0.999 86 | 87 | # ~~~~~ code to plot figure 1.4 ~~~~~~~~~~~~~~ 88 | # Plot population size index 89 | plot(year, out1$mean$popindex, xlab = 'Year', ylab = 'Population index', 90 | ylim = c(500, 1000), pch = 16, frame = FALSE, type= 'b', ) 91 | segments(year, out1$q2.5$popindex, year, out1$q97.5$popindex) 92 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 93 | 94 | 95 | params <- c("site", "year", "popindex", "C") 96 | na <- 100 ; ni <- 1500 ; nt <- 2 ; nb <- 500 ; nc <- 2 97 | out1X <- jags(bdata, inits, params, "model1.txt", n.adapt = na, n.chains = nc, 98 | n.thin = nt, n.iter = ni, n.burnin = nb, parallel = TRUE) 99 | 100 | (n.missing <- rowSums(is.na(C)) ) 101 | (na.sites <- which(n.missing > 0) ) 102 | head(C[160:169, 1:13]) # Some of the data with many NAs ... 103 | # ... and the corresponding estimates 104 | head(round(out1X$mean$C[160:169, 1:13], 1)) 105 | # [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] 106 | # [1,] 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0 0 0 107 | # [2,] 1.0 0.0 0.0 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0 0 0 108 | # [3,] 5.0 5.1 4.6 5.5 6.1 6.3 6.6 6.1 6.3 6.6 1 0 10 109 | # [4,] 1.6 4.0 1.0 1.0 2.0 1.0 2.0 1.0 2.0 1.0 2 3 1 110 | # [5,] 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1 1 0 111 | # [6,] 8.0 6.0 3.0 7.0 9.0 8.0 11.0 8.0 19.0 11.0 13 12 17 112 | 113 | head(round(out1X$sd$C[160:169, 1:13], 1)) 114 | # [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] 115 | # [1,] 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0 0 0 116 | # [2,] 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0 0 0 117 | # [3,] 2.4 2.4 2.2 2.5 2.6 2.7 2.9 2.7 2.6 2.7 0 0 0 118 | # [4,] 1.3 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0 0 0 119 | # [5,] 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0 0 0 120 | # [6,] 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0 0 0 121 | 122 | -------------------------------------------------------------------------------- /AHM2_ch01/AHM2_01.05.1.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 1 : RELATIVE ABUNDANCE MODELS FOR POPULATION DYNAMICS 6 | # ============================================================= 7 | # Code from proofs dated 2020-08-18 8 | 9 | # Approximate execution time for this code: 6 mins 10 | 11 | library(jagsUI) 12 | 13 | # ~~~~~ Need to run 1.3 before this ~~~~~~~ 14 | source("AHM2_01.03.R") 15 | # ~~~~~ and this from 1.4 ~~~~~~~~~~~~~~~~~ 16 | M <- nrow(C) 17 | T <- ncol(C) 18 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 19 | 20 | 21 | # 1.5 Generalized Linear Mixed Models 22 | # =================================== 23 | 24 | # 1.5.1 A GLMM to partition the total variability in relative abundance 25 | # --------------------------------------------------------------------- 26 | 27 | # Bundle and summarize data (same as before) 28 | str(bdata <- list(C = C, M = M, T = T)) 29 | 30 | # Specify model in BUGS language 31 | cat(file = "model2.txt"," 32 | model { 33 | # 'Priors' 34 | mu ~ dnorm(0, 0.001) # Intercept 35 | for(i in 1:M){ 36 | site[i] ~ dnorm(0, tau.site) # Random site effects 37 | } 38 | tau.site <- pow(sd.site, -2) 39 | sd.site ~ dunif(0, 5) 40 | for(t in 1:T){ 41 | year[t] ~ dnorm(0, tau.year) # Random year effects 42 | } 43 | tau.year <- pow(sd.year, -2) 44 | sd.year ~ dunif(0, 3) 45 | tau <- pow(sd, -2) 46 | sd ~ dunif(0, 3) 47 | 48 | # 'Likelihood' 49 | for (i in 1:M){ 50 | for(t in 1:T){ 51 | C[i,t] ~ dpois(lambda[i,t]) 52 | log(lambda[i,t]) <- mu + site[i] + year[t] + eps[i,t] 53 | eps[i,t] ~ dnorm(0, tau) # 'Overdispersion' 54 | } 55 | } 56 | 57 | # Derived quantities 58 | for(t in 1:T){ 59 | popindex[t] <- sum(lambda[,t]) 60 | } 61 | } 62 | ") 63 | 64 | # Initial values 65 | inits <- function() list(mu = rnorm(1), site = rnorm(M), year = rnorm(T), 66 | eps = array(1, dim=c(M, T))) 67 | 68 | # Parameters monitored 69 | params <- c("mu", "sd.site", "sd.year", "sd", "site", "year", "popindex") 70 | 71 | # MCMC settings 72 | na <- 1000 ; ni <- 15000 ; nt <- 10 ; nb <- 5000 ; nc <- 3 73 | 74 | # Call JAGS (ART 4 min), check convergence and summarize posteriors 75 | out2 <- jags(bdata, inits, params, "model2.txt", n.adapt = na, n.chains = nc, 76 | n.thin = nt, n.iter = ni, n.burnin = nb, parallel = TRUE) 77 | 78 | # par(mfrow = c(3, 2)) # ~~~ replace with 'layout' argument 79 | traceplot(out2, layout=c(3,2)) 80 | summary(out2) ; jags.View(out2) ; print(out2, 3) 81 | # mean sd 2.5% 50% 97.5% overlap0 f Rhat n.eff 82 | # mu -0.434 0.157 -0.749 -0.431 -0.130 FALSE 0.997 1.023 92 83 | # sd.site 2.378 0.141 2.115 2.371 2.659 FALSE 1.000 1.084 29 84 | # sd.year 0.116 0.025 0.075 0.112 0.177 FALSE 1.000 1.001 2168 85 | # sd 0.282 0.015 0.252 0.282 0.310 FALSE 1.000 1.007 444 86 | # site[1] -0.603 0.416 -1.466 -0.594 0.149 TRUE 0.929 1.001 3000 87 | # [ ...... ] 88 | 89 | # Save output for use in subsequent sections 90 | save(out2, file="AHM2_01.05.1_out2.RData") 91 | 92 | # ~~~~~~~~~ plot to compare results of out1 and out2 (figures not shown) ~~~~~~~~~~~~~~~~~ 93 | load("AHM2_01.04_out1.RData") 94 | 95 | # Plot population index under models 1 and 2 96 | plot(year-0.1, out1$mean$popindex, cex = 2, pch = 16, xlab = 'Year', 97 | ylab = 'Population index', col = 'red', type = 'b', frame = FALSE, 98 | ylim = c(500, 1000), main = 'red: fixed-effects, blue: random-effects') 99 | segments(year-0.1, out1$q2.5$popindex, year-0.1, out1$q97.5$popindex, col = 'red') 100 | points(year+0.1, out2$mean$popindex, cex = 2, pch = 16, col = 'blue', type = 'b') 101 | segments(year+0.1, out2$q2.5$popindex, year+0.1, out2$q97.5$popindex, col = 'blue') 102 | 103 | # Graphical partitioning of the variance 104 | library(denstrip) 105 | op <- par(mar = c(4, 8, 4, 2)) 106 | plot(out2$sims.list$sd, xlim = c(0, 3), ylim = c(0.5, 3.5), xlab="", ylab="", 107 | type="n", axes = FALSE, 108 | main = "Variance partitioning in space, time and space-time") 109 | axis(1) 110 | axis(2, at = 1:3, labels = c('Space-Time (sd)', 'Time (sd.year)', 'Space (sd.site)'), las = 1) 111 | for(k in 1:3){ 112 | denstrip(unlist(out2$sims.list[k+1]), at = k, ticks = out2$summary[k+1, c(3,5,7)]) 113 | } 114 | par(op) 115 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -------------------------------------------------------------------------------- /AHM2_ch01/AHM2_01.05.2.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 1 : RELATIVE ABUNDANCE MODELS FOR POPULATION DYNAMICS 6 | # ============================================================= 7 | # Code from proofs dated 2020-08-18 8 | 9 | # Run time with the full number of iterations: 1 hr 10 | 11 | library(jagsUI) 12 | 13 | # ~~~~~ Need to run 1.3 before this ~~~~~~~ 14 | source("AHM2_01.03.R") 15 | # ~~~~~ and this from 1.4 ~~~~~~~~~~~~~~~~~ 16 | M <- nrow(C) 17 | T <- ncol(C) 18 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 19 | 20 | 21 | # 1.5 Generalized Linear Mixed Models 22 | # =================================== 23 | 24 | # 1.5.2 A GLMM with trends in relative abundance 25 | # ---------------------------------------------- 26 | 27 | # Bundle data (and center Year) 28 | str(bdata <- list(C = C, yr = year - mean(year), M = M, T = T) ) 29 | # List of 4 30 | # $ C : int [1:267, 1:18] 1 0 NA 0 3 NA NA 5 0 0 ... 31 | # $ yr: num [1:18] -8.5 -7.5 -6.5 -5.5 -4.5 -3.5 -2.5 -1.5 -0.5 0.5 ... 32 | # $ M : int 267 33 | # $ T : int 18 34 | 35 | # Specify model in BUGS language 36 | cat(file = "model3.txt"," 37 | model { 38 | 39 | # 'Priors' 40 | mu ~ dnorm(0, 0.1) # Grand mean (intercept) 41 | for(i in 1:M){ 42 | gamma[i] ~ dnorm(mu.gamma, tau.gamma) # Random site-level trends 43 | site[i] ~ dnorm(0, tau.site) # Random site effects 44 | } 45 | mu.gamma ~ dnorm(0, 0.1) # Mean trend 46 | tau.gamma <- pow(sd.gamma, -2) 47 | sd.gamma ~ dunif(0, 0.2) # Variability of trends 48 | tau.site <- pow(sd.site, -2) 49 | sd.site ~ dunif(0, 3) 50 | 51 | for(t in 1:T){ 52 | year[t] ~ dnorm(0, tau.year) # Random year effects 53 | } 54 | tau.year <- pow(sd.year, -2) 55 | sd.year ~ dunif(0, 2) 56 | tau <- pow(sd, -2) 57 | sd ~ dunif(0, 1) 58 | 59 | # 'Likelihood' 60 | for (i in 1:M){ 61 | for(t in 1:T){ 62 | C[i,t] ~ dpois(lambda[i,t]) 63 | log(lambda[i,t]) <- mu + gamma[i] * yr[t] + site[i] + year[t] + eps[i,t] 64 | eps[i,t] ~ dnorm(0, tau) # Overdispersion 65 | } 66 | } 67 | 68 | # Derived quantities 69 | for(t in 1:T){ 70 | popindex[t] <- sum(lambda[,t]) # Population index 71 | for (i in 1:M){ # Site-specific trends 72 | pred.lam1[i,t] <- exp(mu + site[i] + gamma[i] * yr[t]) 73 | pred.lam2[i,t] <- exp(mu + site[i] + gamma[i] * yr[t]) / exp(mu + site[i]) 74 | } 75 | } 76 | } 77 | ") 78 | 79 | # Initial values 80 | inits <- function() list(mu = rnorm(1), gamma = rnorm(M), site = rnorm(M), 81 | year = rnorm(T), eps = array(1, dim=c(M, T))) 82 | 83 | # Parameters monitored 84 | params <- c("mu", "mu.gamma", "sd.gamma", "sd.site", "sd.year", "sd", "gamma", 85 | "site", "year", "popindex", "pred.lam1", "pred.lam2") 86 | 87 | # MCMC settings 88 | # na <- 5000 ; ni <- 60000 ; nt <- 40 ; nb <- 20000 ; nc <- 3 89 | na <- 5000 ; ni <- 6000 ; nt <- 4 ; nb <- 2000 ; nc <- 3 # ~~~~ for testing 90 | 91 | # Call JAGS (ART 88 min), check convergence and summarize posteriors 92 | out3 <- jags(bdata, inits, params, "model3.txt", n.adapt = na, n.chains = nc, 93 | n.thin = nt, n.iter = ni, n.burnin = nb, parallel = TRUE) 94 | 95 | # par(mfrow = c(3,2)) # ~~~ replaced with 'layout' argument 96 | traceplot(out3, layout=c(3,2)) 97 | summary(out3) ; jags.View(out3) ; print(out3$summary[1:800,-c(4:6)], 3) 98 | # mean sd 2.5% 97.5% Rhat n.eff overlap0 f 99 | # mu -0.456599 0.15677 -0.748280 -0.15097 1.04 55 0 0.998 100 | # mu.gamma 0.013879 0.00612 0.001937 0.02570 1.00 3000 0 0.986 101 | # sd.gamma 0.045594 0.00388 0.038483 0.05369 1.00 2744 0 1.000 102 | # sd.site 2.380585 0.13583 2.134211 2.66447 1.00 443 0 1.000 103 | # sd.year 0.099117 0.02263 0.063627 0.14971 1.00 3000 0 1.000 104 | # sd 0.197952 0.01660 0.164070 0.22954 1.00 511 0 1.000 105 | # gamma[1] -0.020510 0.04022 -0.100570 0.05683 1.00 3000 1 0.690 106 | # [ ..... ] 107 | # year[18] -0.081874 0.05552 -0.190255 0.02882 1.00 3000 1 0.936 108 | # popindex[1] 676.204662 26.18911 626.416755 727.11841 1.00 3000 0 1.000 109 | # [ ..... ] 110 | # popindex[18] 888.755919 28.49865 832.911551 944.49179 1.00 1297 0 1.000 111 | # pred.lam1[1,1] 0.465903 0.23323 0.147836 1.01941 1.00 1844 0 1.000 112 | 113 | # ~~~~~ code for figure 1.5 ~~~~~~~~~~~~~~~~ 114 | op <- par(mfrow = c(1, 2), mar = c(5,5,3,3)) 115 | matplot(year, t(out3$mean$pred.lam1), type = 'l', lty = 1, lwd = 2, xlab = 'Year', 116 | ylab = 'Expected abundance', frame = FALSE, ylim = c(0, 32), las = 1) 117 | matplot(year, t(out3$mean$pred.lam2), type = 'l', lty = 1, lwd = 2, xlab = 'Year', 118 | ylab = 'Site-specific trends (standardized)', frame = FALSE, 119 | ylim = c(0, 2.6), las = 1) 120 | par(op) 121 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 122 | 123 | table(out3$summary[7:273,'overlap0']) 124 | # 0 1 125 | # 45 222 126 | 127 | summary(apply(out3$sims.list$gamma > 0, 1, sum)) 128 | # Min. 1st Qu. Median Mean 3rd Qu. Max. 129 | # 111.0 157.0 166.0 166.2 175.0 216.0 130 | 131 | # ~~~ for the comparison, need to load model out2 ~~~~ 132 | load("AHM2_01.05.1_out2.RData") 133 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 134 | (R2site <- 100* (out2$mean$sd.site - out3$mean$sd.site) / out2$mean$sd.site) 135 | (R2year <- 100* (out2$mean$sd.year - out3$mean$sd.year) / out2$mean$sd.year) 136 | (R2resi <- 100* (out2$mean$sd - out3$mean$sd) / out2$mean$sd) 137 | # [1] -0.5243542 138 | # [1] 13.56628 139 | # [1] 29.6783 140 | 141 | # ~~~ Save output for use in subsequent sections ~~~ 142 | save(out3, file="AHM2_01.05.2_out3.RData") 143 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 144 | -------------------------------------------------------------------------------- /AHM2_ch01/AHM2_01.05.3.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 1 : RELATIVE ABUNDANCE MODELS FOR POPULATION DYNAMICS 6 | # ============================================================= 7 | # Code from proofs dated 2020-08-18 8 | 9 | # Run time with the full number of iterations: 8 mins 10 | 11 | library(AHMbook) 12 | library(jagsUI) 13 | 14 | # ~~~~~ Need to run 1.3 before this ~~~~~~~ 15 | source("AHM2_01.03.R") 16 | # ~~~~~ and this from 1.4 ~~~~~~~~~~~~~~~~~ 17 | M <- nrow(C) 18 | T <- ncol(C) 19 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 20 | 21 | # 1.5 Generalized Linear Mixed Models 22 | # =================================== 23 | 24 | # 1.5.3 Adding covariates into a GLMM for relative abundance and modeling a trend 25 | # ------------------------------------------------------------------------------- 26 | 27 | # Scale some covariates and mean-impute missing values in them 28 | elev.sc <- standardize(dat$elev) # elevation of site 29 | forest.sc <- standardize(dat$forest) # forest cover of site 30 | date.sc <- standardize(date) 31 | date.sc[is.na(date.sc)] <- 0 # mean impute 32 | dur.sc <- standardize(dur) 33 | dur.sc[is.na(dur.sc)] <- 0 # mean impute 34 | 35 | # Bundle and summarize data 36 | str(bdata <- list(C = C, yr = year - mean(year), elev = elev.sc, 37 | forest = forest.sc, date = date.sc, dur = dur.sc, 38 | twosurveys = as.numeric(dat$nsurveys == 2), M = M, T = T) ) 39 | # List of 9 40 | # $ C : int [1:267, 1:18] 1 0 NA 0 3 NA NA 5 0 0 ... 41 | # $ yr : num [1:18] -8.5 -7.5 -6.5 -5.5 -4.5 -3.5 -2.5 -1.5 ... 42 | # $ elev : num [1:267, 1] -1.1539 -1.1539 -0.2175 -0.3735 -0.0614 ... 43 | # $ forest : num [1:267, 1] -1.1471 -0.4967 -0.0992 -0.9303 0.0092 ... 44 | # $ date : num [1:267, 1:18] -0.157 -1.012 0 -0.257 -0.634 ... 45 | # $ dur : num [1:267, 1:18] -0.8792 -1.1884 0 0.0485 -0.5418 ... 46 | # $ twosurveys: num [1:267] 0 0 0 0 0 0 0 0 0 0 ... 47 | # $ M : int 267 48 | # $ T : int 18 49 | 50 | # Specify model in BUGS language 51 | cat(file = "model4.txt"," 52 | model { 53 | 54 | # 'Priors' and linear models 55 | mu ~ dnorm(0, 0.1) # Grand mean (intercept) 56 | for(i in 1:M){ 57 | site[i] ~ dnorm(0, tau.site) # Random site effects 58 | } 59 | 60 | # Linear model for effect of elevation on expectation of trends 61 | for(i in 1:M){ # NOTE: here we model the trends 62 | gamma[i] ~ dnorm(mu.gamma[i], tau.gamma) # Random site-level trends 63 | mu.gamma[i] <- alpha.mu.gamma + beta1.mu.gamma * elev[i] + 64 | beta2.mu.gamma * pow(elev[i],2) 65 | } 66 | alpha.mu.gamma ~ dnorm(0, 0.1) # intercept of mean trend on elev 67 | beta1.mu.gamma ~ dnorm(0, 0.1) # lin effect of elev on trend 68 | beta2.mu.gamma ~ dnorm(0, 0.1) # quad effect of elev on trend 69 | tau.gamma <- pow(sd.gamma, -2) 70 | sd.gamma ~ dunif(0, 0.2) # Variability of trends 71 | 72 | # Other priors 73 | tau.site <- pow(sd.site, -2) 74 | sd.site ~ dunif(0, 3) 75 | for(i in 1:7){ 76 | theta[i] ~ dnorm(0, 0.1) # Covariate effects 77 | } 78 | for(t in 1:T){ 79 | year[t] ~ dnorm(0, tau.year) # Random year effects 80 | } 81 | tau.year <- pow(sd.year, -2) 82 | sd.year ~ dunif(0, 2) 83 | tau <- pow(sd, -2) 84 | sd ~ dunif(0, 1) 85 | 86 | # 'Likelihood' 87 | for (i in 1:M){ 88 | for(t in 1:T){ 89 | C[i,t] ~ dpois(lambda[i,t]) 90 | log(lambda[i,t]) <- mu + gamma[i] * yr[t] + 91 | theta[1] * elev[i] + theta[2] * pow(elev[i],2) + 92 | theta[3] * forest[i] + theta[4] * date[i,t] + 93 | theta[5] * pow(date[i,t],2) + theta[6] * dur[i,t] + 94 | theta[7] * twosurveys[i] + site[i] + year[t] + eps[i,t] 95 | eps[i,t] ~ dnorm(0, tau) 96 | } 97 | } 98 | 99 | # Derived quantities 100 | for(t in 1:T){ 101 | popindex[t] <- sum(lambda[,t]) 102 | } 103 | } 104 | ") 105 | 106 | # Initial values 107 | inits <- function() list(mu = rnorm(1), gamma = rnorm(M), theta = rnorm(7), 108 | site = rnorm(M), year = rnorm(T), eps = array(1, dim=c(M, T))) 109 | 110 | # Parameters monitored 111 | params <- c("mu", "alpha.mu.gamma", "beta1.mu.gamma", "beta2.mu.gamma", 112 | "sd.beta", "theta", "sd.site", "sd.year", "sd", "popindex") 113 | # could also monitor some random effects: "gamma", "site", "year", 114 | 115 | # MCMC settings 116 | na <- 5000 ; ni <- 10000 ; nt <- 5 ; nb <- 5000 ; nc <- 3 117 | 118 | # Call JAGS (ART 7 min), check convergence and summarize posteriors 119 | out4 <- jags(bdata, inits, params, "model4.txt", n.adapt = na, n.chains = nc, 120 | n.thin = nt, n.iter = ni, n.burnin = nb, parallel = TRUE) 121 | # par(mfrow = c(3,2)) # ~~~ replaced with 'layout' argument 122 | traceplot(out4, layout=c(3,2)) 123 | print(out4, 2) 124 | # mean sd 2.5% 50% 97.5% overlap0 f Rhat n.eff 125 | # mu 1.018 0.137 0.754 1.016 1.295 FALSE 1.000 1.008 240 126 | # alpha.mu.gamma 0.013 0.007 -0.002 0.013 0.028 TRUE 0.960 1.001 1652 127 | # beta1.mu.gamma 0.019 0.005 0.009 0.019 0.029 FALSE 1.000 1.015 145 128 | # beta2.mu.gamma -0.001 0.007 -0.015 -0.001 0.013 TRUE 0.558 1.003 2368 129 | # theta[1] 0.929 0.117 0.701 0.930 1.158 FALSE 1.000 1.000 3000 130 | # theta[2] -0.919 0.136 -1.192 -0.913 -0.649 FALSE 1.000 1.029 77 131 | # theta[3] 0.667 0.101 0.467 0.667 0.866 FALSE 1.000 1.002 832 132 | # theta[4] -0.035 0.027 -0.089 -0.035 0.020 TRUE 0.903 1.003 744 133 | # theta[5] 0.010 0.019 -0.027 0.011 0.049 TRUE 0.710 1.002 914 134 | # theta[6] 0.125 0.020 0.084 0.124 0.165 FALSE 1.000 1.000 3000 135 | # theta[7] -3.039 0.393 -3.803 -3.041 -2.273 FALSE 1.000 1.000 3000 136 | # sd.site 1.199 0.070 1.069 1.195 1.341 FALSE 1.000 1.011 185 137 | # sd.year 0.103 0.023 0.067 0.100 0.158 FALSE 1.000 1.001 3000 138 | # sd 0.193 0.017 0.161 0.193 0.226 FALSE 1.000 1.039 180 139 | # ........ 140 | 141 | # ~~~~~~ extra code for these results ~~~~~~~~~~~~~~~~~~~~ 142 | load("AHM2_01.05.1_out2.RData") 143 | (R2site <- 100* (out2$mean$sd.site - out4$mean$sd.site) / out2$mean$sd.site) 144 | (R2year <- 100* (out2$mean$sd.year - out4$mean$sd.year) / out2$mean$sd.year) 145 | (R2resi <- 100* (out2$mean$sd - out4$mean$sd) / out2$mean$sd) 146 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 147 | # [1] 49.35703 148 | # [1] 10.07 149 | # [1] 31.38612 150 | 151 | # ~~~ Save output for use in subsequent sections ~~~ 152 | save(out4, file="AHM2_01.05.3_out4.RData") 153 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 154 | -------------------------------------------------------------------------------- /AHM2_ch01/AHM2_01.05.4.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 1 : RELATIVE ABUNDANCE MODELS FOR POPULATION DYNAMICS 6 | # ============================================================= 7 | # Code from proofs dated 2020-08-18 8 | 9 | # Approximate run time for this script: 30 mins 10 | # Run time with the full number of iterations: 6 hrs 11 | 12 | # library(AHMbook) 13 | library(jagsUI) 14 | 15 | # ~~~~~ Need to run 1.3 before this ~~~~~~~ 16 | source("AHM2_01.03.R") 17 | # ~~~~~ and this from 1.4 ~~~~~~~~~~~~~~~~~ 18 | M <- nrow(C) 19 | T <- ncol(C) 20 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 21 | 22 | # 1.5 Generalized Linear Mixed Models 23 | # =================================== 24 | 25 | # 1.5.4 The “TRIM Model” with temporal autocorrelation 26 | # ---------------------------------------------------- 27 | 28 | # Bundle data 29 | str(bdata <- list(C = C, M = M, T = T)) 30 | 31 | # Specify model in BUGS language 32 | cat(file = "model5.txt"," 33 | model { 34 | 35 | # Priors 36 | for(i in 1:M){ 37 | site[i] ~ dnorm(0, 0.001) # Prior for site effects 38 | } 39 | year[1] <- 0 # Constraint on year effects 40 | for(t in 2:T){ 41 | year[t] ~ dnorm(0, 0.001) # Prior for year effects 2:T 42 | } 43 | tau <- pow(sd, -2) 44 | sd ~ dunif(0, 3) 45 | rho ~ dunif(-1,1) # Autoregressive param. for temp. autocorrelation 46 | 47 | # 'Likelihood' 48 | # First year 49 | for (i in 1:M){ 50 | eps[i,1] ~ dnorm(0, tau) # unstructured random variation (= OD) 51 | C[i,1] ~ dpois(lambda[i,1]) 52 | log(lambda[i,1]) <- site[i] + year[1] + w[i,1] 53 | w[i,1] <- eps[i,1] / sqrt(1 - rho * rho) 54 | 55 | # Later years 56 | for(t in 2:T){ 57 | eps[i,t] ~ dnorm(0, tau) # (same) unstructured random variation 58 | C[i,t] ~ dpois(lambda[i,t]) 59 | log(lambda[i,t]) <- site[i] + year[t] + w[i,t] 60 | w[i,t] <- rho * w[i,t-1] + eps[i,t] 61 | } 62 | } 63 | 64 | # Derived quantities 65 | for(t in 1:T){ 66 | popindex[t] <- sum(lambda[,t]) 67 | } 68 | } 69 | ") 70 | 71 | # Initial values 72 | inits <- function() list(site = rnorm(M), year = c(NA, rnorm(T-1)), 73 | rho = runif(1), eps = array(0.1, dim=c(M, T))) 74 | 75 | # Parameters monitored 76 | params <- c("popindex", "site", "year", "lam.sel", "rho", "sd") 77 | 78 | # MCMC settings 79 | # na <- 10000 ; ni <- 250000 ; nt <- 200 ; nb <- 50000 ; nc <- 3 80 | na <- 10000 ; ni <- 25000 ; nt <- 20 ; nb <- 5000 ; nc <- 3 # ~~~ for testing, 30 mins 81 | 82 | # Call JAGS (ART 251 min), check convergence and summarize posteriors 83 | out5 <- jags(bdata, inits, params, "model5.txt", n.adapt = na, n.chains = nc, 84 | n.thin = nt, n.iter = ni, n.burnin = nb, parallel = TRUE) 85 | # par(mfrow = c(3,2)) # ~~~ replaced with 'layout' argument 86 | traceplot(out5, layout=c(3,2)) 87 | summary(out5) ; jags.View(out5) ; print(out5, 3) 88 | # mean sd 2.5% 50% 97.5% overlap0 f Rhat n.eff 89 | # rho 0.945 0.026 0.892 0.947 0.987 FALSE 1 1.032 71 90 | # sd 0.211 0.012 0.188 0.210 0.235 FALSE 1 1.007 277 91 | # [ ... ] 92 | 93 | # ~~~~ Save output for use in subsequent sections ~~~~~ 94 | save(out5, file="AHM2_01.05.4_out5.RData") 95 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 96 | -------------------------------------------------------------------------------- /AHM2_ch01/AHM2_01.06.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 1 : RELATIVE ABUNDANCE MODELS FOR POPULATION DYNAMICS 6 | # ============================================================= 7 | # Code from proofs dated 2020-08-18 8 | 9 | # Approximate run time for this script: 35 mins 10 | # Run time with the full number of iterations: 6.6 hrs 11 | 12 | # library(AHMbook) 13 | library(jagsUI) 14 | 15 | # ~~~~~ Need to run 1.3 before this ~~~~~~~ 16 | source("AHM2_01.03.R") 17 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 18 | 19 | 20 | # 1.6 Gaussian state-space models for inference about relative abundance 21 | # ====================================================================== 22 | 23 | # 1.6.1 Modeling multiple time-series with fixed effects for site-level parameters 24 | # -------------------------------------------------------------------------------- 25 | 26 | # Check number of zero years in all sites 27 | nzero <- apply(C, 1, function(x) sum(x == 0, na.rm = TRUE)) 28 | plot(sort(nzero)) # Make a graph of number of zero years 29 | sum(nzero <= 1) # 97 sites with at most 1 zero year 30 | table(nzero) 31 | 32 | # Bundle data with restriction on sites 33 | sel <- nzero <= 1 # Select sites with <= 1 zero count 34 | newM <- sum(sel) # Define new number of sites 35 | str(bdata <- list(C = C[sel,], M = newM, T = ncol(C[sel,]))) 36 | # List of 3 37 | # $ C: int [1:97, 1:18] 3 5 9 13 12 2 3 3 6 10 ... 38 | # $ M: int 97 39 | # $ T: int 18 40 | 41 | # Specify model in BUGS language 42 | cat(file = "model6.txt"," 43 | model { 44 | 45 | # Priors 46 | for(i in 1:M){ 47 | n[i, 1] ~ dnorm(0, 0.01)I(0,) # Prior for initial pop. sizes 48 | # curve(dnorm(x, 0, sqrt(1/ 0.01)), 0, 50) # how does it look like ? 49 | mean.gamma[i] ~ dunif(0, 10) # Prior for mean growth rates 50 | sigma.proc[i] ~ dnorm(0, 1)I(0,) # Prior for sd of state process 51 | sigma2.proc[i] <- pow(sigma.proc[i], 2) 52 | tau.proc[i] <- pow(sigma.proc[i], -2) 53 | sigma.obs[i] ~ dnorm(0, 0.01)I(0,) # Prior for sd of obs. process 54 | sigma2.obs[i] <- pow(sigma.obs[i], 2) 55 | tau.obs[i] <- pow(sigma.obs[i], -2) 56 | } 57 | 58 | # 'Likelihood' 59 | # State process 60 | for (i in 1:M){ 61 | for (t in 1:(T-1)){ 62 | gamma[i, t] ~ dnorm(mean.gamma[i], tau.proc[i]) 63 | n[i, t+1] <- n[i, t] * gamma[i, t] 64 | } 65 | } 66 | 67 | # Observation process 68 | for (i in 1:M){ 69 | for (t in 1:T){ 70 | C[i, t] ~ dnorm(n[i, t], tau.obs[i]) 71 | } 72 | } 73 | 74 | # Derived quantities 75 | for(t in 1:T){ 76 | popindex[t] <- sum(n[,t]) 77 | } 78 | } 79 | ") 80 | 81 | # Initial values 82 | inits <- function(){list(sigma.proc = runif(newM, 0, 5), 83 | mean.gamma = runif(newM, 0.1, 2), sigma.obs = runif(newM, 0, 10), 84 | n = cbind(runif(newM, 0, 50), array(NA, dim = c(newM, ncol(C)-1))))} 85 | 86 | # Parameters monitored 87 | params <- c("mean.gamma", "sigma2.proc", "sigma2.obs", "popindex", "n") 88 | 89 | # MCMC settings 90 | # na <- 10000 ; ni <- 6e6 ; nt <- 1000 ; nb <- 5e6 ; nc <- 2 91 | na <- 10000 ; ni <- 6e5 ; nt <- 100 ; nb <- 5e5 ; nc <- 2 # ~~~ for testing, 32 mins 92 | 93 | # Call JAGS (ART 505 min), check convergence and summarize posteriors 94 | out6 <- jags(bdata, inits, params, "model6.txt", n.adapt = na, n.chains = nc, 95 | n.thin = nt, n.iter = ni, n.burnin = nb, parallel = TRUE) 96 | # par(mfrow = c(4,4)) # ~~~ replace with 'layout' argument 97 | traceplot(out6, layout=c(4,4)) # all params 98 | summary(out6) ; jags.View(out6) ; print(out6$summary[1:320,-c(4:6)], 3) 99 | 100 | # Check how many and which parameters have failed to converge 101 | which(out6$summary[,8] > 1.1) # 7 derived quants or latent variables 102 | 103 | # Produce Fig. 1.6 104 | op <- par(mfrow = c(1, 2)) 105 | graphSSM(out6, bdata$C) 106 | par(op) 107 | 108 | # ~~~~ Produce Fig. 1.7 ~~~~~~~~~~~~~~~~ 109 | # Load all the model output from previous sections 110 | load("AHM2_01.04_out1.RData") 111 | load("AHM2_01.05.1_out2.RData") 112 | load("AHM2_01.05.2_out3.RData") 113 | load("AHM2_01.05.3_out4.RData") 114 | load("AHM2_01.05.4_out5.RData") 115 | off <- 0.15 116 | plot(year-2*off, out1$mean$popindex, cex = 2, pch = 16, xlab = 'Year', 117 | ylab = 'Population index', col = 'red', type = 'b', frame = FALSE, 118 | ylim = c(400, 1100)) 119 | segments(year-2*off, out1$q2.5$popindex, year-2*off, out1$q97.5$popindex, col = 'red') 120 | points(year-off, out2$mean$popindex, cex = 2, pch = 16, col = 'blue', type = 'b') 121 | segments(year-off, out2$q2.5$popindex, year-off, out2$q97.5$popindex, col = 'blue') 122 | points(year, out3$mean$popindex, cex = 2, pch = 16, col = 'green', type = 'b') 123 | segments(year, out3$q2.5$popindex, year, out3$q97.5$popindex, col = 'green') 124 | points(year+off, out4$mean$popindex, cex = 2, pch = 16, col = 'brown', type = 'b') 125 | segments(year+off, out4$q2.5$popindex, year+off, out4$q97.5$popindex, col = 'brown') 126 | points(year+2*off, out5$mean$popindex, cex = 2, pch = 16, col = 'black', type = 'b') 127 | segments(year+2*off, out5$q2.5$popindex, year+2*off, out5$q97.5$popindex, col = 'black') 128 | points(year, out6$mean$popindex, cex = 2, pch = 1, col = 'black', type = 'b') 129 | segments(year, out6$q2.5$popindex, year, out6$q97.5$popindex, col = 'black') 130 | legend(2012, 650, c("Model 1", "Model 2", "Model 3", "Model 4", "Model 5", "Model 6"), 131 | col=c("red", "blue", "green", "brown", "black", "black"), lty=1, 132 | pch=c(rep(16,5),1), bty='n') 133 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 134 | 135 | # 1.6.2 Modeling multiple time-series with random effects for sitelevel parameters 136 | 137 | # no code 138 | 139 | # 1.6.3 Brief comments on Gaussian state-space models 140 | 141 | # no code 142 | -------------------------------------------------------------------------------- /AHM2_ch01/AHM2_01.07.1.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 1 : RELATIVE ABUNDANCE MODELS FOR POPULATION DYNAMICS 6 | # ============================================================= 7 | # Code from proofs dated 2020-08-18 8 | 9 | library(AHMbook) 10 | library(jagsUI) 11 | 12 | # 1.7 “Demographic” state-space models for inference about relative abundance 13 | # =========================================================================== 14 | 15 | # 1.7.1 Simulation assessment of a demographic state-space model 16 | # -------------------------------------------------------------- 17 | 18 | set.seed(1) 19 | str(tmp <- simPOP(M = 100, T = 10, mean.lam = 3, beta.lam = 0, sd.log.lam = 0, 20 | mean.gamma = 1.0, beta.gamma = 0, sd.log.gamma.site = 0, 21 | sd.log.gamma.time = 0, sd.log.gamma.survey = 0, sd.rho = 0, mean.p = 0.6, 22 | beta.p = 0, sd.logit.p.site = 0, sd.logit.p.time = 0, sd.logit.p.survey = 0, 23 | show.plot = TRUE)) 24 | 25 | # 1. Ideal case 26 | betas <- 0.5 # Value of all covariate coefficients 27 | str(data <- simPOP(mean.lam = 3, beta.lam = betas, mean.gamma = 1.0, 28 | beta.gamma = betas, sd.rho = 0, mean.p = 0.6, beta.p = betas)) 29 | 30 | 31 | # 2. Effects of “rescue”/immigration 32 | sd.rho <- 0.2 # Value of random immigration parameter 33 | str(data <- simPOP(mean.lam = 3, beta.lam = betas, mean.gamma = 1.0, 34 | beta.gamma = betas, sd.rho = sd.rho, mean.p = 0.6, beta.p = betas)) 35 | 36 | # 3. Effect of heterogeneity in lambda (in extended Markov model) 37 | sd.log.lam <- 1 # Value of overdispersion in lambda 38 | str(data <- simPOP(mean.lam = 3, beta.lam = betas, sd.log.lam = sd.log.lam, 39 | mean.gamma = 1.0, beta.gamma = betas, sd.rho = sd.rho, mean.p = 0.6, 40 | beta.p = betas)) 41 | 42 | # 4. Effect of heterogeneity in gamma (in extended Markov model) 43 | sd.log.gamma.survey <- 0.5 # Value of overdispersion in gamma 44 | str(data <- simPOP(mean.lam = 3, beta.lam = betas, mean.gamma = 1.0, 45 | beta.gamma = betas, sd.log.gamma.survey = sd.log.gamma.survey, sd.rho = 0.2, 46 | mean.p = 0.6, beta.p = betas)) 47 | 48 | # 5. Effect of heterogeneity in p (in extended Markov model) 49 | sd.logit.p.survey <- 1 # Value of overdispersion in p 50 | str(data <- simPOP(mean.lam = 3, beta.lam = betas, mean.gamma = 1.0, 51 | beta.gamma = betas, sd.rho = 0.2, mean.p = 0.6, beta.p = betas, 52 | sd.logit.p.survey = sd.logit.p.survey)) 53 | 54 | # 6. Effects of heterogeneity in lambda, gamma, and p simultaneously (in extended Markov model) 55 | sd.log.lam <- 1 # Value of overdispersion in lambda 56 | sd.log.gamma.survey <- 0.5 # Value of overdispersion in gamma 57 | sd.logit.p.survey <- 1 # Value of overdispersion in p 58 | str(data <- simPOP(mean.lam = 3, beta.lam = betas, sd.log.lam = sd.log.lam, 59 | mean.gamma = 1.0, beta.gamma = betas, 60 | sd.log.gamma.survey = sd.log.gamma.survey, 61 | sd.rho = 0.2, mean.p = 0.6, beta.p = betas, 62 | sd.logit.p.survey = sd.logit.p.survey)) 63 | -------------------------------------------------------------------------------- /AHM2_ch01/AHM2_01.07.3.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 1 : RELATIVE ABUNDANCE MODELS FOR POPULATION DYNAMICS 6 | # ============================================================= 7 | # Code from MS dated 2018-11-30 8 | 9 | # 1.7 “Demographic” state-space models for inference about relative abundance 10 | # =========================================================================== 11 | 12 | # 1.7.3 Comments on demographic state-space models 13 | # ----------------------------------------------------------- 14 | 15 | # ~~~~ code for figure 1.14 ~~~~~~~~~~ 16 | # Compare GLM, GLMM, Gaussian and demographic SSM in terms of standardized 17 | # population trajectory 18 | 19 | # Load saved output 20 | load("AHM2_01.04_out1.RData") 21 | load("AHM2_01.05.3_out4.RData") 22 | load("AHM2_01.07.2extra_outs.RData") 23 | load("AHM2_01.07.2_out11.RData") 24 | 25 | # Standardize to estimate in 2007 26 | tmp1 <- out1$sims.list$popindex / out1$sims.list$popindex[,9] # Model 1 27 | tmp4 <- out4$sims.list$popindex / out4$sims.list$popindex[,9] # Model 4 28 | tmp8 <- out8$sims.list$popindex / out8$sims.list$popindex[,9] # Model 8 29 | tmp11 <- out11$sims.list$popindex / out11$sims.list$popindex[,9] # Model 11 30 | # Get posterior means and CRIs 31 | pm <- cbind(apply(tmp1, 2, mean), apply(tmp4, 2, mean), apply(tmp8, 2, mean), 32 | apply(tmp11, 2, mean)) 33 | fn1 <- function(x) quantile(x, 0.025) 34 | fn2 <- function(x) quantile(x, 0.975) 35 | LCL <- cbind(apply(tmp1, 2, fn1), apply(tmp4, 2, fn1), apply(tmp8, 2,fn1), 36 | apply(tmp11, 2, fn1)) 37 | UCL <- cbind(apply(tmp1, 2, fn2), apply(tmp4, 2, fn2), apply(tmp8, 2, fn2), 38 | apply(tmp11, 2, fn2)) 39 | 40 | ylim = c(0.5, 1.3) 41 | off <- 0.05 42 | year <- 1999:2016 43 | 44 | plot(year-3*off, pm[,1], type = 'b', pch = 16, lty = 1, xlab = 'Year', col = 1, 45 | ylim = ylim, ylab = 'Standardized population level', las = 1, frame = FALSE) 46 | points(year-1*off, pm[,2], type = 'b', pch = 16, lty = 1, col = 2) 47 | points(year+1*off, pm[,3], type = 'b', pch = 16, lty = 1, col = 3) 48 | points(year+3*off, pm[,4], type = 'b', pch = 16, lty = 1, col = 4) 49 | abline(h = 1, col = 'grey') 50 | abline(v = 2007, col = 'grey') 51 | segments(year-3*off, LCL[,1], year-3*off, UCL[,1], col = 1) 52 | segments(year-1*off, LCL[,2], year-1*off, UCL[,2], col = 2) 53 | segments(year+1*off, LCL[,3], year+1*off, UCL[,3], col = 3) 54 | segments(year+3*off, LCL[,4], year+3*off, UCL[,4], col = 4) 55 | legend('bottomright', c('GLM (Model 1)', 'GLMM (Model 4)', 56 | 'Gaussian SSM (Model 8)', 'Demographic SSM (Model 11)'), 57 | col=1:4, pch=16, bty = 'n') 58 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 59 | -------------------------------------------------------------------------------- /AHM2_ch01/AHM2_01.08.1.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 1 : RELATIVE ABUNDANCE MODELS FOR POPULATION DYNAMICS 6 | # ============================================================= 7 | # Code from proofs dated 2020-08-18 8 | 9 | library(AHMbook) 10 | library(jagsUI) 11 | 12 | # 1.8 Modeling population dynamics at two temporal scales 13 | # ======================================================= 14 | 15 | # 1.8.1 Analysis of simulated data under a Gaussian phenomenological model 16 | # ------------------------------------------------------------------------ 17 | 18 | str(out <- simPH(npop = 18, nyear = 17, nrep = 10, date.range = 1:150, 19 | initial.lambda = 300, gamma.parms = c(0, 0.3), mu.range = c(50, 80), 20 | sigma.range = c(10, 20), p.range = c(0.4, 0.6), show.plot = TRUE)) 21 | # ~~~ Produces Fig. 1.15 22 | 23 | # Execute function 24 | str(out <- simPH()) # Implicit defaults 25 | str(out <- simPH(show.plot = F)) # Skip plot browsing 26 | str(out <- simPH(npop = 1)) # Only one population 27 | str(out <- simPH(npop = 100)) # Many populations (only first 16 plotted) 28 | str(out <- simPH(nyear = 2)) # Two years only 29 | str(out <- simPH(nyear = 50)) # Fifty years 30 | str(out <- simPH(date.range = 50:70)) # (Too) narrow survey season 31 | str(out <- simPH(date.range = -100:200)) # Very long survey season 32 | str(out <- simPH(initial.lambda = 10)) # Very small populations (and many extinctions) 33 | str(out <- simPH(gamma.parms = c(0, 0))) # Stable population, no annual variation in gamma 34 | str(out <- simPH(mu.range = c(50, 50))) # No variation in mu 35 | str(out <- simPH(mu.range = c(0, 100))) # Lots of variation in mu 36 | str(out <- simPH(sigma.range = c(10, 80))) # Lots of variation in sigma 37 | 38 | # Create a data set 39 | set.seed(1) 40 | str(data <- simPH(npop = 18, nyear = 17, nrep = 10, date.range = 1:150, 41 | initial.lambda = 500, mu.range = c(50, 80), sigma.range = c(20, 30), 42 | p.range = c(1, 1))) 43 | # ~~~ Produces Fig 1.15 44 | 45 | # Bundle and summarize data set: add pop and year info 46 | str(bugs.data <- list(C = data$C, date = data$date, npop = data$npop, 47 | nyear = data$nyear, nsurvey = data$nrep, pi = pi) ) 48 | # List of 6 49 | # $ C : int [1:18, 1:17, 1:10] 0 4 3 1 0 1 0 2 0 1 ... 50 | # $ date : num [1:18, 1:17, 1:10] 6 14 16 27 8 33 9 9 9 2 ... 51 | # $ npop : num 18 52 | # $ nyear : num 17 53 | # $ nsurvey: num 10 54 | # $ pi : num 3.14 55 | 56 | # Specify model in BUGS language 57 | cat(file = "modelPH.txt"," 58 | model { 59 | 60 | # Priors 61 | # Top-level priors 62 | for(i in 1:npop){ 63 | for(t in 1:nyear){ 64 | mu[i,t] ~ dnorm(0, 0.0001) 65 | # curve(dnorm(x, 0, sqrt(1/ 0.0001)), -200, 200) # how's it look like ? 66 | } 67 | } 68 | expn1 ~ dunif(1, 2000) 69 | for(t in 1:(nyear-1)){ 70 | gamma[t] ~ dunif(0.01, 10) 71 | sigma[t] ~ dunif(0.01, 50) 72 | } 73 | sigma[nyear] ~ dunif(0.01, 50) 74 | 75 | # Likelihood 76 | # Model for between-year dynamics 77 | for(i in 1:npop){ 78 | # Initial conditions 79 | n1[i] ~ dpois(expn1) 80 | n[i,1] <- n1[i] 81 | # Autoregressive (Markovian) transitions from t to tD1 82 | for(t in 2:nyear){ 83 | n[i,t] ~ dpois(n[i,(t-1)]*gamma[t-1]) 84 | } 85 | } 86 | 87 | # Phenomenological within-season population model 88 | for(i in 1:npop){ 89 | for(t in 1:nyear){ 90 | for(k in 1:nsurvey){ 91 | C[i,t,k] ~ dpois(lambda[i,t,k]) 92 | lambda[i,t,k] <- n[i,t]*(1 / (sigma[t]*sqrt(2*pi)) )*exp( - pow((date[i,t,k] - mu 93 | [i,t]),2) / (2*pow(sigma[t], 2)) ) 94 | } 95 | } 96 | } 97 | } 98 | ") 99 | 100 | # Initial values 101 | nst <- 50 * apply(data$C, c(1,2), max, na.rm = TRUE) 102 | gammast <- runif(data$nyear-1, 0.8, 1.1) 103 | inits <- function() list(n = nst, gamma = gammast) 104 | 105 | # Parameters monitored 106 | params <- c("expn1", "n", "n1", "mu", "gamma", "sigma") 107 | 108 | # MCMC settings 109 | na <- 1000 ; ni <- 10000 ; nt <- 5 ; nb <- 5000 ; nc <- 3 110 | 111 | # Call JAGS (ART 3 min), assess convergence and summarize posteriors 112 | out12 <- jags(bugs.data, inits, params, "modelPH.txt", n.adapt = na, 113 | n.chains = nc, n.thin = nt, n.iter = ni, n.burnin = nb, parallel = TRUE) 114 | # par(mfrow = c(3,3)) # ~~~ no longer needed 115 | traceplot(out12, c("expn1", "n1", "gamma", "sigma")) 116 | summary(out12) ; jags.View(out12) ; print(out12, dig = 3) 117 | 118 | # ~~~~~~~~~~ extra code for figure 1.16 ~~~~~~~~~~~~ 119 | # Compare estimates of N1, gamma, mu and sigma to the truth 120 | out <- out12 121 | op <- par(mfrow = c(3,2), mar = c(5,5,4,3)) 122 | lims <- range(c(data$n[,1], out$mean$n[,1], out$q2.5$n[,1] , out$q97.5$n[,1])) 123 | plot(data$n[,1], out$mean$n[,1], xlab = "Truth", 124 | ylab = "Estimate", pch = 16, 125 | main = "Initial relative abundance n1", 126 | xlim = lims, ylim = lims, frame = FALSE) 127 | segments(data$n[,1], out$q2.5$n[,1], data$n[,1], out$q97.5$n[,1]) 128 | abline(0,1) 129 | abline(lm(out$mean$n[,1] ~ data$n[,1]), col = 'blue') 130 | 131 | lims <- range(c(data$n, out$mean$n, out$q2.5$n , out$q97.5$n)) 132 | plot(data$n, out$mean$n, xlab = "Truth", ylab = "Estimate", 133 | pch = 16, main = "Relative abundance n (all pops, all years)", 134 | xlim = lims, ylim = lims, frame = FALSE) 135 | segments(data$n, out$q2.5$n, data$n, out$q97.5$n) 136 | abline(0,1) 137 | abline(lm(c(out$mean$n) ~ c(data$n)), col = 'blue') 138 | 139 | lims <- range(c(data$gamma, out$mean$gamma, out$q2.5$gamma, out$q97.5$gamma)) 140 | plot(data$gamma, out$mean$gamma, xlab = "Truth", 141 | ylab = "Estimated", pch = 16, 142 | main = "Productivity gamma (all years)", 143 | xlim = lims, ylim = lims, frame = FALSE) 144 | segments(data$gamma, out$q2.5$gamma, data$gamma, out$q97.5$gamma) 145 | abline(0,1) 146 | abline(lm(out$mean$gamma ~ data$gamma), col = 'blue') 147 | 148 | lims <- range(c(data$mu, out$mean$mu, out$q2.5$mu, out$q97.5$mu)) 149 | plot(data$mu, out$mean$mu, xlab = "Truth", 150 | ylab = "Estimate", pch = 16, 151 | main = "Mean peak flight date mu (all pops, all years)", 152 | xlim = lims, ylim = lims, frame = FALSE) 153 | segments(data$mu, out$q2.5$mu, data$mu, out$q97.5$mu) 154 | abline(0,1) 155 | abline(lm(c(out$mean$mu) ~ c(data$mu)), col = 'blue') 156 | 157 | lims <- range(c(data$sigma, out$mean$sigma, out$q2.5$sigma, out$q97.5$sigma)) 158 | plot(data$sigma, out$mean$sigma, xlab = " Truth", 159 | ylab = "Estimate", pch = 16, 160 | main = "Length of flight period sigma (all years)", 161 | xlim = lims, ylim = lims, frame = FALSE) 162 | segments(data$sigma, out$q2.5$sigma, data$sigma, out$q97.5$sigma) 163 | abline(0,1) 164 | abline(lm(out$mean$sigma ~ data$sigma), col = 'blue') 165 | par(op) 166 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 167 | -------------------------------------------------------------------------------- /AHM2_ch02/AHM2_02.02.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 2 : MODELING POPULATION DYNAMICS WITH COUNT DATA 6 | # ======================================================== 7 | # Code from proofs dated 2020-08-18 8 | 9 | # 2.2 Swiss MHB Data for the Green Woodpecker 10 | # =========================================== 11 | 12 | # Load data set and grab some data 13 | library(AHMbook) 14 | data("greenWoodpecker") 15 | str(peckers <- greenWoodpecker) 16 | counts <- as.matrix(peckers[,7:48]) # Counts 2004:2017 17 | dateso <- as.matrix(peckers[,49:90]) # Survey Julian dates 2004:2017 18 | timeso <- as.matrix(peckers[,91:132]) # Survey durations 2004:2017 19 | into <- timeso/peckers[,'route.length'] # Survey intensity (min / km) 20 | 21 | # Quick visualizations of counts, survey date, duration and intensityop 22 | op <- par(mfrow = c(2, 2)) # plot not shown 23 | plot(table(counts), frame = FALSE, main = 'MHB Green Woodpecker Counts', 24 | type = 'h', lend = 'butt', lwd = 10) 25 | hist(dateso, main = 'Julian Dates (start on week-end around April 15)', 26 | breaks = 50, col = 'grey') 27 | hist(timeso, main = 'Survey duration (min)', breaks = 50, col = 'grey') 28 | hist(into, main = 'Survey intensity (min / km route length)', 29 | breaks = 50, col = 'grey') 30 | par(op) 31 | 32 | # Standardize survey dates, intensity and times ([ duration) 33 | dates <- standardize(dateso) 34 | int <- standardize(into) 35 | times <- standardize(timeso) 36 | 37 | # Put data into 3D arrays and summarize. This works because surveys 38 | # are grouped within years otherwise be careful! 39 | C <- array(counts, dim=c(267, 3, 14)) 40 | DATE <- array(dates, dim=c(267, 3, 14)) 41 | DUR <- array(times, dim=c(267, 3, 14)) 42 | INT <- array(int, dim=c(267, 3, 14)) 43 | mean.C <- apply(C, c(1,3), mean, na.rm = TRUE) # Mean count per site,year 44 | annual.mean <- apply(mean.C, 2, mean, na.rm = TRUE) 45 | annual.mean2 <- apply(C, 3, mean, na.rm = TRUE) # Direct 3D average 46 | site.mean <- apply(mean.C, 1, mean, na.rm = TRUE) 47 | nsites.with.data <- apply(!is.na(mean.C), 2, sum, na.rm = TRUE) 48 | 49 | cat("N sites with data per year:\n", nsites.with.data, "\n") 50 | # N sites with data per year: 51 | # 265 265 261 263 265 267 267 264 263 263 265 265 264 262 262 52 | 53 | nsites.detected <- apply(mean.C > 0, 2, sum, na.rm = TRUE) 54 | cat("N sites with Pecker detected per year:\n", nsites.detected, "\n") 55 | # N sites with Pecker detected per year: 56 | # 49 77 88 93 90 84 103 114 99 127 114 121 136 147 57 | 58 | cat("Observed occupancy prob.:\n", 59 | round(nsites.detected/nsites.with.data,2), "\n") 60 | # Observed occupancy prob.: 61 | # 0.18 0.29 0.34 0.35 0.34 0.31 0.39 0.43 0.38 0.48 0.43 0.46 0.52 0.56 62 | 63 | cat("Observed mean count per year:\n", round(annual.mean, 2), "\n") 64 | # Observed mean count per year: 65 | # 0.15 0.33 0.42 0.48 0.45 0.43 0.39 0.54 0.49 0.53 0.43 0.52 0.56 0.58 66 | 67 | cat("Observed mean count (site):\n") ; summary(site.mean) 68 | # Observed mean count (site): 69 | # Min. 1st Qu. Median Mean 3rd Qu. Max. 70 | # 0.00000 0.02381 0.23077 0.44850 0.54304 3.90476 71 | 72 | # Scale elevation and forest cover 73 | elevo <- peckers$elev # Elevation (original) 74 | elev <- standardize(elevo) 75 | foresto <- peckers$forest # Forest cover (original) 76 | forest <- standardize(foresto) 77 | 78 | # Mean-impute DATE and INT 79 | DATE[is.na(DATE)] <- 0 # Innocuous mean imputation 80 | INT[is.na(INT)] <- 0 # Almost innocuous mean imputation 81 | -------------------------------------------------------------------------------- /AHM2_ch02/AHM2_02.03.0.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 2 : MODELING POPULATION DYNAMICS WITH COUNT DATA 6 | # ======================================================== 7 | # Code from proofs dated 2020-08-18 8 | 9 | library(jagsUI) 10 | 11 | # ~~~~ need the Green Woodpecker data prepared in 2.2 ~~~~~~~~ 12 | source("AHM2_02.02.R") 13 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 14 | 15 | # 2.3 Year-stratified N-mixture model 16 | # =========================================== 17 | 18 | # Bundle and summarize data set 19 | str(bdata <- list(C = C, nsites = dim(C)[1], nsurveys = dim(C)[2], 20 | nyears = dim(C)[3])) 21 | # List of 4 22 | # $ C : int [1:267, 1:3, 1:14] 0 3 0 0 0 0 0 0 0 0 ... 23 | # $ nsites : int 267 24 | # $ nsurveys: int 3 25 | # $ nyears : int 14 26 | 27 | # Specify model in BUGS language 28 | cat(file = "Nmix1.txt"," 29 | model { 30 | 31 | # Priors 32 | for (t in 1:nyears){ # Loop over years ('seasons') 33 | lambda[t] ~ dunif(0, 100) # Expected abundance 34 | p[t] ~ dunif(0, 1) # Detection probability 35 | } 36 | # Ecological model for true abundance 37 | for (i in 1:nsites){ # Loop over 26 sites 38 | for(t in 1:nyears){ # Loop over 14 years 39 | N[i,t] ~ dpois(lambda[t]) 40 | # Observation model for replicated counts 41 | for (j in 1:nsurveys){ # Loop over 3 occasions 42 | C[i,j,t] ~ dbin(p[t], N[i,t]) 43 | } 44 | } 45 | } 46 | # Derived quantity: Total abundance across all surveyed sites 47 | for (t in 1:nyears){ 48 | totalN[t] <- sum(N[,t]) # includes sites with missing surveys 49 | } 50 | } 51 | ") 52 | 53 | # Initial values: avoid data/prior/inits conflict 54 | Nst <- apply(C, c(1,3), max, na.rm = TRUE)+1 55 | Nst[Nst == '-Inf'] <- 1 56 | inits <- function() list(N = Nst, lambda = runif(dim(C)[3])) 57 | 58 | # Parameters monitored 59 | params <- c("lambda", "p", "totalN") 60 | 61 | # MCMC settings 62 | na <- 100 ; ni <- 3000 ; nt <- 2 ; nb <- 1000 ; nc <- 3 63 | 64 | # Run JAGS (ART 1 min), check convergence and summarize posteriors 65 | out1 <- jags(bdata, inits, params, "Nmix1.txt", n.adapt = na, n.chains = nc, 66 | n.thin = nt, n.iter = ni, n.burnin = nb, parallel = TRUE) 67 | # par(mfrow = c(3, 3)) # ~~~ no longer needed 68 | traceplot(out1) 69 | print(out1, digits = 2) # not shown 70 | 71 | # ~~~~ extra code for figure 2.2 ~~~~~~~~~~~~~~~~ 72 | # Summarize counts and abundance estimates (with 95% CRI) 73 | op <- par(mar = c(5,5,3,2), cex.lab = 1.5, cex.axis = 1.5) 74 | plot(2004:2017, annual.mean, xlab = 'Year', type = 'b', ylab = 'Mean count or E(N)', 75 | frame = FALSE, pch = 16, cex = 2, col = 'red', ylim = c(0, 2)) 76 | points(2004:2017, out1$mean$lambda, type = 'b', pch = 16, cex = 2) 77 | segments(2004:2017, out1$q2.5$lambda, 2004:2017, out1$q97.5$lambda) 78 | par(op) 79 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 80 | -------------------------------------------------------------------------------- /AHM2_ch02/AHM2_02.03.1.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 2 : MODELING POPULATION DYNAMICS WITH COUNT DATA 6 | # ======================================================== 7 | # Code from proofs dated 2020-08-18 8 | 9 | # Approximate run time for this script: 20 mins 10 | 11 | library(jagsUI) 12 | 13 | # ~~~~ need the Green Woodpecker data prepared in 2.2 ~~~~~~~~ 14 | source("AHM2_02.02.R") 15 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 16 | 17 | # 2.3 Year-stratified N-mixture model 18 | # =========================================== 19 | 20 | # 2.3.1 Adding covariates and estimating a common trend over time 21 | # --------------------------------------------------------------- 22 | 23 | # Bundle data 24 | str(bdata <- list(C = C, nsites = dim(C)[1], nsurveys = dim(C)[2], 25 | nyears = dim(C)[3], elev = elev, forest = forest, DATE = DATE, 26 | INT = INT)) 27 | # List of 8 28 | # $ C : int [1:267, 1:3, 1:14] 0 3 0 0 0 0 0 0 0 0 ... 29 | # $ nsites : int 267 30 | # $ nsurveys: int 3 31 | # $ nyears : int 14 32 | # $ elev : num [1:267] -1.206 -1.16 -0.184 -0.439 -0.126 ... 33 | # $ forest : num [1:267] -1.1529 -0.467 0.0023 -0.9002 -0.106 ... 34 | # $ DATE : num [1:267, 1:3, 1:14] -1.09 -1.32 -1.23 -1.27 -1.36 ... 35 | # $ INT : num [1:267, 1:3, 1:14] -0.532 -0.959 0.168 -0.452 -0.865 ... 36 | 37 | # Specify model in BUGS language 38 | cat(file = "Nmix2.txt"," 39 | model { 40 | # Priors 41 | for (t in 1:nyears){ 42 | alpha0[t] <- logit(mean.p[t]) 43 | mean.p[t] ~ dunif(0, 1) 44 | } 45 | for (k in 1:3){ 46 | alpha[k] ~ dnorm(0, 0.01) 47 | } 48 | beta0 ~ dnorm(0, 0.01) 49 | for (k in 1:4){ 50 | beta[k] ~ dnorm(0, 0.01) 51 | } 52 | 53 | # Likelihood 54 | # Ecological model for true abundance 55 | for (i in 1:nsites){ 56 | for(t in 1:nyears){ 57 | N[i,t] ~ dpois(lambda[i,t]) 58 | log(lambda[i,t]) <- beta0 + beta[1] * elev[i]+ beta[2] * 59 | pow(elev[i],2) + beta[3] * forest[i] + beta[4] * (t-7.5) 60 | # Observation model for replicated counts 61 | for (j in 1:nsurveys){ 62 | C[i,j,t] ~ dbin(p[i,j,t], N[i,t]) 63 | logit(p[i,j,t]) <- alpha0[t] + alpha[1] * DATE[i,j,t] + alpha[2] * 64 | pow(DATE[i,j,t],2) + alpha[3] * INT[i,j,t] 65 | } 66 | } 67 | } 68 | 69 | # Derived quantity: Total abundance across all surveyed sites 70 | for (t in 1:nyears){ 71 | totalN[t] <- sum(N[,t]) 72 | } 73 | } 74 | ") 75 | 76 | # Initial values 77 | Nst <- apply(C, c(1,3), max, na.rm = TRUE)+1 # Inits for latent N 78 | Nst[Nst == '-Inf'] <- 1 79 | inits <- function() list(N = Nst, alpha = c(runif(2), NA), 80 | beta0 = runif(1), beta = runif(4)) 81 | 82 | # Parameters monitored 83 | params <- c("alpha0", "alpha", "beta0", "beta", "totalN") 84 | 85 | # MCMC settings 86 | na <- 1000 ; ni <- 15000 ; nt <- 10 ; nb <- 5000 ; nc <- 3 87 | 88 | # Run JAGS (ART 22 mins), check convergence and summarize posteriors 89 | out2 <- jags(bdata, inits, params, "Nmix2.txt", n.adapt = na, 90 | n.chains = nc, n.thin = nt, n.iter = ni, n.burnin = nb, parallel = TRUE) 91 | # par(mfrow = c(3, 3)) # ~~~ no longer needed 92 | traceplot(out2) 93 | print(out2, digits = 2) # shown partially only 94 | # mean sd 2.5% 50% 97.5% overlap0 f Rhat n.eff 95 | # [...output truncated...] 96 | # alpha[1] -0.22 0.03 -0.27 -0.22 -0.17 FALSE 1.00 1.00 394 97 | # alpha[2] 0.06 0.02 0.01 0.06 0.10 FALSE 0.99 1.00 3000 98 | # alpha[3] 0.35 0.03 0.28 0.35 0.41 FALSE 1.00 1.02 182 99 | # beta0 0.17 0.04 0.10 0.17 0.24 FALSE 1.00 1.00 1127 100 | # beta[1] -0.59 0.03 -0.64 -0.59 -0.54 FALSE 1.00 1.00 3000 101 | # beta[2] -0.17 0.03 -0.23 -0.17 -0.11 FALSE 1.00 1.00 2578 102 | # beta[3] 0.13 0.02 0.10 0.13 0.17 FALSE 1.00 1.00 2422 103 | # beta[4] 0.05 0.01 0.03 0.05 0.06 FALSE 1.00 1.01 2914 104 | # [... output truncated ...] 105 | 106 | 107 | # ~~~~~~~~~~~~ extra code for figure 2.3 ~~~~~~~~~~~~~~~~~~~~~ 108 | # Quick plots of response curves of lambda and p to all covariates 109 | op <- par(mfrow = c(2, 3), mar = c(5, 5, 3, 3)) 110 | ylim <- c(0, 2) 111 | curve(exp(out2$mean$beta0 + out2$mean$beta[1] * (x - mean(elevo)) / sd(elevo) + 112 | out2$mean$beta[2] * ((x - mean(elevo)) / sd(elevo))^2), 200, 3000, 113 | xlab = 'Elevation (m)', ylab = 'E(N)', main = 'lambda ~ elev', 114 | frame = FALSE, ylim = ylim) 115 | curve(exp(out2$mean$beta0 + out2$mean$beta[3] * (x - mean(foresto)) / sd(foresto)), 116 | 0, 100, xlab = 'Forest cover (%)', ylab = 'E(N)', main = 'lambda ~ forest', 117 | frame = FALSE, ylim = ylim) 118 | curve(exp(out2$mean$beta0 + out2$mean$beta[4] * (x - 7.5)), 1, 15, 119 | xlab = 'Time (years)', ylab = 'E(N)', 120 | main = 'lambda ~ year (Time trend in abundance)', 121 | frame = FALSE, ylim = ylim) 122 | ylim = c(0, 1) 123 | plot(2004:2017, plogis(out2$mean$alpha0), xlab = 'Year', ylab = 'p', 124 | main = 'p ~ year (Detection intercepts)', cex = 2, pch = 16, 125 | frame = FALSE, ylim = ylim) 126 | # curve(plogis(mean(out2$mean$alpha0) + out2$mean$alpha[1] * (x - mean.date) / sd.date + out2$mean$alpha[2] * ((x - mean.date) / sd.date)^2), 100, 200, xlab = 'Julian date', ylab = 'p', main = 'p ~ date', frame = FALSE, ylim = ylim) 127 | curve(plogis(mean(out2$mean$alpha0) + out2$mean$alpha[1] * standardize2match(x, dateso) + 128 | out2$mean$alpha[2] * standardize2match(x, dateso)^2), 100, 200, 129 | xlab = 'Julian date', ylab = 'p', main = 'p ~ date', frame = FALSE, 130 | ylim = ylim) 131 | curve(plogis(mean(out2$mean$alpha0) + out2$mean$alpha[3] * standardize2match(x, dateso)), 132 | 0, 200, xlab = 'Survey intensity (min / km)', ylab = 'p', 133 | main = 'p ~ intensity', frame = FALSE, ylim = ylim) 134 | par(op) 135 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 136 | -------------------------------------------------------------------------------- /AHM2_ch02/AHM2_02.03.2_#noCode.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 2 : MODELING POPULATION DYNAMICS WITH COUNT DATA 6 | # ======================================================== 7 | # Code from proofs dated 2020-06-11 8 | 9 | library(jagsUI) 10 | 11 | # 2.3 YEAR-STRATIFIED N-MIXTURE MODEL 12 | # =========================================== 13 | 14 | # 2.3.2 YEAR-STRATIFIED MODEL WITH MULTILEVEL ROBUST DESIGN DATA 15 | # (no code) 16 | 17 | -------------------------------------------------------------------------------- /AHM2_ch02/AHM2_02.05.1+2.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 2 : MODELING POPULATION DYNAMICS WITH COUNT DATA 6 | # ======================================================== 7 | # Code from proofs dated 2020-08-18 8 | 9 | # run time for this script 3 mins 10 | 11 | library(jagsUI) 12 | library(AHMbook) 13 | 14 | # 2.5 Dynamic N-mixture model of Dail-Madsen 15 | # ========================================== 16 | 17 | # 2.5.1 A Dail-Madsen simulator 18 | # ----------------------------- 19 | 20 | simDM0 <- function(nsites = 50, nsurveys = 3, nyears = 5, lambda = 4, 21 | phi = 0.8, gamma = 1.5, p = 0.7){ 22 | 23 | ## Simulation for multiple-visit data (from pcountOpen help file) 24 | ## No covariates, constant time intervals between primary periods 25 | # nsites: Number of sites 26 | # nsurveys: Number of rep. (secondary) samples within period of closure 27 | # nyears: Number of primary samples (= period of closure): 28 | # years, seasons etc. 29 | # lambda: Initial expected abundance 30 | # phi, gamma: apparent survival and recruitment rates, respectively 31 | # p: detection probability 32 | 33 | y <- array(NA, dim = c(nsites, nyears, nsurveys)) 34 | N <- matrix(NA, nsites, nyears) 35 | S <- R <- matrix(NA, nsites, nyears-1) 36 | N[,1] <- rpois(nsites, lambda) # Initial state 37 | for(t in 1:(nyears-1)) { # State dynamics 38 | S[,t] <- rbinom(nsites, N[,t], phi) # Survival process 39 | R[,t] <- rpois(nsites, gamma) # Recruitment process 40 | N[,t+1] <- S[,t] + R[,t] 41 | } 42 | for(j in 1:nsurveys){ # Observation process 43 | y[,,j] <- rbinom(nsites*nyears, N, p) 44 | } 45 | 46 | # Put observed data into two dimensions 47 | yy <- array(NA, dim = c(nsites, nsurveys*nyears)) 48 | for(t in 1:nyears){ 49 | yy[,(nsurveys * t-(nsurveys-1)):(nsurveys*t)] <- y[,t,] 50 | } 51 | return(list(nsites = nsites, nsurveys = nsurveys, nyears = nyears, 52 | lambda = lambda, phi = phi, gamma = gamma, p = p, N = N, S = S, R = R, 53 | y = y, yy = yy)) 54 | } 55 | 56 | # Execute function 57 | set.seed(2017, kind = "L'Ecuyer") 58 | str(data <- simDM0(nsites = 50, nsurveys = 3, nyears = 5, lambda = 4, 59 | phi = 0.8, gamma = 1.5, p = 0.7)) 60 | 61 | 62 | # 2.5.2 Fitting the DM model in BUGS 63 | # ---------------------------------- 64 | 65 | # Bundle data set 66 | str(bdata <- list(C = data$y, nsites = dim(data$y)[1], nsurveys = dim(data$y)[3], 67 | nyears = dim(data$y)[2])) 68 | # List of 4 69 | # $ C : int [1:50, 1:5, 1:3] 3 4 4 1 2 5 3 5 7 5 ... 70 | # $ nsites : int 50 71 | # $ nsurveys: int 3 72 | # $ nyears : int 5 73 | 74 | # Specify model in BUGS language 75 | cat(file = "DM1.txt"," 76 | model { 77 | # Priors 78 | lambda ~ dunif(0, 100) # Initial site-specific abundance 79 | phi ~ dunif(0, 1) # Apparent survival (omega in paper/unmarked) 80 | gamma ~ dunif(0, 5) # Per-capita recruitment rate 81 | p ~ dunif(0, 1) # Detection probability 82 | 83 | # Likelihood 84 | for(i in 1:nsites){ 85 | # State process: initial condition 86 | N[i,1] ~ dpois(lambda) 87 | # State process: transition model 88 | for(t in 1:(nyears-1)){ 89 | S[i,t+1] ~ dbin(phi, N[i,t]) # Survival process 90 | # R[i,t+1] ~ dpois(gamma) # 'absolute' recruitment = 'constant' 91 | R[i,t+1] ~ dpois(N[i,t] * gamma) # per-capita recruitment = 'autoreg' 92 | N[i,t+1] <- S[i,t+1] + R[i,t+1] 93 | } 94 | # Observation process 95 | for(t in 1:nyears){ 96 | for(j in 1:nsurveys){ 97 | C[i,t,j] ~ dbin(p, N[i,t]) 98 | } 99 | } 100 | } 101 | } 102 | ") 103 | 104 | # Initial values 105 | Nst <- apply(data$y, c(1,2), max) + 2 106 | Nst[, 2:5] <- NA # cols 2:5 of N are deterministic, N <- S + R. 107 | R1 <- apply(data$y, c(1,2), max) # Observed max. counts + 1 as inits 108 | R1[,1] <- NA 109 | inits <- function(){list( lambda = runif(1, 6, 16), phi = runif(1), 110 | gamma = runif(1), p = runif(1), N = Nst, R = R1 + 1 )} 111 | 112 | # Parameters monitored 113 | params <- c("lambda", "phi", "gamma", "p") 114 | 115 | # MCMC settings 116 | na <- 1000 ; ni <- 25000 ; nt <- 4 ; nb <- 5000 ; nc <- 3 117 | 118 | # Call JAGS (ART 2 min), check convergence and summarize posteriors 119 | out1 <- jags(bdata, inits, params, "DM1.txt", n.adapt = na, n.chains = nc, 120 | n.thin = nt, n.iter = ni, n.burnin = nb, parallel = TRUE) 121 | 122 | # par(mfrow = c(2, 3)) # ~~~ replace with 'layout' argument 123 | traceplot(out1, layout=c(2,3)) 124 | print(out1, 3) 125 | 126 | # Per-capita recruitment parameterisation 127 | # mean sd 2.5% 50% 97.5% overlap0 f Rhat n.eff 128 | # lambda 4.168 0.315 3.575 4.159 4.813 FALSE 1 1.000 15000 129 | # phi 0.863 0.034 0.789 0.865 0.923 FALSE 1 1.002 1982 130 | # gamma 0.232 0.036 0.168 0.230 0.311 FALSE 1 1.002 1682 131 | # p 0.696 0.018 0.659 0.696 0.729 FALSE 1 1.001 5292 132 | 133 | # To choose the absolute recruitment parameterization, we edit the BUGS code above to fit the 134 | # absolute (or "constant") recruitment parameterization simply by commenting out the recruitment line 135 | # for "per capita" and then uncommenting the line previous to that. 136 | # ~~~~~~~~~~~~~~~~~~ here's the new JAGS code ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 137 | cat(file = "DM1b.txt"," 138 | model { 139 | # Priors 140 | lambda ~ dunif(0, 100) # Initial site-specific abundance 141 | phi ~ dunif(0, 1) # Apparent survival (omega in paper/unmarked) 142 | gamma ~ dunif(0, 5) # Per-capita recruitment rate 143 | p ~ dunif(0, 1) # Detection probability 144 | 145 | # Likelihood 146 | for(i in 1:nsites){ 147 | # State process: initial condition 148 | N[i,1] ~ dpois(lambda) 149 | # State process: transition model 150 | for(t in 1:(nyears-1)){ 151 | S[i,t+1] ~ dbin(phi, N[i,t]) # Survival process 152 | R[i,t+1] ~ dpois(gamma) # 'absolute' recruitment = 'constant' 153 | # R[i,t+1] ~ dpois(N[i,t] * gamma) # per-capita recruitment = 'autoreg' 154 | N[i,t+1] <- S[i,t+1] + R[i,t+1] 155 | } # end t 156 | # Observation process 157 | for(t in 1:nyears){ 158 | for(j in 1:nsurveys){ 159 | C[i,t,j] ~ dbin(p, N[i,t]) 160 | } # end j 161 | } # end t 162 | } # end i 163 | } 164 | ") 165 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 166 | 167 | # Call JAGS (ART 1.3 min), check convergence and summarize posteriors 168 | out1b <- jags(bdata, inits, params, "DM1b.txt", n.adapt = na, 169 | n.chains = nc, n.thin = nt, n.iter = ni, n.burnin = nb, parallel = TRUE) 170 | # par(mfrow = c(2, 3)) # ~~~ replace with 'layout' argument 171 | traceplot(out1b, layout=c(2,3)) 172 | print(out1b, 2) 173 | 174 | # Absolute parameterisation 175 | # mean sd 2.5% 50% 97.5% overlap0 f Rhat n.eff 176 | # lambda 4.09 0.31 3.51 4.08 4.72 FALSE 1 1 8586 177 | # phi 0.86 0.03 0.79 0.86 0.92 FALSE 1 1 748 178 | # gamma 1.14 0.17 0.85 1.13 1.51 FALSE 1 1 1061 179 | # p 0.70 0.02 0.66 0.70 0.73 FALSE 1 1 5387 180 | 181 | # ~~~ save the work so far ~~~ 182 | save.image("AHM2_02.05.2.RData") 183 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -------------------------------------------------------------------------------- /AHM2_ch02/AHM2_02.05.3.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 2 : MODELING POPULATION DYNAMICS WITH COUNT DATA 6 | # ======================================================== 7 | # Code from proofs dated 2020-08-18 8 | 9 | library(jagsUI) 10 | library(unmarked) 11 | library(AHMbook) 12 | 13 | # ~~~~~~~~~~ recreate the data set (see 2.5.1) ~~~~~~~~~~ 14 | set.seed(2017, kind = "L'Ecuyer") 15 | str(data <- simDM0(nsites = 50, nsurveys = 3, nyears = 5, lambda = 4, 16 | phi = 0.8, gamma = 1.5, p = 0.7)) 17 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 18 | 19 | # 2.5 Dynamic N-mixture model of Dail-Madsen 20 | # ========================================== 21 | 22 | # 2.5.3 The unmarked function pcountOpen 23 | # -------------------------------------- 24 | 25 | # Prepare data 26 | summary(umf <- unmarkedFramePCO(y = data$yy, numPrimary = data$nyears)) 27 | 28 | # Fit model, backtransform and compare with truth 29 | # Dynamics = constant (as in data simulation) 30 | (fm1 <- pcountOpen(~1, ~1, ~1, ~1, umf, K = max(data$yy) + 100, 31 | dynamics = "constant", control = list(trace=TRUE, REPORT=1)) ) 32 | 33 | # Abundance: 34 | # Estimate SE z P(>|z|) 35 | # 1.4 0.0755 18.5 1.66e-76 36 | 37 | # Recruitment: 38 | # Estimate SE z P(>|z|) 39 | # 0.104 0.144 0.721 0.471 40 | 41 | # Apparent Survival: 42 | # Estimate SE z P(>|z|) 43 | # 1.87 0.276 6.75 1.44e-11 44 | 45 | # Detection: 46 | # Estimate SE z P(>|z|) 47 | # 0.87 0.0825 10.5 5.93e-26 48 | 49 | # AIC: 2466.449 50 | 51 | # Back-transformation of parameters (full output not printed) 52 | (lam <- coef(backTransform(fm1, "lambda"))) # or 53 | (om <- plogis(coef(fm1, type="omega"))) # Apparent survival ! 54 | (gam <- exp(coef(fm1, type="gamma"))) 55 | (p <- plogis(coef(fm1, type="det"))) 56 | # lam(Int) 57 | # 4.046917 58 | # omega(Int) 59 | # 0.8660311 60 | # gamConst(Int) 61 | # 1.109454 62 | # p(Int) 63 | # 0.7046613 64 | 65 | # Dynamics = "autoreg" 66 | # (not consistent with data generating model) 67 | (fm2 <- pcountOpen(lam = ~1, gam = ~1, omega = ~1, p = ~1, data = umf, 68 | dynamics = "autoreg", K = max(data$yy) + 100, 69 | control = list(trace=TRUE, REPORT = 1))) 70 | 71 | # Abundance (log-scale): 72 | # Estimate SE z P(>|z|) 73 | # 1.42 0.0757 18.7 3.3e-78 74 | 75 | # Recruitment (log-scale): 76 | # Estimate SE z P(>|z|) 77 | # -1.48 0.157 -9.4 5.4e-21 78 | 79 | # Apparent Survival (logit-scale): 80 | # Estimate SE z P(>|z|) 81 | # 1.87 0.297 6.29 3.1e-10 82 | 83 | # Detection (logit-scale): 84 | # Estimate SE z P(>|z|) 85 | # 0.844 0.0842 10 1.19e-23 86 | 87 | # AIC: 2490.501 88 | 89 | # Backtransformation of parameters (output omitted) 90 | (lam <- exp(coef(fm2, type = "lambda"))) 91 | (om <- plogis(coef(fm2, type = "omega"))) 92 | (gam <- exp(coef(fm2, type = "gamma"))) 93 | (p <- plogis(coef(fm2, type = "det"))) 94 | -------------------------------------------------------------------------------- /AHM2_ch02/AHM2_02.05.4_#noCode.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 2 : MODELING POPULATION DYNAMICS WITH COUNT DATA 6 | # ======================================================== 7 | # Code from proofs dated 2020-06-11 8 | 9 | # 2.5 Dynamic N-mixture model of Dail-Madsen 10 | # ========================================== 11 | 12 | # 2.5.4 Nonrobust design data 13 | # -------------------------------------- 14 | 15 | # no code -------------------------------------------------------------------------------- /AHM2_ch02/AHM2_02.06_#noCode.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 2 : MODELING POPULATION DYNAMICS WITH COUNT DATA 6 | # ======================================================== 7 | # Code from proofs dated 2020-06-11 8 | 9 | # 2.6 Robustness and fit: summary thoughts on the 10 | # Dail-Madsen models (and on N-mixture models in general) 11 | # ======================================================= 12 | 13 | # no code 14 | -------------------------------------------------------------------------------- /AHM2_ch02/AHM2_02.08.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 2 : MODELING POPULATION DYNAMICS WITH COUNT DATA 6 | # ======================================================== 7 | # Code from proofs dated 2020-08-18 8 | 9 | library(jagsUI) 10 | 11 | # ~~~~ need this code from 2.7.2 ~~~~~~~~~~~ 12 | alfl <- read.csv(system.file("csv", "alfl.csv", package = "unmarked")) 13 | alfl.covs <- read.csv(system.file("csv", "alflCovs.csv", package = "unmarked"), 14 | row.names = 1) 15 | alfl$captureHistory <- paste(alfl$interval1, alfl$interval2, alfl$interval3, sep = "") 16 | alfl$captureHistory <- factor(alfl$captureHistory, 17 | levels = c("001", "010", "011", "100", "101", "110", "111")) 18 | alfl$id <- factor(alfl$id, levels = rownames(alfl.covs)) 19 | alfl.v1 <- alfl[alfl$survey == 1,] 20 | alfl.H1 <- table(alfl.v1$id, alfl.v1$captureHistory) 21 | alfl.v2 <- alfl[alfl$survey == 2,] 22 | alfl.H2 <- table(alfl.v2$id, alfl.v2$captureHistory) 23 | alfl.v3 <- alfl[alfl$survey == 3,] 24 | alfl.H3 <- table(alfl.v3$id, alfl.v3$captureHistory) 25 | # Arrange the data in 3-d array format and also the wide format 26 | Y <- array(NA, c(50, 3, 7)) 27 | Y[1:50,1,1:7] <- alfl.H1 28 | Y[1:50,2,1:7] <- alfl.H2 29 | Y[1:50,3,1:7] <- alfl.H3 30 | Ywide <- cbind(alfl.H1, alfl.H2, alfl.H3) 31 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 32 | 33 | # 2.8 Multinomial mixtures with full dynamics 34 | # =========================================== 35 | 36 | # Prepare time and date (incl. median-centering) 37 | date <- as.matrix(alfl.covs[,c("date.1", "date.2", "date.3")]) 38 | date <- date - median(date) 39 | time <- as.matrix(alfl.covs[,c("time.1", "time.2", "time.3")]) 40 | time <- time - median(time) 41 | 42 | # Prepare response array 43 | y3d <- array(NA, dim = c(nrow(Y), 7, 3)) # Create 3d array 44 | y3d[,,1] <- Ywide[,1:7] 45 | y3d[,,2] <- Ywide[,8:14] 46 | y3d[,,3] <- Ywide[,15:21] 47 | 48 | # Sample sizes 49 | nseasons <- 3 # Number of primary occasions 50 | nsites <- nrow(Ywide) # Number of sites 51 | nobs <- apply(y3d, c(1,3), sum) # Total detections/site, occasion 52 | 53 | # Bundle data (sames as before) 54 | str(bdata <- list(y3d = y3d, nsites = nsites, nseasons = nseasons, 55 | nobs = nobs, woody = alfl.covs[,"woody"], struct = alfl.covs[,"struct"], 56 | date = date, time = time)) 57 | 58 | # Dail-Madsen-type, open model for multinomial sampling protocol 59 | # Specify model in BUGS language 60 | cat(file = "mnDM.txt", " 61 | model{ 62 | 63 | # Prior distributions, regression parameters 64 | alpha0 ~ dnorm(0,0.01) 65 | alpha1 ~ dnorm(0,0.01) 66 | beta0 ~ dunif(-20,20) 67 | beta1 ~ dunif(-20,20) 68 | beta2 ~ dunif(-20,20) 69 | # Priors for dynamics parameters: here they are constant across years 70 | # Here, we could add covariate models for logit(phi) and log(gamma) 71 | phi ~ dunif(0,1) 72 | gamma ~ dunif(0,5) 73 | 74 | # 'Likelihood' 75 | for (i in 1:nsites){ 76 | for (t in 1:nseasons){ 77 | # Linear model for detection function scale 78 | log(p[i,t]) <- alpha0 + alpha1*woody[i] 79 | # Multinomial cell probabilities 80 | cp[i,t,1] <- (1-p[i,t])*(1-p[i,t])*p[i,t] 81 | cp[i,t,2] <- (1-p[i,t])*p[i,t]*(1-p[i,t]) 82 | cp[i,t,3] <- (1-p[i,t])*p[i,t]*p[i,t] 83 | cp[i,t,4] <- p[i,t]*(1-p[i,t])*(1-p[i,t]) 84 | cp[i,t,5] <- p[i,t]*(1-p[i,t])*p[i,t] 85 | cp[i,t,6] <- p[i,t]*p[i,t]*(1-p[i,t]) 86 | cp[i,t,7] <- p[i,t]*p[i,t]*p[i,t] 87 | cp[i,t,8] <- 1-sum(cp[i,t,1:7]) 88 | cellprobs.cond[i,t,1] <- cp[i,t,1]/ sum(cp[i,t,1:7]) 89 | cellprobs.cond[i,t,2] <- cp[i,t,2]/ sum(cp[i,t,1:7]) 90 | cellprobs.cond[i,t,3] <- cp[i,t,3]/ sum(cp[i,t,1:7]) 91 | cellprobs.cond[i,t,4] <- cp[i,t,4]/ sum(cp[i,t,1:7]) 92 | cellprobs.cond[i,t,5] <- cp[i,t,5]/ sum(cp[i,t,1:7]) 93 | cellprobs.cond[i,t,6] <- cp[i,t,6]/ sum(cp[i,t,1:7]) 94 | cellprobs.cond[i,t,7] <- cp[i,t,7]/ sum(cp[i,t,1:7]) 95 | 96 | # Conditional 4-part version of the model 97 | pdet[i,t] <- sum(cp[i,t, 1:7]) 98 | y3d[i,1:7,t] ~ dmulti(cellprobs.cond[i,t,1:7], nobs[i,t]) 99 | # Conditional observation model 100 | nobs[i,t] ~ dbin(pdet[i,t], N[i,t]) # Individuals detected 101 | } 102 | # Poisson regression model for abundance 103 | log(lambda0[i]) <- beta0 + beta1*woody[i] + beta2*struct[i] 104 | N[i,1] ~ dpois(lambda0[i]) # Population size 105 | 106 | # Population dynamics model for subsequent years 107 | for (t in 2:nseasons){ # Loop over primary periods 108 | S[i,t] ~ dbinom(phi, N[i, t-1]) # Survivors 109 | R[i,t] ~ dpois(gamma * N[i, t-1]) # Recruits 110 | N[i,t] <- S[i,t] + R[i,t] # N = Survivors + Recruits 111 | y[i,t] ~ dbin(pdet[i,t],N[i,t]) # Observation model 112 | } 113 | } 114 | # Derived parameters 115 | for(t in 1:nseasons){ 116 | Ntot[t] <- sum(N[,t]) 117 | D[t] <- Ntot[t] / (0.785*nsites) # 50 m point = 0.785 ha 118 | } 119 | } 120 | ") 121 | 122 | # Set up some sensible starting values for S and R 123 | nseasons <- 3 124 | yin <- nobs+1 125 | yin[,2:3] <- NA 126 | Sin <- Rin <- matrix(NA, nrow = nsites, ncol = nseasons) 127 | y1 <- nobs + 1 128 | for(i in 1:nsites){ 129 | for (t in 2:3){ 130 | Sin[i,t] <- rbinom(1,y1[i,t-1], 0.7) 131 | Rin[i,t] <- ifelse((y1[i,t]-Sin[i,t])>0, y1[i,t]-Sin[i,t], 0) 132 | } 133 | } 134 | # Initial values 135 | inits <- function(){list(N = yin, beta0 = runif(1), beta1 = runif(1), 136 | beta2 = runif(1), beta3 = runif(1), alpha0 = runif(1, -3, -2), 137 | alpha1 = runif(1), phi = 0.6, gamma = 0.3, R = Rin, S = Sin) } 138 | 139 | # Parameters monitored 140 | params <- c('beta0', 'beta1', 'beta2', 'beta3', 'alpha0', 'alpha1', 141 | 'phi', 'gamma', 'Ntot', 'D') 142 | 143 | # MCMC settings 144 | na <- 5000 ; ni <- 100000 ; nb <- 50000 ; nt <- 50 ; nc <- 3 145 | 146 | # Run JAGS (ART 6 min), look at convergence and summarize posteriors 147 | out8 <- jags (bdata, inits, params, "mnDM.txt", n.adapt = na, n.iter=ni, 148 | n.burnin=nb, n.thin=nt, n.chains=nc, parallel=TRUE) 149 | # par(mfrow = c(3, 3)) # ~~~ no longer needed 150 | traceplot(out8) 151 | print(out8, 3) 152 | # mean sd 2.5% 50% 97.5% overlap0 f Rhat n.eff 153 | # beta0 -1.122 0.415 -1.929 -1.112 -0.314 FALSE 0.998 1.001 2834 154 | # beta1 2.083 0.692 0.744 2.074 3.473 FALSE 0.999 1.000 3000 155 | # beta2 0.046 0.037 -0.026 0.047 0.118 TRUE 0.892 1.000 3000 156 | # alpha0 -0.546 0.116 -0.778 -0.541 -0.333 FALSE 1.000 1.000 3000 157 | # alpha1 0.334 0.235 -0.132 0.335 0.778 TRUE 0.922 1.000 3000 158 | # phi 0.392 0.105 0.139 0.407 0.556 FALSE 1.000 1.006 430 159 | # gamma 0.199 0.106 0.059 0.176 0.481 FALSE 1.000 1.003 918 160 | # Ntot[1] 55.781 1.466 54.000 56.000 59.000 FALSE 1.000 1.000 3000 161 | # Ntot[2] 33.927 1.010 33.000 34.000 36.000 FALSE 1.000 1.000 3000 162 | # Ntot[3] 17.953 1.038 17.000 18.000 20.000 FALSE 1.000 1.000 3000 163 | # D[1] 1.421 0.037 1.376 1.427 1.503 FALSE 1.000 1.000 3000 164 | # D[2] 0.864 0.026 0.841 0.866 0.917 FALSE 1.000 1.000 3000 165 | # D[3] 0.457 0.026 0.433 0.459 0.510 FALSE 1.000 1.000 3000 166 | -------------------------------------------------------------------------------- /AHM2_ch02/AHM2_02.10.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 2 : MODELING POPULATION DYNAMICS WITH COUNT DATA 6 | # ======================================================== 7 | # Code from proofs dated 2020-08-18 8 | 9 | # Approximate run time for this script: 15 mins 10 | 11 | library(jagsUI) 12 | 13 | # 2.10 Spatially dynamic Dail-Madsen models 14 | # ========================================= 15 | 16 | # Set parameter values and sample sizes 17 | nsites <- 25 # number of sites (must be integer^2) 18 | nyears <- 20 # number of years 19 | nsurveys <- 3 # number of surveys per year 20 | lambda0 <- 5 # initial abundance 21 | phi <- 0.8 # survival rate 22 | gamma <- 0.2 # reproduction rate 23 | kappa <- 0.3 # emigration rate 24 | p <- 0.75 # detection probability 25 | 26 | # Define a grid of sites and adjacency structure 27 | lat <- rep(1:sqrt(nsites), times = sqrt(nsites)) 28 | lon <- rep(1:sqrt(nsites), each = sqrt(nsites)) 29 | plot(lat, lon, pch = 20, las = 1) 30 | dist <- matrix(, nsites, nsites) 31 | for (i in 1:nsites) { 32 | for (j in 1:nsites) { 33 | dist[i,j] <- sqrt((lat[i] - lat[j])^2 + (lon[i] - lon[j])^2) 34 | } 35 | } 36 | adj <- ifelse(dist <= 1.05, 1, 0) # Binary matrix that identifies neighbours 37 | diag(adj) <- 0 38 | nadj <- colSums(adj) # Number of neighbours 39 | 40 | # Simulate a data set 41 | N <- matrix(NA, nsites, nyears) 42 | R <- S <- E <- I <- Ilambda <- matrix(NA, nsites, nyears - 1) 43 | y <- array(NA, c(nsites, nyears, nsurveys)) 44 | N[,1] <- rpois(nsites, lambda0) 45 | for (t in 2:nyears) { 46 | R[,t-1] <- rpois(nsites, gamma*N[,t-1]) 47 | S[,t-1] <- rbinom(nsites, N[,t-1], phi) 48 | E[,t-1] <- rbinom(nsites, S[,t-1], kappa) 49 | for (i in 1:nsites) { 50 | Ilambda[i,t-1] <- sum(E[,t-1] / nadj * adj[,i]) 51 | } 52 | I[,t-1] <- rpois(nsites, Ilambda[,t-1]) 53 | N[,t] <- S[,t-1] - E[,t-1] + R[,t-1] + I[,t-1] 54 | } 55 | for (j in 1:nsurveys) { 56 | y[,,j] <- rbinom(nsites*nyears, N, p) 57 | } 58 | 59 | # Bundle data 60 | str( bdata <- list(nsites = nsites, nyears = nyears, nsurveys = nsurveys, 61 | y = y, adj = adj, nadj = nadj)) 62 | # List of 6 63 | # $ nsites : num 25 64 | # $ nyears : num 20 65 | # $ nsurveys : num 3 66 | # $ y : int [1:25, 1:20, 1:3] 3 3 3 4 5 4 2 1 4 2 ... 67 | # $ adj : num [1:25, 1:25] 0 1 0 0 0 1 0 0 0 0 ... 68 | # $ nadj : num [1:25] 2 3 3 3 2 3 4 4 4 3 ... 69 | 70 | # Specify model in BUGS language 71 | cat(file="spatialDMmodel.txt", " 72 | model { 73 | # Prior distributions 74 | lambda0 ~ dgamma(0.001, 0.001) 75 | phi ~ dunif(0, 1) 76 | gamma ~ dunif(0, 1) 77 | kappa ~ dunif(0, 1) 78 | p ~ dunif(0, 1) 79 | 80 | # Process model 81 | for(i in 1:nsites) { 82 | N[i,1] ~ dpois(lambda0) 83 | for(t in 2:nyears) { 84 | R[i,t-1] ~ dpois(gamma*N[i,t-1]) 85 | S[i,t-1] ~ dbin(phi, N[i,t-1]) 86 | E[i,t-1] ~ dbin(kappa, S[i,t-1]) 87 | Ilambda[i,t-1] <- sum(E[1:nsites,t-1]/ nadj[1:nsites] * adj[1:nsites,i]) 88 | I[i,t-1] ~ dpois(Ilambda[i,t-1]) 89 | N[i,t] <- S[i,t-1] - E[i,t-1] + R[i,t-1] + I[i,t-1] 90 | } 91 | } 92 | 93 | # Observation model 94 | for (i in 1:nsites) { 95 | for (t in 1:nyears) { 96 | for (j in 1:nsurveys) { 97 | y[i,t,j] ~ dbin(p, N[i,t]) 98 | } 99 | } 100 | } 101 | } 102 | ") 103 | 104 | # Initial values. cheap.inits = true values 105 | Ni <- N + 20 ; Ni[,-1] <- NA ; Ri <- R + 10 ; Si <- S + 10 106 | Ei <- E + 5 ; Ii <- I + 5 107 | inits <- function() list(lambda0 = runif(1, 1, 5), phi = runif(1), 108 | gamma = runif(1), kappa = runif(1), p = runif(1), N = Ni, R = Ri, S = Si, 109 | E = Ei, I = Ii) 110 | 111 | # Parameters monitored 112 | params <- c("lambda0", "phi", "gamma", "kappa", "p") 113 | 114 | # MCMC settings 115 | # na <- 2000 ; ni <- 20000 ; nt <- 10 ; nb <- 10000 ; nc <- 3 116 | na <- 2000 ; ni <- 2000 ; nt <- 1 ; nb <- 1000 ; nc <- 3 # ~~~ testing 117 | 118 | # Call JAGS (ART 22 min), check convergence and summarize posteriors 119 | out11 <- jags(bdata, inits, params, model = "spatialDMmodel.txt", 120 | n.adapt = na, n.chains = nc, n.burnin = nb, n.iter = ni, n.thin = nt, 121 | parallel = TRUE) 122 | # par(mfrow = c(2,2)) # ~~~ replace with 'layout' argument 123 | traceplot(out11, layout=c(2,2)) 124 | print(out11) 125 | # mean sd 2.5% 50% 97.5% overlap0 f Rhat n.eff 126 | # lambda0 4.738 0.463 3.878 4.716 5.671 FALSE 1 1.000 3000 127 | # phi 0.825 0.035 0.752 0.826 0.888 FALSE 1 1.010 236 128 | # gamma 0.170 0.035 0.109 0.169 0.240 FALSE 1 1.009 234 129 | # kappa 0.272 0.034 0.211 0.272 0.341 FALSE 1 1.006 533 130 | # p 0.748 0.011 0.726 0.748 0.768 FALSE 1 1.000 3000 131 | -------------------------------------------------------------------------------- /AHM2_ch04/AHM2_04.04.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # 6 | # Chapter 4 : MODELING SPECIES DISTRIBUTION AND RANGE DYNAMICS, AND POPULATION 7 | # DYNAMICS USING DYNAMIC OCCUPANCY MODELS 8 | # ============================================================================ 9 | # Code from proofs dated 2020-08-18 10 | 11 | library(AHMbook) 12 | 13 | # 4.4 A general data simulation function for dynocc models 14 | # ======================================================== 15 | 16 | library(AHMbook) 17 | str(data <- simDynocc( # Explicit defaults 18 | nsites = 250, nyears = 10, nsurveys = 3, year.of.impact = NA, 19 | mean.psi1 = 0.4, beta.Xpsi1 = 0, 20 | range.phi = c(0.5, 1), impact.phi = 0, beta.Xphi = 0, 21 | range.gamma = c(0, 0.5), impact.gamma = 0, beta.Xgamma = 0, 22 | range.p = c(0.1, 0.9), beta.Xp = 0, 23 | range.beta1.survey = c(0, 0), range.beta2.survey = c(0, 0), 24 | trend.sd.site = c(0, 0), trend.sd.survey = c(0, 0), 25 | trend.sd.site.survey = c(0, 0), show.plot = TRUE)) 26 | 27 | # All four parameters constant 28 | str(data <- simDynocc(nsites = 250, nyears = 10, nsurveys = 3, mean.psi1 = 0.6, 29 | range.phi = c(0.7, 0.7), range.gamma = c(0.3, 0.3), range.p = c(0.5, 0.5))) 30 | 31 | # Full time-dependence 32 | str(data <- simDynocc(mean.psi1 = 0.6, range.phi = c(0.5, 0.8), 33 | range.gamma = c(0.1, 0.5), range.p = c(0.1, 0.9))) 34 | 35 | # Constant intercepts, but covariates in all parameters 36 | str(data <- simDynocc(mean.psi1 = 0.6, beta.Xpsi1 = 1, 37 | range.phi = c(0.6, 0.6), beta.Xphi = 2, range.gamma = c(0.3, 0.3), 38 | beta.Xgamma = 2, range.p = c(0.2, 0.2), beta.Xp = -2) ) 39 | 40 | # Full time-dependence and and effects of all covariates (incl. season) 41 | str(data <- simDynocc(mean.psi1 = 0.6, beta.Xpsi1 = 1, 42 | range.phi = c(0.6, 1), beta.Xphi = 2, range.gamma = c(0, 0.2), 43 | beta.Xgamma = 2, range.p = c(0.1, 0.9), beta.Xp = -2, 44 | range.beta1.survey = c(2, 10), range.beta2.survey = c(-10, -20)) ) 45 | 46 | # No detection error (i.e., p = 1) 47 | str(data <- simDynocc(range.p = c(1, 1)) ) 48 | 49 | # Can do a single site .... 50 | str( data <- simDynocc(nsites = 1) ) 51 | 52 | # ... but must have at least two years 53 | str(data <- simDynocc(nyears = 2) ) 54 | 55 | str(data <- simDynocc(nsurveys = 12, mean.psi1 = 0.6, 56 | range.phi = c(0.6, 0.6), range.gamma = c(0.3, 0.3), 57 | range.p = c(0.5, 0.5), range.beta1.survey = c(-0.3, 0.4), 58 | range.beta2.survey = c(0, -0.7)) ) 59 | 60 | # Add detection heterogeneity at the site level 61 | str(data <- simDynocc(trend.sd.site = c(3, 3)) ) # No time trend 62 | str(data <- simDynocc(trend.sd.site = c(1, 3)) ) # With time trend 63 | 64 | # Add detection heterogeneity at the level of the survey 65 | str(data <- simDynocc(trend.sd.survey = c(3, 3)) ) # No time trend 66 | str(data <- simDynocc(trend.sd.survey = c(1, 3)) ) # With time trend 67 | 68 | # Add detection heterogeneity at the level of the individual visit 69 | str(data <- simDynocc(trend.sd.site.survey = c(3, 3)) ) # No trend 70 | str(data <- simDynocc(trend.sd.site.survey = c(1, 3)) ) # With trend 71 | 72 | str(data <- simDynocc(nsites = 250, nyears = 20, nsurveys = 3, 73 | year.of.impact = 10, impact.phi = 80, impact.gamma = 50) ) 74 | -------------------------------------------------------------------------------- /AHM2_ch04/AHM2_04.09.1_Crossbills.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # 6 | # Chapter 4 : MODELING SPECIES DISTRIBUTION AND RANGE DYNAMICS, AND POPULATION 7 | # DYNAMICS USING DYNAMIC OCCUPANCY MODELS 8 | # ============================================================================ 9 | # Code from proofs dated 2020-08-18 10 | 11 | # 4.9 Analysis and mapping of crossbill distribution and range dynamics in Switzerland 12 | # ==================================================================================== 13 | 14 | # 4.9.1 Data manipulations and creation of unmarked data frame 15 | # ------------------------------------------------------------ 16 | 17 | # Read in data set from AHMbook 18 | library(AHMbook) 19 | data(crossbillAHM) 20 | str(cb <- crossbillAHM) 21 | 22 | # Extract response (detection/nondetection data) and survey dates 23 | y <- as.matrix(cb[,6:41]) # Detection/nondetection data 24 | dates <- as.matrix(cb[,42:77]) # Survey dates 25 | 26 | # Standardize covariates for elevation, forest and survey date 27 | mean.ele <- mean(cb$ele, na.rm=TRUE) 28 | sd.ele <- sd(cb$ele, na.rm=TRUE) 29 | elev <- (cb$ele - mean.ele) / sd.ele 30 | mean.forest <- mean(cb$forest, na.rm=TRUE) 31 | sd.forest <- sd(cb$forest, na.rm=TRUE) 32 | forest <- (cb$forest - mean.forest) / sd.forest 33 | mean.date <- mean(dates, na.rm=TRUE) 34 | sd.date <- sd(c(dates), na.rm=TRUE) 35 | DATE <- (dates - mean.date) / sd.date 36 | DATE[is.na(DATE)] <- 0 # Mean-impute missing dates 37 | 38 | # Generate unmarked data frame 39 | library(unmarked) 40 | year <- matrix(as.character(2001:2012), 267, 12, byrow = TRUE) # Year covar. 41 | summary(umf <- unmarkedMultFrame(y = y, siteCovs = data.frame(elev, forest), 42 | yearlySiteCovs = list(year = year), obsCovs=list(date = DATE), numPrimary = 12) ) 43 | -------------------------------------------------------------------------------- /AHM2_ch04/AHM2_04.09.4.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # 6 | # Chapter 4 : MODELING SPECIES DISTRIBUTION AND RANGE DYNAMICS, AND POPULATION 7 | # DYNAMICS USING DYNAMIC OCCUPANCY MODELS 8 | # ============================================================================ 9 | # Code from MS dated 2019-06-17 10 | 11 | library(unmarked) 12 | library(AICcmodavg) 13 | 14 | load("AHM2_04.09.3_fm50.RData") 15 | c.hat <- 2.102584 16 | 17 | 18 | # 4.9 Analysis and mapping of crossbill distribution and range dynamics in Switzerland 19 | # ==================================================================================== 20 | 21 | # 4.9.4 Inference under the AIC-best model 22 | # ---------------------------------------- 23 | 24 | # ~~~~ code to produce the table ~~~~~~~~~~~ 25 | # Produce a table with means, sds and CIs for all parameters 26 | tmp <- summary(fm50) # Print summary 27 | tmp <- cbind(MLE = coef(fm50), SE = c(tmp[[1]][,2], tmp[[2]][,2], tmp[[3]][,2], 28 | tmp[[4]][,2]), rbind(confint(fm50, type = "psi"), confint(fm50, type = "col"), 29 | confint(fm50, type = "ext"), confint(fm50, type = "det"))) 30 | print(tmp, 3) 31 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 32 | 33 | # MLE SE 0.025 0.975 34 | # psi(Int) -0.0793 0.3833 -0.83043 0.67191 35 | # psi(elev) 1.9507 0.4551 1.05876 2.84256 36 | # psi(I(elev^2)) -1.2445 0.5098 -2.24373 -0.24534 37 | # psi(forest) -0.7112 0.5104 -1.71165 0.28924 38 | # psi(I(forest^2)) 0.1655 0.2613 -0.34668 0.67766 39 | # psi(elev:forest) 0.1665 0.4511 -0.71761 1.05057 40 | # psi(elev:I(forest^2)) -0.7809 0.3540 -1.47469 -0.08721 41 | # psi(I(elev^2):forest) 1.8743 0.5393 0.81743 2.93127 42 | # col(year2001) -0.0926 0.3264 -0.73241 0.54716 43 | # col(year2002) -0.3715 0.3821 -1.12040 0.37739 44 | # .... 45 | # col(year2009) -8.7195 55.8571 -118.19737 100.75829 46 | # col(year2010) -0.7878 0.4690 -1.70704 0.13149 47 | # col(year2011) -3.4583 2.3500 -8.06411 1.14756 48 | # col(elev) 0.5002 0.2060 0.09642 0.90405 49 | # col(I(elev^2)) -0.2159 0.2914 -0.78699 0.35515 50 | # col(forest) -0.3927 0.2801 -0.94163 0.15632 51 | # col(I(forest^2)) 0.2008 0.2139 -0.21852 0.62003 52 | # col(elev:forest) 0.3629 0.1822 0.00591 0.71994 53 | # col(elev:I(forest^2)) 0.4318 0.2128 0.01465 0.84887 54 | # col(I(elev^2):forest) 0.5789 0.2884 0.01368 1.14412 55 | # col(I(elev^2):I(forest^2)) -0.9509 0.2876 -1.51459 -0.38726 56 | # ext(year2001) -1.3218 0.5058 -2.31307 -0.33057 57 | # ext(year2002) -3.2547 0.7072 -4.64071 -1.86872 58 | # ... 59 | # ext(year2008) -9.9830 61.7477 -131.00622 111.04026 60 | # ext(year2009) -2.4937 0.4330 -3.34226 -1.64512 61 | # ext(year2010) -2.4372 0.5266 -3.46928 -1.40514 62 | # ext(year2011) -1.7589 0.4253 -2.59239 -0.92533 63 | # ext(elev) -1.9752 0.2615 -2.48781 -1.46257 64 | # ext(I(elev^2)) 1.1320 0.2998 0.54445 1.71959 65 | # ext(forest) 0.4192 0.2536 -0.07780 0.91622 66 | # ext(elev:forest) 0.8572 0.2235 0.41918 1.29519 67 | # ext(I(elev^2):forest) -1.3221 0.2844 -1.87960 -0.76469 68 | # p(year2001) -0.3512 0.1977 -0.73858 0.03622 69 | # p(year2002) -0.2137 0.1623 -0.53188 0.10452 70 | # ... 71 | # p(year2011) -0.7098 0.1449 -0.99376 -0.42582 72 | # p(year2012) 0.2540 0.1630 -0.06543 0.57334 73 | # p(elev) 0.4714 0.0774 0.31958 0.62316 74 | # p(forest) 0.6493 0.0790 0.49455 0.80403 75 | # p(I(forest^2)) -0.2784 0.0488 -0.37412 -0.18274 76 | # p(date) 0.0816 0.0440 -0.00465 0.16781 77 | # p(I(date^2)) 0.1135 0.0383 0.03839 0.18862 78 | # p(elev:forest) 0.4188 0.0674 0.28672 0.55079 79 | 80 | # ~~~~~~~~~~~ bonus code ~~~~~~~~~~~~~~~~~~~~ 81 | # Estimates accounting for a c-hat = 2.10 (with 95% CIs) 82 | tt <- list() 83 | tt[[1]] <- modavg(list(fm50), parm = '(Intercept)', c.hat = c.hat, 84 | parm.type = 'psi', warn=FALSE) 85 | tt[[2]] <- modavg(list(fm50), parm = 'elev', c.hat = c.hat, 86 | parm.type = 'psi', warn=FALSE) 87 | tt[[3]] <- modavg(list(fm50), parm = 'I(elev^2)', c.hat = c.hat, 88 | parm.type = 'psi', warn=FALSE) 89 | tt[[4]] <- modavg(list(fm50), parm = 'forest', c.hat = c.hat, 90 | parm.type = 'psi', warn=FALSE) 91 | tt[[5]] <- modavg(list(fm50), parm = 'I(forest^2)', c.hat = c.hat, 92 | parm.type = 'psi', warn=FALSE) 93 | tt[[6]] <- modavg(list(fm50), parm = 'elev:forest', c.hat = c.hat, 94 | parm.type = 'psi', warn=FALSE) 95 | tt[[7]] <- modavg(list(fm50), parm = 'elev:I(forest^2)', c.hat = c.hat, 96 | parm.type = 'psi', warn=FALSE) 97 | tt[[8]] <- modavg(list(fm50), parm = 'I(elev^2):forest', c.hat = c.hat, 98 | parm.type = 'psi', warn=FALSE) 99 | inflated.uncertainty <- array(NA, dim = c(8, 3), 100 | dimnames = list(NULL, c('SE(infl)', '95%LCL(infl)', '95%UCL(infl)'))) 101 | for(i in 1:8){ 102 | inflated.uncertainty[i, ] <- unlist(tt[[i]][c(4,6,7)]) 103 | } 104 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 105 | 106 | # Compare estimates side by side 107 | print(cbind(tmp[1:8,], inflated.uncertainty), 2) 108 | # MLE SE 0.025 0.975 SE(infl) 95%LCL(infl) 95%UCL(infl) 109 | # psi(Int) -0.079 0.38 -0.83 0.672 0.56 -1.17 1.01 110 | # psi(elev) 1.951 0.46 1.06 2.843 0.66 0.66 3.24 111 | # psi(I(elev^2)) -1.245 0.51 -2.24 -0.245 0.74 -2.69 0.20 112 | # psi(forest) -0.711 0.51 -1.71 0.289 0.74 -2.16 0.74 113 | # psi(I(forest^2)) 0.165 0.26 -0.35 0.678 0.38 -0.58 0.91 114 | # psi(elev:forest) 0.166 0.45 -0.72 1.051 0.65 -1.12 1.45 115 | # psi(elev:I(forest^2)) -0.781 0.35 -1.47 -0.087 0.51 -1.79 0.22 116 | # psi(I(elev^2):forest) 1.874 0.54 0.82 2.931 0.78 0.34 3.41 117 | 118 | -------------------------------------------------------------------------------- /AHM2_ch04/AHM2_04.09.7_#noCode.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 4 : MODELING SPECIES DISTRIBUTION AND RANGE DYNAMICS, AND POPULATION 6 | # DYNAMICS USING DYNAMIC OCCUPANCY MODELS 7 | # ============================================================================ 8 | 9 | # 4.9 Analysis and mapping of crossbill distribution and range dynamics in Switzerland 10 | # ==================================================================================== 11 | 12 | # 4.9.7 Brief comments on the analysis of distribution dynamics of Swiss crossbills 13 | # --------------------------------------------------------------------------- 14 | 15 | # no code 16 | 17 | -------------------------------------------------------------------------------- /AHM2_ch04/AHM2_04.10.3_#noCode.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 4 : MODELING SPECIES DISTRIBUTION AND RANGE DYNAMICS, AND POPULATION 6 | # DYNAMICS USING DYNAMIC OCCUPANCY MODELS 7 | # ============================================================================ 8 | # Code from proofs dated 2020-01-09 9 | 10 | # 4.10 Analysis of citizen-science data using occupancy models 11 | # ============================================================ 12 | 13 | # 4.10.3 Brief comments on the use of occupancy models for citizen-science data 14 | # ----------------------------------------------------------------------------- 15 | 16 | # no code -------------------------------------------------------------------------------- /AHM2_ch05/AHM2_05.2.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # 6 | # Chapter 5 : MODELING METACOMMUNITY DYNAMICS USING DYNAMIC COMMUNITY MODELS 7 | # ========================================================================== 8 | # Code from proofs dated 2020-08-19 9 | 10 | library(AHMbook) 11 | 12 | # 5.2 A general simulation function for the DCM model 13 | # =================================================== 14 | 15 | # Explicit defaults (need to load AHMbook) 16 | str(data <- simDCM(nspec = 50, nsites = 100, nsurveys = 3, nyears = 10, 17 | mean.psi1 = 0.4, sig.lpsi1 = 1, mu.beta.lpsi1 = 0, sig.beta.lpsi1 = 0, 18 | range.mean.phi = c(0.8, 0.8), sig.lphi = 1, mu.beta.lphi = 0, 19 | sig.beta.lphi = 0, range.mean.gamma = c(0.2, 0.2), sig.lgamma = 1, 20 | mu.beta.lgamma = 0, sig.beta.lgamma = 0, range.mean.p = c(0.5, 0.5), 21 | sig.lp = 1, mu.beta.lp = 0, sig.beta.lp = 0, range.beta1.survey = c(0, 0), 22 | range.beta2.survey = c(0, 0), trend.sd.site = c(0, 0), 23 | trend.sd.survey = c(0, 0), show.plot = TRUE) ) 24 | 25 | str(data <- simDCM(nspec = 200)) # More species (looks great) 26 | str(data <- simDCM(nspec = 1)) # A single species (works !) 27 | str(data <- simDCM(nsites = 267)) # More sites 28 | str(data <- simDCM(nsites = 1)) # A single site 29 | str(data <- simDCM(nsurveys = 10)) # More visits 30 | str(data <- simDCM(nyears = 25)) # More years 31 | str(data <- simDCM(nyears = 2)) # Just two years 32 | try(data <- simDCM(nyears = 1)) # A single year ... this crashes 33 | 34 | # No species heterogeneity in parameters of initial occupancy 35 | str(data <- simDCM(sig.lpsi1 = 0, sig.beta.lpsi1 = 0)) 36 | 37 | # No species heterogeneity in parameters of persistence 38 | str(data <- simDCM(sig.lphi = 0, sig.beta.lphi = 0)) 39 | 40 | # No species heterogeneity in parameters of colonization 41 | str(data <- simDCM(sig.lgamma = 0, sig.beta.lgamma = 0)) 42 | 43 | # No species heterogeneity in parameters of detection 44 | str(data <- simDCM(sig.lp = 0, sig.beta.lp = 0)) 45 | 46 | # No annual variation in rates phi, gamma and p 47 | str(data <- simDCM(range.mean.phi = c(0.8, 0.8), range.mean.gamma = c(0.3, 0.3), 48 | range.mean.p = c(0.6, 0.6))) 49 | 50 | 51 | set.seed(1) 52 | dat <- simDCM(nspec = 200, nsites = 20, nsurveys = 2, nyears = 10, 53 | mean.psi1 = 0.1, sig.lpsi1 = 5, 54 | range.mean.phi = c(0.3, 0.3), sig.lphi = 5, 55 | range.mean.gamma = c(0.1, 0.1), sig.lgamma = 5, 56 | range.mean.p = c(0.1, 0.1), sig.lp = 5) 57 | 58 | # ** Number of species ever occurring: 177 59 | # ** Number of species ever detected: 121 60 | # ** Average number of years of occurrence: 6.87 61 | # ** Average number of years with detection: 3.695 62 | 63 | # Pull out data from one year: you could now feed this data set 64 | # into a static community occupancy model analysis (Chapter 11 in AHM1) 65 | str(yyr1 <- dat$y[,,1,]) # Pull out year 1 as an example 66 | # int [1:20, 1:2, 1:200] 0 0 0 0 0 0 0 0 0 0 ... 67 | # - attr(*, "dimnames")=List of 3 68 | # ..$ : chr [1:20] "Site1" "Site2" "Site3" "Site4" ... 69 | # ..$ : chr [1:2] "Survey1" "Survey2" 70 | # ..$ : chr [1:200] "Spec1" "Spec2" "Spec3" "Spec4" ... 71 | 72 | # Pull out data for one species: you could now feed this data set 73 | # into a single-species dynocc model analysis (Chapter 4) 74 | str(ysp5 <- dat$y[,,,5]) # Pull out species 5 as an example 75 | # int [1:20, 1:2, 1:10] 0 0 0 0 0 0 0 0 0 0 ... 76 | # - attr(*, "dimnames")=List of 3 77 | # ..$ : chr [1:20] "Site1" "Site2" "Site3" "Site4" ... 78 | # ..$ : chr [1:2] "Survey1" "Survey2" 79 | # ..$ : chr [1:10] "Year1" "Year2" "Year3" "Year4" ... 80 | -------------------------------------------------------------------------------- /AHM2_ch05/AHM2_05.4.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # 6 | # Chapter 5 : MODELING METACOMMUNITY DYNAMICS USING DYNAMIC COMMUNITY MODELS 7 | # ========================================================================== 8 | # Code from proofs dated 2020-08-19 9 | 10 | library(AHMbook) 11 | 12 | # 5.4 Data formatting for the DCM: fun with multidimensional arrays 13 | # ================================================================= 14 | 15 | # Get a 4D array 16 | library(AHMbook) 17 | set.seed(123) 18 | tmp <- simDCM(show.plot = FALSE) 19 | BigArray <- tmp$y # Grab the 4D detection/nondetection array 20 | str(BigArray) # 100 sites x 3 visits x 10 years x 50 species 21 | 22 | # (1) Shoot holes, i.e., randomly turn 25% of the values into NAs 23 | length(BigArray) # 150k values 24 | out <- sample(1:length(BigArray), length(BigArray)/4) # Sample of 25% 25 | BigArray[out] <- NA # Turn them into NAs 26 | sum(is.na(BigArray)) # we now have 37500 NAs 27 | 28 | # (2) Turn data into vector and create indexing factors for the array dimensions 29 | df <- data.frame( 30 | y = c(BigArray), 31 | site = c(slice.index(BigArray, 1)), 32 | visit = c(slice.index(BigArray, 2)), 33 | year = c(slice.index(BigArray, 3)), 34 | species = c(slice.index(BigArray, 4)) ) 35 | View(df) ; summary(df) # Check the 'max.' for each column 36 | str(df) 37 | 38 | # (3) Toss out the rows with missing response 39 | df <- df[!is.na(df$y),] # Select rows with non-missing y only 40 | sum(is.na(df$y)) # Convince yourself NAs are gone 41 | head(df) # Look at first 6 rows in data frame 42 | # y site visit year species 43 | # 1 0 1 1 1 1 44 | # 3 0 3 1 1 1 45 | # 4 0 4 1 1 1 46 | # 6 0 6 1 1 1 47 | # 7 0 7 1 1 1 48 | # 8 0 8 1 1 1 49 | 50 | # (4) Format data in a spreadsheet format into a 4D array 51 | # Determine required dimensions of 4D array 52 | nsite <- length(unique(df$site)) # Number of sites 53 | nvisit <- length(unique(df$visit)) # Number of surveys or visits 54 | nyear <- length(unique(df$year)) # Number of years 55 | nspec <- length(unique(df$species)) # Number of species 56 | 57 | # Prepare array and pre-fill array with NAs 58 | BigArray2 <- array(NA, dim = c(nsite, nvisit, nyear, nspec)) 59 | 60 | # Fill array with the detection/nondetection data 61 | # Loop over all rows in the spreadsheet data and fill them in 62 | # at the right place in the 4D array 63 | for(i in 1:nrow(df)){ 64 | BigArray2[df$site[i], df$visit[i], df$year[i], df$species[i]] <- df$y[i] 65 | } 66 | 67 | # Do quick checks ... look good 68 | sum(df$y) ; sum(BigArray2, na.rm = TRUE) # quick sum check 69 | length(which(is.na(BigArray2))) # Same 37500 as before 70 | all.equal(BigArray, BigArray2, check.attributes=FALSE) # BigArray has names 71 | 72 | # Get a data set with detections only, no nondetections 73 | str(BigArray <- tmp$y) # Grab the 4D detection/nondetection array again 74 | df <- data.frame(y = c(BigArray), site = c(slice.index(BigArray, 1)), 75 | visit = c(slice.index(BigArray, 2)), year = c(slice.index(BigArray, 3)), 76 | species = c(slice.index(BigArray, 4)) ) # Turn into a spreadsheet format again 77 | df <- df[df$y == 1,] # Toss out all nondetection data 78 | 79 | # Prepare array by pre-filling it with zeroes instead of NAs 80 | BigArray3 <- array(0, dim = c(100, 3, 10, 50)) # known array dims ! 81 | 82 | # Fill array with the detection data 83 | for(i in 1:nrow(df)){ 84 | BigArray3[df$site[i], df$visit[i], df$year[i], df$species[i]] <- df$y[i] 85 | } 86 | sum(BigArray3) - nrow(df) # quick check they're identical 87 | 88 | # Reformat array so sites come last 89 | dim(BigArray3) # 100 3 10 50 90 | dim(BA.v2 <- aperm(BigArray3, c(2,3,4,1))) # 3 10 50 100 91 | -------------------------------------------------------------------------------- /AHM2_ch06/AHM2_06.2_#noCode.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # Chapter 6 : MULTISTATE OCCUPANCY MODELS 6 | # ======================================= 7 | # Code from proofs dated 2020-08-19 8 | 9 | # 6.2 Derivation of multistate occupancy models 10 | # ============================================= 11 | 12 | # no code 13 | 14 | -------------------------------------------------------------------------------- /AHM2_ch06/AHM2_06.4.1.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # 6 | # Chapter 6 : MULTISTATE OCCUPANCY MODELS 7 | # ======================================= 8 | # Code from proofs dated 2020-08-19 9 | 10 | library(jagsUI) 11 | 12 | # 6.4 Case study: Swiss eagle owls 13 | # ================================ 14 | 15 | # 6.4.1 Summarizing the Swiss eagle owl data set and preparation for modeling 16 | # --------------------------------------------------------------------------- 17 | 18 | # Read in the data 19 | library(AHMbook) 20 | data(SwissEagleOwls) 21 | str(dat <- SwissEagleOwls) 22 | 23 | # Append an index for site/year in 'obs' 24 | dat$obs$site.year <- paste(dat$obs$site_name, dat$obs$year, sep = '.') 25 | 26 | # Append a binary version of the detection data 27 | dat$obs$dnd <- as.numeric(dat$obs$y > 0) # Simple detection/nondetection 28 | table(dat$obs$dnd) 29 | 30 | # Create year covariate 31 | year <- 2007:2016 32 | 33 | # Look at frequency of four states in original detection data 34 | table(dat$obs$y) 35 | # 0 1 2 3 36 | # 2414 1977 635 948 37 | 38 | # Convert to three states: yms = 'y multi-state' 39 | dat$obs$yms <- dat$obs$y # Copy 40 | dat$obs$yms[dat$obs$yms == 3] <- 2 # Lump pairs: 0,1,2 41 | dat$obs$yms <- dat$obs$yms + 1 # Renumber observed states: 1,2,3 42 | table(dat$obs$yms) # Look at new response data 43 | # 1 2 3 44 | # 2414 1977 1583 45 | 46 | # Put detection data and survey dates into a 3D array 47 | (nsites <- nrow(dat$sites)) 48 | (nyears <- length(unique(dat$obs$year))) 49 | (nsurveys <- max(as.numeric(names(table(table(dat$obs$site.year)))))) 50 | sitelist <- sort(unique(dat$obs$site_name)) 51 | 52 | # Prepare three empty nsites x nreps x nyears arrays and then fill them all 53 | yms <- date <- y <- array(NA, dim = c(nsites, nsurveys, nyears), 54 | dimnames = list(sitelist, 1:nsurveys, 1:nyears)) 55 | for(i in 1:nsites){ 56 | for(t in 1:nyears){ 57 | sel.site.year <- paste(sitelist[i], t+2006, sep = '.') 58 | tmp <- dat$obs[dat$obs$site.year == sel.site.year,] 59 | nr <- nrow(tmp) 60 | if(nr > 0){ 61 | yms[i,1:nr,t] <- tmp$yms 62 | date[i,1:nr,t] <- tmp$jdate 63 | y[i,1:nr,t] <- tmp$dnd 64 | } 65 | } 66 | } 67 | sum(yms, na.rm = TRUE) ; sum(dat$obs$yms) # Sum checks ... all OK 68 | sum(date, na.rm = TRUE) ; sum(dat$obs$jdate) 69 | sum(y, na.rm = TRUE) ; sum(dat$obs$dnd) 70 | 71 | # Look at parts of these data (first 10 sites, 20 surveys, 3 years) 72 | yms[1:10,,1:3] # Multi-state detections 73 | date[1:10,,1:3] # Survey dates: these are NOT ordered ! 74 | y[1:10,,1:3] # Binary detection/nondetections 75 | 76 | # Compute number of sites visited at least once per season 77 | tmp <- apply(y, c(1,3), max, na.rm = TRUE) 78 | tmp[tmp == '-Inf'] <- NA ; tmp[tmp == 0] <- 1 79 | nvisit <- apply(tmp, 2, sum, na.rm = TRUE) 80 | 81 | # Compute the proportion of visited sites in all 10 years 82 | propvisit <- nvisit / nsites 83 | 84 | # Compute the observed number of occupied sites in all 10 years 85 | tmp <- apply(y, c(1,3), max, na.rm = TRUE) 86 | tmp[tmp == '-Inf'] <- NA 87 | obsnocc <- apply(tmp, 2, sum, na.rm = TRUE) 88 | 89 | # Compute the ratio estimator estimate of population size 90 | nratio <- obsnocc / propvisit 91 | 92 | # ~~~~~~~~~~ extra code for figure 6.4 ~~~~~~~~~~~~~~~~~~ 93 | # Plot number of visited sites and observed number of occupied sites 94 | ylim <- range(c(obsnocc, nratio)) 95 | op <- par(mar = c(5,6,3,3), cex.lab = 1.5, cex.axis = 1.5) 96 | plot(year, nvisit, type = 'b', pch = 1, main = '', xlab = 'Year', 97 | ylab = 'Number', col = 'black', las = 1, cex = 2, ylim = ylim, frame = FALSE) 98 | points(year, obsnocc, type = 'b', pch = 16, col = 'black', cex = 2) 99 | points(year, nratio, type = 'b', pch = 15, col = 'black', cex = 2) 100 | legend('bottomright', c('Ratio estimator of population size', 101 | 'Number of sites visited', 'Number of sites with Eagle owls detected'), 102 | pch = c(15, 1, 16), lwd = 1, cex = 1.5, bty = 'n') 103 | par(op) 104 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 105 | 106 | table(nvisit.site.year <- apply(y, c(1,3), function(x) sum(!is.na(x)))) 107 | # 0 1 2 3 4 5 6 7 8 9 10 108 | # 1457 414 189 146 107 82 57 46 41 25 26 109 | # 11 12 13 14 15 16 17 18 19 20 110 | # 19 15 13 10 10 10 7 6 6 54 111 | 112 | # Summarize yms by site and year 113 | tapply(dat$obs$yms, list(dat$obs$site_name, dat$obs$year), max) 114 | 115 | # Summarize multi-state detections (yms) by site 116 | # (example only shown for last year) 117 | # Table shows number of observations per observation states for each territory 118 | table(dat$obs$yms[dat$obs$year == 2016], dat$obs$site_name[dat$obs$year == 2016]) 119 | # 1 2 3 6 9 10 11 12 17 18 20 22 23 24 26 27 30 31 33 120 | # 1 3 0 3 3 1 1 4 4 0 0 3 0 0 1 1 2 4 5 1 121 | # 2 3 6 0 0 1 0 2 2 1 3 4 3 1 0 3 0 1 2 0 122 | # 3 2 1 1 0 0 0 1 1 4 1 8 0 0 0 1 0 0 0 4 123 | # [output truncated] 124 | 125 | # Compute proportion of missing values in the 3D reponse array 126 | (propNA <- sum(is.na(yms)) / prod(dim(yms))) 127 | # [1] 0.8909854 128 | 129 | # Compute nsurvey matrix: number of surveys per site/year 130 | nsurveys <- array(1, dim = c(274, 10)) # this is nsites x nyears 131 | for(i in 1:nsites){ 132 | for(t in 1:nyears){ 133 | tmp <- which(!is.na(yms[i,,t])) 134 | if(length(tmp) > 0){ 135 | nsurveys[i,t] <- max(tmp) 136 | } 137 | } 138 | } 139 | head(nsurveys) # Look at matrix (site x year) 140 | # [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] 141 | # [1,] 1 5 2 6 3 7 4 10 17 8 142 | # [2,] 1 1 1 6 1 2 5 3 4 7 143 | # [3,] 3 3 18 1 4 19 20 15 14 4 144 | # [4,] 1 1 1 1 1 1 1 5 1 3 145 | # [5,] 1 1 1 1 1 1 1 1 1 1 146 | # [6,] 1 10 8 8 6 4 4 1 2 2 147 | -------------------------------------------------------------------------------- /AHM2_ch06/AHM2_06.4.2.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # 6 | # Chapter 6 : MULTISTATE OCCUPANCY MODELS 7 | # ======================================= 8 | # Code from proofs dated 2020-08-19 9 | 10 | # Approximate time with full number of iterations: 14 mins 11 | 12 | library(jagsUI) 13 | 14 | # ~~~~~~~~~~~ need data preparation from 6.4.1 ~~~~~~~~~~~~~~~~~~ 15 | source("AHM2_06.4.1.R") 16 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 17 | 18 | # 6.4 Case study: Swiss eagle owls 19 | # ================================ 20 | 21 | # 6.4.2 Fitting the simplest possible dynamic multiseason model 22 | # ------------------------------------------------------------- 23 | 24 | # Summarize and bundle data 25 | str(bdata <- list(y = yms, nsites = dim(yms)[1], nsurveys = nsurveys, 26 | nyears = dim(yms)[3])) 27 | # List of 4 28 | # $ y : num [1:274, 1:20, 1:10] NA NA 1 NA NA NA NA 2 2 2 ... 29 | # $ nsites : int 274 30 | # $ nsurveys: num [1:274, 1:10] 1 1 3 1 1 1 1 20 12 20 ... 31 | # $ nyears : int 10 32 | 33 | # Specify model in BUGS language 34 | cat(file = "dynMS1.txt", " 35 | model { 36 | 37 | ### (1) Priors for parameters 38 | # State process priors 39 | # Priors for parameters in initial state vector (Omega) 40 | psi ~ dunif(0, 1) 41 | r ~ dunif(0, 1) 42 | 43 | # Priors for parameters in state transition matrix (PhiMat) 44 | for(s in 1:3){ 45 | phi[s] ~ dunif(0, 1) 46 | rho[s] ~ dunif(0, 1) 47 | } 48 | 49 | # Priors for parameters in observation process (Theta) 50 | p2 ~ dunif(0, 1) # Detection prob. when in state 2 51 | for (s in 1:3) { # Detection prob. when in state 3 52 | beta[s] ~ dgamma(1, 1) # Induce Dirichlet prior 53 | p3[s] <- beta[s] / sum(beta[]) 54 | } 55 | 56 | ### (2) Define relationships between basic model structure and parameters 57 | # Define initial state vector: Year 1 58 | Omega[1] <- 1 - psi # Prob. of non-occupation 59 | Omega[2] <- psi * (1-r) # Prob. of occ. by single bird 60 | Omega[3] <- psi * r # Prob. of occ. by pair 61 | 62 | # Define state transition probability matrix (PhiMat): years 2:nyears 63 | # Define probabilities of state S(t+1) given S(t) 64 | # For now, constant over sites and years 65 | # Note conditional Bernoulli parameterization of multinomial 66 | # Order of indices: Departing state, arrival state 67 | PhiMat[1,1] <- 1 - phi[1] 68 | PhiMat[1,2] <- phi[1] * (1 - rho[1]) 69 | PhiMat[1,3] <- phi[1] * rho[1] 70 | PhiMat[2,1] <- 1 - phi[2] 71 | PhiMat[2,2] <- phi[2] * (1 - rho[2]) 72 | PhiMat[2,3] <- phi[2] * rho[2] 73 | PhiMat[3,1] <- 1 - phi[3] 74 | PhiMat[3,2] <- phi[3] * (1 - rho[3]) 75 | PhiMat[3,3] <- phi[3] * rho[3] 76 | 77 | # Define observation probability matrix (Theta) 78 | # Order of indices: true state, observed state 79 | Theta[1,1] <- 1 80 | Theta[1,2] <- 0 81 | Theta[1,3] <- 0 82 | Theta[2,1] <- 1-p2 83 | Theta[2,2] <- p2 84 | Theta[2,3] <- 0 85 | Theta[3,1] <- p3[1] 86 | Theta[3,2] <- p3[2] 87 | Theta[3,3] <- p3[3] 88 | 89 | ### (3) Likelihood 90 | # Initial state: year 1 91 | for (i in 1:nsites){ 92 | z[i,1] ~ dcat(Omega[]) 93 | } 94 | 95 | # State transitions from yearly interval 1:(nyears-1) 96 | for (i in 1:nsites){ 97 | for(t in 1:(nyears-1)){ 98 | z[i,t+1] ~ dcat(PhiMat[z[i,t],]) 99 | } 100 | } 101 | 102 | # Observation equation 103 | for (i in 1:nsites){ 104 | for (t in 1:nyears){ 105 | for (j in 1:nsurveys[i,t]){ 106 | y[i,j,t] ~ dcat(Theta[z[i, t], ]) 107 | } 108 | } 109 | } 110 | 111 | ### (4) Derived quantities 112 | # Number of sites in each state per year 113 | for (t in 1:nyears){ 114 | for (i in 1:nsites){ 115 | state1[i,t] <- equals(z[i,t], 1) # Indicator for site in state 1 116 | state2[i,t] <- equals(z[i,t], 2) # ... state 2 117 | state3[i,t] <- equals(z[i,t], 3) # ... state 3 118 | } 119 | n.occ[t,1] <- sum(state1[,t]) # Number of unoccupied sites 120 | n.occ[t,2] <- sum(state2[,t]) # Number of sites with single birds 121 | n.occ[t,3] <- sum(state3[,t]) # Number of sites with pairs 122 | n.occ.total[t] <- n.occ[t,2] + n.occ[t, 3] # All occupied 123 | } 124 | } 125 | ") 126 | 127 | # Initial values (chosen to avoid data/model/init conflict) 128 | zst <- array(3, dim = c(bdata$nsites, bdata$nyears) ) 129 | inits <- function(){list(z = zst)} 130 | 131 | # Parameters monitored 132 | params <- c("psi", "r", "phi", "rho", "p2", "p3", "Omega", "PhiMat", 133 | "Theta", "n.occ", "n.occ.total") # Could add "z" 134 | 135 | # MCMC settings 136 | # na <- 1000 ; ni <- 10000 ; nt <- 5 ; nb <- 5000 ; nc <- 3 137 | na <- 1000 ; ni <- 1000 ; nt <- 1 ; nb <- 500 ; nc <- 3 # ~~~~ for testing, 2 mins 138 | 139 | # Call JAGS (ART 21 min), check convergence and summarize posteriors 140 | # odms stands for 'output dynamic multi-state' 141 | odms1 <- jags(bdata, inits, params, "dynMS1.txt", n.adapt = na, 142 | n.chains = nc, n.thin = nt, n.iter = ni, n.burnin = nb, parallel = TRUE) 143 | # par(mfrow = c(3,3)) # ~~~ no longer needed 144 | traceplot(odms1) 145 | print(odms1, 3) 146 | # mean sd 2.5% 50% 97.5% overlap0 f Rhat n.eff 147 | # psi 0.699 0.061 0.577 0.698 0.818 FALSE 1 1.001 3000 148 | # r 0.925 0.063 0.775 0.942 0.997 FALSE 1 1.001 1592 149 | # phi[1] 0.420 0.060 0.310 0.418 0.543 FALSE 1 1.002 2475 150 | # phi[2] 0.762 0.058 0.638 0.768 0.865 FALSE 1 1.001 1546 151 | # phi[3] 0.992 0.006 0.977 0.993 1.000 FALSE 1 1.004 619 152 | # rho[1] 0.087 0.061 0.005 0.077 0.231 FALSE 1 1.006 890 153 | # rho[2] 0.189 0.049 0.105 0.185 0.297 FALSE 1 1.003 1810 154 | # rho[3] 0.886 0.017 0.851 0.887 0.918 FALSE 1 1.002 778 155 | # p2 0.290 0.022 0.246 0.291 0.333 FALSE 1 1.001 2098 156 | # p3[1] 0.196 0.007 0.183 0.196 0.209 FALSE 1 1.001 1663 157 | # p3[2] 0.411 0.008 0.394 0.411 0.426 FALSE 1 1.000 3000 158 | # p3[3] 0.393 0.008 0.378 0.393 0.410 FALSE 1 1.001 1494 159 | # Omega[1] 0.301 0.061 0.182 0.302 0.423 FALSE 1 1.001 3000 160 | # Omega[2] 0.054 0.048 0.002 0.040 0.173 FALSE 1 1.001 1684 161 | # Omega[3] 0.645 0.057 0.528 0.647 0.749 FALSE 1 1.000 3000 162 | # [ ... output truncated ... ] 163 | 164 | round(odms1$mean$PhiMat, 2) # Transition probabilities 165 | # [,1] [,2] [,3] 166 | # [1,] 0.58 0.38 0.04 167 | # [2,] 0.24 0.62 0.14 168 | # [3,] 0.01 0.11 0.88 169 | 170 | round(odms1$mean$Theta, 2) # Observation probabilities 171 | # [,1] [,2] [,3] 172 | # [1,] 1.00 0.00 0.00 173 | # [2,] 0.71 0.29 0.00 174 | # [3,] 0.20 0.41 0.39 175 | -------------------------------------------------------------------------------- /AHM2_ch07/AHM2_07.2.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # 6 | # Chapter 7 : MODELING FALSE POSITIVES 7 | # ==================================== 8 | # Code from proofs dated 2020-08-19 9 | 10 | 11 | library(AHMbook) 12 | library(unmarked) 13 | library(AICcmodavg) 14 | 15 | # 7.2 Basic occupancy models with false positives 16 | # =============================================== 17 | 18 | # 7.2.1 Modeling unclassified false positives in unmarked 19 | # -------------------------------------------------------- 20 | 21 | # Simulation settings 22 | set.seed(1) # Initialize RNGs 23 | nsites <- 200 # number of sites (i = 1, ..., nsites=M) 24 | nsurveys <- 7 # number of visits (j = 1, ..., nsurveys=J) 25 | psi <- 0.6 # expected occupancy probability 26 | p <- 0.7 # detection probability (p_11) 27 | fp <- 0.05 # false-positive error probability (p_10) 28 | 29 | # Simulate occupancy states and encounter histories 30 | z <- rbinom(nsites, 1, psi) # occupancy states 31 | y <- matrix(NA, nrow = nsites, ncol = nsurveys) # empty matrix for detections 32 | for(i in 1:nsites){ 33 | pr_yequals1 <- p*z[i] + fp*(1 - z[i]) # p11 + p10 34 | y[i,] <- rbinom(nsurveys, 1, pr_yequals1) # realized observations 35 | } 36 | 37 | # Number of false-positive detections per occasion 38 | apply(y[z==0,]>0, 2, sum) 39 | # [1] 8 4 3 4 1 8 7 40 | 41 | # Number of false-negative detections per occasion 42 | apply(y[z==1,]==0, 2, sum) 43 | # [1] 39 32 33 39 44 34 42 44 | 45 | type <- c(0, 7, 0) 46 | 47 | # Build the unmarkedFrame 48 | library(unmarked) 49 | summary(umf <- unmarkedFrameOccuFP(y = y, type = type)) # not shown 50 | 51 | largerp11 <- qlogis(c(0.5, 0.7, 0.1)) 52 | largerp10 <- qlogis(c(0.5, 0.1, 0.7)) 53 | 54 | (m1 <- occuFP(detformula = ~1, # model for p_11 55 | FPformula = ~1, # model for p_10 56 | stateformula = ~1, # model for psi 57 | data = umf, # umarkedFrameOccuFP object 58 | starts = largerp11) ) # add p_10 < p_11 constraint 59 | 60 | # Occupancy (logit-scale): 61 | # Estimate SE z P(>|z|) 62 | # 0.323 0.15 2.15 0.0316 63 | 64 | # Detection (logit-scale): 65 | # Estimate SE z P(>|z|) 66 | # 0.762 0.083 9.18 4.32e-20 67 | 68 | # false positive (logit-scale): 69 | # Estimate SE z P(>|z|) 70 | # -2.69 0.199 -13.5 1.2e-41 71 | 72 | # AIC: 1550.633 73 | 74 | ( m2 <- occuFP(detformula = ~1, # model for p_11 75 | FPformula = ~1, # model for p_10 76 | stateformula = ~1, # model for psi 77 | data = umf, # umarkedFrameOccuFP object 78 | starts = largerp10) ) # add p_11 < p_10 constraint 79 | 80 | m1@AIC ; m2@AIC 81 | # [1] 1550.633 82 | # [1] 1550.633 83 | 84 | cbind("m1" = plogis( coef(m1) ), "m2" = plogis( coef(m2))) 85 | # m1 m2 86 | # psi(Int) 0.57997672 0.42001094 87 | # p(Int) 0.68185780 0.06352388 88 | # fp(Int) 0.06352318 0.68186426 89 | 90 | 91 | # 7.2.2 Case study: transience induced false positives in water voles 92 | # --------------------------------------------------------------------- 93 | 94 | # Look at the water vole data (in the AHMbook package) 95 | data(waterVoles) 96 | wv <- waterVoles 97 | head(wv, 3) 98 | # Patch y1 y2 y3 Year 99 | # 1 cla01 1 1 0 2009 100 | # 2 cla02 1 1 0 2009 101 | # 3 cla03 1 1 0 2009 102 | 103 | # Make the false-positive umf (note not all sites surveyed in each year) 104 | summary(wv.umf <- unmarkedFrameOccuFP(y = wv[,c("y1","y2","y3")], 105 | siteCovs = wv[,c("Year"), drop = FALSE], type = c(0, 3, 0)) ) # not shown 106 | 107 | # 'Means' parameterization of these models 108 | stvals <- list("null" = qlogis(c(0.5, 0.5, 0.5, 0.7, 0.1)), 109 | "p11.t" = qlogis(c(0.5, 0.5, 0.5, 0.7, 0.7, 0.7, 0.1)), 110 | "p10.t" = qlogis(c(0.5, 0.5, 0.5, 0.7, 0.1, 0.1, 0.1)), 111 | "both.t" = qlogis(c(0.5, 0.5, 0.5, 0.7, 0.7, 0.7, 0.1, 0.1, 0.1))) 112 | cand.mods <- list( 113 | "null" = occuFP(detformula = ~1, FPformula = ~1, 114 | stateformula = ~Year-1, data = wv.umf, starts = stvals$null), 115 | "p11.t" = occuFP(detformula = ~Year-1, FPformula = ~1, 116 | stateformula = ~Year-1, data = wv.umf, starts = stvals$p11.t), 117 | "p10.t" = occuFP(detformula = ~1, FPformula = ~Year-1, 118 | stateformula = ~Year-1, data = wv.umf, starts = stvals$p10.t), 119 | "both.t" = occuFP(detformula = ~Year-1, FPformula = ~Year-1, 120 | stateformula = ~Year-1, data = wv.umf, starts = stvals$both.t)) 121 | 122 | # ~~~ modSelFP is now deprecated, use the 'unmarked' functions instead ~~~ 123 | # (modTab <- modSelFP(cand.mods)) 124 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 125 | (modTab <- modSel(fitList(fits=cand.mods))) 126 | # nPars AIC dAIC AICwt cuWt 127 | # both.t 9 1054.35 0.00 0.99 0.99 128 | # p10.t 7 1063.29 8.94 0.01 1.00 129 | # p11.t 7 1073.17 18.82 0.00 1.00 130 | # null 5 1073.30 18.95 0.00 1.00 131 | 132 | library(AICcmodavg) 133 | aictab(cand.mods) 134 | # K AICc Delta_AICc AICcWt Cum.Wt LL 135 | # both.t 9 1054.93 0.00 0.99 0.99 -518.18 136 | # p10.t 7 1063.65 8.72 0.01 1.00 -524.65 137 | # null 5 1073.49 18.56 0.00 1.00 -531.65 138 | # p11.t 7 1073.53 18.60 0.00 1.00 -529.58 139 | 140 | # Select the AIC-top model 141 | topmod <- cand.mods$both.t 142 | 143 | # Values for prediction 144 | pred.df <- data.frame(Year = factor(c(2009, 2010, 2011))) 145 | 146 | # Predict 147 | p1 <- predict(topmod, type = "det", newdata = pred.df) 148 | p2 <- predict(topmod, type = "fp", newdata = pred.df) 149 | p3 <- predict(topmod, type = "state", newdata = pred.df) 150 | 151 | # Create a data frame of predictions 152 | preds <- rbind(p1, p2, p3) 153 | preds$Type <- rep(factor(c("Detection", "False Positive", "Occupancy")), each=3) 154 | preds$Year <- rep(c("2009", "2010", "2011"), times=3) # produce estimates for Fig. 7.2 155 | 156 | # ~~~~~ extra code for Fig 7.2 ~~~~~~~~~~~~ 157 | years <- 2009:2011 158 | op <- par(mfrow = c(1,3)) 159 | plot(years, p1[,1], xlab = "Year", ylab = "p", type = "b", pch = 20, 160 | cex = 3, ylim = c(0, 1), cex.lab = 2, frame = FALSE, xaxt="n") 161 | segments(x0 = years, y0 = p1[,1] - 1.96*p1[,2], x1 = years, 162 | y1 = p1[,1] + 1.96*p1[,2]) 163 | title("Detection probability", cex.main = 2) 164 | axis(1, at=years) 165 | plot(years, p2[,1], xlab = "Year", ylab = "fp", type = "b", pch = 20, 166 | cex = 3, ylim = c(0,1), cex.lab = 2, frame = FALSE, xaxt="n") 167 | segments(x0 = years, y0 = p2[,1] - 1.96*p2[,2], x1 = years, 168 | y1 = p2[,1] + 1.96*p2[,2]) 169 | title("False positive probability", cex.main = 2) 170 | axis(1, at=years) 171 | plot(years, p3[,1], xlab = "Year", ylab = "psi", type = "b", pch = 20, 172 | cex = 3, ylim = c(0,1), cex.lab = 2, frame = FALSE, xaxt="n") 173 | segments(x0 = years, y0 = p3[,1] - 1.96*p3[,2], x1 = years, 174 | y1 = p3[,1] + 1.96*p3[,2]) 175 | title("Occupancy probability", cex.main = 2) 176 | axis(1, at=years) 177 | par(op) 178 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 179 | -------------------------------------------------------------------------------- /AHM2_ch07/AHM2_07.4.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # 6 | # Chapter 7 : MODELING FALSE POSITIVES 7 | # ==================================== 8 | # Code from proofs dated 2020-08-19 9 | 10 | library(unmarked) 11 | 12 | # 7.4 Modeling classified false positive detections: 13 | # 'multi-state design' of Miller et al. (2011) 14 | # ================================================ 15 | 16 | # 7.4.1 Modeling classified false positives in unmarked 17 | # ------------------------------------------------------ 18 | 19 | # Set parameter values of the simulation 20 | set.seed(129) # RNG seed 21 | nsites <- 200 # number of sites 22 | nsurveys1 <- 3 # number of occasions with Type 1 data 23 | nsurveys2 <- 4 # number of occasions with Type 2 data 24 | psi <- 0.6 # expected proportion of are occupied 25 | p <- c(0.7,0.5) # detection prob of method 1 and method 2 26 | fp <- 0.05 # false-positive error probability (p_10) 27 | b <- 0.2 # probability y is recorded as certain 28 | 29 | # Simulate the occupancy states and data 30 | z <- rbinom(nsites, 1, psi) 31 | y <- matrix(NA, nrow = nsites, ncol = nsurveys1 + nsurveys2) 32 | for(i in 1:nsites){ 33 | p1 <- p[1]*z[i] # certainly detection (method 1) 34 | p2 <- p[2]*z[i] + fp*(1-z[i]) # uncertainly detection (method 2) 35 | y[i,1:3] <- rbinom(nsurveys1, 1, p1) # simulate method 1 data 36 | y[i,4:7] <- rbinom(nsurveys2, 1, p2) # simulate method 2 data 37 | # Now introduce certain observations: 38 | pr.certain <- z[i] * y[i,4:7] * b 39 | y[i, 4:7] <- y[i, 4:7] + rbinom(4, 1, pr.certain) 40 | } 41 | 42 | # Make a covariate to distinguish between the two methods 43 | Method <- matrix(c(rep("1", 3), rep("2", 4)), nrow = nsites, 44 | ncol = nsurveys1 + nsurveys2, byrow = TRUE) 45 | 46 | type <- c(nsurveys1, 0, nsurveys2) 47 | 48 | summary(umf2 <- unmarkedFrameOccuFP(y = y, obsCovs = list(Method = Method), 49 | type = type)) # not printed 50 | (m2 <- occuFP(detformula = ~ -1 + Method, FPformula = ~ 1, Bformula = ~ 1, 51 | stateformula = ~ 1, data = umf2) ) 52 | 53 | # Occupancy: 54 | # Estimate SE z P(>|z|) 55 | # 0.553 0.148 3.73 0.000192 56 | 57 | # Detection: 58 | # Estimate SE z P(>|z|) 59 | # Method1 1.1176 0.1225 9.12 7.37e-20 60 | # Method2 0.0268 0.0891 0.30 7.64e-01 61 | 62 | # false positive: 63 | # Estimate SE z P(>|z|) 64 | # -3.27 0.331 -9.88 5.26e-23 65 | 66 | # Pcertain: 67 | # Estimate SE z P(>|z|) 68 | # -1.47 0.16 -9.2 3.75e-20 69 | 70 | # AIC: 1734.899 71 | 72 | # Coefficients on the link (= "beta") scale 73 | coef(m2) 74 | # psi(Int) p(Int) p(Method2) fp(Int) b(Int) 75 | # 0.5529142 1.1177836 -1.0912711 -3.2700680 -1.4721436 76 | 77 | # Coefficients on the probability (="real") scale 78 | pred.df <- data.frame(Method = c("1", "2")) 79 | round(rbind( 80 | "det" = predict(m2, type = 'det', newdata = pred.df), 81 | "fp" = predict(m2, type = 'fp', newdata = pred.df[1,,drop=FALSE]), 82 | "b" = predict(m2, type = 'b', newdata = pred.df[1,,drop=FALSE]), 83 | "state" = predict(m2, type = 'state', newdata = pred.df[1,,drop=FALSE])),3) 84 | # Predicted SE lower upper 85 | # det.1 0.754 0.023 0.706 0.795 86 | # det.2 0.507 0.022 0.463 0.550 87 | # fp 0.037 0.012 0.019 0.068 88 | # b 0.187 0.024 0.144 0.239 89 | # state 0.635 0.034 0.565 0.699 90 | 91 | 92 | # 7.4.2. A general multi-type model with covariates 93 | # ------------------------------------------------- 94 | 95 | # Simulation settings 96 | set.seed(2019) # RNG seed 97 | nsites <- 200 # number of sites 98 | nsurveys <- 7 # number of occasions 99 | habitat <- rnorm(nsites) # Some (continuous) habitat descriptor 100 | 101 | # Simulate the occupancy states and data 102 | alpha0 <- 0 # Intercept... 103 | alpha1 <- 1 # ... and slope of psi-habitat regression 104 | psi <- plogis(alpha0 + alpha1*habitat) # Occupancy 105 | z <- rbinom(nsites, 1, psi) # Latent p/a states 106 | y <- matrix(0,nsites, nsurveys) 107 | p <- c(0.7, 0.5) # method 2 will have a lower p 108 | b <- 0.5 # probability that a observed positive is determined to be certain 109 | fp <- 0.05 # False-positive prob. 110 | 111 | # Simulate data of all 3 types. Note p differs between occ 1-2 and 3-7. 112 | # False positives occur in occasions 3-7 but in occasion 7 there are some 113 | # confirmed positives 114 | for(i in 1:nsites){ 115 | # Normal occupancy data 116 | y[i, 1:2] <- rbinom(2, 1, p[1]*z[i]) 117 | # False-positives mixed in 118 | y[i, 3:6] <- rbinom(4, 1, p[2]*z[i] + fp*(1-z[i])) 119 | # Type 3 observations are occupancy data contaminated with false 120 | # positives but then we identify some of them as true 121 | y[i, 7] <- rbinom(1, 1, p[2]*z[i] + fp*(1-z[i])) 122 | } 123 | 124 | # Next we set some of the detections to confirmed positives 125 | true.positives <- z==1 & y[,7]==1 126 | confirmed <- (rbinom(nsites, 1, b) == 1) & true.positives 127 | y[confirmed, 7] <- 2 128 | 129 | # Make a covariate to distinguish between the two methods 130 | Method <- matrix(c(rep("1", 2), rep("2", 5)), nrow = nsites, ncol = 7, 131 | byrow = TRUE) 132 | 133 | # Type indicates a mix of all 3 data types 134 | type <- c(2, 4, 1) 135 | 136 | # Same covariate structure as before 137 | siteCovs <- data.frame(habitat = habitat) 138 | obsCovs <- list(Method = Method) 139 | summary(umf1 <- unmarkedFrameOccuFP(y, siteCovs = siteCovs, obsCovs = obsCovs, 140 | type = type)) # not shown 141 | 142 | # fp starting value should be small (-1 here). 143 | # Note: last parameter in this model is "Pcertain" 144 | ( m3 <- occuFP(detformula = ~ -1 + Method, FPformula = ~1, Bformula = ~1, 145 | stateformula = ~ habitat, data = umf1, starts=c(0, 0, 0, 0, -1, 0)) ) 146 | 147 | # Occupancy: 148 | # Estimate SE z P(>|z|) 149 | # (Intercept) -0.0813 0.160 -0.509 6.11e-01 150 | # habitat 0.9495 0.198 4.791 1.66e-06 151 | # 152 | # Detection: 153 | # Estimate SE z P(>|z|) 154 | # Method1 0.9751 0.1802 5.412 6.22e-08 155 | # Method2 0.0155 0.0954 0.163 8.71e-01 156 | # 157 | # false positive: 158 | # Estimate SE z P(>|z|) 159 | # -2.86 0.207 -13.8 1.29e-43 160 | # 161 | # Pcertain: 162 | # Estimate SE z P(>|z|) 163 | # 0.0388 0.292 0.133 0.894 164 | 165 | (m3b <- occuFP(detformula = ~-1 + Method, FPformula = ~1, Bformula = ~ habitat, 166 | stateformula = ~ habitat, data = umf1, starts = c(0, 0, 0, 0, - 1, 0, 0)) ) 167 | -------------------------------------------------------------------------------- /AHM2_ch07/AHM2_07.5.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # 6 | # Chapter 7 : MODELING FALSE POSITIVES 7 | # ==================================== 8 | # Code from proofs dated 2020-08-19 9 | library(unmarked) 10 | library(jagsUI) 11 | 12 | # 7.5 Bayesian analysis of models with false positives in JAGS 13 | # ============================================================= 14 | 15 | # Random seed and simulation settings 16 | set.seed(129, kind = "Mersenne") 17 | nsites <- 200 # number of sites (i = 1, ..., M) 18 | nsurveys <- 7 # number of visits (k = 1, ..., J) 19 | psi <- 0.6 # expected psi 20 | p <- 0.7 # detection probability (p_11) 21 | fp <- 0.05 # false positive error probability (p_10) 22 | 23 | # Simulate the latent states and the data 24 | z <- matrix(NA, nrow = nsites, ncol = 1) # empty matrix for occ states 25 | z[1:nsites] <- rbinom(nsites, 1, psi) # occupancy states 26 | y <- matrix(NA, nrow = nsites, ncol = nsurveys) # empty matrix for det. 27 | for(i in 1:nsites){ 28 | pr_yequals1 <- p*z[i] + fp*(1-z[i]) # p11 + p10 29 | y[i,] <- rbinom(nsurveys, 1, pr_yequals1) # realized observations 30 | } 31 | 32 | # Bundle data and summarize data bundle 33 | str( bdata <- list(y = y, nsites = nrow(y), nsurveys = ncol(y)) ) 34 | 35 | # Specify model in BUGS language 36 | cat(file = "occufp.txt"," 37 | model { 38 | 39 | # Priors 40 | psi ~ dunif(0, 1) 41 | p ~ dunif(0, 1) 42 | fp ~ dunif(0, 1) 43 | 44 | # Likelihood and process model 45 | for (i in 1:nsites) { # Loop over sites 46 | z[i] ~ dbern(psi) # State model 47 | for (j in 1:nsurveys) { # Loop over replicate surveys 48 | y[i,j] ~ dbern(z[i]*p + (1-z[i])*fp) # Observation model 49 | } 50 | } 51 | } 52 | ") 53 | 54 | # Initial values 55 | zst <- apply(y, 1, max) 56 | inits <- function(){list(z = zst, p = 0.7, fp = 0.05)} 57 | 58 | # Parameters monitored 59 | params <- c("psi", "p", "fp") 60 | 61 | # MCMC settings 62 | na <- 1000 ; ni <- 5000 ; nt <- 1 ; nb <- 1000 ; nc <- 3 63 | 64 | # Call JAGS (ART <1 min), assess convergence and summarize posteriors 65 | out1 <- jags(bdata, inits, params, "occufp.txt", n.adapt = na, 66 | n.chains = nc,n.thin = nt, n.iter = ni, n.burnin = nb, parallel = TRUE) 67 | # par(mfrow = c(2, 2)) # ~~~ replaced with 'layout' argument 68 | traceplot(out1, layout=c(2,2)) 69 | print(out1, 3) 70 | # mean sd 2.5% 50% 97.5% overlap0 f Rhat n.eff 71 | # psi 0.614 0.036 0.543 0.614 0.684 FALSE 1 1 12000 72 | # p 0.718 0.017 0.684 0.718 0.750 FALSE 1 1 5606 73 | # fp 0.057 0.012 0.035 0.057 0.082 FALSE 1 1 9407 74 | 75 | # With both Type 1 and Type 3 data, i.e., what they call 76 | # the "multiple detection states design" 77 | # '''''''''''''''''''''''''''''''''''''''''''''''''''''' 78 | 79 | # Random seed and simulation settings 80 | set.seed(129) # RNG seed 81 | nsites <- 200 # number of sites 82 | nsurv1 <- 3 # number of occasions with Type 1 data 83 | nsurv2 <- 4 # number of occasions with Type 3 data 84 | psi <- 0.6 # expected proportion of are occupied 85 | p <- c(0.7, 0.5) # detection prob of method 1 and method 2 86 | fp <- 0.05 # false-positive error probability (p_10) 87 | b <- 0.2 # probability y is recorded as certain 88 | 89 | # Simulate the latent states and the data 90 | z <- rbinom(nsites, 1, psi) 91 | y <- matrix(NA, nrow = nsites, ncol = nsurv1 + nsurv2) 92 | for(i in 1:nsites){ 93 | p1 <- p[1]*z[i] # certainly detection (method 1) 94 | p2 <- p[2]*z[i] + fp*(1-z[i]) # uncertainly detection (method 2) 95 | y[i,1:3] <- rbinom(nsurv1, 1, p1) # simulate method 1 data 96 | y[i,4:7] <- rbinom(nsurv2, 1, p2) # simulate method 2 data 97 | # now introduce certain observations: 98 | pr.certain <- z[i] * y[i,4:7] * b 99 | y[i, 4:7] <- y[i, 4:7] + rbinom(4, 1, pr.certain) 100 | } 101 | head(y) # Look at data to understand them ! 102 | 103 | # Define a covariate for method 104 | Method <- matrix(c(rep("1", 3), rep("2", 4)), nrow = nsites, 105 | ncol = nsurv1 + nsurv2, byrow = TRUE) 106 | head(Method) 107 | 108 | # Make data categorical so non-detection = 1, certain detection = 3 109 | y[, nsurv2:(nsurv1 + nsurv2)] <- 1 + y[,nsurv2:(nsurv1 + nsurv2)] 110 | 111 | # Bundle data and summarize data bundle (not shown) 112 | str(bdata <- list(y = y, nsites = nrow(y), nsurv1 = nsurv1, nsurv2 = nsurv2)) 113 | 114 | # Specify model in BUGS language 115 | cat(file = "occufp2.txt"," 116 | model { 117 | 118 | # Priors 119 | psi ~ dunif(0, 1) 120 | fp ~ dunif(0, 1) 121 | b ~ dunif(0, 1) 122 | alpha0 ~ dnorm(0,0.01) 123 | alpha1 ~ dnorm(0,0.01) # Method effect 124 | 125 | # Likelihood and process model 126 | for (i in 1:nsites) { # Loop over sites 127 | z[i] ~ dbern(psi) # State model 128 | # Define observation matrix (obsmat) 129 | for(j in 1:(nsurv1+nsurv2)) { 130 | obsmat[i,j,1,1] <- 1-fp # z = 0 obs probs 131 | obsmat[i,j,2,1] <- fp 132 | obsmat[i,j,3,1] <- 0 133 | obsmat[i,j,1,2] <- 1-p[i,j] # z = 1 obs probs 134 | obsmat[i,j,2,2] <- (1-b)*p[i,j] 135 | obsmat[i,j,3,2] <- p[i,j]*b 136 | } 137 | # Observation model: part 1 (for first 3 cols in y) 138 | for(j in 1:nsurv1) { # Loop over replicate surveys 139 | logit(p[i,j]) <- alpha0 140 | y[i,j] ~ dbern(z[i]*p[i,j] ) # ordinary occupancy data 141 | } 142 | # Observation model: part 2 (for last 4 cols in y) 143 | for (j in (nsurv1+1):(nsurv1+nsurv2)) { # Loop over replicates 144 | logit(p[i,j]) <- alpha0 + alpha1 145 | y[i,j] ~ dcat(obsmat[i,j,1:3,z[i]+1] ) 146 | } 147 | } 148 | } 149 | ") 150 | 151 | # Initial values 152 | zst <- apply(y[, 1:nsurv1], 1, max) 153 | inits <- function(){list(z = zst, alpha0 = rnorm(1, -1, 1), 154 | alpha1 = rnorm(1, 0, 1), fp = 0.05, b = 0.1)} 155 | 156 | # Parameters monitored 157 | params <- c("psi", "alpha0", "alpha1", "fp", "b") 158 | 159 | # MCMC settings 160 | na <- 1000 ; ni <- 5000 ; nt <- 1 ; nb <- 1000 ; nc <- 3 161 | 162 | # Call JAGS (ART 1 min), assess convergence and summarize posteriors 163 | out2 <- jags(bdata, inits, params, "occufp2.txt", n.adapt = na, 164 | n.chains = nc, n.thin = nt, n.iter = ni, n.burnin = nb, parallel = TRUE) 165 | # par(mfrow = c(2, 3)) # ~~~ replaced with 'layout' argument 166 | traceplot(out2, layout=c(2,3)) 167 | print(out2, 3) 168 | # mean sd 2.5% 50% 97.5% overlap0 f Rhat n.eff 169 | # psi 0.633 0.034 0.566 0.634 0.699 FALSE 1 1.000 5589 170 | # alpha0 1.121 0.125 0.879 1.120 1.371 FALSE 1 1.001 3616 171 | # alpha1 -1.095 0.154 -1.397 -1.094 -0.794 FALSE 1 1.000 5442 172 | # fp 0.040 0.012 0.019 0.039 0.065 FALSE 1 1.000 8842 173 | # b 0.189 0.025 0.143 0.189 0.238 FALSE 1 1.001 4655 174 | -------------------------------------------------------------------------------- /AHM2_ch07/AHM2_07.8_#no_code.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # 6 | # Chapter 7 : MODELING FALSE POSITIVES 7 | # ==================================== 8 | # Code from proofs dated 2020-08-19 9 | 10 | 11 | # 7.8 Multispecies mis-classification models 12 | # ========================================== 13 | 14 | # (no code) 15 | -------------------------------------------------------------------------------- /AHM2_ch09/AHM2_09.2.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # 6 | # Chapter 9 : SPATIAL MODELS OF DISTRIBUTION AND ABUNDANCE 7 | # ======================================================== 8 | # Code from proofs dated 2020-08-19 9 | 10 | if(!requireNamespace("RandomFields")) 11 | stop("Package 'RandomFields' is not available.") 12 | 13 | library(AHMbook) 14 | 15 | # 9.2 Data simulation for spatial N-mixture and occupancy models 16 | # ============================================================== 17 | 18 | library(AHMbook) 19 | ? simExpCorrRF 20 | str(dat <- simExpCorrRF(variance = 1, theta = 1, size = 50, seed = 1)) 21 | 22 | str(tmp <- simExpCorrRF(theta = 0.0001, size = 200)) 23 | str(tmp <- simExpCorrRF(theta = 1, size = 200)) 24 | str(tmp <- simExpCorrRF(theta = 5, size = 200)) 25 | str(tmp <- simExpCorrRF(theta = 10, size = 200)) 26 | str(tmp <- simExpCorrRF(theta = 100, size = 200)) 27 | str(tmp <- simExpCorrRF(theta = 10000, size = 200)) # cool patterns ! 28 | 29 | data(BerneseOberland) 30 | head(bo <- BerneseOberland) 31 | str(bo) 32 | 33 | # ~~~~ extra code for figure 9.1 ~~~~~~~~~~ 34 | library(raster) 35 | op <- par(mfrow = c(1, 2), mar = c(3,3,3,5), cex.main = 2, cex.axis = 1.5) 36 | r1 <- rasterFromXYZ(data.frame(x = bo$x, y = bo$y, z = bo$elevation)) 37 | plot(r1, col = topo.colors(100), axes = FALSE, box = FALSE, 38 | main = "Elevation (m a.s.l.)", zlim = c(0, 3000)) 39 | r1 <- rasterFromXYZ(data.frame(x = bo$x, y = bo$y, z = bo$forest)) 40 | plot(r1, col = topo.colors(100), axes = FALSE, box = FALSE, 41 | main = "Forest cover (%)", zlim = c(0, 100)) 42 | par(op) 43 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 44 | 45 | # Create Gaussian random field 46 | set.seed(10) # Fig. 9.2 47 | s <- simExpCorrRF(theta = 10, size = 50) 48 | 49 | # Choose sample sizes: 2500 sites and 3 surveys 50 | nsites <- 2500 # Number of sites (corresponding to our 50 by 50 grid) 51 | nreps <- 3 # Number of replicate observations 52 | 53 | # Scale the real Bernese Oberland covariates 54 | elev <- standardize(bo$elevation) 55 | forest <- standardize(bo$forest) 56 | 57 | # Ecological process 58 | beta0 <- 2 # Abundance model: intercept 59 | beta1 <- 2 # Linear effect of elevation: positive 60 | beta2 <- -2 # Quadratic effect of elevation: negative 61 | loglam0 <- beta0 + beta1 * elev + beta2 * elev^2 62 | loglam <- beta0 + beta1 * elev + beta2 * elev^2 + c(s$field) 63 | lam0 <- exp(loglam0) # without spatial autocorrelation 64 | lam <- exp(loglam) # with spatial autocorrelation 65 | 66 | # ~~~~ extra code for figure 9.3 ~~~~ 67 | # Plot expected counts (lambda) as a function of covariates only, 68 | # i.e., excluding spatial field, and including spatial field (Fig. 20-4) 69 | op <- par(mfrow = c(1,2), mar = c(5,8,5,2), cex.lab = 1.5) 70 | plot(bo$elevation, lam0, cex = 1, pch = 16, xlab = "Elevation", 71 | ylab = "Expected counts (lambda)", main = "Excluding spatial field", 72 | frame = FALSE, col = rgb(0, 0, 0, 0.3)) 73 | plot(bo$elevation, lam, cex = 1, pch = 16, xlab = "Elevation", 74 | ylab = "Expected counts (lambda)", main = "Including spatial field", 75 | frame = FALSE, col = rgb(0, 0, 0, 0.3)) 76 | par(op) 77 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 78 | 79 | # Determine actual abundances as Poisson random variables with parameter lam 80 | N <- rpois(n = nsites, lambda = lam) 81 | table(N) # Distribution of abundances across sites 82 | sum(N > 0) / nsites # Finite-sample occupancy 83 | (totalN <- sum(N)) # Total population size in all 2500 sites 84 | 85 | # Create wind speed observational covariate 86 | wind <- matrix(rnorm(nsites*nreps), nrow = nsites, ncol = nreps) 87 | 88 | # Observation process 89 | alpha0 <- 0 # logit-linear intercept 90 | alpha1 <- -1 # slope on forest 91 | alpha2 <- -1 # slope on wind speed 92 | p <- array(NA, dim = c(nsites, nreps)) 93 | for(j in 1:nreps){ 94 | p[,j] <- plogis(alpha0 + alpha1 * forest + alpha2 * wind[,j]) 95 | } 96 | 97 | # Count things 98 | y <- array(dim = c(nsites, nreps)) # Array for counts 99 | for (j in 1:nreps){ 100 | y[,j] <- rbinom(n = nsites, size = N, prob = p[,j]) 101 | } 102 | str(y) 103 | # int [1:2500, 1:3] 1 0 0 0 0 0 0 3 0 0 ... 104 | summary(N) 105 | summary(c(y)) 106 | # Min. 1st Qu. Median Mean 3rd Qu. Max. 107 | # 0.000 0.000 1.000 2.877 3.000 66.000 108 | # Min. 1st Qu. Median Mean 3rd Qu. Max. 109 | # 0.000 0.000 0.000 1.174 1.000 49.000 110 | 111 | # Compare true and observed total abundance 112 | (true <- totalN) # True 113 | (obs <- sum(apply(y, 1, max))) # Observed 114 | cat("Underestimation of total abundance:", round(100*(1-obs/true)), "%\n") 115 | # [1] 7192 116 | # [1] 4371 117 | # Underestimation of total abundance: 39 % 118 | 119 | # Select a sample of sites for surveys 120 | # set.seed(100) 121 | set.seed(100, sample.kind = "Rounding") 122 | sample.size <- 500 123 | sample.sites <- sort(sample(1:nsites, size = sample.size)) 124 | 125 | # ~~~~ extra code for figure 9.4 ~~~~ 126 | op <- par(mfrow = c(1,3), mar = c(3,3,3,6)) 127 | r <- rasterFromXYZ(data.frame(x = bo$x, y = bo$y, z = N)) 128 | plot(r, col = topo.colors(20), axes = FALSE, box = FALSE, 129 | main = "Abundance (N, truncated at 6)", zlim = c(0, 6)) 130 | r <- rasterFromXYZ(data.frame(x = bo$x, y = bo$y, z = apply(p, 1, mean))) 131 | plot(r, col = topo.colors(20), axes = FALSE, box = FALSE, 132 | main = "Average detection probability") 133 | r <- rasterFromXYZ(data.frame(x = bo$x, y = bo$y, z = apply(y, 1, max))) 134 | plot(r, col = topo.colors(20), axes = FALSE, box = FALSE, 135 | main = "Max count (truncated at 6)", zlim = c(0, 6)) 136 | par(op) 137 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 138 | 139 | yobs <- y # Make a copy 140 | yobs[-sample.sites,] <- NA # Turn counts of unsurveyed sites into NAs 141 | head(sample.sites) # Look at the simulated data set 142 | head(yobs) 143 | 144 | simNmixSpatial(nsurveys = 3, mean.lambda = exp(2), beta = c(2, -2), 145 | mean.p = 0.5, alpha = c(-1, -1), sample.size = 500, variance.RF = 1, 146 | theta.RF = 10, seeds = c(10, 100), truncN = 6, show.plots = TRUE) 147 | 148 | simOccSpatial(nsurveys = 3, mean.psi = 0.6, beta = c(2, -2), 149 | mean.p = 0.4, alpha = c(-1, -1), sample.size = 500, variance.RF = 1, 150 | theta.RF = 10, seeds = c(10, 100), show.plots = TRUE) 151 | -------------------------------------------------------------------------------- /AHM2_ch09/AHM2_09.2.R_without_RandomFields.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # 6 | # Chapter 9 : SPATIAL MODELS OF DISTRIBUTION AND ABUNDANCE 7 | # ======================================================== 8 | 9 | # The code below is modified to run without the RandomFields package; if 10 | # RandomFields is available, it will be used by AHMbook, and the results should 11 | # be the same. 12 | # When RandomFields is not available, the 'fields' package is used instead, and 13 | # the results will be different. 14 | if(requireNamespace("RandomFields")) 15 | stop("Package 'RandomFields' IS available; this script is not needed.") 16 | 17 | library(AHMbook) 18 | 19 | # 9.2 Data simulation for spatial N-mixture and occupancy models 20 | # ============================================================== 21 | 22 | library(AHMbook) 23 | ? simExpCorrRF 24 | str(dat <- simExpCorrRF(variance = 1, theta = 1, size = 50, seed = 1)) 25 | 26 | str(tmp <- simExpCorrRF(theta = 0.0001, size = 200)) 27 | str(tmp <- simExpCorrRF(theta = 1, size = 200)) 28 | str(tmp <- simExpCorrRF(theta = 5, size = 200)) 29 | str(tmp <- simExpCorrRF(theta = 10, size = 200)) 30 | try(str(tmp <- simExpCorrRF(theta = 100, size = 200))) # fails 31 | try(str(tmp <- simExpCorrRF(theta = 10000, size = 200))) # fails 32 | 33 | data(BerneseOberland) 34 | head(bo <- BerneseOberland) 35 | str(bo) 36 | 37 | # ~~~~ extra code for figure 9.1 ~~~~~~~~~~ 38 | library(raster) 39 | op <- par(mfrow = c(1, 2), mar = c(3,3,3,5), cex.main = 2, cex.axis = 1.5) 40 | r1 <- rasterFromXYZ(data.frame(x = bo$x, y = bo$y, z = bo$elevation)) 41 | plot(r1, col = topo.colors(100), axes = FALSE, box = FALSE, 42 | main = "Elevation (m a.s.l.)", zlim = c(0, 3000)) 43 | r1 <- rasterFromXYZ(data.frame(x = bo$x, y = bo$y, z = bo$forest)) 44 | plot(r1, col = topo.colors(100), axes = FALSE, box = FALSE, 45 | main = "Forest cover (%)", zlim = c(0, 100)) 46 | par(op) 47 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 48 | 49 | # Create Gaussian random field 50 | set.seed(10) # Fig. 9.2 51 | s <- simExpCorrRF(theta = 10, size = 50) 52 | 53 | # Choose sample sizes: 2500 sites and 3 surveys 54 | nsites <- 2500 # Number of sites (corresponding to our 50 by 50 grid) 55 | nreps <- 3 # Number of replicate observations 56 | 57 | # Scale the real Bernese Oberland covariates 58 | elev <- standardize(bo$elevation) 59 | forest <- standardize(bo$forest) 60 | 61 | # Ecological process 62 | beta0 <- 2 # Abundance model: intercept 63 | beta1 <- 2 # Linear effect of elevation: positive 64 | beta2 <- -2 # Quadratic effect of elevation: negative 65 | loglam0 <- beta0 + beta1 * elev + beta2 * elev^2 66 | loglam <- beta0 + beta1 * elev + beta2 * elev^2 + c(s$field) 67 | lam0 <- exp(loglam0) # without spatial autocorrelation 68 | lam <- exp(loglam) # with spatial autocorrelation 69 | 70 | # ~~~~ extra code for figure 9.3 ~~~~ 71 | # Plot expected counts (lambda) as a function of covariates only, 72 | # i.e., excluding spatial field, and including spatial field (Fig. 20-4) 73 | op <- par(mfrow = c(1,2), mar = c(5,8,5,2), cex.lab = 1.5) 74 | plot(bo$elevation, lam0, cex = 1, pch = 16, xlab = "Elevation", 75 | ylab = "Expected counts (lambda)", main = "Excluding spatial field", 76 | frame = FALSE, col = rgb(0, 0, 0, 0.3)) 77 | plot(bo$elevation, lam, cex = 1, pch = 16, xlab = "Elevation", 78 | ylab = "Expected counts (lambda)", main = "Including spatial field", 79 | frame = FALSE, col = rgb(0, 0, 0, 0.3)) 80 | par(op) 81 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 82 | 83 | # Determine actual abundances as Poisson random variables with parameter lam 84 | N <- rpois(n = nsites, lambda = lam) 85 | table(N) # Distribution of abundances across sites 86 | sum(N > 0) / nsites # Finite-sample occupancy 87 | (totalN <- sum(N)) # Total population size in all 2500 sites 88 | 89 | # Create wind speed observational covariate 90 | wind <- matrix(rnorm(nsites*nreps), nrow = nsites, ncol = nreps) 91 | 92 | # Observation process 93 | alpha0 <- 0 # logit-linear intercept 94 | alpha1 <- -1 # slope on forest 95 | alpha2 <- -1 # slope on wind speed 96 | p <- array(NA, dim = c(nsites, nreps)) 97 | for(j in 1:nreps){ 98 | p[,j] <- plogis(alpha0 + alpha1 * forest + alpha2 * wind[,j]) 99 | } 100 | 101 | # Count things 102 | y <- array(dim = c(nsites, nreps)) # Array for counts 103 | for (j in 1:nreps){ 104 | y[,j] <- rbinom(n = nsites, size = N, prob = p[,j]) 105 | } 106 | str(y) 107 | # int [1:2500, 1:3] 1 0 0 0 0 0 0 3 0 0 ... 108 | summary(N) 109 | summary(c(y)) 110 | # Min. 1st Qu. Median Mean 3rd Qu. Max. 111 | # 0.000 0.000 1.000 2.877 3.000 66.000 112 | # Min. 1st Qu. Median Mean 3rd Qu. Max. 113 | # 0.000 0.000 0.000 1.174 1.000 49.000 114 | 115 | # Compare true and observed total abundance 116 | (true <- totalN) # True 117 | (obs <- sum(apply(y, 1, max))) # Observed 118 | cat("Underestimation of total abundance:", round(100*(1-obs/true)), "%\n") 119 | # [1] 7192 120 | # [1] 4371 121 | # Underestimation of total abundance: 39 % 122 | 123 | # Select a sample of sites for surveys 124 | # set.seed(100) 125 | set.seed(100, sample.kind = "Rounding") 126 | sample.size <- 500 127 | sample.sites <- sort(sample(1:nsites, size = sample.size)) 128 | 129 | # ~~~~ extra code for figure 9.4 ~~~~ 130 | op <- par(mfrow = c(1,3), mar = c(3,3,3,6)) 131 | r <- rasterFromXYZ(data.frame(x = bo$x, y = bo$y, z = N)) 132 | plot(r, col = topo.colors(20), axes = FALSE, box = FALSE, 133 | main = "Abundance (N, truncated at 6)", zlim = c(0, 6)) 134 | r <- rasterFromXYZ(data.frame(x = bo$x, y = bo$y, z = apply(p, 1, mean))) 135 | plot(r, col = topo.colors(20), axes = FALSE, box = FALSE, 136 | main = "Average detection probability") 137 | r <- rasterFromXYZ(data.frame(x = bo$x, y = bo$y, z = apply(y, 1, max))) 138 | plot(r, col = topo.colors(20), axes = FALSE, box = FALSE, 139 | main = "Max count (truncated at 6)", zlim = c(0, 6)) 140 | par(op) 141 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 142 | 143 | yobs <- y # Make a copy 144 | yobs[-sample.sites,] <- NA # Turn counts of unsurveyed sites into NAs 145 | head(sample.sites) # Look at the simulated data set 146 | head(yobs) 147 | 148 | simNmixSpatial(nsurveys = 3, mean.lambda = exp(2), beta = c(2, -2), 149 | mean.p = 0.5, alpha = c(-1, -1), sample.size = 500, variance.RF = 1, 150 | theta.RF = 10, seeds = c(10, 100), truncN = 6, show.plots = TRUE) 151 | 152 | simOccSpatial(nsurveys = 3, mean.psi = 0.6, beta = c(2, -2), 153 | mean.p = 0.4, alpha = c(-1, -1), sample.size = 500, variance.RF = 1, 154 | theta.RF = 10, seeds = c(10, 100), show.plots = TRUE) 155 | -------------------------------------------------------------------------------- /AHM2_ch09/AHM2_09.3.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # 6 | # Chapter 9 : SPATIAL MODELS OF DISTRIBUTION AND ABUNDANCE 7 | # ======================================================== 8 | # Code from proofs dated 2020-08-19 9 | 10 | if(!requireNamespace("RandomFields")) 11 | stop("Package 'RandomFields' is not available.") 12 | 13 | # Approximate execution time for this code: 13 mins 14 | 15 | library(AHMbook) 16 | library(R2WinBUGS) 17 | bugs.dir <- "C:/WinBUGS14" # the location of the WinBUGS14.exe file on your machine 18 | 19 | # ~~~ regenerate the data ~~~~~~ 20 | RNGversion("3.5.3") 21 | dat <- simNmixSpatial(nsurveys = 3, mean.lambda = exp(2), beta = c(2, -2), 22 | mean.p = 0.5, alpha = c(-1, -1), sample.size = 500, variance.RF = 1, 23 | theta.RF = 10,seeds = c(10, 100), truncN = 6, show.plots=FALSE) 24 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 25 | 26 | # 9.3 Fitting a nonspatial N-mixture model to the simulated data 27 | # ============================================================== 28 | 29 | # ~~~ extra WinBUGS code for Nmix fitting ~~~~~~~~~~~~~~~~~~~ 30 | # Bundle data 31 | bdata <- with(dat, list(y = yobs, nsites = dim(y)[1], nrep = dim(y)[2], 32 | elev = elevationS, forest = forestS, wind = wind)) 33 | str(bdata) 34 | # List of 6 35 | # $ y : int [1:2500, 1:3] NA NA 0 NA NA NA NA 3 NA NA ... 36 | # $ nsites: int 2500 37 | # $ nrep : int 3 38 | # $ elev : num [1:2500] 1.06 1.836 1.763 1.305 0.268 ... 39 | # $ forest: num [1:2500] 1.146 -0.363 -0.363 0.208 0.493 ... 40 | # $ wind : num [1:2500, 1:3] 0.534 1.369 -0.426 0.747 -0.414 ... 41 | 42 | # Specify model in BUGS language 43 | cat(file = "Nmix.txt", " 44 | model { 45 | 46 | # Priors 47 | beta0 <- log(mean.lam) 48 | mean.lam ~ dunif(0, 20) 49 | alpha0 <- logit(mean.p) 50 | mean.p ~ dunif(0, 1) 51 | for(v in 1:2){ 52 | alpha[v] ~ dnorm(0, 0.1) 53 | beta[v] ~ dnorm(0, 0.1) 54 | } 55 | 56 | # Model for abundance 57 | for (i in 1:nsites){ 58 | loglam[i] <- beta0 + beta[1] * elev[i] + beta[2] * pow(elev[i],2) 59 | loglam.lim[i] <- min(1000, max(-1000, loglam[i])) # Stabilize log 60 | lam[i] <- exp(loglam.lim[i]) 61 | N[i] ~ dpois(lam[i]) 62 | } 63 | 64 | # Measurement error model 65 | for (i in 1:nsites){ 66 | for (j in 1:nrep){ 67 | y[i,j] ~ dbin(p[i,j], N[i]) 68 | p[i,j] <- 1 / (1 + exp(-lp.lim[i,j])) 69 | lp.lim[i,j] <- min(1000, max(-1000, lp[i,j])) # Stabilize logit 70 | lp[i,j] <- alpha0 + alpha[1] * forest[i] + alpha[2] * wind[i,j] 71 | } 72 | } 73 | 74 | # Derived parameters: total population size in grid 75 | Ntotal <- sum(N[]) 76 | } 77 | " 78 | ) 79 | 80 | # Initial values 81 | Nst <- apply(dat$yobs, 1, max)# Max observed abundance as inits for N 82 | Nst[is.na(Nst)] <- 2 83 | Nst[Nst == 0] <- 2 84 | inits <- function(){ list(N = Nst, mean.lam = 1, beta = rep(0, 2), 85 | mean.p = 0.5, alpha = rep(0, 2))} 86 | 87 | # Parameters monitored 88 | params <- c("mean.lam", "beta0", "beta", "mean.p", "alpha0", "alpha", "Ntotal", "lam") 89 | 90 | # MCMC settings 91 | ni <- 20000 ; nt <- 10 ; nb <- 10000 ; nc <- 3 # 13 mins 92 | 93 | # Call WinBUGS from R (ART 18 min) and summarize posteriors 94 | library(R2WinBUGS) 95 | out1 <- bugs(bdata, inits, params, "Nmix.txt", n.chains = nc, n.thin = nt, 96 | n.iter = ni, n.burnin = nb, debug = FALSE, bugs.directory = bugs.dir) 97 | print(out1, dig = 2) 98 | # save result for comparison with other models 99 | save(out1, file="AHM2_09.3_out1.RData") 100 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 101 | 102 | # Inference for Bugs model at "Nmix.txt", fit using WinBUGS, 103 | # 3 chains, each with 20000 iterations (first 10000 discarded), n.thin = 10 104 | # n.sims = 3000 iterations saved # ART 18 min 105 | # mean sd 2.5% 25% 50% 75% 97.5% Rhat n.eff 106 | # mean.lam 3.62 0.19 3.26 3.50 3.62 3.74 4.00 1 3000 107 | # beta0 1.29 0.05 1.18 1.25 1.29 1.32 1.39 1 3000 108 | # beta[1] 2.45 0.10 2.25 2.38 2.45 2.52 2.65 1 1200 109 | # beta[2] -1.80 0.09 -1.98 -1.86 -1.80 -1.74 -1.64 1 1100 110 | # mean.p 0.58 0.02 0.54 0.56 0.58 0.59 0.61 1 3000 111 | # alpha0 0.31 0.07 0.17 0.26 0.31 0.36 0.45 1 2800 112 | # alpha[1] -0.90 0.07 -1.04 -0.95 -0.90 -0.86 -0.78 1 1500 113 | # alpha[2] -1.14 0.06 -1.26 -1.18 -1.14 -1.10 -1.03 1 2300 114 | # Ntotal 5863.50 238.10 5423.97 5701.00 5857.50 6018.00 6350.02 1 3000 115 | # [....] 116 | 117 | with(dat, cbind(beta0, beta, alpha0, alpha, Ntotal = sum(N), 118 | summaxC = sum(apply(y,1,max)))) # Remember the truth 119 | # beta0 beta1 beta2 alpha0 alpha1 alpha2 Ntotal summaxC 120 | # [1,] 2 2 -2 0 -1 -1 7192 4371 121 | 122 | # ~~~ extra code for figure 9.5 ~~~~~~~~~~~ 123 | # Compare maps of true and estimated density (lambda) 124 | library(raster) 125 | op <- par(mfrow = c(1, 2), mar = c(3, 3, 3,3)) 126 | # r <- rasterFromXYZ(data.frame(x = bo$x, y = bo$y, z = lam)) 127 | r <- with(dat, rasterFromXYZ(data.frame(x = xcoord, y = ycoord, z = lam))) 128 | plot(r, col = topo.colors(20), axes = FALSE, box = FALSE, 129 | main = "Expected abundance lambda (true)", zlim = c(0, 10)) 130 | # r <- rasterFromXYZ(data.frame(x = bo$x, y = bo$y, z = out1$mean$lam)) 131 | r <- with(dat, rasterFromXYZ(data.frame(x = xcoord, y = ycoord, z = out1$mean$lam))) 132 | plot(r, col = topo.colors(20), axes = FALSE, box = FALSE, 133 | main = "Expected abundance lambda (estimate)", zlim = c(0, 10)) 134 | par(op) 135 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 136 | -------------------------------------------------------------------------------- /AHM2_ch09/AHM2_09.3.R_without_RandomFields.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # 6 | # Chapter 9 : SPATIAL MODELS OF DISTRIBUTION AND ABUNDANCE 7 | # ======================================================== 8 | 9 | # The code below is modified to run without the RandomFields package; if 10 | # RandomFields is available, it will be used by AHMbook, and the results should 11 | # be the same. 12 | # When RandomFields is not available, the 'fields' package is used instead, and 13 | # the results will be different. 14 | if(requireNamespace("RandomFields")) 15 | stop("Package 'RandomFields' IS available; this script is not needed.") 16 | 17 | # Approximate execution time for this code: 13 mins 18 | 19 | library(AHMbook) 20 | library(R2WinBUGS) 21 | bugs.dir <- "C:/WinBUGS14" # the location of the WinBUGS14.exe file on your machine 22 | 23 | # ~~~ regenerate the data ~~~~~~ 24 | RNGversion("3.5.3") 25 | dat <- simNmixSpatial(nsurveys = 3, mean.lambda = exp(2), beta = c(2, -2), 26 | mean.p = 0.5, alpha = c(-1, -1), sample.size = 500, variance.RF = 1, 27 | theta.RF = 10,seeds = c(10, 100), truncN = 6, show.plots=FALSE) 28 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 29 | 30 | # 9.3 Fitting a nonspatial N-mixture model to the simulated data 31 | # ============================================================== 32 | 33 | # ~~~ extra WinBUGS code for Nmix fitting ~~~~~~~~~~~~~~~~~~~ 34 | # Bundle data 35 | bdata <- with(dat, list(y = yobs, nsites = dim(y)[1], nrep = dim(y)[2], 36 | elev = elevationS, forest = forestS, wind = wind)) 37 | str(bdata) 38 | # List of 6 39 | # $ y : int [1:2500, 1:3] NA NA 0 NA NA NA NA 3 NA NA ... 40 | # $ nsites: int 2500 41 | # $ nrep : int 3 42 | # $ elev : num [1:2500] 1.06 1.836 1.763 1.305 0.268 ... 43 | # $ forest: num [1:2500] 1.146 -0.363 -0.363 0.208 0.493 ... 44 | # $ wind : num [1:2500, 1:3] 0.534 1.369 -0.426 0.747 -0.414 ... 45 | 46 | # Specify model in BUGS language 47 | cat(file = "Nmix.txt", " 48 | model { 49 | 50 | # Priors 51 | beta0 <- log(mean.lam) 52 | mean.lam ~ dunif(0, 20) 53 | alpha0 <- logit(mean.p) 54 | mean.p ~ dunif(0, 1) 55 | for(v in 1:2){ 56 | alpha[v] ~ dnorm(0, 0.1) 57 | beta[v] ~ dnorm(0, 0.1) 58 | } 59 | 60 | # Model for abundance 61 | for (i in 1:nsites){ 62 | loglam[i] <- beta0 + beta[1] * elev[i] + beta[2] * pow(elev[i],2) 63 | loglam.lim[i] <- min(1000, max(-1000, loglam[i])) # Stabilize log 64 | lam[i] <- exp(loglam.lim[i]) 65 | N[i] ~ dpois(lam[i]) 66 | } 67 | 68 | # Measurement error model 69 | for (i in 1:nsites){ 70 | for (j in 1:nrep){ 71 | y[i,j] ~ dbin(p[i,j], N[i]) 72 | p[i,j] <- 1 / (1 + exp(-lp.lim[i,j])) 73 | lp.lim[i,j] <- min(1000, max(-1000, lp[i,j])) # Stabilize logit 74 | lp[i,j] <- alpha0 + alpha[1] * forest[i] + alpha[2] * wind[i,j] 75 | } 76 | } 77 | 78 | # Derived parameters: total population size in grid 79 | Ntotal <- sum(N[]) 80 | } 81 | " 82 | ) 83 | 84 | # Initial values 85 | Nst <- apply(dat$yobs, 1, max)# Max observed abundance as inits for N 86 | Nst[is.na(Nst)] <- 2 87 | Nst[Nst == 0] <- 2 88 | inits <- function(){ list(N = Nst, mean.lam = 1, beta = rep(0, 2), 89 | mean.p = 0.5, alpha = rep(0, 2))} 90 | 91 | # Parameters monitored 92 | params <- c("mean.lam", "beta0", "beta", "mean.p", "alpha0", "alpha", "Ntotal", "lam") 93 | 94 | # MCMC settings 95 | ni <- 20000 ; nt <- 10 ; nb <- 10000 ; nc <- 3 # 13 mins 96 | 97 | # Call WinBUGS from R (ART 18 min) and summarize posteriors 98 | library(R2WinBUGS) 99 | out1 <- bugs(bdata, inits, params, "Nmix.txt", n.chains = nc, n.thin = nt, 100 | n.iter = ni, n.burnin = nb, debug = FALSE, bugs.directory = bugs.dir) 101 | print(out1, dig = 2) 102 | # save result for comparison with other models 103 | save(out1, file="AHM2_09.3_out1_without_RandomFields.RData") 104 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 105 | 106 | # Inference for Bugs model at "Nmix.txt", fit using WinBUGS, 107 | # 3 chains, each with 20000 iterations (first 10000 discarded), n.thin = 10 108 | # n.sims = 3000 iterations saved # ART 18 min 109 | # mean sd 2.5% 25% 50% 75% 97.5% Rhat n.eff 110 | # mean.lam 3.62 0.19 3.26 3.50 3.62 3.74 4.00 1 3000 111 | # beta0 1.29 0.05 1.18 1.25 1.29 1.32 1.39 1 3000 112 | # beta[1] 2.45 0.10 2.25 2.38 2.45 2.52 2.65 1 1200 113 | # beta[2] -1.80 0.09 -1.98 -1.86 -1.80 -1.74 -1.64 1 1100 114 | # mean.p 0.58 0.02 0.54 0.56 0.58 0.59 0.61 1 3000 115 | # alpha0 0.31 0.07 0.17 0.26 0.31 0.36 0.45 1 2800 116 | # alpha[1] -0.90 0.07 -1.04 -0.95 -0.90 -0.86 -0.78 1 1500 117 | # alpha[2] -1.14 0.06 -1.26 -1.18 -1.14 -1.10 -1.03 1 2300 118 | # Ntotal 5863.50 238.10 5423.97 5701.00 5857.50 6018.00 6350.02 1 3000 119 | # [....] 120 | 121 | with(dat, cbind(beta0, beta, alpha0, alpha, Ntotal = sum(N), 122 | summaxC = sum(apply(y,1,max)))) # Remember the truth 123 | # beta0 beta1 beta2 alpha0 alpha1 alpha2 Ntotal summaxC 124 | # [1,] 2 2 -2 0 -1 -1 7192 4371 125 | 126 | # ~~~ extra code for figure 9.5 ~~~~~~~~~~~ 127 | # Compare maps of true and estimated density (lambda) 128 | library(raster) 129 | op <- par(mfrow = c(1, 2), mar = c(3, 3, 3,3)) 130 | # r <- rasterFromXYZ(data.frame(x = bo$x, y = bo$y, z = lam)) 131 | r <- with(dat, rasterFromXYZ(data.frame(x = xcoord, y = ycoord, z = lam))) 132 | plot(r, col = topo.colors(20), axes = FALSE, box = FALSE, 133 | main = "Expected abundance lambda (true)", zlim = c(0, 10)) 134 | # r <- rasterFromXYZ(data.frame(x = bo$x, y = bo$y, z = out1$mean$lam)) 135 | r <- with(dat, rasterFromXYZ(data.frame(x = xcoord, y = ycoord, z = out1$mean$lam))) 136 | plot(r, col = topo.colors(20), axes = FALSE, box = FALSE, 137 | main = "Expected abundance lambda (estimate)", zlim = c(0, 10)) 138 | par(op) 139 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 140 | -------------------------------------------------------------------------------- /AHM2_ch10/AHM2_10.2.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # 6 | # Chapter 10 : INTEGRATED MODELS FOR MULTIPLE TYPES OF DATA 7 | # ========================================================= 8 | # Code from proofs dated 2020-08-19 9 | 10 | if(!requireNamespace("RandomFields")) 11 | stop("Package 'RandomFields' is not available.") 12 | 13 | library(AHMbook) 14 | # library(unmarked) 15 | 16 | # 10.2 A simulation game to improve your intuition about point, abundance, 17 | # and occurrence patterns 18 | # ======================================================================== 19 | 20 | # Function call with explicit default arguments(requires AHMbook) 21 | str(dat <- simPPe(lscape.size = 150, buffer.width = 25, variance.X = 1, 22 | theta.X = 10, M = 250, beta = 1, quads.along.side = 6)) 23 | 24 | # Produce Fig. 10.2 25 | set.seed(117, sample.kind="Rounding") 26 | str(dat <- simPPe(lscape.size = 200, buffer.width = 25, variance.X = 1, 27 | theta.X = 70, M = 200, beta = 1, quads.along.side = 6)) 28 | 29 | # Smaller study area, fewer individuals (M) 30 | str(dat <- simPPe(lscape.size = 24, buffer.width = 2, variance.X = 1, 31 | theta.X = 10, M = 50, beta = 1, quads.along.side = 6)) 32 | 33 | # Stronger habitat heterogeneity (variance.X): more aggregation 34 | str(dat <- simPPe(lscape.size = 24, buffer.width = 2, variance.X = 10, 35 | theta.X = 10, M = 50, beta = 1, quads.along.side = 6)) 36 | 37 | # Longer habitat gradient (theta.X) 38 | str(dat <- simPPe(lscape.size = 24, buffer.width = 2, variance.X = 1, 39 | theta.X = 250, M = 250, beta = 1, quads.along.side = 6)) 40 | 41 | # No habitat variability (variance.X): homogeneous point process 42 | str(dat <- simPPe(lscape.size = 24, buffer.width = 2, variance.X = 0, 43 | theta.X = 10, M = 100, beta = 1, quads.along.side = 6)) 44 | 45 | # No habitat preference (beta): homogeneous point process 46 | str(dat <- simPPe(lscape.size = 24, buffer.width = 2, variance.X = 1, 47 | theta.X = 10, M = 100, beta = 0, quads.along.side = 6)) 48 | 49 | # Habitat heterogeneity at very small scale (theta.X) -> (almost) 50 | # homogeneous point process (in spite of strong habitat preference) 51 | str(dat <- simPPe(lscape.size = 1000, buffer.width = 20, variance.X = 1, 52 | theta.X = 0.001, M = 250, beta = 1, quads.along.side = 6)) 53 | 54 | str(simPPe(M = 1)) # This often produces no point at all 55 | str(simPPe(M = 10)) 56 | str(simPPe(M = 100)) 57 | str(simPPe(M = 1000)) 58 | 59 | str(simPPe(M = 20, quads.along.side = 50)) # Lots of small sites 60 | str(simPPe(M = 20, quads.along.side = 10)) 61 | str(simPPe(M = 20, quads.along.side = 5)) 62 | str(simPPe(M = 20, quads.along.side = 1)) # study area is one single site 63 | -------------------------------------------------------------------------------- /AHM2_ch10/AHM2_10.2_without_RandomFields.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology 2 | # Modeling distribution, abundance and species richness using R and BUGS 3 | # Volume 2: Dynamic and Advanced models 4 | # Marc Kéry & J. Andy Royle 5 | # 6 | # Chapter 10 : INTEGRATED MODELS FOR MULTIPLE TYPES OF DATA 7 | # ========================================================= 8 | # Code from proofs dated 2020-08-19 9 | 10 | # The code below is modified to run without the RandomFields package; if 11 | # RandomFields is available, it will be used by AHMbook, and the results should 12 | # be the same. 13 | # When RandomFields is not available, the 'fields' package is used instead, and 14 | # the results will be different. 15 | if(requireNamespace("RandomFields")) 16 | stop("Package 'RandomFields' IS available; this script is not needed.") 17 | 18 | library(AHMbook) 19 | # library(unmarked) 20 | 21 | # 10.2 A simulation game to improve your intuition about point, abundance, 22 | # and occurrence patterns 23 | # ======================================================================== 24 | 25 | # Function call with explicit default arguments(requires AHMbook) 26 | str(dat <- simPPe(lscape.size = 150, buffer.width = 25, variance.X = 1, 27 | theta.X = 10, M = 250, beta = 1, quads.along.side = 6)) 28 | 29 | # Produce Fig. 10.2 - this fails without RandomFields 30 | set.seed(117, sample.kind="Rounding") 31 | try(str(dat <- simPPe(lscape.size = 200, buffer.width = 25, variance.X = 1, 32 | theta.X = 70, M = 200, beta = 1, quads.along.side = 6))) 33 | 34 | # Smaller study area, fewer individuals (M) 35 | try(str(dat <- simPPe(lscape.size = 24, buffer.width = 2, variance.X = 1, 36 | theta.X = 10, M = 50, beta = 1, quads.along.side = 6)) ) 37 | 38 | # Stronger habitat heterogeneity (variance.X): more aggregation 39 | try(str(dat <- simPPe(lscape.size = 24, buffer.width = 2, variance.X = 10, 40 | theta.X = 10, M = 50, beta = 1, quads.along.side = 6))) 41 | 42 | # Longer habitat gradient (theta.X) 43 | try(str(dat <- simPPe(lscape.size = 24, buffer.width = 2, variance.X = 1, 44 | theta.X = 250, M = 250, beta = 1, quads.along.side = 6))) 45 | 46 | # No habitat variability (variance.X): homogeneous point process 47 | try(str(dat <- simPPe(lscape.size = 24, buffer.width = 2, variance.X = 0, 48 | theta.X = 10, M = 100, beta = 1, quads.along.side = 6))) 49 | 50 | # No habitat preference (beta): homogeneous point process 51 | try(str(dat <- simPPe(lscape.size = 24, buffer.width = 2, variance.X = 1, 52 | theta.X = 10, M = 100, beta = 0, quads.along.side = 6))) 53 | 54 | # Habitat heterogeneity at very small scale (theta.X) -> (almost) 55 | # homogeneous point process (in spite of strong habitat preference) 56 | str(dat <- simPPe(lscape.size = 1000, buffer.width = 20, variance.X = 1, 57 | theta.X = 0.001, M = 250, beta = 1, quads.along.side = 6)) 58 | 59 | str(simPPe(M = 1)) # This often produces no point at all 60 | str(simPPe(M = 10)) 61 | str(simPPe(M = 100)) 62 | str(simPPe(M = 1000)) 63 | 64 | str(simPPe(M = 20, quads.along.side = 50)) # Lots of small sites 65 | str(simPPe(M = 20, quads.along.side = 10)) 66 | str(simPPe(M = 20, quads.along.side = 5)) 67 | str(simPPe(M = 20, quads.along.side = 1)) # study area is one single site 68 | -------------------------------------------------------------------------------- /AHM2_ch11/AHM2_11.02#noCode.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology - Marc Kéry & J. Andy Royle 2 | # Volume 2 - 2020 3 | # Chapter 11 : SPATIALLY EXPLICIT DISTANCE SAMPLING ALONG TRANSECTS 4 | # ================================================================= 5 | # Code from proofs dated 2020-08-19 6 | 7 | 8 | # 11.2 Distance sampling model components 9 | # ======================================= 10 | 11 | # no R code 12 | -------------------------------------------------------------------------------- /AHM2_ch11/AHM2_11.04.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology - vol.2 - 2021 2 | # Marc Kéry & J. Andy Royle 3 | # 4 | # Chapter 11 : SPATIALLY EXPLICIT DISTANCE SAMPLING ALONG TRANSECTS 5 | # ================================================================= 6 | # Code from proofs dated 2020-08-19 7 | 8 | print("Approximate execution time for this code: 25 mins") 9 | # Run time with the full number of iterations: 75 mins 10 | 11 | library(AHMbook) 12 | library(jagsUI) 13 | 14 | # 11.4 Mark-recapture/distance sampling models on linear transects 15 | # ================================================================ 16 | 17 | # Simulation settings 18 | set.seed( 1234, kind = "Mersenne-Twister") 19 | N <- 200 20 | M <- 500 21 | sigma <- 0.20 22 | alpha0 <- -3 23 | W <- 1/2 # Transect half-width 24 | L <- 4 25 | K <- 2 # Replicates 26 | 27 | # Locations of individuals 28 | u1 <- runif(N, 0, L) 29 | u2 <- runif(N, 0, 2*W) 30 | plot(u1, u2, pch = 20, cex = 1) # plot points (not shown) 31 | abline(0.5, 0, lwd = 2, col = 'grey') 32 | title("Transect population subject to detection") 33 | 34 | # Represent transect by a sequence of points with delta = 0.2 35 | line.pts <- seq(0.01, L - 0.01, .02) 36 | traplocs <- cbind(line.pts, 0.5) # Call these points "traps" 37 | 38 | # Initialize some objects. These are matrices now 39 | d.to.trap <- obs.pos <- pbar <- matrix(NA, nrow = N, ncol = K) 40 | 41 | # Simulate the detections of each individual as a sequence of Bernoulli 42 | # trials and record only the first detection (where it was detected from on 43 | # the line) 44 | dmat <- e2dist(cbind(u1, u2), traplocs) 45 | for(k in 1:K){ 46 | for(i in 1:nrow(dmat)){ 47 | haz <- exp(alpha0)*exp( -(dmat[i,]^2)/(2*sigma*sigma)) 48 | probs <- 1 - exp(-haz) 49 | captured <- rbinom(nrow(traplocs), 1, probs) # Seq. of Bern trials 50 | pbar[i,k] <- 1 - exp(-sum(haz)) # Average prob. of capture 51 | if(sum(captured)==0) 52 | next 53 | obs.pos[i,k] <- (1:length(captured))[captured==1][1] 54 | d.to.trap[i,k] <- dmat[i,][obs.pos[i,k]] 55 | lines(c(u1[i], traplocs[obs.pos[i,k], 1]), c(u2[i], 56 | traplocs[obs.pos[i,k], 2]) ) 57 | } 58 | } 59 | 60 | # Subset to detected individuals 61 | ncap <- apply(!is.na(d.to.trap), 1, sum) 62 | nind <- sum(ncap > 0) 63 | data <- cbind(obs.pos, u1, u2)[ncap>0, ] 64 | obs.pos <- data[, 1:2] # K = 2 vectors here, one for each survey 65 | 66 | ntraps <- nrow(traplocs) 67 | Yarr <- array(0, dim = c(M, ntraps, K) ) 68 | for(k in 1:K){ 69 | for(i in 1:nind){ 70 | if(!is.na(obs.pos[i,k])) { 71 | Yarr[i, obs.pos[i,k], k] <- 1 72 | } 73 | } 74 | } 75 | 76 | # Data augmentation 77 | nz <- M - nind 78 | obs.pos[is.na(obs.pos)] <- ntraps 79 | obs.pos <- rbind(obs.pos, matrix(ntraps, nrow = nz, ncol = K) ) 80 | 81 | # Augment location matrix u 82 | uaug <- rbind( data[,c("u1", "u2")], matrix(NA, nrow = nz, ncol = 2)) 83 | 84 | # Bundle and summarize the data for BUGS 85 | str(data_haz <- list (obs.pos = obs.pos, ntraps = ntraps, traplocs = traplocs, 86 | nind = nind, y = Yarr, nz = nz, u = uaug, nsurveys = K) )# output omitted 87 | 88 | # Model 2a: MRDS with hazard detection model 89 | cat(file="MRDS.txt", " 90 | model { 91 | 92 | # Prior distributions 93 | sigma ~ dunif(0,10) 94 | psi ~ dunif(0,1) 95 | alpha0 ~ dnorm(0,0.01) 96 | 97 | # Models for DA variables and location (pixel) 98 | for(i in 1:(nind+nz)){ 99 | z[i] ~ dbern(psi) 100 | u[i,1] ~ dunif(0, 4) 101 | u[i,2] ~ dunif(0, 1) 102 | for(k in 1:nsurveys){ 103 | for(j in 1:obs.pos[i,k]){ 104 | d[i,j,k] <- pow( pow( u[i,1] - traplocs[j,1],2) + 105 | pow(u[i,2] - traplocs[j,2],2),0.5) 106 | haz[i,j,k] <- exp(alpha0)*exp(-d[i,j,k]*d[i,j,k]/ (2*sigma*sigma)) 107 | p[i,j,k] <- 1 - exp(-haz[i,j,k]) 108 | mu[i,j,k] <- p[i,j,k]*z[i] 109 | y[i,j,k] ~ dbern(mu[i,j,k]) # Observation model 110 | } 111 | } 112 | } 113 | # Derived parameters 114 | N <- sum(z[]) # N is a derived parameter 115 | D <- N/4 # area = 4 ha 116 | } 117 | ") 118 | 119 | # MCMC settings 120 | # na <- 500 ; ni <- 1500 ; nb <- 500 ; nt <- 1 ; nc <-5 121 | na <- 500 ; ni <- 150 ; nb <- 50 ; nt <- 1 ; nc <- 3 # ~~~ for testing, 25 mins 122 | 123 | # Create inits and define parameters to monitor 124 | ust <- uaug 125 | ust[1:nind, ] <- NA 126 | ust[(nind+1):M, ] <- cbind( runif(nz, 0, L), runif(nz, 0, W) ) 127 | inits <- function(){ list (sigma = runif(1, 0.2, 1), psi = runif(1), 128 | alpha0 = runif(1, -5, -2), z = c(rep(1, nind), rep(0, nz)), u = ust ) } 129 | params <- c("sigma", "N", "psi", "D", "alpha0") 130 | 131 | # Run JAGS (ART 95 min), check convergence and summarize posteriors 132 | out2a <- jags (data_haz, inits, params, "MRDS.txt", n.thin = nt, 133 | n.chains = nc, n.burnin = nb, n.iter = ni, n.adapt = na, parallel = TRUE) 134 | # par(mfrow = c(3,2)) # ~~~ replaced with 'layout' argument 135 | traceplot(out2a , layout=c(3,2)) 136 | print(out2a, 2) 137 | # mean sd 2.5% 50% 97.5% overlap0 f Rhat n.eff 138 | # sigma 0.20 0.01 0.18 0.19 0.21 FALSE 1 1.00 762 139 | # N 214.98 19.07 181.00 214.00 256.00 FALSE 1 1.01 388 140 | # psi 0.43 0.04 0.35 0.43 0.52 FALSE 1 1.01 471 141 | # D 53.74 4.77 45.25 53.50 64.00 FALSE 1 1.01 388 142 | # alpha0 -3.06 0.15 -3.37 -3.06 -2.78 FALSE 1 1.01 236 143 | -------------------------------------------------------------------------------- /AHM2_ch11/AHM2_11.06.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology - vol.2 - 2021 2 | # Marc Kéry & J. Andy Royle 3 | # 4 | # Chapter 11 : SPATIALLY EXPLICIT DISTANCE SAMPLING ALONG TRANSECTS 5 | # ================================================================= 6 | # Code from proofs dated 2020-08-19 7 | 8 | print("Approximate execution time for this code: 60 mins") 9 | # Run time with the full number of iterations: 2.8 hrs 10 | 11 | library(AHMbook) 12 | library(jagsUI) 13 | 14 | # 11.6 Hierarchical distance sampling (HDS) with multiple transects 15 | # ================================================================= 16 | 17 | library(AHMbook) 18 | RNGversion("3.5.3") 19 | set.seed(1234, kind = "Mersenne-Twister") 20 | 21 | # Have to know the value of nPix and ntraps. Be careful! 22 | nPix <- 400 23 | ntran <- 2 # Number of transects 24 | ntraps <- 200 # Number of 'traps' per transect 25 | M <- 400 # Data augmentation 26 | y2d <- pixel <- matrix(NA, nrow = M, ncol = ntran) # note: Now matrices! 27 | umat <- array(NA, dim = c(M, 2, ntran)) 28 | Ymat <- array(0, dim = c(M, ntraps, ntran)) 29 | obs.pos <- matrix(NA, nrow = M, ncol = ntran) 30 | nind <- rep(NA, ntran) 31 | Habitat <- matrix(NA, nrow = nPix, ncol = ntran) 32 | 33 | # Simulate multiple transects (produces Figure 11.6) 34 | for(tran in 1:ntran){ 35 | tmp <- simSpatialDSline(N = 200, beta = 1, sigma = 0.25, alpha0 = -3) 36 | # Harvest data 37 | data <- tmp$data 38 | u <- data[ , c("u1", "u2")] 39 | trap <- data[,1] # Integer for line segment 40 | dist.obs <- data[,2] # Distance from observer position to object 41 | traplocs <- tmp$traps # Constant for standardized transects 42 | Habitat[,tran] <- as.vector(tmp$Habitat) 43 | Habitat[,tran] <- Habitat[,tran] - mean(Habitat[,tran]) 44 | Habgrid <- tmp$grid # Always same for standardized transects grid 45 | nind[tran] <- nrow(u) 46 | 47 | # Do data augmentation, including for pixel ID 48 | nz <- M - nind[tran] 49 | y2d[, tran] <- c(rep(1,nind[tran]), rep(0,nz)) 50 | uaug <- rbind(u, matrix(NA, nrow = nz, ncol = 2)) 51 | umat[1:M, 1:2, tran] <- uaug 52 | 53 | # Fill-out the Ymat with pixel of each observation 54 | pixel[1:nind[tran], tran] <- tmp$pixel 55 | Ymat[cbind(1:nind[tran], trap, tran)] <- 1 56 | 57 | # Augment for individuals not captured 58 | obs.pos[, tran] <- c(trap, rep(ntraps, M - nind[tran]) ) 59 | } 60 | 61 | # Bundle and summarize the data for BUGS 62 | str(data <- list (obs.pos = obs.pos, ntraps = ntraps, ntran = ntran, 63 | traplocs = traplocs, nind = nind, y = Ymat, M = M, Habitat = Habitat, 64 | Habgrid = Habgrid, nPix = nPix, pixel = pixel)) 65 | # List of 11 66 | # $ obs.pos : num [1:400, 1:2] 28 99 105 72 31 111 153 143 25 2 ... 67 | # $ ntraps : num 200 68 | # $ ntran : num 2 69 | # $ traplocs: num [1:200, 1:2] 0.01 0.03 0.05 0.07 0.09 0.11 0.13 0.15 0.17 ... 70 | # $ nind : int [1:2] 105 120 71 | # $ y : num [1:400, 1:200, 1:2] 0 0 0 0 0 0 0 0 0 0 ... 72 | # $ M : num 400 73 | # $ Habitat : num [1:400, 1:2] -0.375 -0.142 0.413 -0.546 -0.232 ... 74 | # $ Habgrid : num [1:400, 1:2] 0.05 0.15 0.25 0.35 0.45 0.55 0.65 0.75 0.85 ... 75 | # $ nPix : num 400 76 | # $ pixel : int [1:400, 1:2] 206 143 301 178 169 225 270 307 329 323 ... 77 | 78 | # Write BUGS model 79 | cat(file = "spatialDSmulti.txt", " 80 | model{ 81 | 82 | # Prior distributions 83 | sigma ~ dunif(0,10) 84 | alpha0 ~ dnorm(0,0.01) 85 | beta1 ~ dnorm(0,0.01) 86 | psi[1] ~ dunif(0,1) 87 | psi[2] ~ dunif(0,1) 88 | 89 | # Note that probabilities are computed for each transect now 90 | for(tran in 1:ntran){ 91 | for(g in 1:nPix){ # g is the pixel index 92 | lam[g,tran] <- exp(beta1*Habitat[g,tran]) 93 | probs[g,tran] <- lam[g,tran]/sum(lam[,tran]) 94 | } 95 | } 96 | 97 | # Likelihood and spatial model for each transect 98 | for(tran in 1:ntran){ 99 | for(i in 1:M){ 100 | z[i,tran] ~ dbern(psi[tran]) 101 | pixel[i,tran] ~ dcat(probs[,tran]) 102 | s[i,1:2,tran] <- Habgrid[pixel[i,tran],] # location = derived quantity 103 | # compute distance = derived quantity 104 | for(j in 1:obs.pos[i,tran]){ 105 | d[i,j,tran] <- pow(pow(s[i,1,tran] - traplocs[j,1],2) + 106 | pow(s[i,2,tran] - traplocs[j,2],2), 0.5) 107 | haz[i,j,tran] <- exp(alpha0)*exp(-d[i,j, 108 | tran]*d[i,j,tran]/(2*sigma*sigma)) # Half-normal hazard det. fctn. 109 | p[i,j,tran] <- 1 - exp(-haz[i,j,tran]) 110 | mu[i,j,tran] <- p[i,j,tran]*z[i,tran] 111 | y[i,j,tran] ~ dbern(mu[i,j,tran]) # Observation model 112 | } 113 | } 114 | # Derived parameters 115 | N[tran] <- sum(z[,tran]) # N is a derived parameter 116 | D[tran] <- N[tran]/4 # area = 4 units 117 | } 118 | } 119 | ") 120 | 121 | # MCMC settings 122 | # na <- 1000 ; ni <- 3000 ; nb <- 1000 ; nt <- 1 ; nc <- 6 123 | na <- 1000 ; ni <- 300 ; nb <- 100 ; nt <- 1 ; nc <- 3 # ~~~~ for testing 124 | 125 | # Create inits and define parameters to monitor 126 | inits <- function(){ list (sigma = runif(1,0.2,1), beta1 = rnorm(1, 1, 0.4), 127 | alpha0 = runif(1, -5, -2), z = y2d ) } 128 | params <- c("sigma", "N", "psi", "beta1", "D", "alpha0") 129 | 130 | # Run JAGS (ART 160 min), check convergence and summarize posteriors 131 | out5 <- jags (data, inits, params, "spatialDSmulti.txt", n.adapt = na, 132 | n.thin = nt, n.chains = nc, n.burnin = nb, n.iter = ni, parallel = TRUE, 133 | factories = "base::Finite sampler FALSE") 134 | # par(mfrow = c(3,2)) # ~~~ replaced with 'layout' argument 135 | traceplot(out5, layout=c(3,2)) 136 | print(out5, 3) 137 | # mean sd 2.5% 50% 97.5% overlap0 f Rhat n.eff 138 | # sigma 0.25 0.01 0.23 0.25 0.27 FALSE 1 1.01 505 139 | # N[1] 167.77 16.97 140.00 166.00 206.00 FALSE 1 1.01 314 140 | # N[2] 193.45 19.43 162.00 191.00 239.00 FALSE 1 1.01 274 141 | # psi[1] 0.42 0.05 0.33 0.42 0.53 FALSE 1 1.01 410 142 | # psi[2] 0.48 0.05 0.39 0.48 0.60 FALSE 1 1.01 307 143 | # beta1 1.00 0.09 0.83 1.00 1.17 FALSE 1 1.02 179 144 | # D[1] 41.94 4.24 35.00 41.50 51.50 FALSE 1 1.01 314 145 | # D[2] 48.36 4.86 40.50 47.75 59.75 FALSE 1 1.01 274 146 | # alpha0 -2.73 0.19 -3.13 -2.72 -2.38 FALSE 1 1.00 970 147 | -------------------------------------------------------------------------------- /AHM2_ch11/AHM2_11.07.R: -------------------------------------------------------------------------------- 1 | # Applied hierarchical modeling in ecology - vol.2 - 2021 2 | # Marc Kéry & J. Andy Royle 3 | # 4 | # Chapter 11 : SPATIALLY EXPLICIT DISTANCE SAMPLING ALONG TRANSECTS 5 | # ================================================================= 6 | # Code from proofs dated 2020-08-19 7 | 8 | library(AHMbook) 9 | library(jagsUI) 10 | 11 | # 11.7 Distance sampling models based on pixel frequencies 12 | # ======================================================== 13 | 14 | # 11.7.1 Fitting the pixel frequency distance sampling model in JAGS 15 | # ------------------------------------------------------------------ 16 | 17 | # Simulate a data set 18 | library(AHMbook) ; RNGversion("3.5.0") 19 | set.seed(1234, kind = "Mersenne-Twister") 20 | tmp <- simSpatialDSline(N = 200, beta = 1, sigma = 0.25, alpha0 = -3, 21 | perp = TRUE ) # perp = TRUE forces p(0) = 1 22 | 23 | # Harvest data objects 24 | Habitat <- as.vector(tmp$Habitat) 25 | Habitat <- as.numeric(scale(Habitat)) 26 | Habgrid <- tmp$grid 27 | nind <- nrow(tmp$data) 28 | npixels <- length(tmp$Habitat) 29 | 30 | # Create a vector of pixel counts and pad it with zeros 31 | yg <- tabulate(tmp$pixel, nbins = npixels) 32 | 33 | # Create a covariate: distance between line and pixel center 34 | dist <- abs(Habgrid[,2] - 0.5 ) 35 | 36 | # Bundle and summarize the data for BUGS 37 | str(bdata <- list(y = yg, Habitat = Habitat, npixels = npixels, dist = dist)) 38 | # List of 4 39 | # $ y : int [1:400] 0 0 0 0 0 0 1 0 0 0 ... 40 | # $ Habitat: num [1:400] -0.401 -0.152 0.441 -0.584 -0.248 ... 41 | # $ npixels: int 400 42 | # $ dist : num [1:400] 0.45 0.45 0.45 0.45 0.45 0.45 0.45 0.45 ... 43 | 44 | # Specify model in BUGS language, here we set p0 = 1. 45 | cat(file = "spatialDSpixel.txt", " 46 | model{ 47 | 48 | # Prior distributions 49 | sigma ~ dunif(0,10) 50 | beta0 ~ dnorm(0,0.01) 51 | beta1 ~ dnorm(0,0.01) 52 | 53 | p0 <- 1 # Fix p0 to 1 to honor the CDS assumption 54 | for(g in 1:npixels){ # Point process intensity 55 | lam[g] <- exp(beta0 + beta1*Habitat[g]) 56 | p[g] <- p0*exp(- (1/(2*sigma*sigma))*dist[g]*dist[g]) 57 | # y[g] ~ dpois(p[g]*lam[g]) # equivalent to next two lines 58 | N[g] ~ dpois(lam[g]) 59 | y[g] ~ dbinom(p[g], N[g]) 60 | } 61 | # Derived parameters 62 | Ntot <- sum(N[]) # N is a derived parameter 63 | D <- Ntot/4 # Density, with area = 4 units 64 | } 65 | ") 66 | 67 | # MCMC settings 68 | na <- 1000 ; ni <- 20000 ; nb <- 10000 ; nt <- 10 ; nc <- 3 69 | 70 | # Inits 71 | Nst <- yg + 1 72 | inits <- function(){ list (sigma = runif(1, 0.2, 1), beta0 = -1, beta1 = 1, 73 | N = Nst) } 74 | 75 | # Parameters to monitor 76 | params <- c("sigma", "Ntot", "beta0", "beta1", "D") 77 | 78 | # Run JAGS (ART < 1 min), check convergence and summarize posteriors 79 | out6 <- jags(bdata, inits, params, "spatialDSpixel.txt", n.adapt = na, 80 | n.thin = nt, n.chains = nc, n.burnin = nb, n.iter = ni, parallel = TRUE ) 81 | # par(mfrow = c(2, 3)) # ~~~ replaced with 'layout' argument 82 | traceplot(out6, layout=c(2,3)) 83 | print(out6, 3) 84 | # mean sd 2.5% 50% 97.5% Rhat n.eff 85 | # sigma 0.265 0.035 0.215 0.260 0.348 1.009 457 86 | # Ntot 189.548 18.999 154.000 189.000 228.000 1.008 229 87 | # beta0 -1.063 0.153 -1.370 -1.054 -0.778 1.013 167 88 | # beta1 0.796 0.099 0.604 0.797 0.998 1.002 1401 89 | # D 47.387 4.750 38.500 47.250 57.000 1.008 229 90 | 91 | 92 | # 11.7.2 Analysis of the pixel frequency distance sampling model in unmarked 93 | # using pcount.spHDS 94 | # -------------------------------------------------------------------------- 95 | 96 | # Construct an unmarkedFrame 97 | library(unmarked) 98 | summary(umf <- unmarkedFramePCount(y = matrix(yg, ncol = 1), 99 | siteCovs = data.frame(dist = dist, Habitat = Habitat)) ) 100 | 101 | # unmarkedFrame Object 102 | 103 | # 400 sites 104 | # Maximum number of observations per site: 1 105 | # Mean number of observations per site: 1 106 | # Sites with at least one detection: 86 107 | # 108 | # Tabulation of y observations: 109 | # 0 1 2 3 4 7 110 | # 314 64 13 7 1 1 111 | # 112 | # Site-level covariates: 113 | # dist Habitat 114 | # Min. :0.05 Min. :-2.39613 115 | # 1st Qu.:0.15 1st Qu.:-0.55058 116 | # Median :0.25 Median : 0.05871 117 | # Mean :0.25 Mean : 0.00000 118 | # 3rd Qu.:0.35 3rd Qu.: 0.56853 119 | # Max. :0.45 Max. : 2.52070 120 | # 121 | # Fit the hierarchical distance sampling model 122 | (fm1 <- pcount.spHDS(~ -1 + I(dist^2) ~ Habitat, umf)) 123 | 124 | # Abundance: 125 | # Estimate SE z P(>|z|) 126 | # (Intercept) -1.25 0.1534 -8.12 4.78e-16 127 | # Habitat 1.07 0.0973 11.00 3.66e-28 128 | # 129 | # Detection: 130 | # Estimate SE z P(>|z|) 131 | # 2.49 0.16 15.6 9.01e-55 132 | # 133 | # AIC: 434.9047 134 | 135 | # Generate predictions for each pixel 136 | pred <- predict(fm1, type = "state") 137 | 138 | # Make a quick plot to visualize the result (Fig. 11.7) 139 | library(raster) 140 | M1 <- matrix(pred[,1], nrow = 10, byrow = T) 141 | M2 <- M1[nrow(M1):1, ] 142 | op <- par( mar = c(3, 3, 3, 6) ) 143 | graphics::image(x = 1:40, y = 1:10, t(M2), col = topo.colors(12)) 144 | image_scale(t(M2), col = topo.colors(12)) # AHMbook package 145 | par(op) 146 | 147 | # Estimated total population size in the landscape 148 | ( Nhat <- sum(pred[,1]) ) 149 | # [1] 199.7485 150 | 151 | log(200/sum(exp( 1*Habitat))) 152 | # [1] -1.175485 153 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ## AHM code 2 | 3 | # CHANGES 4 | 5 | ## 2022-11-09 6 | 7 | * In AHM2 chapter 9 sections 1 to 4 and chapter 10 section 2, new scripts are provided which do not require the `RandomFields` package. On Windows, the old `RandomFields` package (version 3.3.14) still works and can be downloaded from [here](https://cran.r-project.org/src/contrib/Archive/RandomFields/). Do not try to use this on a Linux system. 8 | 9 | 10 | Tested: Windows 10, R 4.2.2, `jagsUI` (1.5.2.9002) and `unmarked` (1.2.5.9004), and up-to-date CRAN versions of other packages. 11 | 12 | # 2022-05-04 13 | 14 | * Removed all calls to `library(rgdal)` as none were necessary. The `rgdal` package will be retired before the end of 2023; see [here](https://r-spatial.org//r/2022/04/12/evolution.html). 15 | 16 | Tested: Windows 10, R 4.3-devel, `jagsUI` (1.5.2), and up-to-date CRAN versions of other packages. 17 | 18 | ## 2021-07-12 19 | 20 | * Add script to plot the figures in AHM2 section 8.2.3 (Figs 8.4 to 8.7) with credible intervals. 21 | 22 | ## 2021-06-25 23 | 24 | * Incorporate [errata](https://sites.google.com/site/appliedhierarchicalmodeling/errata) into code for sections AHM2 3.4.4 and 3.4.5. 25 | 26 | ## 2021-06-21 27 | 28 | * Changes to calls to `jagsUI::traceplot` to accommodate the new version (1.5.2). 29 | 30 | `traceplot` and `densityplot` now plot multiple nodes in the same window, so calling `par(mfrow=...)` before calling the plotting function is no longer necessary or effective. The default with > 4 nodes to plot is a 3 x 3 layout. Other layouts can be specified with the `layout` argument. 31 | 32 | Tested: Windows 10, R 4.2-devel, and up-to-date CRAN versions of other packages, including`jagsUI` (1.5.2). 33 | 34 | ## 2021-05-23 35 | 36 | * Minor corrections to several files, mostly typos. 37 | * The testing routine now compares the values produced with the output from a prior run. Previously it only checked for errors in execution. 38 | 39 | Tested: Windows 10, R 4.2-devel, GitHub version `jagsUI` (1.5.1.9102) and up-to-date CRAN versions of other packages, including `unmarked` (1.1.1) and `AHMbook` (0.2.3). 40 | 41 | ## 2021-05-14 42 | 43 | * Fixed incorrect description of `lambda` in comments in AHM2_02.05.1+2.R (thanks to José Jiménez). 44 | * Fixed run time for the same file. 45 | 46 | ## 2021-04-28 47 | 48 | * Fixed restoration of plotting parameters after calls to `par` in multiple files, as autocheck now reports when this is not done. 49 | 50 | Tested: Windows 10, R 4.1.0-alpha, GitHub versions of `AHMbook` (0.2.2.9001), `jagsUI` (1.5.1.9101) and `unmarked` (1.0.1.9014), up-to-date CRAN versions of other packages. 51 | 52 | ## 2021-02-24 to 27 53 | 54 | * Added scripts with NIMBLE code for CAR models in AHM2 sections 3.4.4, 3.4.5, 9.4.1, 9.4.3 and 09.5. 55 | 56 | ## 2021-02-19 57 | 58 | * Removed all non-ASCII characters (mostly smart quotes) from _comments_ in BUGS/JAGS code. These did not affect running the models, but prevented reloading the output saved in `.RData` files. 59 | 60 | ## 2021-02-18 61 | 62 | * Fixed number of cores used by `AICcmodavg::Nmix.gof.test` and `unmarked::parboot` when `parallel=TRUE`; the default is to use all-but-one of the cores on the machine, and can crash when other applications are running. 63 | 64 | Tested: Windows 10, R 4.0.4, GitHub versions of `AHMbook` (0.2.2.9001), `jagsUI` (1.5.1.9101) and `unmarked` (1.0.1.9011), up-to-date CRAN versions of other packages. 65 | 66 | ## 2021-02-13 67 | 68 | * Added bonus script to run the simulation in AHM1 10.7 in JAGS 69 | 70 | ## 2020-10-08 to 27 71 | 72 | * Added code for AHM2 Figures in chapters 2, 7, 11 73 | * Added simulation code for AHM2 1.7.1 74 | * Removed unnecessary call to `library(coda)` in AHM1 11.7 to avoid clashes with `jagsUI::traceplot`. 75 | * Tidied up plotting code in AHM1 11.7. 76 | 77 | Tested: Windows 10, R 4.0.3, jagUI 1.5.1 patched to `ask` only for interactive devices, up-to-date CRAN versions of other packages. 78 | 79 | ## 2020-07-14 to 31 80 | 81 | * Added AHM2 chapters 7 to 11. 82 | 83 | ## 2020-06-27 84 | 85 | Many small changes to AHM1 scripts 86 | 87 | * Added code execution times to scripts which take more than a minute or so to run. 88 | * Added `par(op)` to reset plotting parameters after each block of plotting code. 89 | * Changed indenting in many places to make it consistent across scripts. 90 | * Broke up long lines to keep line length <= 80 characters as far as possible. 91 | * `T` and `F` replaced with `TRUE` and `FALSE` wherever appropriate. 92 | 93 | ## 2020-06-25 94 | 95 | * Added TO_DO file. 96 | * Added AHM2 chapters 5 and 6, including bonus code and figure code. 97 | 98 | ## 2020-06-21 99 | 100 | More material for AHM2 101 | 102 | * Added plotting code for most of the figures in chapters 1 to 3. 103 | * Added chapter 4, including bonus code and figure code. 104 | 105 | ## 2020-06-01 106 | 107 | Testing with R 4.0.1 RC and latest versions of packages. 108 | 109 | * Change of default for `stringsAsFactors` in `data.frame`: `stringsAsFactors=TRUE` needed in some places. 110 | 111 | ## 2020-02-06 112 | 113 | Preliminary code for AHM2 chapters 1 to 3 added. These all work properly but may need some tidying up. 114 | 115 | ## 2019-12-14 116 | 117 | A slew of changes to enable scripts to run reasonably quickly and without human intervention for testing purposes. The main features are: 118 | 119 | * `R2WinBUGS::bugs` calls now all have `debug = FALSE`, original lines with `debug = TRUE` commented out. 120 | * Calls to `browser()` commented out, replaced with a call to `devAskNewPage()`. 121 | * Plotting calls with `ask` argument get `dev.interactive()`, this means R only asks for page confirmation for screen devices. (Testing sends plots to a .PDF file.) 122 | * In a few cases, calls to `jagsUI::jags` have been changed to `parallel = TRUE` to save time. 123 | * Numbers of iterations have been reduced for some simulations and MCMC runs that were taking several hours. 124 | 125 | Tested: Windows 10, R 3.6.2, jagUI 1.5.1 patched to `ask` only for interactive devices, up-to-date CRAN versions of other packages. 126 | 127 | # 2019-08-09 128 | 129 | Changes to scripts so that each script can be run in a new R session. This involved inserting additional code from earlier sections at the top of the script or loading saved output from previous sections. 130 | 131 | In checking the scripts, I found some of the original code no longer worked and provided new code that does work. For example: 132 | 133 | * `AICcmodavg::Nmix.gof.test` and `unmarked::parboot` now have an argument `parallel` with default `TRUE`, but some original code will not run in parallel. 134 | * The output object for `AICcmodavg::predict` has changed. 135 | * From R 3.6.0 a new random number generator was introduced as the default for `sample` and relatives. 136 | * In sections 11.7-11.9 the order of the columns in `all10` is now different, so column numbers are now wrong. 137 | * Shape files for the plots of Swiss maps referred to in the code have not been made available. 138 | 139 | Tested: Windows 10, R 3.6.1 and up-to-date CRAN versions of packages. 140 | 141 | # 2019-08-05 142 | 143 | Uploaded Vol 1 code from 2017-05-19, chopped into scripts for each main section with Errata up to 2019-08-05. 144 | 145 | # 2019-08-02 146 | 147 | Test commit with code for Vol 1 chapter 1 and README.md file. 148 | 149 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # AHM code 2 | 3 | The two-volume work *Applied Hierarchical Modeling in Ecology: Analysis of distribution, abundance and species richness in R and BUGS* by Marc Kéry and Andy Royle contains lots of R and BUGS code. 4 | 5 | The R package `AHMbook`, available on CRAN, has all the data sets and the custom functions used in the books. Commented code for the functions is on GitHub [here](https://github.com/mikemeredith/AHMbook). 6 | 7 | This repository has all the code in the printed books, plus code referred to as "available on the website" but not printed. The aim is to have code which works with current versions of R, JAGS and contributed R packages. The code is regularly tested and updated code inserted, with the original printed code retained but commented out with `#`. Please open an issue if you find other code which does not work. 8 | 9 | In addition to these updates, some code has been inserted: 10 | * Code added at the top of the script to recreate or reload objects from previous sections; each script is self-contained. 11 | * Some changes have been made to facilitate automated checking of scripts, in particular reductions in the number of iterations for simulations, bootstraps and MCMC runs. 12 | * After long runs of `unmarked`, `JAGS` or `WinBUGS`, I've inserted code to save the results to `RData` files. 13 | 14 | Additional code and comments are marked off with twiddly lines like this: 15 | ``` 16 | #~~~~ oldfunction has been replaced with newfunction ~~~~~~~ 17 | # oldfunction(foo) 18 | newfunction(foo) 19 | # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 20 | ``` 21 | 22 | ## Avoiding WinBUGS 23 | 24 | WinBUGS is not essential to work through the code. In most cases, `jagsUI::jags` is a drop-in replacement for `R2WinBUGS::bugs`. JAGS does not do spatial autocorrelation (CAR) models, as used in AHM2 chapters 3 and 9; for those, the `nimble` package can be used, and alternative scripts are provided. 25 | 26 | ## Volume 1 (AHM1) 27 | 28 | The code for the first volume (AHM1), with updates up to 2017, is available as a single huge text file on the [main book web page](http://www.mbr-pwrc.usgs.gov/pubanalysis/keryroylebook/). 29 | 30 | ## Volume 2 (AHM2) 31 | 32 | The book appeared in October 2020 (with copyright dated 2021). The code here is based on the final proofs. 33 | -------------------------------------------------------------------------------- /TO_DO.md: -------------------------------------------------------------------------------- 1 | ## AHM code 2 | 3 | # TO DO list 4 | 5 | ## Additional material needed for AHM2 6 | 7 | At many points in the book it says that full code or additional code is available on the website. Most of that has been inserted into the scripts for the relevant (sub)section. Code to produce most of the plots has also been added. 8 | 9 | The only item still outstanding is: 10 | 11 | * 7.6.6 "We conducted a small simulation study to evaluate the influence of the coupled occupancy model on classification (see the book website for code)." and Figure 7.5. 12 | -------------------------------------------------------------------------------- /install_packages.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | # Install or update packages needed to run the code in this repository 4 | # ==================================================================== 5 | # All of these are available from CRAN 6 | 7 | # I suggest first running 8 | update.packages(ask='graphics',checkBuilt=TRUE) 9 | # to ensure everything is up to date, including dependencies. 10 | 11 | needed <- c("AHMbook", "AICcmodavg", "berryFunctions", "coda", "corrplot", "denstrip", 12 | "devtools", "doParallel", "fields", "foreach", "jagsUI", "lme4", "mcmcOutput", 13 | "nimble", "plotrix", "R2OpenBUGS", "R2WinBUGS", "raster", "rjags", 14 | "sp", "unmarked", "wiqid") # package 'rgdal' is no longer needed 15 | got <- rownames(installed.packages()) 16 | 17 | ( notgot <- needed[!needed %in% got] ) 18 | 19 | install.packages(notgot, dependencies=TRUE) 20 | 21 | # 'devel' versions of packages 22 | # ---------------------------- 23 | # If you want to try out devel versions of packages from GitHub, install these 24 | # AFTER 'update.packages' as that will "downdate" to the latest CRAN version. 25 | # For example: 26 | # remotes::install_github("mikemeredith/AHMbook") 27 | # packageVersion("AHMbook") 28 | # remotes::install_github("rbchan/unmarked") 29 | # remotes::install_github("kenkellner/unmarked") 30 | # packageVersion("unmarked") 31 | # remotes::install_github("kenkellner/jagsUI") 32 | # packageVersion("jagsUI") 33 | 34 | --------------------------------------------------------------------------------