├── .github └── workflows │ └── R-CMD-check.yaml ├── .gitignore ├── .travis.yml ├── DESCRIPTION ├── NAMESPACE ├── NEWS.md ├── R ├── as.mulTree.R ├── as.mulTree_fun.R ├── clean.data.R ├── clean.data_fun.R ├── mulTree-package.R ├── mulTree.R ├── mulTree_fun.R ├── plot.mulTree.R ├── plot.mulTree_fun.R ├── read.mulTree.R ├── read.mulTree_fun.R ├── sanitizing.R ├── summary.mulTree.R ├── summary.mulTree_fun.R ├── tree.bind.R └── tree.bind_fun.R ├── README.md ├── data ├── lifespan.mcmc.rda ├── lifespan.rda └── lifespan_volant_192taxa.rda ├── desiderata.md ├── doc ├── Vanilla_flavoured_phylogenetic_analyses.Rmd ├── Vanilla_flavoured_phylogenetic_analyses.html ├── mulTree-manual.Rnw ├── mulTree-manual.pdf └── mulTree-manual.tex ├── man ├── as.mulTree.Rd ├── clean.data.Rd ├── lifespan.Rd ├── lifespan.mcmc.Rd ├── lifespan_volant_192taxa.Rd ├── mulTree-package.Rd ├── mulTree.Rd ├── plot.mulTree.Rd ├── read.mulTree.Rd ├── summary.mulTree.Rd └── tree.bind.Rd └── tests ├── testthat.R └── testthat ├── test-as.mulTree.R ├── test-clean.data.R ├── test-mulTree.R ├── test-plot.mulTree.R ├── test-read.mulTree.R ├── test-sanitizing.R ├── test-summary.mulTree.R └── test-tree.bind.R /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master, release] 6 | pull_request: 7 | branches: [main, master, release] 8 | 9 | name: R-CMD-check 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: ${{ matrix.config.os }} 14 | 15 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 16 | 17 | strategy: 18 | fail-fast: false 19 | matrix: 20 | config: 21 | - {os: macos-latest, r: 'release'} 22 | - {os: windows-latest, r: 'release'} 23 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 24 | - {os: ubuntu-latest, r: 'release'} 25 | - {os: ubuntu-latest, r: 'oldrel-1'} 26 | 27 | env: 28 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 29 | R_KEEP_PKG_SOURCE: yes 30 | R_REMOTES_NO_ERRORS_FROM_WARNINGS: true 31 | 32 | steps: 33 | - uses: actions/checkout@v3 34 | 35 | - uses: r-lib/actions/setup-pandoc@v2 36 | 37 | - uses: r-lib/actions/setup-r@v2 38 | with: 39 | r-version: ${{ matrix.config.r }} 40 | http-user-agent: ${{ matrix.config.http-user-agent }} 41 | use-public-rspm: true 42 | 43 | - uses: r-lib/actions/setup-r-dependencies@v2 44 | with: 45 | extra-packages: any::rcmdcheck 46 | needs: check 47 | 48 | - uses: r-lib/actions/check-r-package@v2 49 | with: 50 | upload-snapshots: true 51 | error-on: '"error"' 52 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Security 2 | .coveralls.yml 3 | 4 | # Raw data and idiocy prevention# 5 | *.xlsx 6 | *.xls 7 | *.doc 8 | *.docx 9 | *.pptx 10 | 11 | # Compiled source # 12 | *.com 13 | *.class 14 | *.dll 15 | *.exe 16 | *.o 17 | *.so 18 | 19 | # Packages # 20 | *.7z 21 | *.dmg 22 | *.gz 23 | *.iso 24 | *.jar 25 | *.rar 26 | *.tar 27 | *.zip 28 | 29 | # Logs and databases # 30 | *.log 31 | *.sql 32 | *.sqlite 33 | 34 | # LaTeX # 35 | *.fls 36 | *.aux 37 | *.bbl 38 | *.blg 39 | *.dvi 40 | *.fff 41 | *.lof 42 | *.lot 43 | *.out 44 | *.toc 45 | *.ttt 46 | *.fdb_latexmk 47 | *.pdf 48 | 49 | # beamer 50 | *.nav 51 | *.snm 52 | 53 | # OS generated files # 54 | *.DS_Store 55 | ehthumbs.db 56 | Icon? 57 | Thumbs.db 58 | 59 | # R # 60 | *.Rhistory 61 | *.Rapp.history 62 | 63 | # *.\#* 64 | # \#*\# 65 | 66 | ignore/ 67 | *.Rcheck/ 68 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: r 2 | warnings_are_errors: false 3 | 4 | # blacklist 5 | branches: 6 | except: 7 | - master 8 | 9 | # whitelist 10 | branches: 11 | only: 12 | - release 13 | 14 | # covr 15 | r_packages: 16 | - covr 17 | 18 | after_success: 19 | - Rscript -e 'library(covr); codecov()' 20 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: mulTree 2 | Title: Performs MCMCglmm on Multiple Phylogenetic Trees 3 | Author: Thomas Guillerme & Kevin Healy 4 | Maintainer: Thomas Guillerme 5 | Version: 1.3.7 6 | Date: 2020-04-12 7 | Description: Allows to run a MCMCglmm on multiple phylogenetic trees to take into account phylogenetic uncertainty. 8 | Depends: 9 | R (>= 3.6.0), 10 | ape, 11 | coda, 12 | hdrcde, 13 | MCMCglmm, 14 | snow 15 | License: GPL (>= 2) 16 | VignetteBuilder: knitr 17 | Suggests: 18 | testthat, 19 | knitr 20 | RoxygenNote: 7.3.2 21 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(plot,mulTree) 4 | S3method(summary,mulTree) 5 | export(as.mulTree) 6 | export(clean.data) 7 | export(mulTree) 8 | export(read.mulTree) 9 | export(tree.bind) 10 | import(ape) 11 | importFrom(MCMCglmm,MCMCglmm) 12 | importFrom(coda,as.mcmc) 13 | importFrom(coda,effectiveSize) 14 | importFrom(coda,gelman.diag) 15 | importFrom(coda,mcmc.list) 16 | importFrom(grDevices,gray) 17 | importFrom(graphics,axis) 18 | importFrom(graphics,plot) 19 | importFrom(graphics,points) 20 | importFrom(graphics,polygon) 21 | importFrom(hdrcde,hdr) 22 | importFrom(snow,clusterCall) 23 | importFrom(snow,makeCluster) 24 | importFrom(snow,stopCluster) 25 | importFrom(stats,as.formula) 26 | importFrom(stats,end) 27 | importFrom(stats,median) 28 | importFrom(stats,quantile) 29 | importFrom(stats,rnorm) 30 | importFrom(stats,terms) 31 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | mulTree 1.3.7 (2020-04-12) 2 | ========================= 3 | 4 | ### MINOR IMPROVEMENTS 5 | 6 | * Updated package to R version 3.6.3 7 | * Updated package to `ape` version 5.3 8 | 9 | mulTree 1.3.6 (2019-05-08) 10 | ========================= 11 | 12 | ### MINOR IMPROVEMENTS 13 | 14 | * Updated package to R version 3.6.0 15 | 16 | mulTree 1.3.5 (2019-03-04) 17 | ========================= 18 | 19 | ### MINOR IMPROVEMENTS 20 | 21 | * `read.mulTree` can now read more than 9 chains (following [Hugo Gruson](https://github.com/Bisaloo)'s [contribution](https://github.com/TGuillerme/mulTree/pull/51)) 22 | 23 | mulTree 1.3.4 (2018-08-08) 24 | ========================= 25 | 26 | ### NEW FEATURES 27 | 28 | * Increased test coverage for all functions. 29 | 30 | ### MINOR IMPROVEMENTS 31 | 32 | * Improved optional arguments handling for `mulTree` (following [Eldar Rakhimberdiev](https://github.com/eldarrak)'s contribution) 33 | * Fixed typos in the manual 34 | 35 | mulTree 1.3.3 (2018-03-14) 36 | ========================= 37 | 38 | ### MINOR IMPROVEMENTS 39 | 40 | * Converted `patch_notes.md` into `NEWS.md` (with the correct standard format). 41 | 42 | ### BUG FIXES 43 | 44 | * Minor bug fix: the trees in `data(lifespan)` are now all ultrametric. 45 | 46 | mulTree 1.3.2 (2017/10/19) 47 | ========================= 48 | 49 | ### NEW FEATURES 50 | 51 | * Complex formula management in `mulTree` and `as.mulTree`. 52 | 53 | ### MINOR IMPROVEMENTS 54 | 55 | * Added `ask` option to `mulTree`, whether to ask to overwrite files or not. 56 | * Minor changes (internal) and code coverage increased for `SIDER` release. 57 | 58 | 59 | mulTree 1.3.0 (2017-06-12) 60 | ========================= 61 | 62 | ### BUG FIXES 63 | 64 | * Minor fix to `clean.data` to properly deal with data frames. 65 | 66 | 67 | mulTree 1.2.6 (2017/05/15) 68 | ========================= 69 | 70 | ### NEW FEATURES 71 | 72 | * Allows R-structure's standrad multi-response model in `as.mulTree` (e.g. `rand.terms = ~taxa + specimen + us(trait):observation`). 73 | 74 | ### MINOR IMPROVEMENTS 75 | 76 | * Removed `caper` dependencies. 77 | * `coda::gelman.diag` in `mulTree` now only outputs a warning rather than a stop messag 78 | 79 | ### BUG FIXES 80 | 81 | * Minor fixes to code internal documentation. 82 | 83 | 84 | mulTree 1.2.5 (2017/01/09) 85 | ========================= 86 | 87 | ### MINOR IMPROVEMENTS 88 | 89 | * Added minor sanitising function to `mulTree` the formula now has to match the data set column names. 90 | 91 | ### BUG FIXES 92 | 93 | * Fixed a bug with the `parallel` option in `mulTree`: only one cluster is now generated at the start of the function rather than one at each iteration. 94 | * Fixed a minor bug with `as.mulTree`: the random terms formula's environment is not anymore exported by the function when set up by default. 95 | 96 | 97 | mulTree 1.2.4 (2016/08/10) 98 | ========================= 99 | 100 | ### MINOR IMPROVEMENTS 101 | 102 | * Models memory management is now safer and is done only out of R environment leading to minor speed improvements in `mulTree` function. 103 | * Some errors are now more verbose in `mulTree` and `summary.mulTree`. 104 | 105 | ### BUG FIXES 106 | * Fixed a bug in the convergence test where the convergence was not ran on the VCV matrix. 107 | * Fixed bug with `plot.mulTree` that didn't allow to plot more than 5 parameters. 108 | 109 | 110 | mulTree 1.2.3 (2016/07/06) 111 | ========================= 112 | 113 | ### NEW FEATURES 114 | 115 | * New phylogenetic analysis markdown vignette! 116 | 117 | ### MINOR IMPROVEMENTS 118 | 119 | * External functions are now properly imported via the `NAMESPACE`. 120 | 121 | mulTree 1.2.2 (2016/02/19) 122 | ========================= 123 | 124 | ### BUG FIXES 125 | * major bug fix in `mulTree` where models saved out of `R` environment where accumulating data from former models (now fixed: each model saved out of the `R` environment contains only data for the target model). 126 | 127 | mulTree 1.2.1 (2016/01/25) 128 | ========================= 129 | 130 | ### BUG FIXES 131 | * minor bug fix in `summary.mulTree` that can now deal with multiple hdr for each probabilities. 132 | * minor bug fix in `plot.mulTree` with the number of terms used 133 | 134 | mulTree 1.2.0 (2016/01/21) 135 | ========================= 136 | 137 | ### NEW FEATURES 138 | 139 | * complete new architectural structure! 140 | * all the functions are now unit tested! 141 | * all manuals are now written in Roxygen2 format! 142 | 143 | ### DEPRECATED AND DEFUNCT 144 | 145 | * many functions arguments names have been modified, please check individual functions manual. 146 | * `rTreeBind` is renamed to `tree.bind`. 147 | * In `as.mulTree`, the argument `species` is now `taxa`. 148 | * `mulTree` output: when output chain name already exists in current directory, the function now asks if user wants to overwrite the existing files. 149 | * In `read.mulTree`, the argument `mulTree.mcmc` is now `mulTree.chain`. 150 | * In `summary.mulTree`, the argument `mulTree.mcmc` is now `mulTree.results` and the argument `CI` is now `prob`. 151 | * `summary.mulTree` now outputs a `c("matrix", "mulTree")` class object. 152 | * In `plot.mulTree`, the argument `mulTree.mcmc` must now be an object returned from `summary.mulTree`. 153 | 154 | 155 | mulTree 1.1.2 (2015/11/05) 156 | ========================= 157 | 158 | ### MINOR IMPROVMENTS 159 | 160 | * added the `extract` option to `read.mulTree` to extract specific elements of each models. 161 | * minor update on `as.mulTree`: can now intake single `phylo` objects. 162 | 163 | ### BUG FIXES 164 | 165 | * fixed bug with `clean.data` function 166 | 167 | 168 | mulTree 1.1.1 (2015/10/02) 169 | ========================= 170 | 171 | ### NEW FEATURES 172 | 173 | * `summary.mulTree` and `plot.mulTree` have now an option whether to use `hdrcde::hdr` or not. 174 | 175 | 176 | mulTree 1.1.0 (2015/08/17) 177 | ========================= 178 | 179 | ### NEW FEATURES 180 | 181 | * `mulTree` can now be run in parallel! 182 | 183 | 184 | mulTree 1.0.6 (2015/07/25) 185 | ========================= 186 | 187 | ### NEW FEATURES 188 | 189 | * `plot.mulTree` has several more graphical options (see `?plot.mulTree`). 190 | 191 | 192 | mulTree 1.0.5 (2015/07/08) 193 | ========================= 194 | 195 | ### BUG FIXES 196 | 197 | * `clean.data` now properly cleans data.frames with multiple specimens entries. 198 | 199 | 200 | mulTree 1.0.4 (2015/07/01) 201 | ========================= 202 | 203 | ### MINOR IMPROVEMENTS 204 | 205 | * improved formula management for `as.mulTree` and `mulTree`. 206 | 207 | 208 | mulTree 1.0.3 (2015/06/03) 209 | ========================= 210 | 211 | ### MINOR IMPROVEMENTS 212 | 213 | * `as.mulTree` now deals properly with same taxa entries. 214 | * updated examples for `as.mulTree` and `mulTree` on how to use specimen as a random term. 215 | 216 | 217 | mulTree 1.0.2 (2015/05/17) 218 | ========================= 219 | 220 | ### BUG FIXES 221 | 222 | * Fixed bug in `as.mulTree` function with the random terms management. 223 | 224 | mulTree 1.0.1 (2014/12/19) 225 | ========================= 226 | 227 | ### NEW FEATURES 228 | 229 | * NEW: `clean.data` function allows to match data and multiple trees and drop the non-shared taxa. 230 | * `as.mulTree` function now allows multiple specimens for any taxa and allows the user to fix the random terms to be passed to the `mulTree` function. 231 | 232 | 233 | Version in bold have a [release back-up](https://github.com/TGuillerme/mulTree/releases). 234 | -------------------------------------------------------------------------------- /R/as.mulTree.R: -------------------------------------------------------------------------------- 1 | #' @title Combines a data table and a "multiPhylo" object into a list to be used by the mulTree function 2 | #' 3 | #' @description Combines a data table and a multiple phylogenies. Changes the name of the taxa column into "sp.col" to be read by \code{\link[MCMCglmm]{MCMCglmm}}. 4 | #' 5 | #' @param data A \code{data.frame} or \code{matrix} containing at least two variable and taxa names. 6 | #' @param tree A \code{phylo} or \code{multiPhylo} object. 7 | #' @param taxa The name or the number of the column containing the list of taxa in the \code{data}. 8 | #' @param rand.terms A \code{\link[stats]{formula}} ontaining additional random terms to add to the default formula (phylogenetic effect). If missing, the random terms are the column containing the taxa names and a column containing the specimen names if more than one taxa per specimen is present. 9 | #' @param clean.data A \code{logical} value: whether to use the \code{\link{clean.data}} function. Default = \code{FALSE}. 10 | #' 11 | #' @return 12 | #' A \code{mulTree} object the data to be passed to the \code{\link{mulTree}} function. 13 | #' 14 | #' @details 15 | #' If \code{rand.terms} is specified by the user, the first element is forced to be called "animal". 16 | #' 17 | #' @examples 18 | #' ##Creates a data.frame 19 | #' data_table <- data.frame(taxa = LETTERS[1:5], var1 = rnorm(5), 20 | #' var2 = c(rep("a",2), rep("b",3))) 21 | #' ##Creates a list of tree 22 | #' tree_list <- rmtree(5,5, tip.label = LETTERS[1:5]) 23 | #' ##Creates the "mulTree" object 24 | #' as.mulTree(data_table, tree_list, taxa = "taxa") 25 | #' 26 | #' ##Creating a mulTree object with multiple specimens 27 | #' ##Creates a data.frame with taxa being labelled as "spec1" 28 | #' data_table_sp1 <- data.frame(taxa = LETTERS[1:5], var1 = rnorm(5), 29 | #' var2 = c(rep("a",2), rep("b",3)), specimen = c(rep("spec1", 5))) 30 | #' ##Creates a data.frame with taxa being labelled as "spec2" 31 | #' data_table_sp2 <- data.frame(taxa = LETTERS[1:5], var1 = rnorm(5), 32 | #' var2 = c(rep("a",2), rep("b",3)), specimen = c(rep("spec2", 5))) 33 | #' ##Combines both data.frames 34 | #' data_table <- rbind(data_table_sp1, data_table_sp2) 35 | #' ##Creates a list of tree 36 | #' tree_list <- rmtree(5,5, tip.label = LETTERS[1:5]) 37 | #' ##Creates the "mulTree" object (with a random term formula) 38 | #' as.mulTree(data_table, tree_list, taxa = "taxa", rand.terms = ~taxa+specimen) 39 | #' 40 | #' @seealso \code{\link{mulTree}} 41 | #' @author Thomas Guillerme 42 | #' @export 43 | 44 | as.mulTree <- function(data, tree, taxa, rand.terms, clean.data = FALSE) { 45 | 46 | ## Get the match call 47 | match_call <- match.call() 48 | 49 | ## SANITIZING 50 | ## data 51 | ## converting into a data.frame (if matrix) 52 | if (is(data, "matrix")) { 53 | data <- as.data.frame(data) 54 | } 55 | check.class(data, "data.frame") 56 | ## testing the length of the dataset 57 | if(length(data) < 3) { 58 | stop("data must contain one taxa name column and at least two variables.") 59 | } 60 | 61 | ## tree 62 | ## convert to multiPhylo if is phylo 63 | if(is(tree, "phylo")) { 64 | tree <- list(tree) 65 | class(tree) <- "multiPhylo" 66 | } 67 | ## must be multiPhylo 68 | check.class(tree, "multiPhylo", " must be of class phylo or multiPhylo.") 69 | 70 | ## taxa 71 | if (is(taxa, "numeric")) { 72 | taxa.column.num = TRUE 73 | } else { 74 | if (is(taxa, "character")) { 75 | taxa.column.num = FALSE 76 | } else { 77 | stop(paste(as.expression(match_call$taxa)," not found in ", as.expression(match_call$data), sep = ""), call. = FALSE) 78 | } 79 | } 80 | 81 | ## is provided column present in data? 82 | if(taxa.column.num == TRUE) { 83 | if(taxa > length(data)) { 84 | stop(paste("taxa column not found in ", as.expression(match_call$data), sep = ""), call. = FALSE) 85 | } else { 86 | taxa = names(data)[taxa] 87 | } 88 | } else { 89 | taxa.names <- grep(taxa, names(data)) 90 | if(length(taxa.names) == 0) { 91 | stop(paste(as.expression(match_call$taxa)," not found in ", as.expression(match_call$data), ".", sep = ""), call. = FALSE) 92 | } 93 | } 94 | 95 | ## rand.terms 96 | if(missing(rand.terms)) { 97 | set_rand_terms <- TRUE 98 | } else { 99 | ## Checking random terms class 100 | check.class(rand.terms, "formula") 101 | ## Checking if the element of rand.terms are present in the table 102 | terms_list <- labels(stats::terms(rand.terms)) 103 | ## Checking if the terms are column names 104 | terms_list_match <- match(terms_list, colnames(data)) 105 | 106 | if(any(is.na(terms_list_match))) { 107 | 108 | ## Check if the non-matching terms are correlation terms 109 | no_match <- terms_list[is.na(terms_list_match)] 110 | is_cor <- grep("us\\(", no_match) 111 | 112 | if(length(is_cor) != length(no_match)) { 113 | ## At leas one wrong term anyway! 114 | stop("The following random terms do not match with any column name provided in data:\n ", paste(as.character(no_match), sep = ", "), ".", sep = "") 115 | } else { 116 | cor_term_tmp <- strsplit(no_match, split = ":")[[1]] 117 | is_us <- grep("us\\(", cor_term_tmp) 118 | cor_term <- c(strsplit(strsplit(cor_term_tmp[is_us], split = "\\(")[[1]][2], "\\)")[[1]][1], cor_term_tmp[-is_us]) 119 | cor_terms_list_match <- match(cor_term, colnames(data)) 120 | 121 | if(any(is.na(cor_terms_list_match))) { 122 | if(!any(cor_term[is.na(cor_terms_list_match)] %in% c("units", "trait"))) { 123 | stop("The following random terms do not match with any column name provided in data:\n ", paste(cor_term[is.na(cor_terms_list_match)], sep = ", "), ".", sep = "") 124 | } 125 | } 126 | } 127 | } 128 | 129 | ## check if at least of the terms is the phylogeny (i.e. animal) 130 | if(length(grep(taxa, terms_list)) > 0 || length(grep("animal", terms_list)) > 0) { 131 | set_rand_terms <- FALSE 132 | } else { 133 | stop("The provided random terms should at least contain the taxa column (phylogeny).") 134 | } 135 | } 136 | 137 | ## clean.data 138 | check.class(clean.data, "logical") 139 | 140 | ## BUILDING THE "mulTree" OBJECT LIST 141 | 142 | ## cleaning the data (optional) 143 | if(clean.data == TRUE) { 144 | data_cleaned <- mulTree::clean.data(data, tree, data.col = taxa) 145 | tree_new <- data_cleaned$tree 146 | data_new <- data_cleaned$data 147 | if(all(is.na(c(data_cleaned$dropped_tips, data_cleaned$dropped_rows)))) { 148 | cat("Taxa in the tree and the table are all matching!\n") 149 | } else { 150 | cat("The following taxa were dropped from the analysis:\n", c(data_cleaned$dropped_tips, data_cleaned$dropped_rows), "\n") 151 | } 152 | } else { 153 | tree_new <- tree 154 | data_new <- data 155 | } 156 | 157 | ## renaming the taxa column in the data.frame 158 | ## (this is because of the weird way comparative.data() deals with it's arguments (names.col <- as.character(substitute(names.col))), taxa as to be replaced by just "sp.col" instead of the more cleaner way: (taxa, list(taxa = taxa))) as in names.col <- as.character(substitute(taxa, list(taxa = taxa))).) 159 | names(data_new) <- sub(taxa, "sp.col", names(data_new)) 160 | 161 | ## Setting the random terms 162 | if(set_rand_terms) { 163 | ## adding the "animal" column for MCMCglmm() random phylogenetic effect 164 | data_new["animal"] <- NA 165 | data_new$animal <- data_new$sp.col 166 | rand.terms <- substitute(~animal) 167 | } else { 168 | ## Check which term corresponds to the phylogeny (i.e. animal) 169 | phylo_term <- terms_list[which(terms_list == taxa)] 170 | ## Composite phylo_term 171 | if(length(phylo_term) == 0) { 172 | if(length(grep(taxa, terms_list)) > 0) { 173 | phylo_term <- which(colnames(data_new) == "sp.col") 174 | } else { 175 | phylo_term <- which(colnames(data_new) == "animal") 176 | } 177 | } 178 | 179 | data_new[phylo_term] <- NA 180 | data_new[phylo_term] <- data_new[,which(names(data_new) == "sp.col")] 181 | 182 | ## Modify the formula and the column name to correspond to animal (phylogeny) for MCMCglmm (unless the phylo term is already called animal) 183 | #TG: THIS PART OF THE CODE IS A BIT CLUMSY! MIGHT WANT TO MODIFY THAT IN THE FUTURE 184 | 185 | 186 | if(phylo_term != "animal") { 187 | if(length(grep("animal", rand.terms)) == 0) { 188 | names(data_new)[which(names(data_new) == phylo_term)] <- "animal" 189 | if(length(terms_list) == 1) { 190 | rand.terms[[2]] <- substitute(animal) 191 | } 192 | if(length(terms_list) == 2) { 193 | rand.terms[[2]][[2]] <- substitute(animal) 194 | } 195 | if(length(terms_list) == 3) { 196 | rand.terms[[2]][[2]][[2]] <- substitute(animal) 197 | } 198 | if(length(terms_list) == 4) { 199 | rand.terms[[2]][[2]][[2]][[2]] <- substitute(animal) 200 | } 201 | if(length(terms_list) == 5) { 202 | rand.terms[[2]][[2]][[2]][[2]][[2]] <- substitute(animal) 203 | } 204 | if(length(terms_list) == 6) { 205 | rand.terms[[2]][[2]][[2]][[2]][[2]][[2]] <- substitute(animal) 206 | } 207 | if(length(terms_list) == 7) { 208 | rand.terms[[2]][[2]][[2]][[2]][[2]][[2]][[2]] <- substitute(animal) 209 | } 210 | if(length(terms_list) == 8) { 211 | rand.terms[[2]][[2]][[2]][[2]][[2]][[2]][[2]][[2]] <- substitute(animal) 212 | } 213 | if(length(terms_list) == 9) { 214 | rand.terms[[2]][[2]][[2]][[2]][[2]][[2]][[2]][[2]][[2]] <- substitute(animal) 215 | } 216 | message("The random terms formula has been updated to \"", rand.terms,"\".\nThe column \"", taxa, "\" has been duplicated into a new column called \"animal\".") 217 | } 218 | } 219 | } 220 | 221 | ## Creating the mulTree object 222 | taxa_column <- paste("renamed column ", taxa, " into 'sp.col'", sep = "") 223 | output <- list(phy = tree_new, data = data_new, random.terms = rand.terms, taxa.column = taxa_column) 224 | ## Assign class 225 | class(output) <- "mulTree" 226 | 227 | return(output) 228 | } 229 | -------------------------------------------------------------------------------- /R/as.mulTree_fun.R: -------------------------------------------------------------------------------- 1 | ## Extracting tip labels from a tree (in alphabetical order) 2 | select.tip.labels <- function(tree, sort=TRUE) { 3 | if(sort == TRUE) { 4 | return(sort(tree$tip.label)) 5 | } else { 6 | return(tree$tip.label) 7 | } 8 | } 9 | 10 | ## Transform specimens in unique species occurrences if necessary 11 | specimen.transform <- function(data) { 12 | ## Checking if they are multiple specimens in the data 13 | if(length(unique(data$sp.col)) == length(data$sp.col)) { 14 | ## all entries are unique 15 | return(data) 16 | } else { 17 | ## remove the duplicated names (create a dummy data) 18 | return(data.frame("sp.col"=unique(data$sp.col), "dummy"=stats::rnorm(length(unique(data$sp.col))))) 19 | } 20 | } 21 | 22 | # #Testing if the data can be use in comparative.data 23 | # comparative.data.test <- function(data, tree) { 24 | # #Try lapply loop 25 | # comparative.data.try <- function(...) { 26 | # return(try(caper::comparative.data(...), silent = TRUE)) 27 | # } 28 | 29 | # #Testing each tree 30 | # test <- lapply(tree, comparative.data.try, data = specimen.transform(data), names.col = "sp.col", vcv = FALSE) 31 | 32 | # #All outputs must be "comparative.data" and match the lenght of the tree object 33 | # test_results <- unlist(lapply(test, class)) 34 | # if(length(test_results) != length(tree)) { 35 | # return(FALSE) 36 | # } else { 37 | # if(any(test_results != "comparative.data")) { 38 | # return(FALSE) 39 | # } else { 40 | # return(TRUE) 41 | # } 42 | # } 43 | # } 44 | 45 | -------------------------------------------------------------------------------- /R/clean.data.R: -------------------------------------------------------------------------------- 1 | #' @title Cleaning phylogenetic data 2 | #' 3 | #' @description Cleans a table/tree to match with a given table/tree 4 | #' 5 | #' @param data A \code{data.frame} or \code{matrix} with the elements names as row names. 6 | #' @param tree A \code{phylo} or \code{multiPhylo} object. 7 | #' @param data.col Optional, the number (\code{numeric}) or name (\code{character}) of the column in \code{data} that contains the tip labels to match. If left missing, the \code{data}'s rownames are used (default is \code{FALSE}). 8 | #' 9 | #' @return 10 | #' A \code{list} containing the cleaned data and tree(s) and information on the eventual dropped tips and rows. 11 | #' 12 | #' @examples 13 | #' ##Creating a set of different trees 14 | #' trees_list <- list(rtree(5, tip.label = LETTERS[1:5]), rtree(4, 15 | #' tip.label = LETTERS[1:4]), rtree(6, tip.label = LETTERS[1:6])) 16 | #' class(trees_list) <- "multiPhylo" 17 | #' 18 | #' ##Creating a matrix 19 | #' dummy_data <- matrix(c(rnorm(5), runif(5)), 5, 2, 20 | #' dimnames = list(LETTERS[1:5], c("var1", "var2"))) 21 | #' 22 | #' ##Cleaning the trees and the data 23 | #' cleaned <- clean.data(data = dummy_data, tree = trees_list) 24 | #' ##The taxa that where dropped (tips and rows): 25 | #' c(cleaned$dropped_tips, cleaned$dropped_rows) 26 | #' ##The cleaned trees: 27 | #' cleaned$tree 28 | #' ##The cleaned data set: 29 | #' cleaned$data 30 | #' 31 | #' @author Thomas Guillerme 32 | #' @export 33 | 34 | clean.data <- function(data, tree, data.col = FALSE) { 35 | 36 | ## Get call 37 | match_call <- match.call() 38 | 39 | ## SANITIZING 40 | ## data 41 | data_class <- check.class(data, c("matrix", "data.frame"), " must be a data.frame or matrix object.") 42 | ## if matrix, it must have row names 43 | if(data_class == "matrix" && is.null(rownames(data))) { 44 | stop(paste(match_call$data, "must have row names.")) 45 | } 46 | 47 | ## tree 48 | tree_class <- check.class(tree, c("phylo", "multiPhylo"), " must be a phylo or multiPhylo object.") 49 | 50 | ## data.col 51 | if(data.col != FALSE) { 52 | check.length(data.col, 1, " must be either a numeric value or a character string.", errorif = FALSE) 53 | data_col_class <- check.class(data.col, c("numeric", "character")) 54 | 55 | if(data_col_class == "numeric") { 56 | ## Data.col is numeric 57 | if(data.col > ncol(data)) { 58 | stop(paste("Column", match_call$data.col, "is not present in", match_call$data)) 59 | } 60 | } else { 61 | ## Data.col is character 62 | data.col <- match(data.col, colnames(data)) 63 | if(is.na(data.col)) { 64 | stop(paste("Column", match_call$data.col, "is not present in", match_call$data)) 65 | } 66 | } 67 | } 68 | 69 | ## CLEANING THE DATA/TREES 70 | ## for a single tree 71 | if(tree_class == "phylo") { 72 | 73 | cleaned_data <- clean.tree.table(tree, data, data.col) 74 | 75 | } else { 76 | ## for multiple trees 77 | ## lapply function 78 | cleaned_list <- lapply(tree, clean.tree.table, data = data, data.col = data.col) 79 | 80 | ## Selecting the tips to drop 81 | tips_to_drop <- unique(unlist(lapply(cleaned_list, function(x) x[[3]]))) 82 | ## removing NAs 83 | if(any(is.na(tips_to_drop))) { 84 | tips_to_drop <- tips_to_drop[-which(is.na(tips_to_drop))] 85 | } 86 | 87 | ## Selecting the rows to drop 88 | rows_to_drop <- unique(unlist(lapply(cleaned_list, function(x) x[[4]]))) 89 | ## removing NAs 90 | if(any(is.na(rows_to_drop))) { 91 | rows_to_drop <- rows_to_drop[-which(is.na(rows_to_drop))] 92 | } 93 | 94 | ## Combining both 95 | taxa_to_drop <- c(tips_to_drop, rows_to_drop) 96 | 97 | ## Dropping the tips across all trees 98 | if(length(taxa_to_drop) != 0) { 99 | tree_new <- lapply(tree, drop.tip, taxa_to_drop) ; class(tree_new) <- 'multiPhylo' 100 | } else { 101 | ## removing taxa from the trees 102 | ## keep the same trees 103 | tree_new <- tree 104 | if(length(tips_to_drop) == 0) tips_to_drop <- NA 105 | } 106 | 107 | ## Dropping the rows 108 | if(length(rows_to_drop) != 0) { 109 | ## removing taxa from the data 110 | if(data.col != FALSE) { 111 | data_new <- data[!(data[,data.col] %in% rows_to_drop), ] 112 | } else { 113 | data_new <- data[!(rownames(data) %in% rows_to_drop), ] 114 | } 115 | } else { 116 | ## keep the same data 117 | data_new <- data 118 | if(length(rows_to_drop) == 0) rows_to_drop <- NA 119 | } 120 | 121 | ## output list 122 | cleaned_data <- list("tree" = tree_new, "data" = data_new, "dropped_tips" = tips_to_drop, "dropped_rows" = rows_to_drop) 123 | } 124 | 125 | return(cleaned_data) 126 | 127 | ## End 128 | } 129 | -------------------------------------------------------------------------------- /R/clean.data_fun.R: -------------------------------------------------------------------------------- 1 | ## Cleaning a tree so that the species match with the ones in a table 2 | clean.tree.table <- function(tree, data, data.col) { 3 | 4 | ## Intersecting names between both data sets 5 | if(data.col != FALSE) { 6 | matching_names <- intersect(tree$tip.label, data[,data.col]) 7 | } else { 8 | matching_names <- intersect(tree$tip.label, rownames(data)) 9 | } 10 | 11 | ## Which data is present 12 | if(data.col != FALSE) { 13 | data_match <- data[,data.col] %in% matching_names 14 | } else { 15 | data_match <- rownames(data) %in% matching_names 16 | } 17 | 18 | ## Which tips are present 19 | tips_match <- tree$tip.label %in% matching_names 20 | 21 | ## Matching the data 22 | if(all(data_match)) { 23 | dropped_rows <- NA 24 | } else { 25 | rows_numbers <- which(!data_match) 26 | if(data.col != FALSE) { 27 | dropped_rows <- as.character(data[,data.col][rows_numbers]) 28 | } else { 29 | dropped_rows <- rownames(data)[rows_numbers] 30 | } 31 | data <- data[-c(rows_numbers),] 32 | } 33 | 34 | ## Matching the tree 35 | if(all(tips_match)) { 36 | dropped_tips <- NA 37 | } else { 38 | dropped_tips <- tree$tip.label[!tips_match] 39 | tree <- drop.tip(tree, tip = dropped_tips) 40 | } 41 | 42 | return(list("tree" = tree, "data" = data, "dropped_tips" = dropped_tips, "dropped_rows" = dropped_rows)) 43 | } -------------------------------------------------------------------------------- /R/mulTree-package.R: -------------------------------------------------------------------------------- 1 | # devtools::build_win(version = "R-devel") 2 | 3 | #' Performs MCMCglmm On Multiple Phylogenetic Trees. 4 | #' 5 | #' Allows to run a MCMCglmm on multiuple phylogenetic trees to take into account phylogenetic uncertainty. 6 | #' 7 | #' @name mulTree-package 8 | #' 9 | #' @docType package 10 | #' 11 | #' @author Thomas Guillerme & Kevin Healy 12 | #' 13 | #' @references Healy, K., Guillerme T., Finlay, S., Kane, A., Kelly, S.B.A., McClean, D., Kelly, D.J., Donohue, I., Jackson, A.L. and Cooper, N. , 14 | #' 2014. Ecology and mode of life explain lifespan variation in birds and mammals. Proceedings of the Royal Society of London B. 281(1784), 20140298, 15 | #' 16 | #' @keywords phylogenetic correction, MCMCglmm, Bayesian, tree distribution 17 | #' 18 | #' @import ape 19 | NULL 20 | #' @importFrom stats terms 21 | NULL 22 | #' @importFrom stats rnorm 23 | NULL 24 | #' @importFrom stats as.formula 25 | NULL 26 | #' @importFrom stats quantile 27 | NULL 28 | #' @importFrom stats median 29 | NULL 30 | #' @importFrom stats end 31 | NULL 32 | # #' @importFrom caper comparative.data 33 | # NULL 34 | #' @importFrom coda as.mcmc 35 | NULL 36 | #' @importFrom coda gelman.diag 37 | NULL 38 | #' @importFrom coda effectiveSize 39 | NULL 40 | #' @importFrom coda mcmc.list 41 | NULL 42 | #' @importFrom MCMCglmm MCMCglmm 43 | NULL 44 | #' @importFrom hdrcde hdr 45 | NULL 46 | #' @importFrom snow makeCluster 47 | NULL 48 | #' @importFrom snow clusterCall 49 | NULL 50 | #' @importFrom snow stopCluster 51 | NULL 52 | #' @importFrom grDevices gray 53 | NULL 54 | #' @importFrom graphics plot 55 | NULL 56 | #' @importFrom graphics points 57 | NULL 58 | #' @importFrom graphics polygon 59 | NULL 60 | #' @importFrom graphics axis 61 | NULL 62 | 63 | 64 | 65 | 66 | #' Example Aves and Mammalia lifespan for the mulTree package 67 | #' 68 | #' This is a dataset containing lifespan data from 192 species of birds and mammals. 69 | #' 70 | #' @name lifespan_volant_192taxa 71 | #' @docType data 72 | #' 73 | #' @format The datafile contains a data frame (\code{lifespan_volant_192taxa}) of 192 complete cases for those species. The data frame contains five variables: 74 | #' \describe{ 75 | #' \item{species}{The species binomial name.} 76 | #' \item{class}{The species phylogenetic class.} 77 | #' \item{longevity}{The mean centred logged maximum lifespan in years.} 78 | #' \item{mass}{The mean centred logged body mass in grams.} 79 | #' \item{volant}{Flying ability, as a two level factor: volant and nonvolant.} 80 | #' } 81 | #' 82 | #' @references Healy, K., Guillerme, T., Finlay, S., Kane, A., Kelly, S, B, A., McClean, D., Kelly, D, J., Donohue, I., Jackson, A, L., Cooper, N. (2014) Ecology and mode-of-life explain lifespan variation in birds and mammals. Proceedings of the Royal Society B 281, 20140298c 83 | #' 84 | #' @keywords datasets 85 | NULL 86 | 87 | 88 | #' Example of mulTree analysis data 89 | #' 90 | #' This is an example of MCMCglmm output files using the \code{\link{mulTree}} function on the \code{lifespan} data. 91 | #' 92 | #' @name lifespan.mcmc 93 | #' @docType data 94 | #' 95 | #' @format Contains the results of a \code{mulTree} analysis on two trees with two independent chains per trees. 96 | #' 97 | #' @references Healy, K., Guillerme, T., Finlay, S., Kane, A., Kelly, S, B, A., McClean, D., Kelly, D, J., Donohue, I., Jackson, A, L., Cooper, N. (2014) Ecology and mode-of-life explain lifespan variation in birds and mammals. Proceedings of the Royal Society B 281, 20140298c 98 | #' 99 | #' @keywords datasets 100 | NULL 101 | 102 | 103 | #' Example dataset for the \code{mulTree} package 104 | #' 105 | #' This is a dataset containing lifespan data and trees from Healy et al (2014) 106 | #' 107 | #' @name lifespan 108 | #' @docType data 109 | #' 110 | #' @format Contains a \code{data.frame} and two \code{multiPhylo} objects: 111 | #' \describe{ 112 | #' \item{lifespan_volant}{A \code{data.frame} object of five variables for 192 species (see \code{\link{lifespan_volant_192taxa}}).} 113 | #' \item{trees_aves}{A \code{multiPhylo} object of two trees of 58 bird species. The tip names are the binomial names of the species.} 114 | #' \item{trees_mammalia}{A a \code{multiPhylo} object of two trees of 134 mammal species. The tip names are the binomial names of the species.} 115 | #' } 116 | #' 117 | #' @references Healy, K., Guillerme, T., Finlay, S., Kane, A., Kelly, S, B, A., McClean, D., Kelly, D, J., Donohue, I., Jackson, A, L., Cooper, N. (2014) Ecology and mode-of-life explain lifespan variation in birds and mammals. Proceedings of the Royal Society B 281, 20140298c 118 | #' 119 | #' @keywords datasets 120 | NULL 121 | 122 | -------------------------------------------------------------------------------- /R/mulTree.R: -------------------------------------------------------------------------------- 1 | #' @title Run MCMCglmm on multiple trees 2 | #' 3 | #' @description Running a \code{\link[MCMCglmm]{MCMCglmm}} model on a multiple phylogenies and a \code{data.frame} combined using \code{\link{as.mulTree}}. The results are written out of \code{R} environment as individual models. 4 | #' 5 | #' @param mulTree.data A list of class \code{mulTree} generated using \code{\link{as.mulTree}}. 6 | #' @param formula An object of class \code{formula} (excluding the random terms). 7 | #' @param parameters A list of three numerical values to be used respectively as: (1) the number of generations, (2) the sampling value, (3) the burnin. 8 | #' @param chains The number of independent chains to run per model. 9 | #' @param priors A series of priors to use for the MCMC. If missing, the priors will be the default parameters from the \code{\link[MCMCglmm]{MCMCglmm}} function. 10 | #' @param ... Any additional arguments to be passed to the \code{\link[MCMCglmm]{MCMCglmm}} function. 11 | #' @param convergence A numerical value for assessing chains convergence (default = \code{1.1}). 12 | #' @param ESS A numerical value for assessing the effective sample size (default = \code{1000}). 13 | #' @param verbose A logical value stating whether to be verbose or not (default = \code{TRUE}). 14 | #' @param output A string of characters that will be used as chain name for the models output (default = \code{mulTree_models}). 15 | #' @param warn Whether to print the warning messages from the \code{\link[MCMCglmm]{MCMCglmm}} function (default = \code{FALSE}). 16 | #' @param parallel An optional vector containing the virtual connection process type for running the chains in parallel (requires \code{snow} package). 17 | #' @param ask \code{logical}, whether to ask to overwrite models (\code{TRUE} - default) or not (\code{FALSE})). 18 | #' 19 | #' @return 20 | #' Generates MCMCglmm models and saves them sequentially out of \code{R} environment to minimise users RAM usage. 21 | #' Use \code{\link{read.mulTree}} to reload the models back in the \code{R} environment. 22 | #' Because of the calculation of the vcv matrix for each model and each tree in the MCMCglmm models, this function is really RAM demanding. 23 | #' For big datasets we heavily recommend to have at least 4GB RAM DDR3 available. 24 | #' 25 | #' @examples 26 | #' ## Quick example: 27 | #' ## Before the analysis 28 | #' data <- data.frame("sp.col" = LETTERS[1:5], var1 = rnorm(5), var2 = rnorm(5)) 29 | #' tree <- replicate(3, rcoal(5, tip.label = LETTERS[1:5]), simplify = FALSE) 30 | #' class(tree) <- "multiPhylo" 31 | #' mulTree.data <- as.mulTree(data, tree, taxa = "sp.col") 32 | #' priors <- list(R = list(V = 1/2, nu = 0.002), 33 | #' G = list(G1 = list(V = 1/2, nu = 0.002))) 34 | #' ## quick example 35 | #' mulTree(mulTree.data, formula = var1 ~ var2, parameters = c(10000, 10, 1000), 36 | #' chains = 2, prior = priors, output = "quick_example", convergence = 1.1, 37 | #' ESS = 100) 38 | #' ## Clean folder 39 | #' file.remove(list.files(pattern = "quick_example")) 40 | #' ## alternative example with parallel argument (and double the chains!) 41 | #' mulTree(mulTree.data, formula = var1 ~ var2, parameters = c(10000, 10, 1000), 42 | #' chains = 4, prior = priors, output = "quick_example", convergence = 1.1, 43 | #' ESS = 100, parallel = "SOCK") 44 | #' ## Clean folder 45 | #' file.remove(list.files(pattern = "quick_example")) 46 | #' 47 | #' \dontrun{ 48 | #' ## Before the analysis: 49 | #' ## read in the data 50 | #' data(lifespan) 51 | #' ## combine aves and mammalia trees 52 | #' combined_trees <- tree.bind(x = trees_mammalia, y = trees_aves, sample = 2, 53 | #' root.age = 250) 54 | #' 55 | #' ## Preparing the variables for the mulTree function 56 | #' ## creates the "mulTree" object 57 | #' mulTree_data <- as.mulTree(data = lifespan_volant, tree = combined_trees, 58 | #' taxa = "species") 59 | #' ## formula 60 | #' test_formula <- longevity ~ mass + volant 61 | #' ## parameters (number of generations, thin/sampling, burnin) 62 | #' mcmc_parameters <- c(101000, 10, 1000) 63 | #' # For higher ESS run longer by increasing the number of generations 64 | #' ## priors 65 | #' mcmc_priors <- list(R = list(V = 1/2, nu = 0.002), 66 | #' G = list(G1 = list(V = 1/2, nu = 0.002))) 67 | #' 68 | #' ## Running MCMCglmm on multiple trees 69 | #' ## WARNING: This example takes between 1 and 2 minutes to run 70 | #' ## and generates files in your current directory. 71 | #' mulTree(mulTree_data, formula = test_formula, parameters = mcmc_parameters, 72 | #' priors = mcmc_priors, output = "longevity.example", ESS = 50) 73 | #' 74 | #' ## The models are saved out of R environment under the "longevity.example" 75 | #' ## chains names. 76 | #' ## Use read.mulTree() to read the generated models. 77 | #' 78 | #' ## Remove the generated files from the current directory 79 | #' file.remove(list.files(pattern = "longevity.example")) 80 | #' 81 | #' ## Parallel example 82 | #' ## Loading the snow package 83 | #' library(snow) 84 | #' ## Running the same MCMCglmm on multiple trees 85 | #' mulTree(mulTree_data, formula = test_formula, parameters = mcmc_parameters, 86 | #' priors = mcmc_priors, output = "longevity.example", ESS = 50, 87 | #' parallel = "SOCK") 88 | #' ## Remove the generated files from the current directory 89 | #' file.remove(list.files(pattern = "longevity.example")) 90 | #' 91 | #' ## Same example but including specimens 92 | #' ## Subset of the data 93 | #' data <- lifespan_volant[sample(nrow(lifespan_volant), 30),] 94 | #' ##Create a dataset with two specimen per species 95 | #' data <- rbind(cbind(data, specimen = rep("spec1", 30)), cbind(data, 96 | #' specimen = rep("spec2", 30))) 97 | #' ##Cleaning the trees 98 | #' trees <- clean.data(data, combined_trees, data.col = "species")$tree 99 | #' 100 | #' ##Creates the mulTree object 101 | #' mulTree_data <- as.mulTree(data, trees, taxa = "species", 102 | #' rand.terms = ~species+specimen) 103 | #' 104 | #' ## Updating the priors 105 | #' mcmc_priors <- list(R = list(V = 1/2, nu = 0.002), 106 | #' G = list(G1 = list(V = 1/2, nu = 0.002), 107 | #' G2 = list(V = 1/2, nu = 0.002))) 108 | #' 109 | #' ##Running MCMCglmm on multiple trees 110 | #' mulTree(mulTree_data, formula = test_formula, parameters = mcmc_parameters, 111 | #' priors = mcmc_priors, output = "longevity.example", ESS = 50) 112 | #' ##Remove the generated files from the current directory 113 | #' file.remove(list.files(pattern = "longevity.example")) 114 | #'} 115 | #' 116 | #' @seealso \code{\link[MCMCglmm]{MCMCglmm}}, \code{\link{as.mulTree}}, \code{\link{read.mulTree}} 117 | #' @author Thomas Guillerme 118 | #' @export 119 | 120 | #DEBUG 121 | # source("sanitizing.R") 122 | # source("mulTree_fun.R") 123 | # source("read.mulTree_fun.R") 124 | # data <- data.frame("sp.col" = LETTERS[1:5], var1 = rnorm(5), var2 = rnorm(5)) 125 | # tree <- replicate(3, rcoal(5, tip.label = LETTERS[1:5]), simplify = FALSE) 126 | # class(tree) <- "multiPhylo" 127 | # mulTree.data <- as.mulTree(data, tree, taxa = "sp.col") 128 | # priors <- list(R = list(V = 1/2, nu = 0.002), G = list(G1 = list(V = 1/2, nu = 0.002))) 129 | # formula = var1 ~ var2 130 | # parameters = c(10000, 10, 1000) 131 | # chains = 2 132 | # prior = priors 133 | # output = "quick_example" 134 | # convergence = 1.1 135 | # ESS = 100 136 | # verbose = TRUE 137 | # warn = FALSE 138 | 139 | mulTree <- function(mulTree.data, formula, parameters, chains = 2, priors, ..., convergence = 1.1, ESS = 1000, verbose = TRUE, output = "mulTree_models", warn = FALSE, parallel, ask = TRUE) { 140 | 141 | ## HEADER 142 | ## libraries 143 | if(!missing(parallel)) { 144 | requireNamespace("snow") 145 | } 146 | ## timer(start) 147 | start.time <- Sys.time() 148 | 149 | ## Set working environment 150 | mulTree_env <- new.env() 151 | 152 | ## SANITIZING 153 | check.class(mulTree.data, "mulTree") 154 | 155 | ## formula 156 | check.class(formula, 'formula') 157 | ## Check the terms 158 | formula_terms <- as.character(attr(stats::terms(formula), "variables"))[-1] 159 | ## Remove potential trait/units 160 | if(length(grep("trait:", formula)) > 0) { 161 | formula_terms <- formula_terms[-which(formula_terms == "trait")] 162 | } 163 | if(length(grep("units:", formula)) > 0) { 164 | formula_terms <- formula_terms[-which(formula_terms == "units")] 165 | } 166 | 167 | check_formula <- match(formula_terms, colnames(mulTree.data$data)) 168 | 169 | if(any(is.na(check_formula))) { 170 | ## Check if the NA is from a multi-random 171 | na_formula_terms <- formula_terms[which(is.na(check_formula))] 172 | 173 | if(grep("\\(", na_formula_terms) > 0) { 174 | ## Function for clean term splitting 175 | split.term <- function(one_na) { 176 | return(unlist(strsplit(gsub(" ", "", gsub("\\)", "", strsplit(one_na, split = "\\(")[[1]][2])), split = ","))) 177 | } 178 | ## Splitting the terms (e.g. from a cbind) 179 | split_terms <- unique(unlist(lapply(as.list(na_formula_terms), split.term))) 180 | ## Matching the terms to the column names 181 | matching <- split_terms %in% colnames(mulTree.data$data) 182 | 183 | if(any(!matching)) { 184 | stop(paste(paste(formula_terms[which(!matching)], collapse = ", "), "terms in the formula do not match dataset column names.")) 185 | } 186 | } else { 187 | stop(paste(paste(formula_terms[which(is.na(check_formula))], collapse = ", "), "terms in the formula do not match dataset column names.")) 188 | } 189 | } 190 | 191 | ## chains 192 | check.class(chains, 'numeric') 193 | check.length(chains, 1, " must be a single value.") 194 | if(chains == 1) { 195 | message("Only one chain has been called: the convergence test can't be performed.") 196 | } 197 | 198 | ## parameters 199 | check.class(parameters, 'numeric') 200 | check.length(parameters, 3, " must be a vector of three elements: (1) the number of generations, (2) the sampling and (3) the burnin.") 201 | 202 | ## priors 203 | if(!missing(priors)) { 204 | check.class(priors, 'list') 205 | } 206 | 207 | ## convergence 208 | check.class(convergence, 'numeric') 209 | check.length(convergence, 1, " must be a single value.") 210 | 211 | ## ESS 212 | check.class(ESS, 'numeric') 213 | check.length(ESS, 1, " must be a single value.") 214 | 215 | ## verbose 216 | check.class(verbose, 'logical') 217 | 218 | ## output 219 | check.class(output, 'character') 220 | check.length(output, 1, " must be a single chain of characters.") 221 | ## Check if the output chain name is already present in the current directory 222 | if(ask && length(grep(output, list.files())) > 0) { 223 | read.key(paste("Output chain name \"", output, "\" already exists!\nPress [enter] if you wish to overwrite the models or [esc] to cancel.", sep = ""), "Models will be overwritten...") 224 | } 225 | 226 | ## warn 227 | check.class(warn, 'logical', " must be logical.") 228 | 229 | ## parallel 230 | if(!missing(parallel)) { 231 | check.class(parallel, "character") 232 | ## Set up the cluster 233 | cluster_ID <- snow::makeCluster(chains, parallel) 234 | do_parallel <- TRUE 235 | } else { 236 | do_parallel <- FALSE 237 | } 238 | 239 | dots <- list(...) 240 | optional_args <- ifelse(length(dots) == 0, FALSE, TRUE) 241 | 242 | ## RUNNING THE MODELS 243 | for (ntree in 1:length(mulTree.data$phy)) { 244 | ## Setting up mulTree arguments 245 | mulTree_arguments <- list("warn" = warn, "fixed" = formula, "random" = mulTree.data$random.terms, "pedigree" = mulTree.data$phy[[ntree]], "prior" = priors, "data" = mulTree.data$data, "verbose" = FALSE, "nitt" = parameters[1], "thin" = parameters[2], "burnin" = parameters[3]) 246 | 247 | ## Run the models 248 | if(!do_parallel) { 249 | for(nchain in 1:chains) { 250 | 251 | ## Run the model 252 | if(optional_args){ 253 | model <- lapply.MCMCglmm(c(mulTree_arguments, dots)) 254 | } else { 255 | model <- lapply.MCMCglmm(mulTree_arguments) 256 | } 257 | 258 | ## Saving the model out of R environment 259 | save(model, file = get.model.name(nchain, ntree, output)) 260 | 261 | ## reset the model's content (for safety) 262 | model <- NULL 263 | } 264 | 265 | } else { 266 | ## Run the models 267 | if(optional_args){ 268 | model_tmp <- snow::clusterCall(cluster_ID, lapply.MCMCglmm, c(mulTree_arguments, dots)) 269 | } else { 270 | model_tmp <- snow::clusterCall(cluster_ID, lapply.MCMCglmm, mulTree_arguments) 271 | } 272 | 273 | # if (!exists('pr')) { 274 | # model_tmp <- snow::clusterCall(cluster_ID, lapply.MCMCglmm, ntree, mulTree.data=mulTree.data, formula=formula, priors=priors, parameters=parameters, ..., warn=warn) 275 | # } else { 276 | # model_tmp <- snow::clusterCall(cluster_ID, lapply.MCMCglmm, ntree, mulTree.data=mulTree.data, formula=formula, priors=priors, parameters=parameters, ..., warn=warn, pr=pr) 277 | # } 278 | 279 | # model_tmp <- snow::clusterCall(cluster_ID, lapply.MCMCglmm, ntree, mulTree.data, formula, priors, parameters, ..., warn) 280 | #model_tmp <- snow::clusterCall(cluster_ID, lapply.MCMCglmm, ntree, mulTree.data=mulTree.data, formula=formula, priors=priors, parameters=parameters, warn=warn) ; warning("DEBUG MODE") 281 | 282 | ## Saving the models 283 | for (nchain in 1:chains) { 284 | ## Save on model for one chain 285 | model <- model_tmp[[nchain]] 286 | save(model, file = get.model.name(nchain, ntree, output)) 287 | ## Reset the model's content (for safety) 288 | model <- NULL 289 | } 290 | 291 | ## Reset the models for both chains (safety) 292 | model_tmp <- NULL 293 | } 294 | 295 | ## RUNNING THE CONVERGENCE DIAGNOSIS (if more than one chain) 296 | if(chains > 1) { 297 | ## Get the models 298 | models <- lapply(as.list(seq(1:chains)), extract.chains, ntree, output) 299 | ## Run the convergence test 300 | converge.test <- convergence.test(models) 301 | if(!is.null(converge.test)) { 302 | ## Saving the convergence test 303 | save(converge.test, file = paste(output, "-tree", ntree, "_conv", ".rda", sep = "")) 304 | } 305 | ## Calculate the ESS 306 | ESS_results <- lapply(models, ESS.lapply) 307 | names(ESS_results) <- paste("C", 1:chains, sep = "") 308 | ESS_results <- unlist(ESS_results) 309 | ## reset the models content (for safety) 310 | models <- NULL 311 | } 312 | 313 | ## BE VERBOSE 314 | if(verbose == TRUE) { 315 | cat("\n", format(Sys.Date()), " - ", format(Sys.time(), "%H:%M:%S"), ":", " MCMCglmm performed on tree ", ntree, "\n", sep = "") 316 | if(chains > 1) { 317 | cat("Convergence diagnosis:\n") 318 | if(all(ESS_results > ESS)) { 319 | cat("Effective sample size is > ", ESS, ": TRUE\n", sep = "") 320 | cat(ESS_results, sep="; ") ; cat("\n") 321 | } else { 322 | cat("Effective sample size is > ", ESS, ": FALSE\n", sep = "") 323 | cat(ESS_results, sep="; ") ; cat("\n") 324 | cat(paste(names(which(ESS_results < ESS)), collapse =", "), " < ", ESS, "\n", sep = "") 325 | } 326 | if(!is.null(converge.test)) { 327 | cat("All levels converged < ", convergence, ": ", all(converge.test$psrf[,c(1:2)] < convergence), "\n", sep = "") 328 | cat(converge.test$psrf[,c(1:2)], sep="; ") ; cat("\n") 329 | } 330 | cat("Individual models saved as: ", output, "-tree", ntree, "_chain*.rda\n", sep = "") 331 | cat("Convergence diagnosis saved as: ", output, "-tree", ntree, "_conv.rda", "\n", sep = "") 332 | } else { 333 | cat("Model saved as: ", output, "-tree", ntree, "_chain1.rda\n", sep = "") 334 | } 335 | } 336 | } 337 | 338 | if(!missing(parallel)) { 339 | ## Stop the cluster 340 | snow::stopCluster(cluster_ID) 341 | } 342 | 343 | ## OUTPUT 344 | 345 | ## timer (end) 346 | end.time <- Sys.time() 347 | execution.time <- difftime(end.time, start.time, units = "secs") 348 | 349 | ## verbose 350 | if(verbose==TRUE) { 351 | cat("\n",format(Sys.Date())," - ",format(Sys.time(), "%H:%M:%S"), ":", " MCMCglmm successfully performed on ", length(mulTree.data$phy), " trees.\n",sep = "") 352 | get.timer(execution.time) 353 | cat("Use read.mulTree() to read the data as 'mulTree' data.\nUse summary.mulTree() and plot.mulTree() for plotting or summarizing the 'mulTree' data.\n", sep = "") 354 | } 355 | 356 | return(invisible()) 357 | } 358 | -------------------------------------------------------------------------------- /R/mulTree_fun.R: -------------------------------------------------------------------------------- 1 | ## Asking for confirmation 2 | read.key <- function(msg1, msg2, scan = TRUE) { 3 | message(msg1) 4 | if(scan == TRUE) { 5 | scan(n = 1, quiet = TRUE) 6 | } 7 | silent <- "yes" 8 | if(!missing(msg2)) { 9 | message(msg2) 10 | } 11 | } 12 | 13 | ## Runs one single (on one single tree) MCMCglmmm 14 | lapply.MCMCglmm <- function(all_args){ 15 | 16 | ## require MCMCglmm for snow 17 | require(MCMCglmm) 18 | 19 | ## Remove the warn from the arguments list 20 | warn <- all_args$warn 21 | all_args$warn <- NULL 22 | ## Disable warnings (if needed) 23 | if(warn == FALSE) {options(warn=-1)} 24 | 25 | ## Formula check 26 | if(class(all_args$random) == "call") { 27 | all_args$random <- stats::as.formula(all_args$random) 28 | } 29 | 30 | ## MCMCglmm 31 | model <- do.call(MCMCglmm::MCMCglmm, all_args) 32 | #model <- MCMCglmm::MCMCglmm(fixed = formula, random = mulTree.data$random.terms, pedigree = mulTree.data$phy[[tree]], prior = priors, data = mulTree.data$data, verbose = FALSE, nitt = parameters[1], thin = parameters[2], burnin = parameters[3]); warning("DEBUG") ## , ...) 33 | 34 | ## Re-enable warnings (if needed) 35 | if(warn == FALSE) {options(warn = 0)} 36 | 37 | return(model) 38 | } 39 | 40 | 41 | ## Runs one single (on one single tree) MCMCglmmm 42 | # lapply.MCMCglmm2 <- function(tree, mulTree.data, formula, priors, parameters, warn, ...){ 43 | 44 | # ## require MCMCglmm for snow 45 | # require(MCMCglmm) 46 | 47 | # ## Disable warnings (if needed) 48 | # if(warn == FALSE) {options(warn=-1)} 49 | 50 | # ## Formula check 51 | # if(class(mulTree.data$random.terms) == "call") { 52 | # mulTree.data$random.terms <- stats::as.formula(mulTree.data$random.terms) 53 | # } 54 | 55 | # ## MCMCglmm 56 | # model <- MCMCglmm::MCMCglmm(fixed = formula, random = mulTree.data$random.terms, pedigree = mulTree.data$phy[[tree]], prior = priors, data = mulTree.data$data, verbose = FALSE, nitt = parameters[1], thin = parameters[2], burnin = parameters[3], ...) 57 | # #model <- MCMCglmm::MCMCglmm(fixed = formula, random = mulTree.data$random.terms, pedigree = mulTree.data$phy[[tree]], prior = priors, data = mulTree.data$data, verbose = FALSE, nitt = parameters[1], thin = parameters[2], burnin = parameters[3]); warning("DEBUG") ## , ...) 58 | 59 | # ## Re-enable warnings (if needed) 60 | # if(warn == FALSE) {options(warn = 0)} 61 | 62 | # return(model) 63 | # } 64 | 65 | 66 | ## get the name of a model 67 | get.model.name <- function(nchain, ntree, output){ 68 | return(paste(output, "-tree", ntree, "_chain", nchain, ".rda", sep = "")) 69 | } 70 | 71 | ## get the chains of a model 72 | extract.chains <- function(nchain, ntree, output) { 73 | return(get.mulTree.model(get.model.name(nchain, ntree, output))) 74 | } 75 | 76 | ## Runs a convergence test 77 | convergence.test <- function(models){ 78 | ## lapply wrapper 79 | get.VCV <- function (model) { 80 | return(coda::as.mcmc(model$VCV[1:(length(model$VCV[, 1])), ])) 81 | } 82 | 83 | ## get the list of mcmcm 84 | list_mcmc <- lapply(models, get.VCV) 85 | 86 | ## Convergence check using Gelman and Rubins diagnoses set to return true or false based on level of scale reduction set (default = 1.1) 87 | convergence <- try(coda::gelman.diag(coda::mcmc.list(list_mcmc)), silent = TRUE) 88 | 89 | ## Print error messages if convergence didn't run 90 | if(class(convergence) == "try-error") { 91 | warning(paste("Convergence test failed.\nError probably originated from coda::gelman.diag.\n", paste(convergence, collapse = "\n"), sep = ""), call. = FALSE) 92 | convergence <- NULL 93 | } 94 | 95 | return(convergence) 96 | } 97 | 98 | ## Extract the ESS of a model 99 | ESS.lapply <- function(model) { 100 | Sol <- coda::effectiveSize(model$Sol[]) 101 | VCV <- coda::effectiveSize(model$VCV[]) 102 | return(list("Sol"=Sol, "VCV"=VCV)) 103 | } 104 | 105 | ## Get the timer 106 | get.timer <- function(execution.time) { 107 | if (execution.time[[1]] < 60) { 108 | cat("Total execution time: ", execution.time[[1]], " secs.\n", sep = "") 109 | } else { 110 | if (execution.time[[1]] >= 60 & execution.time[[1]] < 3600) { 111 | cat("Total execution time: ", execution.time[[1]]/60, " mins.\n", sep = "") 112 | } else { 113 | if (execution.time[[1]] >= 3600 & execution.time[[1]] < 86400) { 114 | cat("Total execution time: ", execution.time[[1]]/3600, " hours.\n", sep = "") 115 | } else { 116 | if (execution.time[[1]] >= 86400) { 117 | cat("Total execution time: ", execution.time[[1]]/86400, " days.\n", sep = "") 118 | } 119 | } 120 | } 121 | } 122 | } -------------------------------------------------------------------------------- /R/plot.mulTree.R: -------------------------------------------------------------------------------- 1 | #' @title Plots \code{mulTree} results 2 | #' 3 | #' @description Plots a boxplots of the terms of a \code{mulTree} analysis. 4 | #' 5 | #' @param mulTree.summary A \code{mulTree} matrix summarized by \code{\link{summary.mulTree}}. 6 | #' @param terms An optional vector of terms labels. 7 | #' @param cex.terms An optional value for the size of the terms labels. 8 | #' @param cex.coeff An optional value for the size of the coefficients labels. 9 | #' @param horizontal Whether to plot the results horizontally (\code{default = FALSE}). 10 | #' @param ylim Optional, the y limits of the plot. 11 | #' @param col Optional, the color of the plot. 12 | #' @param ... Any additional arguments to be passed to \code{\link[graphics]{plot}}. 13 | #' 14 | #' @examples 15 | #' ## read in the data 16 | #' data(lifespan.mcmc) 17 | #' 18 | #' ## summarising the results 19 | #' summarized_data <- summary(lifespan.mcmc) 20 | #' 21 | #' ## plotting the results 22 | #' plot(summarized_data) 23 | #' 24 | #' ## Same plot using more options 25 | #' plot(summarized_data, horizontal = TRUE, ylab = "", ylim = c(-2,2), 26 | #' main = "Posterior distributions", cex.terms = 0.5, cex.coeff = 0.8, 27 | #' terms = c("Intercept", "BodyMass", "Volancy", "Phylogeny", "Residuals"), 28 | #' col = c("red"), cex.main = 0.8) 29 | #' abline(v = 0, lty = 3) 30 | #' 31 | #' @seealso \code{\link{mulTree}}, \code{\link{read.mulTree}}, \code{\link{summary.mulTree}} 32 | #' @author Thomas Guillerme 33 | #' 34 | #' @export 35 | 36 | #DEBUG 37 | # source("sanitizing.R") 38 | # source("plot.mulTree_fun.R") 39 | 40 | plot.mulTree <- function(mulTree.summary, terms, cex.terms, cex.coeff, horizontal = FALSE, ylim, col, ...) { 41 | 42 | match_call <- match.call() 43 | 44 | ## SANITIZING 45 | ## mulTree.results 46 | if(!all(class(mulTree.summary) == c("matrix","mulTree"))) { 47 | stop(match_call$mulTree.summary, " is not mulTree matrix.\nUse summary.mulTree() to properly generate the data.", sep = "") 48 | } 49 | 50 | ## terms 51 | if(!missing(terms)) { 52 | check.class(terms, "character") 53 | check.length(terms, nrow(mulTree.summary), paste(" must have the same number of terms as ", match_call$mulTree.summary, sep = ""), errorif = FALSE) 54 | } else { 55 | terms <- rownames(mulTree.summary) 56 | } 57 | 58 | ## cex.terms 59 | if(!missing(cex.terms)) { 60 | check.class(cex.terms, "numeric") 61 | check.length(cex.terms, 1, " must be a single value for the size of the terms labels.") 62 | } 63 | 64 | ## cex.terms 65 | if(!missing(cex.coeff)) { 66 | check.class(cex.coeff, "numeric") 67 | check.length(cex.coeff, 1, " must be a single value for the size of the coefficients labels.") 68 | } 69 | 70 | ## horizontal 71 | check.class(horizontal, "logical") 72 | 73 | ## default optional arguments 74 | ## Get the automatic ylimits 75 | if(missing(ylim)) { 76 | ylim <- get.ylim(mulTree.summary) 77 | } 78 | 79 | ## Get the automatic colours 80 | if(missing(col)) { 81 | col <- grDevices::gray(seq(from = 1-(1/((ncol(mulTree.summary)-1)/2*2)), to = 0+(1/((ncol(mulTree.summary)-1)/2*2)), length.out = (ncol(mulTree.summary)-1)/2)) 82 | } 83 | 84 | 85 | ## PLOTTING THE RESULTS 86 | ## Set up the space between terms 87 | terms_space <- 0.5 88 | ## Plot the frame 89 | if (horizontal == FALSE) { 90 | ## Plot the horizontal frame 91 | graphics::plot(1,1, xlim = c(1 - terms_space, nrow(mulTree.summary) + terms_space), ylim = ylim, type = "n", xaxt = "n", yaxt = "n", bty = "n", ...) 92 | #graphics::plot(1,1, xlim = c(1 - terms_space, nrow(mulTree.summary) + terms_space), ylim = ylim, type = "n", xaxt = "n", yaxt = "n", bty = "n",) ; warning("DEBUG MODE") 93 | 94 | ## Adding the y axis (coefficients) 95 | if(!missing(cex.coeff)) { 96 | graphics::axis(side = 2, cex.axis = cex.coeff) 97 | } else { 98 | graphics::axis(side = 2) 99 | } 100 | 101 | ## Adding the x axis (terms) 102 | if(!missing(cex.terms)) { 103 | graphics::axis(side = 1, at = 1:nrow(mulTree.summary), labels = terms, las = 2, cex.axis = cex.terms) 104 | } else { 105 | graphics::axis(side = 1, at = 1:nrow(mulTree.summary), labels = terms, las = 2) 106 | } 107 | 108 | } else { 109 | ## Plot the vertical frame 110 | graphics::plot(1,1, ylim = c(1 - terms_space, nrow(mulTree.summary) + terms_space), xlim = ylim, type = "n", xaxt = "n", yaxt = "n", bty = "n", ...) 111 | #graphics::plot(1,1, ylim = c(1 - terms_space, nrow(mulTree.summary) + terms_space), xlim = ylim, type = "n", xaxt = "n", yaxt = "n", bty = "n") ; warning("DEBUG MODE") 112 | 113 | ## Adding the y axis (terms) 114 | if(!missing(cex.terms)) { 115 | graphics::axis(side = 2, at = 1:nrow(mulTree.summary), labels = rev(terms), las = 2, cex.axis = cex.terms) 116 | } else { 117 | graphics::axis(side = 2, at = 1:nrow(mulTree.summary), labels = rev(terms), las = 2) 118 | } 119 | 120 | ## Adding the x axis (coefficients) 121 | if(!missing(cex.coeff)) { 122 | graphics::axis(side = 3, cex.axis = cex.coeff) 123 | } else { 124 | graphics::axis(side = 3) 125 | } 126 | } 127 | 128 | ## Setting box parameters 129 | box_width <- seq(from=0.1, by = 0.05, length.out = (ncol(mulTree.summary)-1)/2) 130 | 131 | ## Drawing the polygons 132 | for (term in 1:nrow(mulTree.summary)) { 133 | for (CI in 1:c((ncol(mulTree.summary)-1)/2)) { 134 | ## Drawing the polygons 135 | if(horizontal == FALSE) { 136 | graphics::polygon(x = get.width(box_width, term, CI), y = get.height(mulTree.summary, term, CI), col = col) 137 | } else { 138 | graphics::polygon(y = get.width(box_width, nrow(mulTree.summary)-(term-1), CI), x = get.height(mulTree.summary, term, CI), col = col) 139 | } 140 | } 141 | ## Drawing the central tendencies 142 | if(horizontal == FALSE) { 143 | graphics::points(term, mulTree.summary[term, 1], pch = 19) 144 | } else { 145 | graphics::points(mulTree.summary[term, 1], nrow(mulTree.summary)-(term-1), pch = 19) 146 | } 147 | } 148 | 149 | } 150 | -------------------------------------------------------------------------------- /R/plot.mulTree_fun.R: -------------------------------------------------------------------------------- 1 | ## Setting ylim 2 | get.ylim <- function(matrix) { 3 | return(c(min(matrix, na.rm=TRUE) - 0.01*min(matrix, na.rm=TRUE), max(matrix, na.rm=TRUE) + 0.01*(max(matrix, na.rm=TRUE)))) 4 | } 5 | 6 | ## Get the width of a box 7 | get.width <- function(box_width, term, CI) { 8 | return(c(term - box_width[CI], term - box_width[CI], term + box_width[CI], term + box_width[CI])) 9 | } 10 | 11 | ## Get the height of a box 12 | get.height <- function(data_CI, term, CI) { 13 | return(c(data_CI[term, 2 + (CI-1)] , rep(data_CI[term, ncol(data_CI) - (CI-1)], 2), data_CI[term, 2 + (CI-1)])) 14 | } -------------------------------------------------------------------------------- /R/read.mulTree.R: -------------------------------------------------------------------------------- 1 | #' @title Reads MCMCglmm models fromn mulTree. 2 | #' 3 | #' @description Reads MCMCglmm objects from the \code{\link{mulTree}} function back into the \code{R} environment. 4 | #' 5 | #' @param mulTree.chain A chain name of \code{MCMCglmm} models written by the \code{\link{mulTree}} function. 6 | #' @param convergence Logical, whether to read the convergence file associated with the chain name (default = \code{FALSE}). 7 | #' @param model Logical, whether to input a single \code{MCMCglmm} model or the list of random and fixed terms only (default = \code{FALSE}). 8 | #' @param extract Optional, the name of one or more elements to extract from each model (rather than loading the full model; default = \code{NULL}). 9 | #' 10 | #' @return 11 | #' A \code{list} of the terms of class \code{mulTree} by default. 12 | #' Else a \code{MCMCglmm} object (if \code{model = TRUE}); a \code{gelman.diag} object (if \code{convergence = TRUE}) or a list of extracted elements from the \code{MCMCglmm} models (if \code{extract} is not \code{NULL}). 13 | #' 14 | #' @details 15 | #' The argument \code{model = TRUE} can be used to load the \code{MCMCglmm} object of a unique chain. 16 | #' The resulting object can be then summarized or plotted as S3 method for class \code{MCMCglmm}. 17 | #' 18 | #' @examples 19 | #' ## Creating some dummy mulTree models 20 | #' data <- data.frame("sp.col" = LETTERS[1:5], var1 = rnorm(5), var2 = rnorm(5)) 21 | #' tree <- replicate(3, rcoal(5, tip.label = LETTERS[1:5]), simplify = FALSE) 22 | #' class(tree) <- "multiPhylo" 23 | #' mulTree.data <- as.mulTree(data, tree, taxa = "sp.col") 24 | #' priors <- list(R = list(V = 1/2, nu = 0.002), 25 | #' G = list(G1 = list(V = 1/2, nu = 0.002))) 26 | #' mulTree(mulTree.data, formula = var1 ~ var2, parameters = c(10000, 10, 1000), 27 | #' chains = 2, prior = priors, output = "quick_example", convergence = 1.1, 28 | #' ESS = 100, verbose = FALSE) 29 | #' 30 | #' ## Reading all the models 31 | #' all_chains <- read.mulTree("quick_example") 32 | #' 33 | #' ## Reading the convergence diagnosis for all the trees 34 | #' read.mulTree("quick_example", convergence = TRUE) 35 | #' 36 | #' ## Reading a specific model 37 | #' model <- read.mulTree("quick_example-tree1_chain1", model = TRUE) 38 | #' 39 | #' ## Reading only the error term and the tune for all models 40 | #' read.mulTree("quick_example", extract=c("error.term", "Tune")) 41 | #' 42 | #' ##Remove the generated files from the current directory 43 | #' file.remove(list.files(pattern = "quick_example")) 44 | #' 45 | #' @seealso \code{\link{mulTree}}, \code{\link{plot.mulTree}}, \code{\link{summary.mulTree}} 46 | #' @author Thomas Guillerme 47 | #' @export 48 | 49 | read.mulTree <- function(mulTree.chain, convergence = FALSE, model = FALSE, extract = NULL) { 50 | ## HEADER 51 | match_call<-match.call() 52 | 53 | ## SANITIZING 54 | ## mulTree.chain 55 | check.class(mulTree.chain, "character") 56 | ## check if chain is present 57 | scanned_chains <- list.files(pattern = mulTree.chain) 58 | ## check.length(scanned_chains, 0, " files not found in current directory.", errorif = TRUE) 59 | if(length(scanned_chains) == 1) { 60 | if(length(grep("chain[0-9]+\\.rda$", scanned_chains)) == 0) { 61 | stop("File \"", mulTree.chain, "\" is not a mulTree chain but a single file.", sep="",call.=FALSE) 62 | } 63 | } else { 64 | if(length(grep("chain[0-9]+\\.rda$", scanned_chains)) == 0) { 65 | stop("File \"", mulTree.chain, "\" not found in current directory.", sep="",call.=FALSE) 66 | } 67 | } 68 | 69 | 70 | ## convergence 71 | check.class(convergence, 'logical') 72 | if(convergence == TRUE & length(scanned_chains) == 1) { 73 | stop("The convergence file can't be loaded because \"", mulTree.chain, "\" is a single model.\n", sep="") 74 | } 75 | 76 | ## model 77 | check.class(model, 'logical') 78 | if(length(scanned_chains) > 1 & model == TRUE) { 79 | stop("The MCMCglmm model can't be loaded because \"", mulTree.chain, "\" is a chain name.\nPlease specify the single model's name.", sep="") 80 | } 81 | 82 | ## extract 83 | if(!is.null(extract)) { 84 | check.class(extract, 'character') 85 | } 86 | 87 | ## READING THE MCMC MODEL BACK IN R ENVIRONMENT 88 | ## Extracting some specific elements from all the chains 89 | if(!is.null(extract)) { 90 | ## Extract the testing model 91 | test_model <- get.mulTree.model(paste(mulTree.chain, "-tree1_", "chain1.rda", sep="")) 92 | ## checking if the required element exists 93 | if(any(is.na(match(extract, names(test_model))))) { 94 | stop(paste(as.expression(match_call$extract), " element does not exist in any model.", sep="")) 95 | } else { 96 | ## Proceed to extraction 97 | if(length(extract) == 1) { 98 | ## Remove only one element 99 | output <- get.element(extract, mulTree.chain) 100 | } else { 101 | ## Remove the number of elements 102 | output <- lapply(as.list(extract), get.element, mulTree.chain) 103 | names(output) <- extract 104 | } 105 | } 106 | ## Stop the function here 107 | return(output) 108 | } 109 | 110 | ## Extracting a single model 111 | if(model == TRUE) { 112 | ## get the model 113 | output <- get.mulTree.model(scanned_chains) 114 | ## Stop the function here 115 | return(output) 116 | 117 | } else { 118 | ## Reading the convergence files 119 | if(convergence == TRUE) { 120 | ## Selecting the convergence scanned_chains 121 | conv_file <- scanned_chains[grep("_conv.rda", scanned_chains)] 122 | if(length(conv_file) == 1) { 123 | ## Reading a single convergence file 124 | output <- get.convergence(conv_file) 125 | } else { 126 | ## Reading multiple convergence scanned_chains 127 | output <- lapply(conv_file, get.convergence) 128 | names(output) <- strsplit(conv_file, split=".rda") 129 | } 130 | ## Stop the function here 131 | return(output) 132 | 133 | ## Reading the chains 134 | } else { 135 | ## Selecting the chains 136 | mcmc_file <- scanned_chains[grep("_chain", scanned_chains)] 137 | if(length(mcmc_file) == 1) { 138 | ## Reading a single chain 139 | output <- get.mulTree.model(mcmc_file) 140 | out_table <- get.table.mulTree(output) 141 | } else { 142 | ## Reading multiple chains 143 | output <- lapply(mcmc_file, get.mulTree.model) 144 | out_table <- lapply(output, get.table.mulTree) 145 | ## Combine the elements of each chain 146 | out_table_tmp <- as.list(as.data.frame(mapply(c, out_table[[1]], out_table[[2]]))) 147 | if(length(out_table) > 2) { 148 | for (chain in 3:length(mcmc_file)) { 149 | out_table_tmp <- as.list(as.data.frame(mapply(c, out_table_tmp, out_table[[chain]]))) 150 | } 151 | } 152 | out_table <- out_table_tmp 153 | } 154 | ## Set output of class mulTree 155 | class(out_table) <- "mulTree" 156 | return(out_table) 157 | } 158 | } 159 | } -------------------------------------------------------------------------------- /R/read.mulTree_fun.R: -------------------------------------------------------------------------------- 1 | ## Reads a single model 2 | get.mulTree.model <- function(mcmc.file) { 3 | model <- get(load(mcmc.file)) 4 | ## Testing if the mcmc.file is the right object class 5 | if(class(model) != "MCMCglmm") { 6 | stop(paste("No MCMCglmm model found in file", mcmc.file)) 7 | } 8 | return(model) 9 | } 10 | 11 | ## Get the convergence diagnosis file 12 | get.convergence <- function(conv.file){ 13 | conv.name <- load(conv.file) 14 | converge <- get(conv.name) 15 | ## Testing if the converge object is the right object class 16 | check.class(converge, "gelman.diag") 17 | return(converge) 18 | } 19 | 20 | ## Extracting some specific elements from the chain 21 | get.element <- function(element, chain) { 22 | ## Getting the right files 23 | mcmc_files <- list.files(pattern = chain) 24 | mcmc_files <- mcmc_files[grep("_chain", mcmc_files)] 25 | 26 | ## Extracting all the models 27 | all_models <- lapply(as.list(mcmc_files), get.mulTree.model) 28 | ## Extracting the element 29 | all_elements <- sapply(all_models, "[[", element, simplify = FALSE) 30 | 31 | ## applying the names of to the list 32 | names(all_elements) <- paste(mcmc_files, element, sep="$") 33 | 34 | return(all_elements) 35 | } 36 | 37 | ## Isolate the fixed terms (model$Sol) and the random terms (model$VCV) from a single model 38 | get.table.mulTree <- function(mcmc.file) { 39 | ## Getting the fixed terms 40 | table_mcmc <- as.data.frame(mcmc.file$Sol) 41 | ## Adding the random terms 42 | random_terms <- c("phylogenetic.variance","residual.variance") 43 | table_mcmc[random_terms[1]] <- as.vector(mcmc.file$VCV[,1]) 44 | table_mcmc[random_terms[2]] <- as.vector(mcmc.file$VCV[,2]) 45 | ## Output 46 | return(as.list(table_mcmc)) 47 | } 48 | 49 | -------------------------------------------------------------------------------- /R/sanitizing.R: -------------------------------------------------------------------------------- 1 | ## SANITYZING FUNCTIONS 2 | ## Checking the class of an object and returning an error message if != class 3 | check.class <- function(object, class, msg, errorif = FALSE) { 4 | ## Get call 5 | match_call <- match.call() 6 | 7 | ## class_object variable initialisation 8 | class_object <- class(object)[1] 9 | ## class_length variable initialisation 10 | length_class <- length(class) 11 | 12 | ## Set msg if missing 13 | if(missing(msg)) { 14 | if(length_class != 1) { 15 | msg <- paste(" must be of class ", paste(class, collapse = " or "), ".", sep = "") 16 | } else { 17 | msg <- paste(" must be of class ", class, ".", sep = "") 18 | } 19 | } 20 | 21 | ## check if object is class. 22 | if(length_class != 1) { 23 | ## check if object is class in a cascade (class[1] else class[2] else class[3], etc..) 24 | ## returns error only if object is not of any class 25 | 26 | error <- NULL 27 | for(counter in 1:length_class) { 28 | if(errorif != TRUE) { 29 | if(class_object != class[counter]) { 30 | error <- c(error, TRUE) 31 | } else { 32 | error <- c(error, FALSE) 33 | } 34 | } else { 35 | if(class_object == class[counter]) { 36 | error <- c(error, TRUE) 37 | } else { 38 | error <- c(error, FALSE) 39 | } 40 | } 41 | } 42 | ## If function did not return, class is not matching 43 | if(!any(!error)) { 44 | stop(match_call$object, msg, call. = FALSE) 45 | } else { 46 | return(class_object) 47 | } 48 | 49 | } else { 50 | if(errorif != TRUE) { 51 | if(class_object != class) { 52 | stop(match_call$object, msg , call. = FALSE) 53 | } 54 | } else { 55 | if(class_object == class) { 56 | stop(match_call$object, msg , call. = FALSE) 57 | } 58 | } 59 | } 60 | } 61 | 62 | 63 | ## Checking the class of an object and returning an error message if != class 64 | check.length <- function(object, length, msg, errorif = FALSE) { 65 | 66 | match_call <- match.call() 67 | 68 | if(errorif != TRUE) { 69 | if(length(object) != length) { 70 | stop(match_call$object, msg , call. = FALSE) 71 | } 72 | } else { 73 | if(length(object) == length) { 74 | stop(match_call$object, msg , call. = FALSE) 75 | } 76 | } 77 | } -------------------------------------------------------------------------------- /R/summary.mulTree.R: -------------------------------------------------------------------------------- 1 | #' @title Summarises \code{mulTree} data 2 | #' 3 | #' @description Summarises the \code{MCMCglmm} models calculated from multiple trees by caculating the highest density regions (\code{\link[hdrcde]{hdr}}) of the fixed and random terms. 4 | #' 5 | #' @param mulTree.results A \code{mulTree} object obtained from \code{\link{read.mulTree}} function. 6 | #' @param prob One or more precentage values for to be the credibility intervals (\code{default = c(50, 95)}). 7 | #' @param use.hdr Logical, whether to calculate the highest density region using \code{\link[hdrcde]{hdr}} (\code{TRUE}) or the quantiles using \code{\link[stats]{quantile}} (\code{FALSE}). 8 | #' @param cent.tend A function for calculating the central tendency (\code{default = median}) from the quantiles (if \code{use.hdr = FALSE}; else is ignored). 9 | #' @param ... Any optional arguments to be passed to the \code{\link[hdrcde]{hdr}} or \code{\link[stats]{quantile}} functions. 10 | #' 11 | #' @details 12 | #' When using the highest density region caculation method (\code{use.hdr = TRUE}), the returned central tendency is always the first estimated mode (see \code{\link[hdrcde]{hdr}}). 13 | #' Note that the results maybe vary when using \code{use.hdr = FALSE} or \code{TRUE}. 14 | #' We recommend to use \code{use.hdr = TRUE} when possible. 15 | #' 16 | #' When \code{use.hdr = FALSE}, the computation is faster but the quantiles are calculated and not estimated. 17 | #' 18 | #' When \code{use.hdr = TRUE}, the computation is slower but the quantiles are estimated using the highest density regions. 19 | #' The given estimates central tendency is calculated as the mode of the estimated highest density region. 20 | #' For speeding up the calculations, the bandwidth (\code{h} argument) from \code{\link[hdrcde]{hdr}} can be estimated by using \code{\link[stats]{bw.nrd0}}. 21 | #' 22 | #' @return 23 | #' A \code{matrix} of class \code{mulTree}. 24 | #' 25 | #' @examples 26 | #' ## Read in the data 27 | #' data(lifespan.mcmc) 28 | #' 29 | #' ## Summarizing all the chains 30 | #' summary(lifespan.mcmc) 31 | #' 32 | #' ## Modyfing the CI 33 | #' summary(lifespan.mcmc, prob = 95) 34 | #' 35 | #' ## Using use.hdr = FALSE 36 | #' summary(lifespan.mcmc, use.hdr = FALSE) 37 | #' 38 | #' @seealso \code{\link{mulTree}}, \code{\link{read.mulTree}}, \code{\link{plot.mulTree}} 39 | #' @author Thomas Guillerme 40 | #' 41 | #' @export 42 | 43 | # DEBUG 44 | # source("sanitizing.R") 45 | # source("summary.mulTree_fun.R") 46 | 47 | summary.mulTree <- function(mulTree.results, prob = c(50, 95), use.hdr = TRUE, cent.tend = stats::median, ...) { 48 | 49 | match_call <- match.call() 50 | 51 | ## SANITIZING 52 | ## mulTree.results 53 | check.class(mulTree.results, "mulTree", " is not of class mulTree.\nUse read.mulTree() to properly load the data.") 54 | 55 | ## prob 56 | check.class(prob, "numeric") 57 | if(any(prob > 100) | any(prob < 0)) { 58 | stop("prob argument must percentages (between 0 and 100).") 59 | } 60 | 61 | ## cent.tend 62 | check.class(cent.tend, c("function", "standardGeneric")) 63 | ## check if the function properly outputs a single value 64 | try(test_cent.tend <- cent.tend(stats::rnorm(10)), silent = TRUE) 65 | if(length(test_cent.tend) != 1 & class(test_cent.tend) != "numeric") { 66 | stop(paste(match_call$cent.tend, " cannot calculate a central tendency of a distribution.")) 67 | } 68 | 69 | ## use.hdr 70 | check.class(use.hdr, "logical") 71 | 72 | ## SUMMARISING 73 | if(use.hdr == FALSE) { 74 | ## Calculate the quantiles 75 | mulTree_results <- lapply(mulTree.results, lapply.quantile, prob, cent.tend, ...) 76 | #mulTree_results <- lapply(mulTree.results, lapply.quantile, prob, cent.tend) ; warning("DEBUG MODE") 77 | } else { 78 | ## Calculate the hdr 79 | mulTree_results <- try(mapply(lapply.hdr, mulTree.results, as.list(names(mulTree.results)), MoreArgs=list(prob, ...), SIMPLIFY=FALSE), silent = TRUE) 80 | #mulTree_results <- try(mapply(lapply.hdr, mulTree.results, as.list(names(mulTree.results)), MoreArgs=list(prob), SIMPLIFY=FALSE), silent = TRUE) ; warning("DEBUG MODE") 81 | if(is(mulTree_results, "try-error")) { 82 | stop(paste("Impossible to calculate the HDR!\n", 83 | "Try using the option 'use.hdr = FALSE' for calculating the quantiles instead.\n", 84 | "'hdr' function gave the following error:\n", 85 | mulTree_results[[1]], 86 | sep = "")) 87 | } 88 | } 89 | 90 | ## Transform the results into a table 91 | results_out <- result.list.to.table(mulTree_results) 92 | ## Add the names 93 | if(use.hdr == FALSE) { 94 | if(is.null(match_call$cent.tend)) { 95 | estimate <- "Estimates(median)" 96 | } else { 97 | estimate <- paste("Estimates(", match_call$cent.tend,")", sep="") 98 | } 99 | } else { 100 | estimate <- "Estimates(mode hdr)" 101 | } 102 | colnames(results_out) <- c(estimate, paste(c(rep("lower.CI(", length(prob)), rep("upper.CI(", length(prob))), prob.converter(prob)*100, ")", sep="")) 103 | rownames(results_out) <- names(mulTree.results) 104 | 105 | ## Set class 106 | class(results_out) <- c("matrix", "mulTree") 107 | 108 | return(results_out) 109 | } -------------------------------------------------------------------------------- /R/summary.mulTree_fun.R: -------------------------------------------------------------------------------- 1 | ## is.wholenumber from ?is.integer example 2 | is.wholenumber <- function(x, tol = .Machine$double.eps^0.5) { 3 | abs(x - round(x)) < tol 4 | } 5 | 6 | ## converts probabilities into quantile 7 | prob.converter <- function(prob) { 8 | sort(c(50-prob/2, 50+prob/2)/100) 9 | } 10 | 11 | ## Calculate the quantiles from a vector (for lapply) 12 | lapply.quantile <- function(X, prob, cent.tend, ...) { 13 | ## Get the quantiles 14 | quantile_out <- stats::quantile(X, probs = prob.converter(prob), ...) 15 | ## Calculate the central tendency 16 | return(list("quantiles" = quantile_out, "central" = cent.tend(X))) 17 | } 18 | 19 | ## Smoothing the hdr (if more than one value for the prob region) 20 | smooth.hdr <- function(hdr_out, prob, name) { 21 | ## Test if smoothing needed 22 | if(length(hdr_out$hdr) > length(prob)*2) { 23 | ## Smooth the values 24 | new_hdr <- matrix(NA, nrow=length(prob), ncol=2) 25 | for(CI in 1:nrow(hdr_out$hdr)) { 26 | new_hdr[CI, ] <- c(min(hdr_out$hdr[CI, ], na.rm = TRUE), max(hdr_out$hdr[CI, ], na.rm = TRUE)) 27 | } 28 | hdr_out$hdr <- new_hdr 29 | ## Print some warning! 30 | warning(name, " has multiple highest density regions (hdr) for some probabilities.\nOnly the maximum and the minimum hdr were used for each probabilities.", sep="") 31 | } 32 | return(hdr_out) 33 | } 34 | 35 | ## Calculate the hdr from a vector (for lapply) 36 | lapply.hdr <- function(X, name, prob, ...) { 37 | ## Calculate the hdr 38 | hdr_out <- hdrcde::hdr(X, prob, ...) 39 | 40 | ## Smooth the results (if needed) 41 | hdr_out <- smooth.hdr(hdr_out, prob, name) 42 | 43 | ## Transform the hdr output into a vector 44 | hdr_out[[1]] <- sort(hdr_out[[1]]) 45 | return(hdr_out) 46 | } 47 | 48 | ## Transform a list into table 49 | result.list.to.table <- function(list) { 50 | ## Getting the credibility intervals 51 | credibility_intervals <- matrix(unlist(sapply(list, "[", 1)), nrow = length(list), byrow = TRUE) 52 | ## Getting the central tendencies (get only the first elements) 53 | central_tendency <- matrix(unlist(lapply(sapply(list, "[", 2), "[[", 1)), nrow = length(list), byrow = TRUE) 54 | ## combine the results 55 | return(cbind(central_tendency, credibility_intervals)) 56 | } -------------------------------------------------------------------------------- /R/tree.bind.R: -------------------------------------------------------------------------------- 1 | #' @title Randomly binding trees together 2 | #' 3 | #' @description Randomly binds trees together with a provided number of trees and a root age. 4 | #' 5 | #' @param x,y Two \code{phylo} or \code{multiPhylo} objects. 6 | #' @param sample The number of trees to create. If missing, the \code{sample} size is set to 1. 7 | #' @param root.age The age of the root where both trees are combined (can be any unit). If missing, the \code{root.edge} is set to \code{0}. 8 | #' 9 | #' @return 10 | #' If \code{x}, \code{y} and \code{sample} are \eqn{>1}, the function returns a \code{multiPhylo} object; else it returns a \code{phylo} object. 11 | #' 12 | #' @examples 13 | #' ## Combines 2 randomly chosen trees from x and from y into z putting the root age at 12. 14 | #' x <- rmtree(10, 5) ; y <- rmtree(5, 5) 15 | #' tree.bind(x, y, sample = 3, root.age = 12) 16 | #' 17 | #' ##Combines one mammal and and one bird tree and setting the root age at 250 Mya. 18 | #' data(lifespan) 19 | #' combined_trees <- tree.bind(trees_mammalia, trees_aves, sample = 1, root.age = 250) 20 | #' plot(combined_trees) # A tree with both mammals and aves 21 | #' 22 | #' @author Thomas Guillerme 23 | #' @export 24 | 25 | tree.bind <- function(x, y, sample, root.age) { 26 | ## SANITIZING 27 | ## trees 28 | ## getting the class of each tree object (and checking their class) 29 | x_class <- check.class(x, c("multiPhylo", "phylo")) 30 | y_class <- check.class(y, c("multiPhylo", "phylo")) 31 | 32 | ## transforming the trees into multiPhylo objects 33 | if(x_class == "phylo") x <- list(x) ; class(x) <- "multiPhylo" 34 | if(y_class == "phylo") y <- list(y) ; class(y) <- "multiPhylo" 35 | 36 | ## sample 37 | if(missing(sample)) { 38 | sample <- 1 39 | } else { 40 | check.class(sample, "numeric") 41 | } 42 | 43 | ## root age 44 | if(missing(root.age)) { 45 | root.age <- 0 46 | } else { 47 | check.class(root.age, "numeric") 48 | } 49 | 50 | ## RANDOMLY BINDING THE TREES 51 | ## Sample draws (using get.replace to set replace or not with verbose warning) 52 | rand_x <- sample.trees(x, sample, get.replace(x, sample, TRUE)) 53 | rand_y <- sample.trees(y, sample, get.replace(y, sample, TRUE)) 54 | sample_list <- as.list(seq(1:sample)) # number of samples to draw 55 | 56 | ## Bind the trees 57 | binded_trees <- lapply(sample_list, lapply.bind.tree, x, y, rand_x, rand_y, root.age) 58 | 59 | ## OUTPUT 60 | 61 | ## Check if the trees can be converted into phylo/multiPhylo 62 | if(all(unlist(lapply(binded_trees, Ntip)) == unlist(lapply(binded_trees, function(x) length(unique(x$tip.label)))))) { 63 | ## output a tree if length = 1 64 | if(length(binded_trees) == 1) { 65 | binded_trees <- binded_trees[[1]] ; class(binded_trees) <- "phylo" 66 | } else { 67 | ## output is a multiPhylo 68 | class(binded_trees) <- "multiPhylo" 69 | } 70 | return(binded_trees) 71 | } else { 72 | ## Some trees have duplicated names 73 | warning("Some trees have duplicated tip labels.\nThe output can not be converted into phylo or multiPhylo objects.") 74 | return(binded_trees) 75 | } 76 | 77 | } -------------------------------------------------------------------------------- /R/tree.bind_fun.R: -------------------------------------------------------------------------------- 1 | ## Whether to sample with replace or not in tree.bind 2 | get.replace <- function(tree, sample, verbose=FALSE) { 3 | ## Get call 4 | match_call <- match.call() 5 | ## If only one sample is need do not replace 6 | if (sample == 1) { 7 | replace <- FALSE 8 | } else { 9 | ## If class is phylo (one tree) do replace 10 | if(class(tree) == "phylo") { 11 | replace <- TRUE 12 | } else { 13 | ## If multiPhylo has only one element do replace 14 | if(length(tree) == 1) { 15 | replace <- TRUE 16 | } else { 17 | ## If sample is bigger than the number of trees do replace 18 | replace <- ifelse(length(tree) < sample, TRUE, FALSE) 19 | } 20 | } 21 | } 22 | ## Verbose 23 | if(verbose == TRUE && replace == TRUE) { 24 | warning("The sample is a higher than the number of trees in ", match_call$tree, ".\n", match_call$tree, " will be re-sampled.", call.=FALSE) 25 | } 26 | 27 | return(replace) 28 | } 29 | 30 | ## Creates the list of trees to sample (with or without replacement) 31 | sample.trees <- function(tree, sample, replace) { 32 | rand <- sample(1:length(tree), sample, replace = replace) 33 | return(rand) 34 | } 35 | 36 | 37 | ## Adds an edge length to the phylogeny 38 | add.root.edge <- function(tree, root.age) { 39 | tree$root.edge <- root.age - max(node.depth.edgelength(tree)) 40 | ## Make sure root edge can not be negative! 41 | if(tree$root.edge < 0) { 42 | tree$root.edge <- 0 43 | } 44 | return(tree) 45 | } 46 | 47 | ## Lapply loop for binding trees 48 | lapply.bind.tree <- function(element, x, y, rand_x, rand_y, root.age) { 49 | return(add.root.edge(x[[rand_x[element]]], root.age) + add.root.edge(y[[rand_y[element]]], root.age)) 50 | } -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # `mulTree` 2 | 3 | [![R-CMD-check](https://github.com/TGuillerme/mulTree/workflows/R-CMD-check/badge.svg)](https://github.com/TGuillerme/mulTree/actions) 4 | [![codecov](https://codecov.io/gh/TGuillerme/mulTree/branch/release/graph/badge.svg)](https://codecov.io/gh/TGuillerme/mulTree) 5 | [![Project Status: Active - The project has reached a stable, usable state and is being actively developed.](http://www.repostatus.org/badges/latest/active.svg)](http://www.repostatus.org/#active) 6 | [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.12902.svg)](https://doi.org/10.5281/zenodo.12902) 7 | 8 | This package is based on the [MCMCglmm](http://cran.r-project.org/web/packages/MCMCglmm/index.html) package 9 | and runs a MCMCglmm analysis on multiple trees. 10 | This code has been used prior to this package release in [Healy et. al. (2014)](http://rspb.royalsocietypublishing.org/content/281/1784/20140298.full.pdf?ijkey=gPt28ElSAYBvRhZ&keytype=ref). 11 | Please send me an [email](mailto:guillert@tcd.ie) or a pull request if you find/have any issue using this package. 12 | 13 | 14 | Check out the [presentation](https://figshare.com/articles/Guillerme_BESMacro2016_pdf/3478922) of some aspects of the package. 15 | 16 | ## Installing mulTree 17 | ```r 18 | ## Installing the package 19 | if(!require(devtools)) install.packages("devtools") 20 | library(devtools) 21 | install_github("TGuillerme/mulTree", ref = "release") 22 | library(mulTree) 23 | ``` 24 | The following installs the latest released version (see patch notes below). For the piping hot development version (not recommended), replace the `ref="release"` option by `ref="master"`. If you're using the `master` branch, see the latest developement in the [patch note](https://github.com/TGuillerme/mulTree/blob/master/patch_notes.md). 25 | 26 | #### Warning note: 27 | If you're using a PC and the package doesn't install correctly, it might be due to the fact that dependencies are not installed correctly. You can fix buy downloading `R`'s latest version and installing the missing packages manualy: 28 | ```r 29 | ## Install the missing packages 30 | install.packages(c("MCMCglmm", "coda", "hdrcde", "snow", "ape", "corpcor", "curl")) 31 | ``` 32 | 33 | #### Vignettes 34 | * The package manual [here (in .Rnw)](https://github.com/TGuillerme/mulTree/blob/master/doc/mulTree-manual.Rnw) or [here (in .pdf)](https://github.com/TGuillerme/mulTree/blob/master/doc/mulTree-manual.pdf). 35 | * An additional example of running simple phylogenetic models is [here](https://github.com/TGuillerme/mulTree/blob/master/doc/Vanilla_flavoured_phylogenetic_analyses.Rmd). 36 | 37 | ##### Patch notes (latest version) 38 | * 2020-04-12 - 1.3.7 39 | * Updated package to R version 3.6.3 40 | * Updated package to `ape` version 5.3 41 | 42 | Previous patch notes and the *next version* ones can be seen [here](https://github.com/TGuillerme/mulTree/blob/master/patch_notes.md). 43 | 44 | Authors 45 | ------- 46 | [Thomas Guillerme](http://tguillerme.github.io) and [Kevin Healy](http://healyke.github.io) 47 | 48 | ## Contributors 49 | 50 | [Eldar Rakhimberdiev](https://github.com/eldarrak), [Hugo Gruson](https://github.com/Bisaloo). 51 | 52 | Citation 53 | ------- 54 | If you are using this package, please cite (if the DOI is in there, even better!): 55 | 56 | * Guillerme, T. & Healy, K. (**2014**). mulTree: a package for running MCMCglmm analysis on multiple trees. ZENODO. 10.5281/zenodo.12902 57 | ###### [BibTeX](https://zenodo.org/record/12902/export/hx), [CSL](https://zenodo.org/record/12902/export/csl), [DataCite](https://zenodo.org/record/12902/export/dcite3), [Dublin core](https://zenodo.org/record/12902/export/xd), [Mendeley](https://www.mendeley.com/import/?url=https://zenodo.org/record/12902), [more...](https://zenodo.org/record/12902/#.XTpLtlBS8W8) 58 | 59 | Related packages 60 | ------- 61 | 62 | [`SIDER` R package](https://github.com/healyke/SIDER) 63 | 64 | Used in 65 | ------- 66 | 67 | Check out the papers that have cited `mulTree` since 2014 here (>50): 68 | -------------------------------------------------------------------------------- /data/lifespan.mcmc.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/TGuillerme/mulTree/ad24fb3f403add36955e1dffe4c89ebd3e241b6a/data/lifespan.mcmc.rda -------------------------------------------------------------------------------- /data/lifespan.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/TGuillerme/mulTree/ad24fb3f403add36955e1dffe4c89ebd3e241b6a/data/lifespan.rda -------------------------------------------------------------------------------- /data/lifespan_volant_192taxa.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/TGuillerme/mulTree/ad24fb3f403add36955e1dffe4c89ebd3e241b6a/data/lifespan_volant_192taxa.rda -------------------------------------------------------------------------------- /desiderata.md: -------------------------------------------------------------------------------- 1 | # To do list 2 | * Add the shuffle-tree algorithm to MCMCglmm 3 | * Allow different functions to be used for the tree-by-tree algorithm (`MCMCglmm`, `pgls`, `pic`) 4 | 5 | ### Get a function for measuring the posterior phylo signal from individual models. 6 | `lambda <- model$VCV[, "phylo"] / (model$VCV[, "phylo"] + model$VCV[, "units"])` 7 | 8 | ## One day... 9 | Properly test the effect of using multiple trees. 10 | 11 | ### 1 - Simulated data 12 | * Simulate multiple trees with more or less variance 13 | * Simulate some continuous character 14 | ### 2 - Empirical data 15 | * Take the Longevity papers trees 16 | * Isolate a fixed number 17 | ### 3 - Run MCMCglmm on the empirical/simulated data 18 | * Run MCMCglmm on *n* trees (each time) 19 | * Run MCMCglmm with tree swapping on *n* trees (Luke's approach) 20 | * Run MCMCglmm on the *n* trees (`mulTree` approach) -------------------------------------------------------------------------------- /doc/Vanilla_flavoured_phylogenetic_analyses.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Adavanced Phylogenetic analyses (Vanilla flavour)" 3 | author: "Kevin Healy" 4 | date: "27 April 2016" 5 | output: pdf_document 6 | --- 7 | 8 | This is a short example of running some simple phylogenetic comparative analysis using both PGLS and MCMCglmm. Due to time constraints it will be a very quick run through but will hopefully give you a flavour of what these models look like and the basics in running them. 9 | You should have come across pgls models earlier today from the [`caper` package see here](https://cran.r-project.org/web/packages/caper/vignettes/caper.pdf). 10 | For more on `MCMCglmm` see the [course notes](https://cran.r-project.org/web/packages/MCMCglmm/vignettes/CourseNotes.pdf) or [vignettes](https://cran.r-project.org/web/packages/MCMCglmm/vignettes/Overview.pdf). 11 | 12 | ## Installation 13 | 14 | First we need to install some packages including `ape` and `caper` that run the PGLS models and the `MCMCglmm` package to run the Bayesian version of a phylogenetic comparative analysis. 15 | 16 | ```{r install_packages, results="hide", message=FALSE, warning=FALSE} 17 | if(!require(ape)) install.packages("ape") 18 | if(!require(caper)) install.packages("caper") 19 | if(!require(MCMCglmm)) install.packages("MCMCglmm") 20 | ``` 21 | 22 | We will also install from GitHub the [`mulTree` package](https://github.com/TGuillerme/mulTree) which is still under development (so watch out for BUGS - and please [report them](mailto:guillert@tcd.ie)) but contains some handy data and also will allow us to use `MCMCglmm` to include the error associated with building phylogenies within our analysis later in the session. 23 | 24 | To do so we need to get them from GitHub and so we need to run. 25 | 26 | ```{r install_mulTree, results="hide", message=FALSE} 27 | if(!require(devtools)) install.packages("devtools") 28 | library(devtools) 29 | install_github("TGuillerme/mulTree", ref = "release") 30 | ``` 31 | 32 | Now we load the packages, and we are good to go. 33 | 34 | ```{r load_pakages, results="hide", message=FALSE, warning=FALSE} 35 | library(ape) 36 | library(caper) 37 | library(MCMCglmm) 38 | library(mulTree) 39 | ``` 40 | 41 | ## Data 42 | 43 | We will use some handy data that is part of a [`mulTree` package](https://github.com/TGuillerme/mulTree) that contains some trees and data that are ready to go. 44 | 45 | ```{r load_data, message=FALSE, warning=FALSE} 46 | data(lifespan) 47 | ``` 48 | 49 | This data file contains a subset of the data used in an analysis on the role of flying (volant) in the evolution of maximum lifespan in birds and mammals ([link to the paper](http://rspb.royalsocietypublishing.org/content/281/1784/20140298)). 50 | Note that these data have been log transformed, mean centered and expressed in units of standard deviation. 51 | The original lifespan data were taken from the [Anage database](http://genomics.senescence.info/species/). 52 | 53 | ```{r show_data, message=FALSE, warning=FALSE} 54 | # Data have been log transformed, mean centered and expressed in units of 55 | # standard deviation. 56 | head(lifespan_volant) 57 | 58 | ``` 59 | 60 | We will use a phylogeny of mammals constructed in [Kuhn *et al* 2011](http://onlinelibrary.wiley.com/doi/10.1111/j.2041-210X.2011.00103.x/abstract}), were they produce 10000 trees with each individual tree comprising one resolution of the polytomies of a previously published supertree. 61 | For now we will just use the first tree in the list, later we will return to see how we might include a range of trees. 62 | 63 | ```{r plot_mammals, message=FALSE, warning=FALSE, fig.width=8,fig.height=10} 64 | # The 10Ktrees from Khun et al (2011) gives a set of trees to represent 65 | # different polytomies. For now let just take one. 66 | mammal_tree <- trees_mammalia[[1]] 67 | plot(mammal_tree, cex = 0.3) 68 | 69 | # The number of species 70 | Ntip(mammal_tree) 71 | 72 | # We can also check that its ultrametric 73 | is.ultrametric(mammal_tree) 74 | ``` 75 | 76 | ## Lets run some models 77 | 78 | Lets first start off running a simple **glm** for a subset of data for mammals 79 | 80 | ```{r setting formula, message=FALSE, warning=FALSE} 81 | # Subset for mammals 82 | lifespan_mammals <- lifespan_volant[lifespan_volant$class == "Mammalia",] 83 | 84 | # lets define our fixed factors 85 | formula_a <- longevity ~ mass + volant 86 | 87 | # and run a simple glm 88 | glm_mod <- glm(formula = formula_a, family = "gaussian", 89 | data = lifespan_mammals) 90 | summary(glm_mod) 91 | ``` 92 | 93 | So far our simple model assumes that each data point is independent. 94 | We assume that even if two species are closely related to each other that their lifespans are in no way related. 95 | We know however that the traits of two very closely related species are likely to be related. 96 | For example, a close relative of a large animal, like a whale, would also be expected to be large, especially if the two species split in recent evolutionary time. 97 | To include the non-independent nature of our data we will first turn to Phylogenetic generalized linear models (PGLS). 98 | 99 | ### PGLS 100 | 101 | In phylogenetic comparative methods we try to deal with this non-independence by using the structure of a phylogeny to weight the error term so that our model fit is no longer blind to the non-independence of our data. 102 | 103 | The first step is to make sure that our data and phylogeny match up correctly. 104 | We will use the comparative.data function from the caper package to make sure that the species in the dataset are matched up to the species in the phylogeny. 105 | To do so we need to give the phylogeny (`phy` argument); the dataset and the name of the column in the dataset with the species names (`names.col` argument). 106 | As we want to calculated a variance-covariance matrix of the phylogeny we set `vcv = true`. 107 | 108 | 109 | ```{r comparative.data, message=FALSE, warning=FALSE} 110 | # Create the comparative data 111 | comp_data <- comparative.data(phy = mammal_tree, data =lifespan_volant, 112 | names.col = species, vcv = TRUE) 113 | head(comp_data$data) 114 | 115 | # Note that in the comp_data$data that there are now no birds; 116 | # these have been dropped 117 | head(comp_data$dropped) 118 | ``` 119 | 120 | We can now run some models, first lets run two models with lambda set to 1 and something close to 0. 121 | 122 | ```{r fixed lambda, message=FALSE, warning=FALSE} 123 | # We have the formula and the comparative.data object comp_data which contains 124 | # but the phylogeny and the data. Lets set the lambda in this case to 1. 125 | pgls_l1 <- pgls(formula = formula_a, data = comp_data, lambda = c(1)) 126 | pgls_l0 <- pgls(formula = formula_a, data = comp_data, lambda = c(0.01)) 127 | summary(pgls_l1) 128 | summary(pgls_l0) 129 | ``` 130 | 131 | The outputs looks similar to our glm with the estimates of the Coefficients, adjusted R-squared etc. 132 | However lets run a model were lambda is no longer fixed. 133 | We can do this by specifying `lambda = "ML"` which tells the model to estimate it using Maximum Likelihood. 134 | 135 | ```{r running pgls, message=FALSE, warning=FALSE} 136 | # Finally we also need to set the lambda in this case to ML. This means the we 137 | # will using Maximum Likelihood to calculate the lambda. 138 | pgls_mod <- pgls(formula = formula_a, data = comp_data, lambda = "ML") 139 | summary(pgls_mod) 140 | ``` 141 | 142 | 143 | Now under branch length transformations we also now get the estimated branch transformation under maximum likelihood. 144 | As we are only interested in fitting only lambda for now the other types of transformations, (kappa and delta), are held fixed. 145 | 146 | Lambda here estimated as : 147 | ```{r lambda, message=FALSE, warning=FALSE} 148 | pgls_mod$param["lambda"] 149 | ``` 150 | 151 | As it is close to 1 the traits in this model are correlated under Brownian motion. 152 | If our value was 0 it would indicate that our data points are essentially independent. 153 | We can then go a check various elements of the model such as the likelihood profile for lambda. 154 | 155 | ```{r lambda_profile, message=FALSE, warning=FALSE} 156 | mod_profile <- pgls.profile(pgls_mod) 157 | plot(mod_profile) 158 | ``` 159 | 160 | Which looks good as the profile shows a nice clear peak. 161 | 162 | 163 | We would also then go ahead and check our residuals etc. but for now we will assume everything is good and move onto running a similar model using `MCMCglmm`. 164 | 165 | 166 | ### MCMCglmm 167 | 168 | So far we have fitted a very simple **glm** and a **PGLS** model that included phylogeny to account for non-independence. 169 | Now we will use a Bayesian approach were we include phylogeny as a random term using the animal model in the `MCMCglmm` package. 170 | 171 | As we are using a Bayesian approach we will first set up the priors. 172 | In most cases we want to use a non-informative prior that doesn’t influence the estimated posterior distribution. 173 | For the random effect variance prior we will use an inverse-Gamma distribution. 174 | In `MCMCglmm` this is described by two parameters: `nu` and `V`. 175 | These terms are related to the shape (alpha) and scale (beta) parameters on an inverse-Gamma with `alpha = nu/2`, and `Beta = (nu*V)/2`. 176 | As we don’t want our estimates to be heavily influenced by our prior we will use weakly informative prior values such as descripted as `V = 1` and `nu = 0.002`. 177 | For more on priors for the animal model see the [`MCMCglmm` course notes](https://cran.r-project.org/web/packages/MCMCglmm/vignettes/CourseNotes.pdf). 178 | 179 | ```{r priors, message=FALSE, warning=FALSE} 180 | prior <- list(R = list(V=1, nu=0.002), 181 | G = list(G1 = list(V=1, nu=0.002))) 182 | ``` 183 | 184 | We describe our prior as above for the random (G) and residual variances (R) each of them as a list, which we will in turn put within a list. 185 | If we wanted to include more random terms we would include a G2, G3 etc for each additional random term within the G list. 186 | We could also specify priors for the fixed terms using B, however `MCMCglmm` will automatically do that for us and as it usually does a good job at it we will ignore it here. 187 | 188 | Next we need to decide on the parameters relating to running the mcmc chain in the model. 189 | We need to include how many iterations we want to run the the chain for (`nitt` argument), the burnin we want to discard at the start of the chain (`burnin` argument) and also how often we want to sample and store from the chain (`thin` argument). 190 | We discard a burnin as we don't want the starting point of the chain to over-influence our final estimates. 191 | For now lets just use a burnin of 1/6 of the nitt, just to be safe. 192 | The thinning is used to help reduce autocorrelation in our sample, how much you use often depends on how much autocorrelation you find. 193 | 194 | To save time we will only run this model over 12000 iterations (however, much larger nitt is often required). 195 | 196 | ```{r parameters, message=FALSE, warning=FALSE} 197 | # Number of interations 198 | nitt <- 12000 199 | 200 | # Length of burnin 201 | burnin <- 2000 202 | 203 | # Amount of thinning 204 | thin <- 5 205 | ``` 206 | 207 | Now we need to set up the data. We have already cleaned and matched up our data earlier using the `comparative.data` function but we need to now add an extra column into our dataset called `"animal"` which contains the species matched between the tree and the data. 208 | 209 | ```{r MCMCglmm_data, message=FALSE, warning=FALSE} 210 | #Matched data 211 | mcmc_data <- comp_data$data 212 | 213 | #As MCMCglmm requires a colume named animal for it to identify it as a phylo 214 | # model we include an extra colume with the species names in it. 215 | mcmc_data <- cbind(animal = rownames(mcmc_data), mcmc_data) 216 | mcmc_tree <- comp_data$phy 217 | ``` 218 | 219 | `MCMCglmm` reserves the random variable `"animal"` to call a model that includes the phylogeny as an additive genetic effect. 220 | If we name it something else, like say `"species"`, `MCMCglmm` will either throw an error looking for `"animal"`, or if we do not provide a phylogeny under pedigree it will run `"species"` like a standard random term. 221 | Now we can run the model. 222 | 223 | ```{r MCMCglmm_run, message=FALSE, warning=FALSE, verbose = FALSE} 224 | 225 | mod_mcmc <- MCMCglmm(fixed = formula_a, 226 | random = ~ animal, 227 | family = "gaussian", 228 | pedigree = mcmc_tree, 229 | data = mcmc_data, 230 | nitt = nitt, 231 | burnin = burnin, 232 | thin = thin, 233 | prior = prior) 234 | ``` 235 | 236 | As the model runs we see the iterations print out. 237 | These chains can take some time to run, depending on the model, however, since we only ran our chains for 12000 iterations it doesn't take long here. 238 | 239 | Before we even look at our model we need to check if the model ran appropriately. 240 | We can do this by visually inspecting the chains to make sure there has been no unruly behaviour! 241 | We can extract the full chains using `model$Sol` for the fixed effects and `model$VCV` for the random effect variances. 242 | So `Sol[,1]` will give you the first fixed term, in this case the intercept, and `VCV[,1]` will give you the first random term, which is `"animal"` and so on. 243 | As our model is an mcmc object when we use the plot function we get a trace plot. 244 | 245 | ```{r MCMCglmm_plot, message=FALSE, warning=FALSE, verbose = FALSE} 246 | plot(mod_mcmc$Sol) 247 | plot(mod_mcmc$VCV) 248 | ``` 249 | 250 | On the right hand side of the plots is the posterior distributions for each of the terms. 251 | On the left side of these plots are the traces of the mcmc chain for each estimate. 252 | What we want to see in these trace plots is "hairy caterpillars" (not my phrase!). 253 | That is a trace with no obvious trend that is bouncing around some stable point. 254 | 255 | What we don't want to see in the trace plots can be demonstrated if we only run our model over a very short chain (`itt == 1000`). 256 | Notice that without a burnin the start of trace is well outside the area that the chain will converges towards. 257 | 258 | ```{r MCMCglmm_crap_run, message=FALSE, warning=FALSE, verbose = FALSE, echo=FALSE} 259 | mod_mcmc_short_run <- MCMCglmm(fixed = formula_a, 260 | random= ~ animal, 261 | family="gaussian", 262 | pedigree = mcmc_tree, 263 | data = mcmc_data, 264 | nitt = c(1000), 265 | burnin = c(1), 266 | thin = c(1), 267 | prior = prior, 268 | verbose=FALSE) 269 | 270 | traceplot(mod_mcmc_short_run$VCV[,2]) 271 | ``` 272 | 273 | So in our longer run model everything looks good visually, however we also want to check the level of autocorrelation in these traces. 274 | We can do this using the `autocorr.diag` function which gives the level of correlation along the chain between some lag sizes. 275 | 276 | ```{r check auto correlation, message=FALSE, warning=FALSE, verbose = FALSE} 277 | autocorr.diag(mod_mcmc$Sol) 278 | autocorr.diag(mod_mcmc$VCV) 279 | ``` 280 | 281 | or we can look at autocorrelation plots for each of the traces, we'll look at just one using the `acf` function here. 282 | 283 | ```{r acf, message=FALSE, warning=FALSE, verbose = FALSE} 284 | # acf plot for the first fixed estimate in our model (the intercept) 285 | acf(mod_mcmc$Sol[,1], lag.max = 20) 286 | 287 | # acf plot for the first random term in our model (the animal term) 288 | acf(mod_mcmc$VCV[,1], lag.max = 20) 289 | ``` 290 | 291 | For our intercept the autocorrelation plot looks good, however the animal term still shows some autocorrelation. 292 | One quick way to deal with this is to simply increase the thinning. 293 | 294 | ```{r long run, message=FALSE, warning=FALSE} 295 | 296 | nitt2 <- 240000 297 | burnin2 = 40000 298 | thin2 = 100 299 | 300 | mod_mcmc_long <- MCMCglmm(fixed = formula_a, 301 | random= ~ animal, 302 | family="gaussian", 303 | pedigree = mcmc_tree, 304 | data = mcmc_data, 305 | nitt = nitt2, 306 | burnin = burnin2, 307 | thin = thin2, 308 | prior = prior, 309 | verbose = FALSE) 310 | 311 | acf(mod_mcmc_long$VCV[,1], lag.max = 20) 312 | ``` 313 | 314 | That looks better now. 315 | Noticed I also increased the number of iterations. 316 | One rough and ready rule that I like to use is to aim for an effective sample size of my chains, which is the number of iterations used in the posterior after the burnin, thinning and accounting for autocorrelation, somewhere between 1000-2000. 317 | 318 | ```{r effective sample size, message=FALSE, warning=FALSE, verbose = FALSE} 319 | # acf plot for the first fixed estimate in our model (the intercept) 320 | effectiveSize(mod_mcmc_long$Sol) 321 | effectiveSize(mod_mcmc_long$VCV) 322 | ``` 323 | 324 | * One thing to note is that while thinning might help autocorrelation it wont solve it and you might have to use parameter expanded priors. 325 | These are priors that help weight the chain away from zero, a common problem when variance is low or with certain phylogenetic structures. 326 | They work by splitting the prior into 2 components with one component weighing the chain away from zero. 327 | 328 | 329 | One last thing to check is that our MCMC chain has properly converged and that our estimate is not the result of some type of transitional behaviour. 330 | That is have our chains "found" the optimum or do we need to let them run longer before they settle around some estimate. 331 | To check this we will run a second model and see if it converges on the same estimates as our first model. 332 | 333 | ```{r second mcmc mod, message=FALSE, warning=FALSE, verbose = FALSE} 334 | mod_mcmc_2 <- MCMCglmm(fixed = formula_a, 335 | random = ~ animal, 336 | family ="gaussian", 337 | pedigree = mcmc_tree, 338 | data = mcmc_data, 339 | nitt = nitt2, 340 | burnin = burnin2, 341 | thin = thin2, 342 | prior = prior, 343 | verbose = FALSE) 344 | ``` 345 | 346 | We can now check the convergence of the two chains using the Gelman and Rubin Multiple Sequence Diagnostic. 347 | This calculates the within-chain and between-chain variance of the chains and then gives a scale reduced factor, ([see here for more](http://svitsrv25.epfl.ch/R-doc/library/coda/html/gelman.diag.html)). 348 | When this number is close to one (say below 1.1) the chains are indistinguishable and hence can be considered to be converged. 349 | 350 | ```{r convergance test, message=FALSE, warning=FALSE, verbose = FALSE} 351 | # Checking convergence for our fixed factors 352 | gelman.diag(mcmc.list(mod_mcmc_long$Sol, mod_mcmc_2$Sol)) 353 | 354 | # Checking convergence for our random terms 355 | gelman.diag(mcmc.list(mod_mcmc_long$VCV, mod_mcmc_2$VCV)) 356 | ``` 357 | 358 | Since everything looks good, we will finally look at the results of our model. 359 | 360 | ```{r MCMCglmm_summay, message=FALSE, warning=FALSE, verbose = FALSE} 361 | summary(mod_mcmc_long) 362 | ``` 363 | 364 | First off we can find the estimates for the fixed factors are under the Location effects section (again notice the similarity to our PGLS model). 365 | Each parameter has a measure of the effect size using the post.mean and a lower and higher 95% credible interval (CI). 366 | These are simply calculated from the posterior distributions we looked at in the above plots, so if you would rather calculated the median instead of using the mean we can simple use 367 | 368 | ```{r MCMCglmm_median, message=FALSE, warning=FALSE, verbose = FALSE} 369 | median(mod_mcmc_long$Sol[,1]) 370 | ``` 371 | 372 | We also have the effective sample size (`eff.samp`) and the `pMCMC` which calculated as two times the probability that the estimate is either > or < 0, using which ever one is smaller. 373 | However since our data has been mean centred and expressed in units of standard deviation we can look at what proportion of our posterior is on either side of zero. 374 | 375 | For the random terms we have the posterior distribution for our G-structure which includes or phylogenetic effect and the R-structure which is our residual variation. 376 | 377 | We also have the DIC which is a Bayesian version of AIC. 378 | Like AIC it is a measure of the trade-off between the "fit" of the model and the number of parameters, with a lower number better. 379 | 380 | Finally, we can also calculate the H^2 which is comparable to Pagel's lambda as 381 | 382 | ```{r heritability, message=FALSE, warning=FALSE, verbose = FALSE} 383 | H <- ( var(mod_mcmc_long$VCV[,"animal"]))/ 384 | (var(mod_mcmc_long$VCV[,"animal"]) + var(mod_mcmc_long$VCV[,"units"])) 385 | H 386 | ``` 387 | 388 | Before moving on to the next section try running the above analysis subsetted for birds as opposed to mammals. 389 | 390 | ```{r , message=FALSE, warning=FALSE, fig.width=8,fig.height=10} 391 | #aves tree from Jetz et al 2012 392 | aves_tree <- trees_aves[[1]] 393 | ``` 394 | 395 | 396 | 397 | That seems like a lot of work to get the same result so why bother. 398 | One reason is that you are fundamentally team Bayesian. 399 | Another is that `MCMCglmm` can give you a lot of flexibility in your models. 400 | As I mentioned above this is the vanilla model and it can we can create much more complex models by such as including extra random terms, include multiple responses and a bunch of other things. 401 | One quick thing I will do (if we have the time) is to run an analysis over a range of phylogenies. 402 | 403 | ## Extending MCMCglmm: including multiple trees 404 | 405 | So far we have run our analysis over one single phylogeny. 406 | However we know phylogenies do not exist without uncertainty. 407 | For example, we only used a single tree from 10000 in Kuhn *et al* (2011) and other phylogenies are now starting to be given as distributions such as the [Jetz *et al* (2012) bird phylogeny](http://birdtree.org/}). 408 | One of the nice features about using `MCMCglmm` is that as the output is a posterior distribution we can simple run multiple models, one for each tree, and combine the output. 409 | This is starting to become more common (for example this paper came out just last week) and is a nice way to include the uncertainty relating to the phylogeny itself. 410 | 411 | As an example of doing this we will use some `mulTree` code (which is still in development at the moment and hence not on CRAN yet) that makes running these analysis easier for us. 412 | 413 | For fun lets run a model over both birds and mammal using a subset of 2 trees from both Kuhn *et al* 2011 and Jetz *et al* 2012. 414 | 415 | ```{r mammal and aves trees, message=FALSE, warning=FALSE, verbose = FALSE} 416 | trees_aves 417 | trees_mammalia 418 | ``` 419 | 420 | We need to graft these different phylogenies together, in this case we will use a root age of 250 million years ago. 421 | If we only wanted one combined tree we would set the argument `sample = 1`. 422 | 423 | ```{r combine trees, message=FALSE, warning=FALSE, verbose = FALSE} 424 | combined_trees <- tree.bind(trees_mammalia, trees_aves, sample = 2, 425 | root.age = 250) 426 | ``` 427 | 428 | We will use the same data as before but this time we will keep the birds in it 429 | 430 | ```{r show data again, message=FALSE, warning=FALSE} 431 | data(lifespan) 432 | # Data have been log transformed, mean centered and expressed in units of 433 | # standard deviation. 434 | head(lifespan_volant) 435 | 436 | ##lets package all the data up into one mulTree object 437 | mulTree_data <- as.mulTree(data = lifespan_volant, tree = combined_trees, 438 | taxa = "species") 439 | ``` 440 | 441 | We need to set up our parameters as before. 442 | ```{r set up multree, message=FALSE, warning=FALSE} 443 | # The formula 444 | mul_formula <- longevity ~ mass + volant 445 | # The MCMC parameters (iterations, thining, burnin) 446 | mul_parameters <- c(nitt2, thin2, burnin2) 447 | # The MCMCglmm priors 448 | mul_priors <- list(R = list(V = 1, nu = 0.002), 449 | G = list(G1 = list(V = 1, nu = 0.002))) 450 | ``` 451 | 452 | As running multiple MCMCglmm models can quickly cause issues with memory storage in `R` (100 trees would require at least 200 chains in order to test for convergence) so `mulTree` exports each set of chains to you working directory only reading them back in when required. 453 | So make sure you are happy with wherever you are sending your models. 454 | 455 | ```{r getwd, message=FALSE, warning=FALSE} 456 | getwd() 457 | ``` 458 | 459 | If we are all happy with that we can finally send our model going. 460 | In this case we don’t want to run the models for too long so we will only use 2 chains. 461 | As way to keep a general eye on all our models `mulTree` will check whether the effective sample size (ESS) of each model is above some number across all parameters. 462 | 463 | ```{r running multree, message=FALSE, warning=FALSE} 464 | mulTree(mulTree.data = mulTree_data, formula = mul_formula, priors = mul_priors, 465 | parameters = mul_parameters, output = "longevity_example", ESS = 1000, 466 | chains = 2) 467 | ``` 468 | 469 | Now that we have run the model lets read the trees back in. 470 | 471 | ```{r reading back in multree, message=FALSE, warning=FALSE} 472 | # Reading only one specific model 473 | one_model <- read.mulTree("longevity_example-tree1_chain1", model = TRUE) 474 | 475 | # This model is a normal MCMCglmm object that has been ran on one single tree 476 | class(one_model) ; names(one_model) 477 | 478 | # Reading the convergence diagnosis test to see if the two chains converged for 479 | # each tree 480 | read.mulTree("longevity_example", convergence = TRUE) 481 | # As indicated here, the chains converged for both chains! 482 | 483 | # Reading all the models to perform the MCMCglmm analysis on multiple trees 484 | all_models <- read.mulTree("longevity_example") 485 | str(all_models) 486 | # This object contains 39600 estimations of the Intercept and the terms! 487 | 488 | # If you want to remove the chains from the current directory run the following: 489 | # file.remove(list.files(pattern="longevity_example")) 490 | # However when doing your actual analysis you should keep all your models stored 491 | # somewhere! 492 | ``` 493 | 494 | Great it looks similar to what we've seen before. 495 | 496 | ```{r summary all models from multree, message=FALSE, warning=FALSE} 497 | summarised_results <- summary(all_models, use.hdr = FALSE, cent.tend = mean, 498 | prob = c(75, 25)) 499 | 500 | ``` 501 | 502 | And just for fun we can make some density plots 503 | 504 | ```{r mulTree plots, message=FALSE, warning=FALSE} 505 | plot(summarised_results, horizontal = TRUE, ylab = "", cex.coeff = 0.8, 506 | main = "Posterior distributions", ylim = c(-2,2), cex.terms = 0.5, 507 | terms = c("Intercept", "Body Mass", "Volancy", "Phylogeny", "Residuals"), 508 | col = "grey", cex.main = 0.8) 509 | ``` 510 | 511 | -------------------------------------------------------------------------------- /doc/mulTree-manual.Rnw: -------------------------------------------------------------------------------- 1 | \documentclass{article} 2 | \usepackage[sc]{mathpazo} 3 | \usepackage[T1]{fontenc} 4 | \usepackage{geometry} 5 | \usepackage{natbib} 6 | \usepackage[utf8]{inputenc} 7 | \geometry{verbose,tmargin=2.5cm,bmargin=2.5cm,lmargin=2.5cm,rmargin=2.5cm} 8 | \setcounter{secnumdepth}{2} 9 | \setcounter{tocdepth}{2} 10 | \usepackage{url} 11 | \usepackage[unicode=true,pdfusetitle, 12 | bookmarks=true,bookmarksnumbered=true,bookmarksopen=true,bookmarksopenlevel=2, 13 | breaklinks=false,pdfborder={0 0 1},backref=false,colorlinks=false] 14 | {hyperref} 15 | \hypersetup{ 16 | pdfstartview={XYZ null null 1}} 17 | 18 | \begin{document} 19 | <>= 20 | library(knitr) 21 | # set global chunk options 22 | opts_chunk$set(fig.path='figure/minimal-', fig.align='center', fig.show='hold') 23 | options(formatR.arrow=TRUE,width=90) 24 | @ 25 | 26 | 27 | \title{\texttt{mulTree} manual} 28 | 29 | 30 | \author{Thomas Guillerme} 31 | 32 | \maketitle 33 | 34 | This package is based on the \href{http://cran.r-project.org/web/packages/MCMCglmm/index.html}{\texttt{MCMCglmm} package} and runs a MCMCglmm analysis on multiple trees. 35 | 36 | \section{Installation} 37 | You can install the latest released version (\Sexpr{packageVersion("mulTree")}) directly from GitHub using the following: 38 | 39 | <>= 40 | if(!require(devtools)) install.packages("devtools") 41 | install_github("TGuillerme/mulTree", ref = "release") 42 | @ 43 | 44 | %\tableofcontents 45 | 46 | \section{Quick go through} 47 | 48 | Note that this section will be developed in the future. 49 | Stay tuned! 50 | 51 | <>= 52 | ## Loading the package 53 | library(mulTree) 54 | 55 | ## Loading the lifespan data 56 | data(lifespan) 57 | @ 58 | 59 | 60 | \subsection{Combining phylogenies: \texttt{tree.bind}} 61 | This function allows to combine phylogenies, in this example, we are going to combine the \texttt{trees\_mammalia} and the \texttt{trees\_aves} randomly at a root.age of 250 million years ago. 62 | 63 | <>= 64 | ## The 2 mammalian trees 65 | trees_mammalia 66 | ## Number of tips in both 67 | unlist(lapply(trees_mammalia, Ntip)) 68 | 69 | ## The 2 aves trees 70 | trees_aves 71 | ## Number of tips in both 72 | unlist(lapply(trees_aves, Ntip)) 73 | 74 | ## Combining them 75 | combined_trees <- tree.bind(trees_mammalia, trees_aves, sample = 2, 76 | root.age = 250) 77 | combined_trees 78 | ## Number of tips in both 79 | unlist(lapply(combined_trees, Ntip)) 80 | @ 81 | 82 | \subsection{Preparing the \texttt{mulTree} data: \texttt{as.mulTree}} 83 | This function allows to combine the trees to some trait data and get it in the right format to be passed to the \texttt{mulTree} function. 84 | 85 | <>= 86 | ## The trait data 87 | head(lifespan_volant) 88 | 89 | ## Creating the mulTree object 90 | mulTree_data <- as.mulTree(data = lifespan_volant, tree = combined_trees, 91 | taxa = "species") 92 | 93 | ## This object is classified as "mulTree" and contains different elements to be 94 | ## passed to the mulTree function 95 | class(mulTree_data) ; names(mulTree_data) 96 | @ 97 | 98 | 99 | \subsection{Running the \texttt{MCMCglmm} on multiple trees: \texttt{mulTree}} 100 | This function intakes the normal arguments form the \href{http://cran.r-project.org/web/packages/MCMCglmm/index.html}{\texttt{MCMCglmm} function} alongside with the \texttt{mulTree} object. 101 | 102 | \textbf{WARNING: this part of the code does currently not run on \texttt{knitr} and is therefore skipped.}\\ 103 | However, this part works normally if copy / pasted into the \texttt{R} console. 104 | Be warned however, that this part of the code can take several minutes to run! 105 | 106 | <>= 107 | ## The glmm formula 108 | my_formula <- longevity ~ mass + volant 109 | 110 | ## The MCMC parameters (generations, sampling, burnin) 111 | my_parameters <- c(100000, 10, 1000) 112 | 113 | ## The MCMCglmm priors 114 | my_priors <- list(R = list(V = 1/2, nu = 0.002), 115 | G = list(G1 = list(V = 1/2, nu = 0.002))) 116 | 117 | ## Running the MCMCglmm on multiple trees 118 | mulTree(mulTree.data = mulTree_data, formula = my_formula, priors = my_priors, 119 | parameters = my_parameters, output = "longevity_example", ESS = 50, 120 | chains = 2) 121 | @ 122 | 123 | 124 | \subsection{Reading the models: \texttt{read.mulTree}} 125 | The models where written out of the \texttt{R} environment in your current directory. 126 | To reinput them in the \texttt{R} environment and analysis the results, we can use the \texttt{read.mulTree} function. 127 | 128 | \textbf{WARNING: this part of the code does currently not run on \texttt{knitr} and is therefore skipped.}\\ 129 | However, this part works normally if copy / pasted into the \texttt{R} console. 130 | 131 | <>= 132 | ## Reading only one specific model 133 | one_model <- read.mulTree("longevity_example-tree1_chain1", model = TRUE) 134 | ## This model is a normal MCMCglmm object that has been ran on one single tree 135 | class(one_model) ; names(one_model) 136 | 137 | ## Reading the convergence diagnosis test to see if the two chains converged for 138 | ## each tree 139 | read.mulTree("longevity_example", convergence = TRUE) 140 | ## As indicated here, the chains converged for both chains! 141 | 142 | ## Reading all the models to perform the MCMCglmm analysis on multiple trees 143 | all_models <- read.mulTree("longevity_example") 144 | str(all_models) 145 | ## This object contains 39600 estimations of the Intercept and the terms! 146 | 147 | ## Removing the chains from the current directory 148 | file.remove(list.files(pattern="longevity_example")) 149 | @ 150 | 151 | <>= 152 | ## To temporarily remedy the problem with knitr described above we can load pre 153 | ## calculated MCMCglmm. 154 | data(lifespan.mcmc) 155 | 156 | ## NOTE HOWEVER THAT IF YOU ARE RUNNING THE CODE OF THIS VIGNETTE IN THE R 157 | ## CONSOLE, YOU WON'T NEED THIS STEP! 158 | 159 | ## Summarizing all the chains 160 | all_models <- lifespan.mcmc 161 | @ 162 | 163 | 164 | \subsection{Summarising the results: \texttt{summary.mulTree}} 165 | It is possible to summarise the results of the glmm on all chains using the \texttt{summary.mulTree} function. 166 | 167 | <>= 168 | ## Summarising the results by estimating the highest density regions 169 | ## and their associated 95 and 50 confidence intervals (default) 170 | summarised_results <- summary(all_models) 171 | summarised_results 172 | 173 | ## Summarising the results using the quick 'n' dirty way along with some options 174 | ## i.e just measuring the distributions quantiles 175 | ## note that there is a S3 method for "mulTree" objects allowing to just use 176 | ## summary() 177 | summary(all_models, use.hdr = FALSE, cent.tend = mean, prob = c(75, 25)) 178 | @ 179 | 180 | \newpage 181 | 182 | \subsection{Visualising the results: \texttt{plot.mulTree}} 183 | Finally it is possible to simply plot the results from the MCMCglmm analysis on multiple trees using the S3 method for \texttt{plot.mulTree}. 184 | Here are two examples: 185 | 186 | <>= 187 | ## Graphical options 188 | quartz(width = 10, height = 5) ; par(mfrow = (c(1,2)), bty = "n") 189 | 190 | ## Plotting using the default options 191 | plot(summarised_results) 192 | 193 | ## Plotting using some more pretty options 194 | plot(summarised_results, horizontal = TRUE, ylab = "", cex.coeff = 0.8, 195 | main = "Posterior distributions", ylim = c(-2,2), cex.terms = 0.5, 196 | terms = c("Intercept", "Body Mass", "Volancy", "Phylogeny", "Residuals"), 197 | col = "red", cex.main = 0.8) 198 | abline(v = 0, lty = 3) 199 | @ 200 | 201 | \end{document} -------------------------------------------------------------------------------- /doc/mulTree-manual.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/TGuillerme/mulTree/ad24fb3f403add36955e1dffe4c89ebd3e241b6a/doc/mulTree-manual.pdf -------------------------------------------------------------------------------- /doc/mulTree-manual.tex: -------------------------------------------------------------------------------- 1 | \documentclass{article}\usepackage[]{graphicx}\usepackage[]{color} 2 | %% maxwidth is the original width if it is less than linewidth 3 | %% otherwise use linewidth (to make sure the graphics do not exceed the margin) 4 | \makeatletter 5 | \def\maxwidth{ % 6 | \ifdim\Gin@nat@width>\linewidth 7 | \linewidth 8 | \else 9 | \Gin@nat@width 10 | \fi 11 | } 12 | \makeatother 13 | 14 | \definecolor{fgcolor}{rgb}{0.345, 0.345, 0.345} 15 | \newcommand{\hlnum}[1]{\textcolor[rgb]{0.686,0.059,0.569}{#1}}% 16 | \newcommand{\hlstr}[1]{\textcolor[rgb]{0.192,0.494,0.8}{#1}}% 17 | \newcommand{\hlcom}[1]{\textcolor[rgb]{0.678,0.584,0.686}{\textit{#1}}}% 18 | \newcommand{\hlopt}[1]{\textcolor[rgb]{0,0,0}{#1}}% 19 | \newcommand{\hlstd}[1]{\textcolor[rgb]{0.345,0.345,0.345}{#1}}% 20 | \newcommand{\hlkwa}[1]{\textcolor[rgb]{0.161,0.373,0.58}{\textbf{#1}}}% 21 | \newcommand{\hlkwb}[1]{\textcolor[rgb]{0.69,0.353,0.396}{#1}}% 22 | \newcommand{\hlkwc}[1]{\textcolor[rgb]{0.333,0.667,0.333}{#1}}% 23 | \newcommand{\hlkwd}[1]{\textcolor[rgb]{0.737,0.353,0.396}{\textbf{#1}}}% 24 | 25 | \usepackage{framed} 26 | \makeatletter 27 | \newenvironment{kframe}{% 28 | \def\at@end@of@kframe{}% 29 | \ifinner\ifhmode% 30 | \def\at@end@of@kframe{\end{minipage}}% 31 | \begin{minipage}{\columnwidth}% 32 | \fi\fi% 33 | \def\FrameCommand##1{\hskip\@totalleftmargin \hskip-\fboxsep 34 | \colorbox{shadecolor}{##1}\hskip-\fboxsep 35 | % There is no \\@totalrightmargin, so: 36 | \hskip-\linewidth \hskip-\@totalleftmargin \hskip\columnwidth}% 37 | \MakeFramed {\advance\hsize-\width 38 | \@totalleftmargin\z@ \linewidth\hsize 39 | \@setminipage}}% 40 | {\par\unskip\endMakeFramed% 41 | \at@end@of@kframe} 42 | \makeatother 43 | 44 | \definecolor{shadecolor}{rgb}{.97, .97, .97} 45 | \definecolor{messagecolor}{rgb}{0, 0, 0} 46 | \definecolor{warningcolor}{rgb}{1, 0, 1} 47 | \definecolor{errorcolor}{rgb}{1, 0, 0} 48 | \newenvironment{knitrout}{}{} % an empty environment to be redefined in TeX 49 | 50 | \usepackage{alltt} 51 | \usepackage[sc]{mathpazo} 52 | \usepackage[T1]{fontenc} 53 | \usepackage{geometry} 54 | \usepackage{natbib} 55 | \usepackage[utf8]{inputenc} 56 | \geometry{verbose,tmargin=2.5cm,bmargin=2.5cm,lmargin=2.5cm,rmargin=2.5cm} 57 | \setcounter{secnumdepth}{2} 58 | \setcounter{tocdepth}{2} 59 | \usepackage{url} 60 | \usepackage[unicode=true,pdfusetitle, 61 | bookmarks=true,bookmarksnumbered=true,bookmarksopen=true,bookmarksopenlevel=2, 62 | breaklinks=false,pdfborder={0 0 1},backref=false,colorlinks=false] 63 | {hyperref} 64 | \hypersetup{ 65 | pdfstartview={XYZ null null 1}} 66 | \IfFileExists{upquote.sty}{\usepackage{upquote}}{} 67 | \begin{document} 68 | 69 | 70 | 71 | \title{\texttt{mulTree} manual} 72 | 73 | 74 | \author{Thomas Guillerme} 75 | 76 | \maketitle 77 | 78 | This package is based on the \href{http://cran.r-project.org/web/packages/MCMCglmm/index.html}{\texttt{MCMCglmm} package} and runs a MCMCglmm analysis on multiple trees. 79 | 80 | \section{Installation} 81 | You can install the latest released version (1.2) directly from GitHub using the following: 82 | 83 | \begin{knitrout} 84 | \definecolor{shadecolor}{rgb}{0.969, 0.969, 0.969}\color{fgcolor}\begin{kframe} 85 | \begin{alltt} 86 | \hlkwa{if}\hlstd{(}\hlopt{!}\hlkwd{require}\hlstd{(devtools))} \hlkwd{install.packages}\hlstd{(}\hlstr{"devtools"}\hlstd{)} 87 | \hlkwd{install_github}\hlstd{(}\hlstr{"TGuillerme/mulTree"}\hlstd{,} \hlkwc{ref} \hlstd{=} \hlstr{"release"}\hlstd{)} 88 | \end{alltt} 89 | \end{kframe} 90 | \end{knitrout} 91 | 92 | %\tableofcontents 93 | 94 | \section{Quick go through} 95 | 96 | Note that this section will be developed in the future. 97 | Stay tuned! 98 | 99 | \begin{knitrout} 100 | \definecolor{shadecolor}{rgb}{0.969, 0.969, 0.969}\color{fgcolor}\begin{kframe} 101 | \begin{alltt} 102 | \hlcom{## Loading the package} 103 | \hlkwd{library}\hlstd{(mulTree)} 104 | \end{alltt} 105 | 106 | 107 | {\ttfamily\noindent\itshape\color{messagecolor}{\#\# Loading required package: caper}} 108 | 109 | {\ttfamily\noindent\itshape\color{messagecolor}{\#\# Loading required package: MASS}} 110 | 111 | {\ttfamily\noindent\itshape\color{messagecolor}{\#\# Loading required package: mvtnorm}} 112 | 113 | {\ttfamily\noindent\itshape\color{messagecolor}{\#\# Loading required package: coda}} 114 | 115 | {\ttfamily\noindent\itshape\color{messagecolor}{\#\# Loading required package: hdrcde}} 116 | 117 | {\ttfamily\noindent\itshape\color{messagecolor}{\#\# hdrcde 3.1 loaded}} 118 | 119 | {\ttfamily\noindent\itshape\color{messagecolor}{\#\# Loading required package: MCMCglmm}} 120 | 121 | {\ttfamily\noindent\itshape\color{messagecolor}{\#\# Loading required package: Matrix}} 122 | 123 | {\ttfamily\noindent\itshape\color{messagecolor}{\#\# Loading required package: snow}}\begin{alltt} 124 | \hlcom{## Loading the lifespan data} 125 | \hlkwd{data}\hlstd{(lifespan)} 126 | \end{alltt} 127 | \end{kframe} 128 | \end{knitrout} 129 | 130 | 131 | \subsection{Combining phylogenies: \texttt{tree.bind}} 132 | This function allows to combine phylogenies, in this example, we are going to combine the \texttt{trees\_mammalia} and the \texttt{trees\_aves} randomly at a root.age of 250 million years ago. 133 | 134 | \begin{knitrout} 135 | \definecolor{shadecolor}{rgb}{0.969, 0.969, 0.969}\color{fgcolor}\begin{kframe} 136 | \begin{alltt} 137 | \hlcom{## The 2 mammalian trees} 138 | \hlstd{trees_mammalia} 139 | \end{alltt} 140 | \begin{verbatim} 141 | ## 2 phylogenetic trees 142 | \end{verbatim} 143 | \begin{alltt} 144 | \hlcom{## Number of tips in both} 145 | \hlkwd{unlist}\hlstd{(}\hlkwd{lapply}\hlstd{(trees_mammalia, Ntip))} 146 | \end{alltt} 147 | \begin{verbatim} 148 | ## [1] 134 134 149 | \end{verbatim} 150 | \begin{alltt} 151 | \hlcom{## The 2 aves trees} 152 | \hlstd{trees_aves} 153 | \end{alltt} 154 | \begin{verbatim} 155 | ## 2 phylogenetic trees 156 | \end{verbatim} 157 | \begin{alltt} 158 | \hlcom{## Number of tips in both} 159 | \hlkwd{unlist}\hlstd{(}\hlkwd{lapply}\hlstd{(trees_aves, Ntip))} 160 | \end{alltt} 161 | \begin{verbatim} 162 | ## [1] 58 58 163 | \end{verbatim} 164 | \begin{alltt} 165 | \hlcom{## Combining them} 166 | \hlstd{combined_trees} \hlkwb{<-} \hlkwd{tree.bind}\hlstd{(trees_mammalia, trees_aves,} \hlkwc{sample} \hlstd{=} \hlnum{2}\hlstd{,} 167 | \hlkwc{root.age} \hlstd{=} \hlnum{250}\hlstd{)} 168 | \hlstd{combined_trees} 169 | \end{alltt} 170 | \begin{verbatim} 171 | ## 2 phylogenetic trees 172 | \end{verbatim} 173 | \begin{alltt} 174 | \hlcom{## Number of tips in both} 175 | \hlkwd{unlist}\hlstd{(}\hlkwd{lapply}\hlstd{(combined_trees, Ntip))} 176 | \end{alltt} 177 | \begin{verbatim} 178 | ## [1] 192 192 179 | \end{verbatim} 180 | \end{kframe} 181 | \end{knitrout} 182 | 183 | \subsection{Preparing the \texttt{mulTree} data: \texttt{as.mulTree}} 184 | This function allows to combine the trees to some trait data and get it in the right format to be passed to the \texttt{mulTree} function. 185 | 186 | \begin{knitrout} 187 | \definecolor{shadecolor}{rgb}{0.969, 0.969, 0.969}\color{fgcolor}\begin{kframe} 188 | \begin{alltt} 189 | \hlcom{## The trait data} 190 | \hlkwd{head}\hlstd{(lifespan_volant)} 191 | \end{alltt} 192 | \begin{verbatim} 193 | ## species class longevity mass volant 194 | ## 1 Dolichotis_patagonum Mammalia -0.1490041 1.0875446 nonvolant 195 | ## 2 Eidolon_helvum Mammalia 0.4686111 -0.2748337 volant 196 | ## 3 Elephas_maximus Mammalia 2.1071286 3.1220340 nonvolant 197 | ## 4 Equus_asinus Mammalia 1.6128024 2.0352764 nonvolant 198 | ## 5 Equus_burchellii Mammalia 1.2962194 2.2295299 nonvolant 199 | ## 6 Equus_caballus Mammalia 1.9001076 2.2548716 nonvolant 200 | \end{verbatim} 201 | \begin{alltt} 202 | \hlcom{## Creating the mulTree object} 203 | \hlstd{mulTree_data} \hlkwb{<-} \hlkwd{as.mulTree}\hlstd{(}\hlkwc{data} \hlstd{= lifespan_volant,} \hlkwc{tree} \hlstd{= combined_trees,} 204 | \hlkwc{taxa} \hlstd{=} \hlstr{"species"}\hlstd{)} 205 | 206 | \hlcom{## This object is classified as "mulTree" and contains different elements to be} 207 | \hlcom{## passed to the mulTree function} 208 | \hlkwd{class}\hlstd{(mulTree_data) ;} \hlkwd{names}\hlstd{(mulTree_data)} 209 | \end{alltt} 210 | \begin{verbatim} 211 | ## [1] "mulTree" 212 | ## [1] "phy" "data" "random.terms" "taxa.column" 213 | \end{verbatim} 214 | \end{kframe} 215 | \end{knitrout} 216 | 217 | 218 | \subsection{Running the \texttt{MCMCglmm} on multiple trees: \texttt{mulTree}} 219 | This function intakes the normal arguments form the \href{http://cran.r-project.org/web/packages/MCMCglmm/index.html}{\texttt{MCMCglmm} function} alongside with the \texttt{mulTree} object. 220 | 221 | \textbf{WARNING: this part of the code does currently not run on \texttt{knitr} and is therefore skipped.}\\ 222 | However, this part works normally if copy / pasted into the \texttt{R} console. 223 | Be warned however, that this part of the code can take several minutes to run! 224 | 225 | \begin{knitrout} 226 | \definecolor{shadecolor}{rgb}{0.969, 0.969, 0.969}\color{fgcolor}\begin{kframe} 227 | \begin{alltt} 228 | \hlcom{## The glmm formula} 229 | \hlstd{my_formula} \hlkwb{<-} \hlstd{longevity} \hlopt{~} \hlstd{mass} \hlopt{+} \hlstd{volant} 230 | 231 | \hlcom{## The MCMC parameters (generations, sampling, burnin)} 232 | \hlstd{my_parameters} \hlkwb{<-} \hlkwd{c}\hlstd{(}\hlnum{100000}\hlstd{,} \hlnum{10}\hlstd{,} \hlnum{1000}\hlstd{)} 233 | 234 | \hlcom{## The MCMCglmm priors} 235 | \hlstd{my_priors} \hlkwb{<-} \hlkwd{list}\hlstd{(}\hlkwc{R} \hlstd{=} \hlkwd{list}\hlstd{(}\hlkwc{V} \hlstd{=} \hlnum{1}\hlopt{/}\hlnum{2}\hlstd{,} \hlkwc{nu} \hlstd{=} \hlnum{0.002}\hlstd{),} 236 | \hlkwc{G} \hlstd{=} \hlkwd{list}\hlstd{(}\hlkwc{G1} \hlstd{=} \hlkwd{list}\hlstd{(}\hlkwc{V} \hlstd{=} \hlnum{1}\hlopt{/}\hlnum{2}\hlstd{,} \hlkwc{nu} \hlstd{=} \hlnum{0.002}\hlstd{)))} 237 | 238 | \hlcom{## Running the MCMCglmm on multiple trees} 239 | \hlkwd{mulTree}\hlstd{(}\hlkwc{mulTree.data} \hlstd{= mulTree_data,} \hlkwc{formula} \hlstd{= my_formula,} \hlkwc{priors} \hlstd{= my_priors,} 240 | \hlkwc{parameters} \hlstd{= my_parameters,} \hlkwc{output} \hlstd{=} \hlstr{"longevity_example"}\hlstd{,} \hlkwc{ESS} \hlstd{=} \hlnum{50}\hlstd{,} 241 | \hlkwc{chains} \hlstd{=} \hlnum{2}\hlstd{)} 242 | \end{alltt} 243 | \end{kframe} 244 | \end{knitrout} 245 | 246 | 247 | \subsection{Reading the models: \texttt{read.mulTree}} 248 | The models where written out of the \texttt{R} environment in your current directory. 249 | To reinput them in the \texttt{R} environment and analysis the results, we can use the \texttt{read.mulTree} function. 250 | 251 | \textbf{WARNING: this part of the code does currently not run on \texttt{knitr} and is therefore skipped.}\\ 252 | However, this part works normally if copy / pasted into the \texttt{R} console. 253 | 254 | \begin{knitrout} 255 | \definecolor{shadecolor}{rgb}{0.969, 0.969, 0.969}\color{fgcolor}\begin{kframe} 256 | \begin{alltt} 257 | \hlcom{## Reading only one specific model} 258 | \hlstd{one_model} \hlkwb{<-} \hlkwd{read.mulTree}\hlstd{(}\hlstr{"longevity_example-tree1_chain1"}\hlstd{,} \hlkwc{model} \hlstd{=} \hlnum{TRUE}\hlstd{)} 259 | \hlcom{## This model is a normal MCMCglmm object that has been ran on one single tree} 260 | \hlkwd{class}\hlstd{(one_model) ;} \hlkwd{names}\hlstd{(one_model)} 261 | 262 | \hlcom{## Reading the convergence diagnosis test to see if the two chains converged for} 263 | \hlcom{## each tree} 264 | \hlkwd{read.mulTree}\hlstd{(}\hlstr{"longevity_example"}\hlstd{,} \hlkwc{convergence} \hlstd{=} \hlnum{TRUE}\hlstd{)} 265 | \hlcom{## As indicated here, the chains converged for both chains!} 266 | 267 | \hlcom{## Reading all the models to perform the MCMCglmm analysis on multiple trees} 268 | \hlstd{all_models} \hlkwb{<-} \hlkwd{read.mulTree}\hlstd{(}\hlstr{"longevity_example"}\hlstd{)} 269 | \hlkwd{str}\hlstd{(all_models)} 270 | \hlcom{## This object contains 39600 estimations of the Intercept and the terms!} 271 | 272 | \hlcom{## Removing the chains from the current directory} 273 | \hlkwd{file.remove}\hlstd{(}\hlkwd{list.files}\hlstd{(}\hlkwc{pattern}\hlstd{=}\hlstr{"longevity_example"}\hlstd{))} 274 | \end{alltt} 275 | \end{kframe} 276 | \end{knitrout} 277 | 278 | \begin{knitrout} 279 | \definecolor{shadecolor}{rgb}{0.969, 0.969, 0.969}\color{fgcolor}\begin{kframe} 280 | \begin{alltt} 281 | \hlcom{## To temporarily remedy the problem with knitr described above we can load pre} 282 | \hlcom{## calculated MCMCglmm.} 283 | \hlkwd{data}\hlstd{(lifespan.mcmc)} 284 | 285 | \hlcom{## NOTE HOWEVER THAT IF YOU ARE RUNNING THE CODE OF THIS VIGNETTE IN THE R} 286 | \hlcom{## CONSOLE, YOU WON'T NEED THIS STEP!} 287 | 288 | \hlcom{## Summarizing all the chains} 289 | \hlstd{all_models} \hlkwb{<-} \hlstd{lifespan.mcmc} 290 | \end{alltt} 291 | \end{kframe} 292 | \end{knitrout} 293 | 294 | 295 | \subsection{Summarising the results: \texttt{summary.mulTree}} 296 | It is possible to summarise the results of the glmm on all chains using the \texttt{summary.mulTree} function. 297 | 298 | \begin{knitrout} 299 | \definecolor{shadecolor}{rgb}{0.969, 0.969, 0.969}\color{fgcolor}\begin{kframe} 300 | \begin{alltt} 301 | \hlcom{## Summarising the results by estimating the highest density regions} 302 | \hlcom{## and their associated 95 and 50 confidence intervals (default)} 303 | \hlstd{summarised_results} \hlkwb{<-} \hlkwd{summary}\hlstd{(all_models)} 304 | \hlstd{summarised_results} 305 | \end{alltt} 306 | \begin{verbatim} 307 | ## Estimates(mode hdr) lower.CI(2.5) lower.CI(25) upper.CI(75) upper.CI(97.5) 308 | ## Intercept -0.06998610 -1.13208516 -0.44485793 0.29071331 1.01296766 309 | ## mass 0.51833434 0.38949558 0.47446737 0.56227627 0.64498845 310 | ## volancy 0.98968793 0.39699455 0.78557659 1.18069855 1.55656202 311 | ## phy.var 0.91499147 0.62185688 0.81016755 1.03538468 1.28537639 312 | ## res.var 0.04437394 0.02238432 0.03521267 0.05303716 0.07522866 313 | ## attr(,"class") 314 | ## [1] "matrix" "mulTree" 315 | \end{verbatim} 316 | \begin{alltt} 317 | \hlcom{## Summarising the results using the quick 'n' dirty way along with some options} 318 | \hlcom{## i.e just measuring the distributions quantiles} 319 | \hlcom{## note that there is a S3 method for "mulTree" objects allowing to just use} 320 | \hlcom{## summary()} 321 | \hlkwd{summary}\hlstd{(all_models,} \hlkwc{use.hdr} \hlstd{=} \hlnum{FALSE}\hlstd{,} \hlkwc{cent.tend} \hlstd{= mean,} \hlkwc{prob} \hlstd{=} \hlkwd{c}\hlstd{(}\hlnum{75}\hlstd{,} \hlnum{25}\hlstd{))} 322 | \end{alltt} 323 | \begin{verbatim} 324 | ## Estimates(mean) lower.CI(12.5) lower.CI(37.5) upper.CI(62.5) upper.CI(87.5) 325 | ## Intercept -0.06726806 -0.69609640 -0.24328020 0.10553401 0.56463730 326 | ## mass 0.51757042 0.44244907 0.49679614 0.53879559 0.59259546 327 | ## volancy 0.97726166 0.63844718 0.88624230 1.07205171 1.31429889 328 | ## phy.var 0.94630374 0.75547035 0.88405672 0.99072104 1.14261125 329 | ## res.var 0.04758039 0.03238856 0.04198954 0.05061299 0.06364383 330 | ## attr(,"class") 331 | ## [1] "matrix" "mulTree" 332 | \end{verbatim} 333 | \end{kframe} 334 | \end{knitrout} 335 | 336 | \newpage 337 | 338 | \subsection{Visualising the results: \texttt{plot.mulTree}} 339 | Finally it is possible to simply plot the results from the MCMCglmm analysis on multiple trees using the S3 method for \texttt{plot.mulTree}. 340 | Here are two examples: 341 | 342 | \begin{knitrout} 343 | \definecolor{shadecolor}{rgb}{0.969, 0.969, 0.969}\color{fgcolor}\begin{kframe} 344 | \begin{alltt} 345 | \hlcom{## Graphical options} 346 | \hlkwd{quartz}\hlstd{(}\hlkwc{width} \hlstd{=} \hlnum{10}\hlstd{,} \hlkwc{height} \hlstd{=} \hlnum{5}\hlstd{) ;} \hlkwd{par}\hlstd{(}\hlkwc{mfrow} \hlstd{= (}\hlkwd{c}\hlstd{(}\hlnum{1}\hlstd{,}\hlnum{2}\hlstd{)),} \hlkwc{bty} \hlstd{=} \hlstr{"n"}\hlstd{)} 347 | 348 | \hlcom{## Plotting using the default options} 349 | \hlkwd{plot}\hlstd{(summarised_results)} 350 | 351 | \hlcom{## Plotting using some more pretty options} 352 | \hlkwd{plot}\hlstd{(summarised_results,} \hlkwc{horizontal} \hlstd{=} \hlnum{TRUE}\hlstd{,} \hlkwc{ylab} \hlstd{=} \hlstr{""}\hlstd{,} \hlkwc{cex.coeff} \hlstd{=} \hlnum{0.8}\hlstd{,} 353 | \hlkwc{main} \hlstd{=} \hlstr{"Posterior distributions"}\hlstd{,} \hlkwc{ylim} \hlstd{=} \hlkwd{c}\hlstd{(}\hlopt{-}\hlnum{2}\hlstd{,}\hlnum{2}\hlstd{),} \hlkwc{cex.terms} \hlstd{=} \hlnum{0.5}\hlstd{,} 354 | \hlkwc{terms} \hlstd{=} \hlkwd{c}\hlstd{(}\hlstr{"Intercept"}\hlstd{,} \hlstr{"Body Mass"}\hlstd{,} \hlstr{"Volancy"}\hlstd{,} \hlstr{"Phylogeny"}\hlstd{,} \hlstr{"Residuals"}\hlstd{),} 355 | \hlkwc{col} \hlstd{=} \hlstr{"red"}\hlstd{,} \hlkwc{cex.main} \hlstd{=} \hlnum{0.8}\hlstd{)} 356 | \hlkwd{abline}\hlstd{(}\hlkwc{v} \hlstd{=} \hlnum{0}\hlstd{,} \hlkwc{lty} \hlstd{=} \hlnum{3}\hlstd{)} 357 | \end{alltt} 358 | \end{kframe} 359 | 360 | {\centering \includegraphics[width=1\linewidth]{figure/minimal-plot_mulTree1-1} 361 | 362 | } 363 | 364 | 365 | 366 | \end{knitrout} 367 | 368 | \end{document} 369 | -------------------------------------------------------------------------------- /man/as.mulTree.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/as.mulTree.R 3 | \name{as.mulTree} 4 | \alias{as.mulTree} 5 | \title{Combines a data table and a "multiPhylo" object into a list to be used by the mulTree function} 6 | \usage{ 7 | as.mulTree(data, tree, taxa, rand.terms, clean.data = FALSE) 8 | } 9 | \arguments{ 10 | \item{data}{A \code{data.frame} or \code{matrix} containing at least two variable and taxa names.} 11 | 12 | \item{tree}{A \code{phylo} or \code{multiPhylo} object.} 13 | 14 | \item{taxa}{The name or the number of the column containing the list of taxa in the \code{data}.} 15 | 16 | \item{rand.terms}{A \code{\link[stats]{formula}} ontaining additional random terms to add to the default formula (phylogenetic effect). If missing, the random terms are the column containing the taxa names and a column containing the specimen names if more than one taxa per specimen is present.} 17 | 18 | \item{clean.data}{A \code{logical} value: whether to use the \code{\link{clean.data}} function. Default = \code{FALSE}.} 19 | } 20 | \value{ 21 | A \code{mulTree} object the data to be passed to the \code{\link{mulTree}} function. 22 | } 23 | \description{ 24 | Combines a data table and a multiple phylogenies. Changes the name of the taxa column into "sp.col" to be read by \code{\link[MCMCglmm]{MCMCglmm}}. 25 | } 26 | \details{ 27 | If \code{rand.terms} is specified by the user, the first element is forced to be called "animal". 28 | } 29 | \examples{ 30 | ##Creates a data.frame 31 | data_table <- data.frame(taxa = LETTERS[1:5], var1 = rnorm(5), 32 | var2 = c(rep("a",2), rep("b",3))) 33 | ##Creates a list of tree 34 | tree_list <- rmtree(5,5, tip.label = LETTERS[1:5]) 35 | ##Creates the "mulTree" object 36 | as.mulTree(data_table, tree_list, taxa = "taxa") 37 | 38 | ##Creating a mulTree object with multiple specimens 39 | ##Creates a data.frame with taxa being labelled as "spec1" 40 | data_table_sp1 <- data.frame(taxa = LETTERS[1:5], var1 = rnorm(5), 41 | var2 = c(rep("a",2), rep("b",3)), specimen = c(rep("spec1", 5))) 42 | ##Creates a data.frame with taxa being labelled as "spec2" 43 | data_table_sp2 <- data.frame(taxa = LETTERS[1:5], var1 = rnorm(5), 44 | var2 = c(rep("a",2), rep("b",3)), specimen = c(rep("spec2", 5))) 45 | ##Combines both data.frames 46 | data_table <- rbind(data_table_sp1, data_table_sp2) 47 | ##Creates a list of tree 48 | tree_list <- rmtree(5,5, tip.label = LETTERS[1:5]) 49 | ##Creates the "mulTree" object (with a random term formula) 50 | as.mulTree(data_table, tree_list, taxa = "taxa", rand.terms = ~taxa+specimen) 51 | 52 | } 53 | \seealso{ 54 | \code{\link{mulTree}} 55 | } 56 | \author{ 57 | Thomas Guillerme 58 | } 59 | -------------------------------------------------------------------------------- /man/clean.data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/clean.data.R 3 | \name{clean.data} 4 | \alias{clean.data} 5 | \title{Cleaning phylogenetic data} 6 | \usage{ 7 | clean.data(data, tree, data.col = FALSE) 8 | } 9 | \arguments{ 10 | \item{data}{A \code{data.frame} or \code{matrix} with the elements names as row names.} 11 | 12 | \item{tree}{A \code{phylo} or \code{multiPhylo} object.} 13 | 14 | \item{data.col}{Optional, the number (\code{numeric}) or name (\code{character}) of the column in \code{data} that contains the tip labels to match. If left missing, the \code{data}'s rownames are used (default is \code{FALSE}).} 15 | } 16 | \value{ 17 | A \code{list} containing the cleaned data and tree(s) and information on the eventual dropped tips and rows. 18 | } 19 | \description{ 20 | Cleans a table/tree to match with a given table/tree 21 | } 22 | \examples{ 23 | ##Creating a set of different trees 24 | trees_list <- list(rtree(5, tip.label = LETTERS[1:5]), rtree(4, 25 | tip.label = LETTERS[1:4]), rtree(6, tip.label = LETTERS[1:6])) 26 | class(trees_list) <- "multiPhylo" 27 | 28 | ##Creating a matrix 29 | dummy_data <- matrix(c(rnorm(5), runif(5)), 5, 2, 30 | dimnames = list(LETTERS[1:5], c("var1", "var2"))) 31 | 32 | ##Cleaning the trees and the data 33 | cleaned <- clean.data(data = dummy_data, tree = trees_list) 34 | ##The taxa that where dropped (tips and rows): 35 | c(cleaned$dropped_tips, cleaned$dropped_rows) 36 | ##The cleaned trees: 37 | cleaned$tree 38 | ##The cleaned data set: 39 | cleaned$data 40 | 41 | } 42 | \author{ 43 | Thomas Guillerme 44 | } 45 | -------------------------------------------------------------------------------- /man/lifespan.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mulTree-package.R 3 | \docType{data} 4 | \name{lifespan} 5 | \alias{lifespan} 6 | \title{Example dataset for the \code{mulTree} package} 7 | \format{ 8 | Contains a \code{data.frame} and two \code{multiPhylo} objects: 9 | \describe{ 10 | \item{lifespan_volant}{A \code{data.frame} object of five variables for 192 species (see \code{\link{lifespan_volant_192taxa}}).} 11 | \item{trees_aves}{A \code{multiPhylo} object of two trees of 58 bird species. The tip names are the binomial names of the species.} 12 | \item{trees_mammalia}{A a \code{multiPhylo} object of two trees of 134 mammal species. The tip names are the binomial names of the species.} 13 | } 14 | } 15 | \description{ 16 | This is a dataset containing lifespan data and trees from Healy et al (2014) 17 | } 18 | \references{ 19 | Healy, K., Guillerme, T., Finlay, S., Kane, A., Kelly, S, B, A., McClean, D., Kelly, D, J., Donohue, I., Jackson, A, L., Cooper, N. (2014) Ecology and mode-of-life explain lifespan variation in birds and mammals. Proceedings of the Royal Society B 281, 20140298c 20 | } 21 | \keyword{datasets} 22 | -------------------------------------------------------------------------------- /man/lifespan.mcmc.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mulTree-package.R 3 | \docType{data} 4 | \name{lifespan.mcmc} 5 | \alias{lifespan.mcmc} 6 | \title{Example of mulTree analysis data} 7 | \format{ 8 | Contains the results of a \code{mulTree} analysis on two trees with two independent chains per trees. 9 | } 10 | \description{ 11 | This is an example of MCMCglmm output files using the \code{\link{mulTree}} function on the \code{lifespan} data. 12 | } 13 | \references{ 14 | Healy, K., Guillerme, T., Finlay, S., Kane, A., Kelly, S, B, A., McClean, D., Kelly, D, J., Donohue, I., Jackson, A, L., Cooper, N. (2014) Ecology and mode-of-life explain lifespan variation in birds and mammals. Proceedings of the Royal Society B 281, 20140298c 15 | } 16 | \keyword{datasets} 17 | -------------------------------------------------------------------------------- /man/lifespan_volant_192taxa.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mulTree-package.R 3 | \docType{data} 4 | \name{lifespan_volant_192taxa} 5 | \alias{lifespan_volant_192taxa} 6 | \title{Example Aves and Mammalia lifespan for the mulTree package} 7 | \format{ 8 | The datafile contains a data frame (\code{lifespan_volant_192taxa}) of 192 complete cases for those species. The data frame contains five variables: 9 | \describe{ 10 | \item{species}{The species binomial name.} 11 | \item{class}{The species phylogenetic class.} 12 | \item{longevity}{The mean centred logged maximum lifespan in years.} 13 | \item{mass}{The mean centred logged body mass in grams.} 14 | \item{volant}{Flying ability, as a two level factor: volant and nonvolant.} 15 | } 16 | } 17 | \description{ 18 | This is a dataset containing lifespan data from 192 species of birds and mammals. 19 | } 20 | \references{ 21 | Healy, K., Guillerme, T., Finlay, S., Kane, A., Kelly, S, B, A., McClean, D., Kelly, D, J., Donohue, I., Jackson, A, L., Cooper, N. (2014) Ecology and mode-of-life explain lifespan variation in birds and mammals. Proceedings of the Royal Society B 281, 20140298c 22 | } 23 | \keyword{datasets} 24 | -------------------------------------------------------------------------------- /man/mulTree-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mulTree-package.R 3 | \docType{package} 4 | \name{mulTree-package} 5 | \alias{mulTree-package} 6 | \title{Performs MCMCglmm On Multiple Phylogenetic Trees.} 7 | \description{ 8 | Allows to run a MCMCglmm on multiuple phylogenetic trees to take into account phylogenetic uncertainty. 9 | } 10 | \references{ 11 | Healy, K., Guillerme T., Finlay, S., Kane, A., Kelly, S.B.A., McClean, D., Kelly, D.J., Donohue, I., Jackson, A.L. and Cooper, N. , 12 | 2014. Ecology and mode of life explain lifespan variation in birds and mammals. Proceedings of the Royal Society of London B. 281(1784), 20140298, 13 | } 14 | \author{ 15 | Thomas Guillerme & Kevin Healy 16 | } 17 | \keyword{Bayesian,} 18 | \keyword{MCMCglmm,} 19 | \keyword{correction,} 20 | \keyword{distribution} 21 | \keyword{phylogenetic} 22 | \keyword{tree} 23 | -------------------------------------------------------------------------------- /man/mulTree.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mulTree.R 3 | \name{mulTree} 4 | \alias{mulTree} 5 | \title{Run MCMCglmm on multiple trees} 6 | \usage{ 7 | mulTree( 8 | mulTree.data, 9 | formula, 10 | parameters, 11 | chains = 2, 12 | priors, 13 | ..., 14 | convergence = 1.1, 15 | ESS = 1000, 16 | verbose = TRUE, 17 | output = "mulTree_models", 18 | warn = FALSE, 19 | parallel, 20 | ask = TRUE 21 | ) 22 | } 23 | \arguments{ 24 | \item{mulTree.data}{A list of class \code{mulTree} generated using \code{\link{as.mulTree}}.} 25 | 26 | \item{formula}{An object of class \code{formula} (excluding the random terms).} 27 | 28 | \item{parameters}{A list of three numerical values to be used respectively as: (1) the number of generations, (2) the sampling value, (3) the burnin.} 29 | 30 | \item{chains}{The number of independent chains to run per model.} 31 | 32 | \item{priors}{A series of priors to use for the MCMC. If missing, the priors will be the default parameters from the \code{\link[MCMCglmm]{MCMCglmm}} function.} 33 | 34 | \item{...}{Any additional arguments to be passed to the \code{\link[MCMCglmm]{MCMCglmm}} function.} 35 | 36 | \item{convergence}{A numerical value for assessing chains convergence (default = \code{1.1}).} 37 | 38 | \item{ESS}{A numerical value for assessing the effective sample size (default = \code{1000}).} 39 | 40 | \item{verbose}{A logical value stating whether to be verbose or not (default = \code{TRUE}).} 41 | 42 | \item{output}{A string of characters that will be used as chain name for the models output (default = \code{mulTree_models}).} 43 | 44 | \item{warn}{Whether to print the warning messages from the \code{\link[MCMCglmm]{MCMCglmm}} function (default = \code{FALSE}).} 45 | 46 | \item{parallel}{An optional vector containing the virtual connection process type for running the chains in parallel (requires \code{snow} package).} 47 | 48 | \item{ask}{\code{logical}, whether to ask to overwrite models (\code{TRUE} - default) or not (\code{FALSE})).} 49 | } 50 | \value{ 51 | Generates MCMCglmm models and saves them sequentially out of \code{R} environment to minimise users RAM usage. 52 | Use \code{\link{read.mulTree}} to reload the models back in the \code{R} environment. 53 | Because of the calculation of the vcv matrix for each model and each tree in the MCMCglmm models, this function is really RAM demanding. 54 | For big datasets we heavily recommend to have at least 4GB RAM DDR3 available. 55 | } 56 | \description{ 57 | Running a \code{\link[MCMCglmm]{MCMCglmm}} model on a multiple phylogenies and a \code{data.frame} combined using \code{\link{as.mulTree}}. The results are written out of \code{R} environment as individual models. 58 | } 59 | \examples{ 60 | ## Quick example: 61 | ## Before the analysis 62 | data <- data.frame("sp.col" = LETTERS[1:5], var1 = rnorm(5), var2 = rnorm(5)) 63 | tree <- replicate(3, rcoal(5, tip.label = LETTERS[1:5]), simplify = FALSE) 64 | class(tree) <- "multiPhylo" 65 | mulTree.data <- as.mulTree(data, tree, taxa = "sp.col") 66 | priors <- list(R = list(V = 1/2, nu = 0.002), 67 | G = list(G1 = list(V = 1/2, nu = 0.002))) 68 | ## quick example 69 | mulTree(mulTree.data, formula = var1 ~ var2, parameters = c(10000, 10, 1000), 70 | chains = 2, prior = priors, output = "quick_example", convergence = 1.1, 71 | ESS = 100) 72 | ## Clean folder 73 | file.remove(list.files(pattern = "quick_example")) 74 | ## alternative example with parallel argument (and double the chains!) 75 | mulTree(mulTree.data, formula = var1 ~ var2, parameters = c(10000, 10, 1000), 76 | chains = 4, prior = priors, output = "quick_example", convergence = 1.1, 77 | ESS = 100, parallel = "SOCK") 78 | ## Clean folder 79 | file.remove(list.files(pattern = "quick_example")) 80 | 81 | \dontrun{ 82 | ## Before the analysis: 83 | ## read in the data 84 | data(lifespan) 85 | ## combine aves and mammalia trees 86 | combined_trees <- tree.bind(x = trees_mammalia, y = trees_aves, sample = 2, 87 | root.age = 250) 88 | 89 | ## Preparing the variables for the mulTree function 90 | ## creates the "mulTree" object 91 | mulTree_data <- as.mulTree(data = lifespan_volant, tree = combined_trees, 92 | taxa = "species") 93 | ## formula 94 | test_formula <- longevity ~ mass + volant 95 | ## parameters (number of generations, thin/sampling, burnin) 96 | mcmc_parameters <- c(101000, 10, 1000) 97 | # For higher ESS run longer by increasing the number of generations 98 | ## priors 99 | mcmc_priors <- list(R = list(V = 1/2, nu = 0.002), 100 | G = list(G1 = list(V = 1/2, nu = 0.002))) 101 | 102 | ## Running MCMCglmm on multiple trees 103 | ## WARNING: This example takes between 1 and 2 minutes to run 104 | ## and generates files in your current directory. 105 | mulTree(mulTree_data, formula = test_formula, parameters = mcmc_parameters, 106 | priors = mcmc_priors, output = "longevity.example", ESS = 50) 107 | 108 | ## The models are saved out of R environment under the "longevity.example" 109 | ## chains names. 110 | ## Use read.mulTree() to read the generated models. 111 | 112 | ## Remove the generated files from the current directory 113 | file.remove(list.files(pattern = "longevity.example")) 114 | 115 | ## Parallel example 116 | ## Loading the snow package 117 | library(snow) 118 | ## Running the same MCMCglmm on multiple trees 119 | mulTree(mulTree_data, formula = test_formula, parameters = mcmc_parameters, 120 | priors = mcmc_priors, output = "longevity.example", ESS = 50, 121 | parallel = "SOCK") 122 | ## Remove the generated files from the current directory 123 | file.remove(list.files(pattern = "longevity.example")) 124 | 125 | ## Same example but including specimens 126 | ## Subset of the data 127 | data <- lifespan_volant[sample(nrow(lifespan_volant), 30),] 128 | ##Create a dataset with two specimen per species 129 | data <- rbind(cbind(data, specimen = rep("spec1", 30)), cbind(data, 130 | specimen = rep("spec2", 30))) 131 | ##Cleaning the trees 132 | trees <- clean.data(data, combined_trees, data.col = "species")$tree 133 | 134 | ##Creates the mulTree object 135 | mulTree_data <- as.mulTree(data, trees, taxa = "species", 136 | rand.terms = ~species+specimen) 137 | 138 | ## Updating the priors 139 | mcmc_priors <- list(R = list(V = 1/2, nu = 0.002), 140 | G = list(G1 = list(V = 1/2, nu = 0.002), 141 | G2 = list(V = 1/2, nu = 0.002))) 142 | 143 | ##Running MCMCglmm on multiple trees 144 | mulTree(mulTree_data, formula = test_formula, parameters = mcmc_parameters, 145 | priors = mcmc_priors, output = "longevity.example", ESS = 50) 146 | ##Remove the generated files from the current directory 147 | file.remove(list.files(pattern = "longevity.example")) 148 | } 149 | 150 | } 151 | \seealso{ 152 | \code{\link[MCMCglmm]{MCMCglmm}}, \code{\link{as.mulTree}}, \code{\link{read.mulTree}} 153 | } 154 | \author{ 155 | Thomas Guillerme 156 | } 157 | -------------------------------------------------------------------------------- /man/plot.mulTree.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot.mulTree.R 3 | \name{plot.mulTree} 4 | \alias{plot.mulTree} 5 | \title{Plots \code{mulTree} results} 6 | \usage{ 7 | \method{plot}{mulTree}( 8 | mulTree.summary, 9 | terms, 10 | cex.terms, 11 | cex.coeff, 12 | horizontal = FALSE, 13 | ylim, 14 | col, 15 | ... 16 | ) 17 | } 18 | \arguments{ 19 | \item{mulTree.summary}{A \code{mulTree} matrix summarized by \code{\link{summary.mulTree}}.} 20 | 21 | \item{terms}{An optional vector of terms labels.} 22 | 23 | \item{cex.terms}{An optional value for the size of the terms labels.} 24 | 25 | \item{cex.coeff}{An optional value for the size of the coefficients labels.} 26 | 27 | \item{horizontal}{Whether to plot the results horizontally (\code{default = FALSE}).} 28 | 29 | \item{ylim}{Optional, the y limits of the plot.} 30 | 31 | \item{col}{Optional, the color of the plot.} 32 | 33 | \item{...}{Any additional arguments to be passed to \code{\link[graphics]{plot}}.} 34 | } 35 | \description{ 36 | Plots a boxplots of the terms of a \code{mulTree} analysis. 37 | } 38 | \examples{ 39 | ## read in the data 40 | data(lifespan.mcmc) 41 | 42 | ## summarising the results 43 | summarized_data <- summary(lifespan.mcmc) 44 | 45 | ## plotting the results 46 | plot(summarized_data) 47 | 48 | ## Same plot using more options 49 | plot(summarized_data, horizontal = TRUE, ylab = "", ylim = c(-2,2), 50 | main = "Posterior distributions", cex.terms = 0.5, cex.coeff = 0.8, 51 | terms = c("Intercept", "BodyMass", "Volancy", "Phylogeny", "Residuals"), 52 | col = c("red"), cex.main = 0.8) 53 | abline(v = 0, lty = 3) 54 | 55 | } 56 | \seealso{ 57 | \code{\link{mulTree}}, \code{\link{read.mulTree}}, \code{\link{summary.mulTree}} 58 | } 59 | \author{ 60 | Thomas Guillerme 61 | } 62 | -------------------------------------------------------------------------------- /man/read.mulTree.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/read.mulTree.R 3 | \name{read.mulTree} 4 | \alias{read.mulTree} 5 | \title{Reads MCMCglmm models fromn mulTree.} 6 | \usage{ 7 | read.mulTree(mulTree.chain, convergence = FALSE, model = FALSE, extract = NULL) 8 | } 9 | \arguments{ 10 | \item{mulTree.chain}{A chain name of \code{MCMCglmm} models written by the \code{\link{mulTree}} function.} 11 | 12 | \item{convergence}{Logical, whether to read the convergence file associated with the chain name (default = \code{FALSE}).} 13 | 14 | \item{model}{Logical, whether to input a single \code{MCMCglmm} model or the list of random and fixed terms only (default = \code{FALSE}).} 15 | 16 | \item{extract}{Optional, the name of one or more elements to extract from each model (rather than loading the full model; default = \code{NULL}).} 17 | } 18 | \value{ 19 | A \code{list} of the terms of class \code{mulTree} by default. 20 | Else a \code{MCMCglmm} object (if \code{model = TRUE}); a \code{gelman.diag} object (if \code{convergence = TRUE}) or a list of extracted elements from the \code{MCMCglmm} models (if \code{extract} is not \code{NULL}). 21 | } 22 | \description{ 23 | Reads MCMCglmm objects from the \code{\link{mulTree}} function back into the \code{R} environment. 24 | } 25 | \details{ 26 | The argument \code{model = TRUE} can be used to load the \code{MCMCglmm} object of a unique chain. 27 | The resulting object can be then summarized or plotted as S3 method for class \code{MCMCglmm}. 28 | } 29 | \examples{ 30 | ## Creating some dummy mulTree models 31 | data <- data.frame("sp.col" = LETTERS[1:5], var1 = rnorm(5), var2 = rnorm(5)) 32 | tree <- replicate(3, rcoal(5, tip.label = LETTERS[1:5]), simplify = FALSE) 33 | class(tree) <- "multiPhylo" 34 | mulTree.data <- as.mulTree(data, tree, taxa = "sp.col") 35 | priors <- list(R = list(V = 1/2, nu = 0.002), 36 | G = list(G1 = list(V = 1/2, nu = 0.002))) 37 | mulTree(mulTree.data, formula = var1 ~ var2, parameters = c(10000, 10, 1000), 38 | chains = 2, prior = priors, output = "quick_example", convergence = 1.1, 39 | ESS = 100, verbose = FALSE) 40 | 41 | ## Reading all the models 42 | all_chains <- read.mulTree("quick_example") 43 | 44 | ## Reading the convergence diagnosis for all the trees 45 | read.mulTree("quick_example", convergence = TRUE) 46 | 47 | ## Reading a specific model 48 | model <- read.mulTree("quick_example-tree1_chain1", model = TRUE) 49 | 50 | ## Reading only the error term and the tune for all models 51 | read.mulTree("quick_example", extract=c("error.term", "Tune")) 52 | 53 | ##Remove the generated files from the current directory 54 | file.remove(list.files(pattern = "quick_example")) 55 | 56 | } 57 | \seealso{ 58 | \code{\link{mulTree}}, \code{\link{plot.mulTree}}, \code{\link{summary.mulTree}} 59 | } 60 | \author{ 61 | Thomas Guillerme 62 | } 63 | -------------------------------------------------------------------------------- /man/summary.mulTree.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/summary.mulTree.R 3 | \name{summary.mulTree} 4 | \alias{summary.mulTree} 5 | \title{Summarises \code{mulTree} data} 6 | \usage{ 7 | \method{summary}{mulTree}( 8 | mulTree.results, 9 | prob = c(50, 95), 10 | use.hdr = TRUE, 11 | cent.tend = stats::median, 12 | ... 13 | ) 14 | } 15 | \arguments{ 16 | \item{mulTree.results}{A \code{mulTree} object obtained from \code{\link{read.mulTree}} function.} 17 | 18 | \item{prob}{One or more precentage values for to be the credibility intervals (\code{default = c(50, 95)}).} 19 | 20 | \item{use.hdr}{Logical, whether to calculate the highest density region using \code{\link[hdrcde]{hdr}} (\code{TRUE}) or the quantiles using \code{\link[stats]{quantile}} (\code{FALSE}).} 21 | 22 | \item{cent.tend}{A function for calculating the central tendency (\code{default = median}) from the quantiles (if \code{use.hdr = FALSE}; else is ignored).} 23 | 24 | \item{...}{Any optional arguments to be passed to the \code{\link[hdrcde]{hdr}} or \code{\link[stats]{quantile}} functions.} 25 | } 26 | \value{ 27 | A \code{matrix} of class \code{mulTree}. 28 | } 29 | \description{ 30 | Summarises the \code{MCMCglmm} models calculated from multiple trees by caculating the highest density regions (\code{\link[hdrcde]{hdr}}) of the fixed and random terms. 31 | } 32 | \details{ 33 | When using the highest density region caculation method (\code{use.hdr = TRUE}), the returned central tendency is always the first estimated mode (see \code{\link[hdrcde]{hdr}}). 34 | Note that the results maybe vary when using \code{use.hdr = FALSE} or \code{TRUE}. 35 | We recommend to use \code{use.hdr = TRUE} when possible. 36 | 37 | When \code{use.hdr = FALSE}, the computation is faster but the quantiles are calculated and not estimated. 38 | 39 | When \code{use.hdr = TRUE}, the computation is slower but the quantiles are estimated using the highest density regions. 40 | The given estimates central tendency is calculated as the mode of the estimated highest density region. 41 | For speeding up the calculations, the bandwidth (\code{h} argument) from \code{\link[hdrcde]{hdr}} can be estimated by using \code{\link[stats]{bw.nrd0}}. 42 | } 43 | \examples{ 44 | ## Read in the data 45 | data(lifespan.mcmc) 46 | 47 | ## Summarizing all the chains 48 | summary(lifespan.mcmc) 49 | 50 | ## Modyfing the CI 51 | summary(lifespan.mcmc, prob = 95) 52 | 53 | ## Using use.hdr = FALSE 54 | summary(lifespan.mcmc, use.hdr = FALSE) 55 | 56 | } 57 | \seealso{ 58 | \code{\link{mulTree}}, \code{\link{read.mulTree}}, \code{\link{plot.mulTree}} 59 | } 60 | \author{ 61 | Thomas Guillerme 62 | } 63 | -------------------------------------------------------------------------------- /man/tree.bind.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tree.bind.R 3 | \name{tree.bind} 4 | \alias{tree.bind} 5 | \title{Randomly binding trees together} 6 | \usage{ 7 | tree.bind(x, y, sample, root.age) 8 | } 9 | \arguments{ 10 | \item{x, y}{Two \code{phylo} or \code{multiPhylo} objects.} 11 | 12 | \item{sample}{The number of trees to create. If missing, the \code{sample} size is set to 1.} 13 | 14 | \item{root.age}{The age of the root where both trees are combined (can be any unit). If missing, the \code{root.edge} is set to \code{0}.} 15 | } 16 | \value{ 17 | If \code{x}, \code{y} and \code{sample} are \eqn{>1}, the function returns a \code{multiPhylo} object; else it returns a \code{phylo} object. 18 | } 19 | \description{ 20 | Randomly binds trees together with a provided number of trees and a root age. 21 | } 22 | \examples{ 23 | ## Combines 2 randomly chosen trees from x and from y into z putting the root age at 12. 24 | x <- rmtree(10, 5) ; y <- rmtree(5, 5) 25 | tree.bind(x, y, sample = 3, root.age = 12) 26 | 27 | ##Combines one mammal and and one bird tree and setting the root age at 250 Mya. 28 | data(lifespan) 29 | combined_trees <- tree.bind(trees_mammalia, trees_aves, sample = 1, root.age = 250) 30 | plot(combined_trees) # A tree with both mammals and aves 31 | 32 | } 33 | \author{ 34 | Thomas Guillerme 35 | } 36 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(mulTree) 3 | 4 | test_check("mulTree") 5 | -------------------------------------------------------------------------------- /tests/testthat/test-as.mulTree.R: -------------------------------------------------------------------------------- 1 | # TEST as.mulTree 2 | # Testing select.tip.labels 3 | test_that("select.tip.labels works", { 4 | # Errors 5 | expect_error( 6 | select.tip.labels("a") 7 | ) 8 | expect_error( 9 | select.tip.labels(1) 10 | ) 11 | # Output is character vector... 12 | expect_is( 13 | select.tip.labels(rtree(5)), "character" 14 | ) 15 | # ... of 5 elements: t1, to t5 16 | expect_equal( 17 | select.tip.labels(rtree(5)), c("t1", "t2", "t3", "t4", "t5") 18 | ) 19 | }) 20 | 21 | 22 | # Testing specimen.transform 23 | data1 <- data.frame("sp.col" = LETTERS[1:5], var1 = rnorm(5), var2 = c(rep("a",2), rep("b",3))) 24 | data2 <- rbind(data1, data1) 25 | test_that("specimen.transform works", { 26 | # Errors 27 | expect_error( 28 | specimen.transform("a") 29 | ) 30 | expect_error( 31 | specimen.transform(matrix(NA, 5,5)) 32 | ) 33 | #No modification 34 | expect_equal( 35 | specimen.transform(data1), data1 36 | ) 37 | #Only 5 rows out instead of 10 38 | expect_equal( 39 | nrow(data2), 10 40 | ) 41 | expect_equal( 42 | nrow(specimen.transform(data2)), 5 43 | ) 44 | #Only unique sp.col names 45 | expect_equal( 46 | length(unique(data2$sp.col)), 5 47 | ) 48 | expect_equal( 49 | length(specimen.transform(data2)$sp.col), 5 50 | ) 51 | }) 52 | 53 | # Testing example 54 | data_table <- data.frame(taxa = LETTERS[1:5], var1 = rnorm(5), var2 = c(rep("a",2), rep("b",3))) 55 | tree_list <- rmtree(5,5, tip.label = LETTERS[1:5]) 56 | data_table_sp1 <- data.frame(taxa = LETTERS[1:5], var1 = rnorm(5), var2 = c(rep("a",2), rep("b",3)), specimen = c(rep("spec1", 5))) 57 | data_table_sp2 <- data.frame(taxa = LETTERS[1:5], var1 = rnorm(5), var2 = c(rep("a",2), rep("b",3)), specimen = c(rep("spec2", 5))) 58 | data_table2 <- rbind(data_table_sp1, data_table_sp2) 59 | test_that("as.mulTree works", { 60 | # Matrix conversion works 61 | expect_is( 62 | as.mulTree(as.matrix(data_table), tree_list, taxa = "taxa"), "mulTree" 63 | ) 64 | # Wrong table format 65 | expect_error( 66 | as.mulTree(data_table[,-1], tree_list, taxa = "taxa") 67 | ) 68 | # Tree conversion 69 | expect_is( 70 | as.mulTree(data_table, tree_list[[1]], taxa = "taxa"), "mulTree" 71 | ) 72 | # Taxa column number 73 | expect_is( 74 | as.mulTree(data_table, tree_list, taxa = 1), "mulTree" 75 | ) 76 | # Wrong taxa column 77 | expect_error( 78 | as.mulTree(data_table, tree_list, taxa = "bob") 79 | ) 80 | expect_error( 81 | as.mulTree(data_table, tree_list, taxa = 8) 82 | ) 83 | 84 | # Cleaning data 85 | test <- capture_output(as.mulTree(data_table, tree_list, taxa = "taxa", clean.data = TRUE)) 86 | expect_equal( 87 | test, "Taxa in the tree and the table are all matching!" 88 | ) 89 | test <- capture_output(as.mulTree(data_table[-1,], tree_list, taxa = "taxa", clean.data = TRUE)) 90 | expect_equal( 91 | test, "The following taxa were dropped from the analysis:\n A NA " 92 | ) 93 | 94 | }) 95 | 96 | # Testing example 97 | test_that("example works", { 98 | # Errors 99 | #taxa not found 100 | expect_error( 101 | as.mulTree(data_table, tree_list, taxa = "WRONGNAME") 102 | ) 103 | #tree not a tree 104 | expect_error( 105 | as.mulTree(data_table, 1, taxa = "taxa") 106 | ) 107 | #table not a table 108 | expect_error( 109 | as.mulTree("bla", tree_list, taxa = "taxa") 110 | ) 111 | 112 | #Example 1 113 | # outputs a mulTree... 114 | expect_is( 115 | as.mulTree(data_table, tree_list, taxa = "taxa"), "mulTree" 116 | ) 117 | # ...of for objects: 118 | expect_equal( 119 | length(as.mulTree(data_table, tree_list, taxa = "taxa")), 4 120 | ) 121 | # first being a multiphylo object 122 | expect_is( 123 | as.mulTree(data_table, tree_list, taxa = "taxa")$phy, "multiPhylo" 124 | ) 125 | # second being a data.frame object 126 | expect_is( 127 | as.mulTree(data_table, tree_list, taxa = "taxa")$data, "data.frame" 128 | ) 129 | # third being a call (formula) object 130 | expect_is( 131 | as.mulTree(data_table, tree_list, taxa = "taxa")$random.terms, "call" 132 | ) 133 | # forth being some text 134 | expect_is( 135 | as.mulTree(data_table, tree_list, taxa = "taxa")$taxa.column, "character" 136 | ) 137 | 138 | #Example 2 139 | # outputs a mulTree... 140 | test2 <- suppressMessages(as.mulTree(data_table2, tree_list, taxa = "taxa", rand.terms = ~taxa+specimen)) 141 | expect_is( 142 | test2, "mulTree" 143 | ) 144 | # ...of for objects: 145 | expect_equal( 146 | length(test2), 4 147 | ) 148 | # first being a multiphylo object 149 | expect_is( 150 | test2$phy, "multiPhylo" 151 | ) 152 | # second being a data.frame object 153 | expect_is( 154 | test2$data, "data.frame" 155 | ) 156 | expect_equal( 157 | dim(test2$data), c(10,5) 158 | ) 159 | # third being a formula object 160 | expect_is( 161 | test2$random.terms, "formula" 162 | ) 163 | expect_equal( 164 | test2$random.terms, ~animal + specimen 165 | ) 166 | # forth being some text 167 | expect_is( 168 | test2$taxa.column, "character" 169 | ) 170 | 171 | 172 | #Example 3 (with correlation) 173 | # outputs a mulTree... 174 | test3 <- suppressMessages(as.mulTree(data_table2, tree_list, taxa = "taxa", rand.terms = ~taxa+specimen+var2:us(var1))) 175 | test3.1 <- suppressMessages(as.mulTree(data_table2, tree_list, taxa = "taxa", rand.terms = ~taxa+specimen+us(var1):var2)) 176 | expect_error( 177 | as.mulTree(data_table2, tree_list, taxa = "taxa", rand.terms = ~taxa+specimen+var2:us(var8)) 178 | ) 179 | expect_error( 180 | as.mulTree(data_table2, tree_list, taxa = "taxa", rand.terms = ~specimen+var2:us(var1)) 181 | ) 182 | expect_is( 183 | test3, "mulTree" 184 | ) 185 | # ...of for objects: 186 | expect_equal( 187 | length(test3), 4 188 | ) 189 | # first being a multiphylo object 190 | expect_is( 191 | test3$phy, "multiPhylo" 192 | ) 193 | # second being a data.frame object 194 | expect_is( 195 | test3$data, "data.frame" 196 | ) 197 | expect_equal( 198 | dim(test3$data), c(10,5) 199 | ) 200 | # third being a formula object 201 | expect_is( 202 | test3$random.terms, "formula" 203 | ) 204 | expect_equal( 205 | test3$random.terms, ~animal + specimen + var2:us(var1) 206 | ) 207 | expect_equal( 208 | test3.1$random.terms, ~animal + specimen + us(var1):var2 209 | ) 210 | # forth being some text 211 | expect_is( 212 | test3$taxa.column, "character" 213 | ) 214 | }) 215 | -------------------------------------------------------------------------------- /tests/testthat/test-clean.data.R: -------------------------------------------------------------------------------- 1 | # TEST clean.data 2 | # Testing clean.tree.table 3 | tree <- rtree(6, tip.label = LETTERS[1:6]) 4 | data <- matrix(data =c(rnorm(4), runif(4)), 4, 2, dimnames = list(LETTERS[2:5])) 5 | test <- clean.tree.table(tree, data, data.col = FALSE) 6 | test_that("clean.tree.table works", { 7 | # Errors 8 | expect_error( 9 | clean.tree.table(TRUE) 10 | ) 11 | # Output is a list... 12 | expect_is( 13 | test, "list" 14 | ) 15 | # ... of 4 elements. 16 | expect_equal( 17 | length(test), 4 18 | ) 19 | # First element is a tree... 20 | expect_is( 21 | test[[1]], "phylo" 22 | ) 23 | # ...with three taxa. 24 | expect_equal( 25 | Ntip(test[[1]]), 4 26 | ) 27 | # Second element is a table... 28 | expect_is( 29 | test[[2]], "matrix" 30 | ) 31 | # ...with three rows. 32 | expect_equal( 33 | nrow(test[[2]]), 4 34 | ) 35 | # Third element contains "F" and "A" 36 | expect_equal( 37 | sort(test[[3]]), c("A", "F") 38 | ) 39 | # Forth element contains NA 40 | expect_equal( 41 | test[[4]], NA 42 | ) 43 | }) 44 | 45 | #Testing clean.data 46 | trees_list <- list(rtree(5, tip.label = LETTERS[1:5]), rtree(4, tip.label = LETTERS[1:4]), rtree(6, tip.label = LETTERS[1:6])) ; class(trees_list) <- "multiPhylo" 47 | dummy_data <- matrix(c(rnorm(5), runif(5)), 5, 2, dimnames = list(LETTERS[1:5], c("var1", "var2"))) 48 | cleaned <- clean.data(data = dummy_data, tree = trees_list) 49 | test_that("clean.data works with a matrix", { 50 | # Output is a list... 51 | expect_is( 52 | cleaned, "list" 53 | ) 54 | # ... of 4 elements. 55 | expect_equal( 56 | length(cleaned), 4 57 | ) 58 | # First element are trees... 59 | expect_is( 60 | cleaned[[1]], "multiPhylo" 61 | ) 62 | # ...with 4 taxa each. 63 | expect_equal( 64 | unique(unlist(lapply(cleaned[[1]], Ntip))), 4 65 | ) 66 | # Second element is a table... 67 | expect_is( 68 | cleaned[[2]], "matrix" 69 | ) 70 | # ...with four rows. 71 | expect_equal( 72 | nrow(cleaned[[2]]), 4 73 | ) 74 | # Third element contains "F" 75 | expect_equal( 76 | cleaned[[3]], "F" 77 | ) 78 | # Forth element contains "E" 79 | expect_equal( 80 | cleaned[[4]], "E" 81 | ) 82 | }) 83 | 84 | 85 | #Testing clean.data on data.frames 86 | trees_list <- list(rtree(5, tip.label = LETTERS[1:5]), rtree(4, tip.label = LETTERS[1:4]), rtree(6, tip.label = LETTERS[1:6])) ; class(trees_list) <- "multiPhylo" 87 | dummy_data <- data.frame(LETTERS[1:5], matrix(c(rnorm(5), runif(5)), 5, 2)) 88 | colnames(dummy_data) <- c("species", "var1", "var2") 89 | cleaned <- clean.data(data = dummy_data, tree = trees_list, data.col = "species") 90 | test_that("clean.data works with a data.frame", { 91 | # Errors 92 | expect_error( 93 | clean.data(data = matrix(c(rnorm(5), runif(5)), 5, 2), tree = trees_list, data.col = "species") 94 | ) 95 | expect_error( 96 | clean.data(data = dummy_data, tree = trees_list, data.col = 8) 97 | ) 98 | expect_error( 99 | clean.data(data = dummy_data, tree = trees_list, data.col = "8") 100 | ) 101 | 102 | # Works with a single tree 103 | expect_is( 104 | clean.data(data = dummy_data, tree = trees_list[[1]], data.col = "species"), "list" 105 | ) 106 | 107 | # Output is a list... 108 | expect_is( 109 | cleaned, "list" 110 | ) 111 | # ... of 4 elements. 112 | expect_equal( 113 | length(cleaned), 4 114 | ) 115 | # First element are trees... 116 | expect_is( 117 | cleaned[[1]], "multiPhylo" 118 | ) 119 | # ...with 4 taxa each. 120 | expect_equal( 121 | unique(unlist(lapply(cleaned[[1]], Ntip))), 4 122 | ) 123 | # Second element is a table... 124 | expect_is( 125 | cleaned[[2]], "data.frame" 126 | ) 127 | # ...with four rows. 128 | expect_equal( 129 | nrow(cleaned[[2]]), 4 130 | ) 131 | # Third element contains "F" 132 | expect_equal( 133 | cleaned[[3]], "F" 134 | ) 135 | # Forth element contains "E" 136 | expect_equal( 137 | cleaned[[4]], "E" 138 | ) 139 | 140 | # Returns NAs if trees and data are the same 141 | 142 | trees_list <- list(rtree(5, tip.label = LETTERS[1:5]), rtree(5, tip.label = LETTERS[1:5]), rtree(5, tip.label = LETTERS[1:5])) ; class(trees_list) <- "multiPhylo" 143 | dummy_data <- data.frame(LETTERS[1:5], matrix(c(rnorm(5), runif(5)), 5, 2)) 144 | colnames(dummy_data) <- c("species", "var1", "var2") 145 | cleaned <- clean.data(data = dummy_data, tree = trees_list, data.col = "species") 146 | 147 | expect_true( 148 | is.na(cleaned$dropped_tips) 149 | ) 150 | expect_true( 151 | is.na(cleaned$dropped_rows) 152 | ) 153 | 154 | }) 155 | -------------------------------------------------------------------------------- /tests/testthat/test-mulTree.R: -------------------------------------------------------------------------------- 1 | # TEST as.mulTree 2 | # Testing select.tip.labels 3 | test_that("read.key works - scan option deactivated!", { 4 | #Message 5 | expect_message( 6 | read.key("message1", scan=FALSE) 7 | ) 8 | expect_message( 9 | read.key("message1", "message2", scan=FALSE) 10 | ) 11 | #Too many messages 12 | expect_error( 13 | read.key("message1", "message2", "message3", scan=FALSE) 14 | ) 15 | #Not enough messages 16 | expect_error( 17 | read.key(scan=FALSE) 18 | ) 19 | }) 20 | 21 | # Dummy data for testing 22 | set.seed(1) 23 | data <- data.frame("sp.col" = LETTERS[1:5], var1 = rnorm(5), var2 = rnorm(5)) 24 | tree <- replicate(3, rcoal(5, tip.label = LETTERS[1:5]), simplify = FALSE) ; class(tree) <- "multiPhylo" 25 | mulTree_data <- as.mulTree(data, tree, taxa = "sp.col") ; mulTree.data <- mulTree_data 26 | formula <- var1 ~ var2 27 | parameters <- c(1000, 10, 100) 28 | chains <- 2 29 | priors <- list(R = list(V = 1/2, nu = 0.002), G = list(G1 = list(V = 1/2, nu = 0.002))) 30 | 31 | ## Making the arg list 32 | mulTree_arguments <- list("warn" = FALSE, "fixed" = formula, "random" = mulTree.data$random.terms, "pedigree" = mulTree.data$phy[[1]], "prior" = priors, "data" = mulTree.data$data, "verbose" = FALSE, "nitt" = parameters[1], "thin" = parameters[2], "burnin" = parameters[3]) 33 | 34 | # Testing lapply MCMCglmm wrapper function 35 | # test_that("lapply.MCMCglmm works", { 36 | # #Errors 37 | # # tree is not a single tree (multiPhylo) 38 | # test_args <- mulTree_arguments 39 | # test_args$pedigree <- mulTree.data$phy 40 | # expect_error( 41 | # lapply.MCMCglmm(test_args) 42 | # ) 43 | 44 | # # mulTree.data is not the proper dataset 45 | # test_args <- mulTree_arguments 46 | # test_args$data <- matrix(1) 47 | # expect_error( 48 | # lapply.MCMCglmm(test_args) 49 | # ) 50 | 51 | # # formula is not a formula 52 | # test_args <- mulTree_arguments 53 | # test_args$formula <- "bob" 54 | # expect_error( 55 | # lapply.MCMCglmm(test_args) 56 | # ) 57 | 58 | # # priors' not a list 59 | # test_args <- mulTree_arguments 60 | # test_args$priors <- 1 61 | # expect_error( 62 | # lapply.MCMCglmm(test_args) 63 | # ) 64 | 65 | # # parameters is not a vector 66 | # test_args <- mulTree_arguments 67 | # test_args$thin <- parameters 68 | # expect_warning( 69 | # expect_error( 70 | # lapply.MCMCglmm(test_args) 71 | # ) 72 | # ) 73 | 74 | # # wrong additional argument 75 | # test_args <- mulTree_arguments 76 | # test_args$whatever <- TRUE 77 | # expect_error( 78 | # lapply.MCMCglmm(test_args) 79 | # ) 80 | 81 | # # When no errors, outputs a MCMCglmm object 82 | # test <- lapply.MCMCglmm(mulTree_arguments) 83 | # # Output is MCMCglmm 84 | # expect_is( 85 | # test, "MCMCglmm" 86 | # ) 87 | # # MCMCglmm is of standard length 88 | # expect_equal( 89 | # length(test), 19 90 | # ) 91 | 92 | # # Correct optional arguments handling 93 | # test_args <- mulTree_arguments 94 | # test_args$family <- "gaussian" 95 | # test_args$nodes <- "ALL" 96 | # test_args$scale <- TRUE 97 | # test_args$pr <- FALSE 98 | # test_args$pl <- FALSE 99 | # test_args$DIC <- TRUE 100 | # test_args$singular.ok <- FALSE 101 | # test_args$saveX <- TRUE 102 | # test_args$saveZ <- TRUE 103 | # test_args$saveXL <- TRUE 104 | # test_args$slice <- FALSE 105 | # test_args$trunc <- FALSE 106 | 107 | # test <- lapply.MCMCglmm(test_args) 108 | 109 | # # Output is MCMCglmm 110 | # expect_is( 111 | # test, "MCMCglmm" 112 | # ) 113 | # # MCMCglmm is of standard length 114 | # expect_equal( 115 | # length(test), 19 116 | # ) 117 | # }) 118 | 119 | test_that("get.model.name internal fun", { 120 | expect_equal(get.model.name(1,1,"test"), "test-tree1_chain1.rda") 121 | }) 122 | 123 | data <- data.frame("sp.col" = LETTERS[1:5], var1 = rnorm(5), var2 = rnorm(5)) 124 | tree <- replicate(3, rcoal(5, tip.label = LETTERS[1:5]), simplify = FALSE) 125 | class(tree) <- "multiPhylo" 126 | mulTree.data <- as.mulTree(data, tree, taxa = "sp.col") 127 | priors <- list(R = list(V = 1/2, nu = 0.002), 128 | G = list(G1 = list(V = 1/2, nu = 0.002))) 129 | 130 | mulTree(mulTree.data, formula = var1 ~ var2, parameters = c(1000, 10, 100), 131 | chains = 2, prior = priors, output = "quick_example", convergence = 1.1, 132 | ESS = 100, ask = FALSE, verbose = FALSE) 133 | 134 | test_that("extract.chains internal fun", { 135 | model <- extract.chains(1, 1, "quick_example") 136 | expect_is(model, "MCMCglmm") 137 | }) 138 | 139 | test_that("ESS.lapply internal fun", { 140 | model <- extract.chains(1, 1, "quick_example") 141 | ESS <- ESS.lapply(model) 142 | expect_is(ESS, "list") 143 | expect_equal(names(ESS), c("Sol", "VCV")) 144 | }) 145 | 146 | ## Clean folder 147 | remove <- file.remove(list.files(pattern = "quick_example")) 148 | 149 | test_that("cleaned files", { 150 | expect_true(all(remove)) 151 | }) 152 | 153 | 154 | test_that("get.timer internal function", { 155 | expect_output(get.timer(list(600)), "Total execution time: 10 mins.") 156 | expect_output(get.timer(list(3600)), "Total execution time: 1 hours.") 157 | expect_output(get.timer(list(3601)), "Total execution time: 1.000278 hours.") 158 | expect_output(get.timer(list(86400)), "Total execution time: 1 days") 159 | expect_output(get.timer(list(1000000)), "Total execution time: 11.57407 days") 160 | }) 161 | 162 | 163 | # Creating two dummy chains 164 | mulTree_arguments <- list("warn" = FALSE, "fixed" = formula, "random" = mulTree.data$random.terms, "pedigree" = mulTree.data$phy[[1]], "prior" = priors, "data" = mulTree.data$data, "verbose" = FALSE, "nitt" = parameters[1], "thin" = parameters[2], "burnin" = parameters[3]) 165 | 166 | set.seed(1) 167 | model_tree1_chain1 <- lapply.MCMCglmm(mulTree_arguments) 168 | model_tree1_chain2 <- lapply.MCMCglmm(mulTree_arguments) 169 | # Testing the convergence test 170 | test_that("convergence.test works", { 171 | # Errors 172 | # Not a list 173 | expect_error( 174 | convergence.test(model_tree1_chain1) 175 | ) 176 | # Not enough chains 177 | expect_warning( 178 | convergence.test(list(model_tree1_chain1)) 179 | ) 180 | # Missing arguments (error + message) 181 | expect_error( 182 | expect_message(convergence.test("bla")) 183 | ) 184 | # Convergence works 185 | test <- convergence.test(list(model_tree1_chain1, model_tree1_chain2)) 186 | # Output is gelman.diag 187 | expect_is( 188 | test, "gelman.diag" 189 | ) 190 | # gelman.diag is standard format 191 | expect_equal( 192 | length(test), 2 193 | ) 194 | # psrf is standard matrix 195 | expect_is( 196 | test$psrf, "matrix" 197 | ) 198 | }) 199 | 200 | #Testing ESS lapply (structure similar to convergence.test) 201 | test_that("ESS.lapply works", { 202 | # Errors 203 | # Something silly 204 | expect_error( 205 | ESS.lapply(3, 1) 206 | ) 207 | # ESS is a numeric vector (length 2) 208 | expect_is( 209 | ESS.lapply(model_tree1_chain1), "list" 210 | ) 211 | expect_equal( 212 | names(ESS.lapply(model_tree1_chain1)), c("Sol","VCV") 213 | ) 214 | }) 215 | 216 | 217 | ## Get timer 218 | test_that("get.timer works", { 219 | 220 | one_sec <- 1 221 | attr(one_sec, "units") <- "secs" 222 | class(one_sec) <- "difftime" 223 | two_min <- 2*60 224 | attr(two_min, "units") <- "secs" 225 | class(two_min) <- "difftime" 226 | three_hour <- 3*60*60 227 | attr(three_hour, "units") <- "secs" 228 | class(three_hour) <- "difftime" 229 | 230 | expect_equal( 231 | capture_output(get.timer(one_sec)), "Total execution time: 1 secs." 232 | ) 233 | expect_equal( 234 | capture_output(get.timer(two_min)), "Total execution time: 2 mins." 235 | ) 236 | expect_equal( 237 | capture_output(get.timer(three_hour)), "Total execution time: 3 hours." 238 | ) 239 | 240 | one_day <- 86401 241 | attr(one_day, "units") <- "secs" 242 | class(one_day) <- "difftime" 243 | 244 | expect_equal( 245 | capture_output(get.timer(one_day)), "Total execution time: 1.000012 days." 246 | ) 247 | }) 248 | 249 | 250 | 251 | #Testing quick example 252 | test_that("Quick mulTree example works", { 253 | #Errors 254 | #Not mulTree format 255 | expect_error( 256 | mulTree(data, formula = var1 ~ var2, parameters = c(10000, 10, 1000), chains = 2, prior = priors, output = "quick_example", convergence = 1.1, ESS = 100) 257 | ) 258 | #Not matching formula 259 | # expect_error( 260 | # mulTree(mulTree.data, formula = var1 ~ var3, parameters = c(10000, 10, 1000), chains = 2, prior = priors, output = "quick_example", convergence = 1.1, ESS = 100) 261 | # ) 262 | #Not enough parameters 263 | expect_error( 264 | mulTree(mulTree.data, formula = var1 ~ var2, parameters = c(1,1), chains = 2, prior = priors, output = "quick_example", convergence = 1.1, ESS = 100) 265 | ) 266 | #Chains are not numeric 267 | expect_error( 268 | mulTree(mulTree.data, formula = var1 ~ var2, parameters = c(10000, 10, 1000), chains = "plenty", prior = priors, output = "quick_example", convergence = 1.1, ESS = 100) 269 | ) 270 | #Priors are not a lits 271 | expect_error( 272 | mulTree(mulTree.data, formula = var1 ~ var2, parameters = c(10000, 10, 1000), chains = 2, prior = 1, output = "quick_example", convergence = 1.1, ESS = 100) 273 | ) 274 | 275 | # 276 | # Does not run on Travis! 277 | # 278 | 279 | # #First example works 280 | # set.seed(1) 281 | # mulTree_test1 <- system.time(mulTree(mulTree.data, formula = var1 ~ var2, parameters = c(100, 10, 10), chains = 2, prior = priors, output = "mulTree_testing", verbose = FALSE)) 282 | # #Generates 9 files 283 | # expect_equal( 284 | # length(list.files(pattern = "mulTree_testing")), 9 285 | # ) 286 | # expect_equal( 287 | # length(list.files(pattern = "mulTree_testing-tree1_chain")), 2 288 | # ) 289 | # expect_equal( 290 | # length(list.files(pattern = "mulTree_testing-tree2_chain")), 2 291 | # ) 292 | # expect_equal( 293 | # length(list.files(pattern = "mulTree_testing-tree3_chain")), 2 294 | # ) 295 | # expect_equal( 296 | # length(list.files(pattern = "mulTree_testing-tree1_conv")), 1 297 | # ) 298 | # expect_equal( 299 | # length(list.files(pattern = "mulTree_testing-tree2_conv")), 1 300 | # ) 301 | # expect_equal( 302 | # length(list.files(pattern = "mulTree_testing-tree3_conv")), 1 303 | # ) 304 | # #File remove successful 305 | # expect_true(all(file.remove(list.files(pattern = "mulTree_testing"))) 306 | # ) 307 | 308 | # #Second example (parallel) works 309 | # set.seed(1) 310 | # mulTree_test2 <- system.time(mulTree(mulTree.data, formula = var1 ~ var2, parameters = c(100, 10, 10), chains = 2, prior = priors, output = "mulTree_testing", parallel = "SOCK", verbose = FALSE)) 311 | # #Generates 9 files 312 | # expect_equal( 313 | # length(list.files(pattern = "mulTree_testing")), 9 314 | # ) 315 | # expect_equal( 316 | # length(list.files(pattern = "mulTree_testing-tree1_chain")), 2 317 | # ) 318 | # expect_equal( 319 | # length(list.files(pattern = "mulTree_testing-tree2_chain")), 2 320 | # ) 321 | # expect_equal( 322 | # length(list.files(pattern = "mulTree_testing-tree3_chain")), 2 323 | # ) 324 | # expect_equal( 325 | # length(list.files(pattern = "mulTree_testing-tree1_conv")), 1 326 | # ) 327 | # expect_equal( 328 | # length(list.files(pattern = "mulTree_testing-tree2_conv")), 1 329 | # ) 330 | # expect_equal( 331 | # length(list.files(pattern = "mulTree_testing-tree3_conv")), 1 332 | # ) 333 | # #File remove successful 334 | # expect_true( 335 | # all(file.remove(list.files(pattern = "mulTree_testing"))) 336 | # ) 337 | # # Timer test 338 | 339 | }) 340 | -------------------------------------------------------------------------------- /tests/testthat/test-plot.mulTree.R: -------------------------------------------------------------------------------- 1 | # TEST plot.mulTree 2 | # Testing get.ylim 3 | test_that("get.ylim works", { 4 | # Error 5 | expect_error( 6 | get.ylim("bla") 7 | ) 8 | # Output is 0.99 + 1.01 (max and min of 1 +/- 1%) 9 | expect_equal( 10 | get.ylim(1), c(0.99, 1.01) 11 | ) 12 | # Output is 0.99 + 10.01 13 | expect_equal( 14 | get.ylim(matrix(seq(from=0, to=9), 5)), c(0, 9.09) 15 | ) 16 | }) 17 | 18 | # Testing get.width 19 | test_that("get.width works", { 20 | # Error 21 | expect_error( 22 | get.width("bla") 23 | ) 24 | # Output is 0,0,2,2 25 | expect_equal( 26 | get.width(1,1,1), c(0,0,2,2) 27 | ) 28 | # Output is 9.7, 9.7, 10.3, 10.3 29 | expect_equal( 30 | get.width(c(0.10, 0.20, 0.30), 10, 3), c(9.7, 9.7, 10.3, 10.3) 31 | ) 32 | }) 33 | 34 | # Testing get.height 35 | test_that("get.height works", { 36 | # Error 37 | expect_error( 38 | get.height("bla") 39 | ) 40 | expect_error( 41 | get.height(1,1,1) 42 | ) 43 | expect_error( 44 | get.height(matrix(seq(1:15), nrow=3), 4, 1) 45 | ) 46 | # Output works 47 | expect_equal( 48 | get.height(matrix(seq(1:15), nrow=3), 1, 1), c(4,13,13,4) 49 | ) 50 | expect_equal( 51 | get.height(matrix(seq(1:15), nrow=3), 3, 2), c(9,12,12,9) 52 | ) 53 | }) 54 | 55 | 56 | # Testing plot examples 57 | test_that("plot.mulTree examples work", { 58 | 59 | ## read in the data 60 | data(lifespan.mcmc) 61 | 62 | ## summarising the results 63 | summarized_data <- summary(lifespan.mcmc) 64 | 65 | ## plotting the results 66 | expect_null(plot(summarized_data)) 67 | 68 | ## Same plot using more options 69 | expect_null( 70 | plot(summarized_data, horizontal = TRUE, ylab = "", ylim = c(-2,2), 71 | main = "Posterior distributions", cex.terms = 0.5, cex.coeff = 0.8, 72 | terms = c("Intercept", "BodyMass", "Volancy", "Phylogeny", "Residuals"), 73 | col = c("red"), cex.main = 0.8) 74 | ) 75 | }) -------------------------------------------------------------------------------- /tests/testthat/test-read.mulTree.R: -------------------------------------------------------------------------------- 1 | # TEST read.mulTree 2 | # Dummy data for testing 3 | set.seed(1) 4 | data <- data.frame("sp.col" = LETTERS[1:5], var1 = rnorm(5), var2 = rnorm(5)) 5 | tree <- replicate(3, rcoal(5, tip.label = LETTERS[1:5]), simplify = FALSE) ; class(tree) <- "multiPhylo" 6 | mulTree.data <- as.mulTree(data, tree, taxa = "sp.col") 7 | priors <- list(R = list(V = 1/2, nu = 0.002), G = list(G1 = list(V = 1/2, nu = 0.002))) 8 | file.remove(list.files(pattern="read.mulTree_testing")) 9 | mulTree(mulTree.data, formula = var1 ~ var2, parameters = c(10000, 10, 1000), chains = 2, prior = priors, output = "read.mulTree_testing", convergence = 1.1, ESS = 100, verbose = FALSE) 10 | 11 | # Testing get.mulTree.model to get individual models 12 | test_that("get.mulTree.model works", { 13 | #Errors 14 | # file not found 15 | expect_error( 16 | expect_warning(get.mulTree.model("Some_wrong_file")) 17 | ) 18 | # file not a MCMCglmm model 19 | expect_error( 20 | get.mulTree.model("read.mulTree_testing-tree2_conv.rda") 21 | ) 22 | # Reading a single model 23 | # Input succeeds 24 | expect_is( 25 | get.mulTree.model("read.mulTree_testing-tree1_chain1.rda"), "MCMCglmm" 26 | ) 27 | # (18 elements) 28 | expect_equal( 29 | length(get.mulTree.model("read.mulTree_testing-tree1_chain1.rda")), 22 30 | ) 31 | }) 32 | 33 | # Testing get.convergence to get the convergence test 34 | test_that("get.convergence works", { 35 | #Errors 36 | # file not found 37 | expect_error( 38 | expect_warning(get.convergence("Some_wrong_file")) 39 | ) 40 | # file not a MCMCglmm model 41 | expect_error( 42 | get.convergence("read.mulTree_testing-tree1_chain1.rda") 43 | ) 44 | # Reading a single model 45 | # Input succeeds 46 | expect_is( 47 | get.convergence("read.mulTree_testing-tree1_conv.rda"), "gelman.diag" 48 | ) 49 | # first element is a matrix 50 | expect_is( 51 | get.convergence("read.mulTree_testing-tree1_conv.rda")[[1]], "matrix" 52 | ) 53 | }) 54 | 55 | # Testing get.element to get the proper element 56 | test_that("get.element works", { 57 | #Errors 58 | # Missing arguments 59 | expect_error( 60 | get.element("Tune") 61 | ) 62 | expect_error( 63 | get.element("read.mulTree_testing") 64 | ) 65 | # Wrong chain name 66 | expect_error( 67 | get.element("Tune", "read.mulTree_testing_wrong") 68 | ) 69 | # Wrong element name (output is null) 70 | expect_true( 71 | all(unlist(lapply(get.element("Blune","read.mulTree_testing"), is.null))) 72 | ) 73 | # Extracting all the "Tune" elements 74 | # Output is a list 75 | expect_is( 76 | get.element("Tune", "read.mulTree_testing"), "list" 77 | ) 78 | # Of 6 objects 79 | expect_equal( 80 | length(get.element("Tune", "read.mulTree_testing")), 6 81 | ) 82 | # All equal to 1 83 | expect_equal( 84 | as.numeric(unlist(get.element("Tune", "read.mulTree_testing"))), rep(1,6) 85 | ) 86 | }) 87 | 88 | # Testing get.mulTree.table 89 | test_that("get.mulTree.table works", { 90 | #Errors 91 | # Missing arguments 92 | expect_error( 93 | get.table.mulTree("Tune") 94 | ) 95 | # Getting the table 96 | # Get the table from an extracted model 97 | table_test <- get.table.mulTree(get.mulTree.model("read.mulTree_testing-tree1_chain1.rda")) 98 | # Table is a list 99 | expect_is( 100 | table_test, "list" 101 | ) 102 | # Of 4 elements 103 | expect_equal( 104 | length(table_test), 4 105 | ) 106 | #Each containing 900 elements 107 | expect_equal( 108 | unlist(unique(lapply(table_test, length))), 900 109 | ) 110 | }) 111 | 112 | # Testing read.mulTree 113 | test_that("example works", { 114 | # Errors 115 | # wrong chain name 116 | expect_error( 117 | read.mulTree("quick_example") 118 | ) 119 | a <- 1 ; save(a, file = "dummy_file_for_testing_read.mulTree") 120 | expect_error( 121 | read.mulTree("dummy_file_for_testing_read.mulTree") 122 | ) 123 | expect_true(file.remove("dummy_file_for_testing_read.mulTree")) 124 | # wrong format 125 | expect_error( 126 | read.mulTree(1) 127 | ) 128 | # wrong format (args) 129 | expect_error( 130 | read.mulTree("read.mulTree_testing", model = "yes") 131 | ) 132 | expect_error( 133 | read.mulTree("read.mulTree_testing", convergence = "yes") 134 | ) 135 | expect_error( 136 | read.mulTree("read.mulTree_testing", extract = "yes") 137 | ) 138 | expect_error( 139 | read.mulTree("read.mulTree_testing-tree1_chain1", convergence = TRUE) 140 | ) 141 | expect_error( 142 | read.mulTree("read.mulTree_testing-tree2", model = TRUE) 143 | ) 144 | # Running the example 145 | # Reading all the models 146 | all_chains <- read.mulTree("read.mulTree_testing") 147 | # Class is mulTree 148 | expect_is( 149 | all_chains, "mulTree" 150 | ) 151 | # List of 4 152 | expect_equal( 153 | length(all_chains), 4 154 | ) 155 | # List of 5400 elements 156 | expect_equal( 157 | unlist(unique(lapply(all_chains, length))), 5400 158 | ) 159 | ## Reading the convergence diagnosis test 160 | conv_test <- read.mulTree("read.mulTree_testing", convergence = TRUE) 161 | # list of 3 162 | expect_equal( 163 | length(conv_test), 3 164 | ) 165 | # gelman.diag objects 166 | expect_equal( 167 | unlist(unique(lapply(conv_test, class))), "gelman.diag" 168 | ) 169 | # Reading a specific model 170 | model <- read.mulTree("read.mulTree_testing-tree1_chain1", model = TRUE) 171 | # class MCMCglmm 172 | expect_is( 173 | model, "MCMCglmm" 174 | ) 175 | expect_equal( 176 | length(model), 22 177 | ) 178 | # Reading only the error term and the tune for all models 179 | elements <- read.mulTree("read.mulTree_testing", extract=c("error.term", "Tune")) 180 | # 2 elements 181 | expect_equal( 182 | names(elements), c("error.term", "Tune") 183 | ) 184 | # each containing 6 185 | expect_equal( 186 | unlist(unique(lapply(elements, length))), 6 187 | ) 188 | }) 189 | 190 | #Remove the data 191 | test_that("data has been cleaned", { 192 | #All true! 193 | expect_true( 194 | all(file.remove(list.files(pattern = "read.mulTree_testing"))) 195 | ) 196 | }) -------------------------------------------------------------------------------- /tests/testthat/test-sanitizing.R: -------------------------------------------------------------------------------- 1 | #TEST sanitizing 2 | 3 | #Testing class.check 4 | #examples 5 | class_1<-NA ; class(class_1) <- 'class_1' 6 | class_2<-NA ; class(class_2) <- 'class_2' 7 | class_3<-NA ; class(class_3) <- 'class_3' 8 | class_list<-c("class_1", "class_2") 9 | 10 | #Test 11 | test_that("check.class works", { 12 | #class - single 13 | expect_null( 14 | check.class(class_1, "class_1", 'test') 15 | ) 16 | expect_error( 17 | check.class(class_1, "class_1", 'test', errorif=TRUE) 18 | ) 19 | expect_null( 20 | check.class(class_2, "class_2", 'test') 21 | ) 22 | expect_error( 23 | check.class(class_2, "class_2", 'test', errorif=TRUE) 24 | ) 25 | #class - multiple 26 | expect_that( 27 | check.class(class_1, class_list, 'test'), equals("class_1") 28 | ) 29 | expect_that( 30 | check.class(class_2, class_list, 'test'), equals("class_2") 31 | ) 32 | expect_error( 33 | check.class(class_3, class_list, 'test') 34 | ) 35 | }) 36 | 37 | #Testing check.length 38 | #examples 39 | length_1<-1 40 | length_2<-c(1, 1 41 | ) 42 | length_3<-NA 43 | length_4<-"1" 44 | 45 | #Test 46 | test_that("check.length works", { 47 | expect_null( 48 | check.length(length_1, '1', 'test') 49 | ) 50 | expect_null( 51 | check.length(length_3, '1', 'test') 52 | ) 53 | expect_null( 54 | check.length(length_4, '1', 'test') 55 | ) 56 | expect_error( 57 | check.length(length_2, '1', 'test') 58 | ) 59 | expect_error( 60 | check.length(length_1, '1', 'test', errorif=TRUE) 61 | ) 62 | }) -------------------------------------------------------------------------------- /tests/testthat/test-summary.mulTree.R: -------------------------------------------------------------------------------- 1 | # TEST summary.mulTree 2 | # Testing is.wholenumber works 3 | test_that("is.wholenumber works", { 4 | # Error 5 | expect_error( 6 | is.wholenumber("a") 7 | ) 8 | # Testing which number is whole 9 | # Not this one 10 | expect_false( 11 | is.wholenumber(1.1) 12 | ) 13 | # But this one is 14 | expect_true( 15 | is.wholenumber(round(1.1)) 16 | ) 17 | expect_true( 18 | is.wholenumber(1) 19 | ) 20 | }) 21 | 22 | # Testing if prob.converter works 23 | test_that("prob.converter works", { 24 | # Error 25 | expect_error( 26 | prob.converter("a") 27 | ) 28 | # Transforming one CI 29 | expect_is( 30 | prob.converter(50), "numeric" 31 | ) 32 | expect_equal( 33 | prob.converter(50), c(0.25, 0.75) 34 | ) 35 | # Transforming multiple CIs 36 | expect_is( 37 | prob.converter(c(50, 95)), "numeric" 38 | ) 39 | expect_equal( 40 | prob.converter(c(50, 95)), c(0.025, 0.25, 0.75, 0.975) 41 | ) 42 | # And even more! 43 | expect_equal( 44 | length(prob.converter(seq(1:100))), 200 45 | ) 46 | }) 47 | 48 | # Testing lapply.quantile 49 | test_that("lapply.quantile works", { 50 | # Errors 51 | expect_error( 52 | lapply.quantile("X", prob=c(50,95), cent.tend=mean) 53 | ) 54 | expect_error( 55 | lapply.quantile(rnorm(100), prob="X", cent.tend=mean) 56 | ) 57 | expect_true( 58 | lapply.quantile(rnorm(100), prob=c(50,95), cent.tend=mean)[[2]] != lapply.quantile(rnorm(100), prob=c(50,95), cent.tend=median)[[2]] 59 | ) 60 | # Output is a list 61 | expect_is( 62 | lapply.quantile(rnorm(100), prob=c(50,95), cent.tend=mean), "list" 63 | ) 64 | # Of two elements 65 | expect_equal( 66 | names(lapply.quantile(rnorm(100), prob=c(50,95), cent.tend=mean)), c("quantiles", "central") 67 | ) 68 | # First one is length 4 69 | expect_equal( 70 | length(lapply.quantile(rnorm(100), prob=c(50,95), cent.tend=mean)[[1]]), 4 71 | ) 72 | # Second one is length 1 73 | expect_equal( 74 | length(lapply.quantile(rnorm(100), prob=c(50,95), cent.tend=mean)[[2]]), 1 75 | ) 76 | # And works with additional arguments 77 | expect_is( 78 | lapply.quantile(rnorm(100), prob=c(50,95), cent.tend=mean, na.rm=TRUE), "list" 79 | ) 80 | }) 81 | 82 | # Testing lapply.hdr 83 | test_that("lapply.hdr works", { 84 | 85 | ## Smooth hdr (internal) 86 | 87 | smooth_simple <- smooth.hdr(hdrcde::hdr(rnorm(100), prob=c(50,95)), prob=c(50,95), "test_hrd") 88 | expect_is(smooth_simple, "list") 89 | expect_equal(names(smooth_simple), c("hdr", "mode", "falpha")) 90 | 91 | expect_warning(smooth_bimod <- smooth.hdr(hdrcde::hdr((c(rnorm(50, 1, 1), rnorm(50, 10, 1))), prob=c(50,95)), prob=c(50,95), "test_hrd")) 92 | expect_is(smooth_bimod, "list") 93 | expect_equal(names(smooth_bimod), c("hdr", "mode", "falpha")) 94 | 95 | # Errors 96 | expect_error( 97 | lapply.hdr("X", prob=c(50,95)) 98 | ) 99 | expect_warning( 100 | expect_error(lapply.hdr(rnorm(100), prob="X")) 101 | ) 102 | # Output is a list 103 | expect_is( 104 | lapply.hdr(rnorm(100), prob=c(50,95)), "list" 105 | ) 106 | # Of two elements 107 | expect_equal( 108 | names(lapply.hdr(rnorm(100), prob=c(50,95))), c("hdr", "mode", "falpha") 109 | ) 110 | # First one is length 4 111 | expect_equal( 112 | length(lapply.hdr(rnorm(100), prob=c(50,95))[[1]]), 4 113 | ) 114 | # Second one is length 1 115 | expect_equal( 116 | length(lapply.hdr(rnorm(100), prob=c(50,95))[[2]]), 1 117 | ) 118 | # And works with additional arguments 119 | expect_is( 120 | lapply.hdr(rnorm(100), prob=c(50,95), n=100), "list" 121 | ) 122 | }) 123 | 124 | # Testing result.list.to.table 125 | test_that("result.list.to.table works", { 126 | list_test <- replicate(3, list("a"=rnorm(4), "b"=rnorm(sample(1:3, 1))), simplify = FALSE) 127 | # Errors 128 | expect_error( 129 | result.list.to.table(NULL) 130 | ) 131 | # Output is a matrix 132 | expect_is( 133 | result.list.to.table(list_test), "matrix" 134 | ) 135 | # of dimension 3 by 5 136 | expect_equal( 137 | dim(result.list.to.table(list_test)), c(3,5) 138 | ) 139 | }) 140 | 141 | # Loading the inbuilt data 142 | data(lifespan.mcmc) 143 | mulTree.results <- lifespan.mcmc 144 | 145 | # Testing example 146 | test_that("example works", { 147 | # Errors 148 | expect_error( 149 | summary.mulTree(list(1)) 150 | ) 151 | expect_error( 152 | summary(lifespan.mcmc, prob="A") 153 | ) 154 | expect_error( 155 | summary(lifespan.mcmc, use.hdr="why not") 156 | ) 157 | expect_error( 158 | expect_warning(summary(lifespan.mcmc, use.hdr=FALSE, cent.tend=matrix)) 159 | ) 160 | expect_error( 161 | summary(lifespan.mcmc, prob = 101) 162 | ) 163 | test <- lifespan.mcmc 164 | test$Intercept <- 1 165 | test$mass <- 1 166 | test$volancy <- 1 167 | test$phy.var <- 1 168 | test$res.var <- 1 169 | expect_error( 170 | summary(test) 171 | ) 172 | 173 | # Default example 174 | test_example <- summary(lifespan.mcmc) 175 | expect_is( 176 | test_example, "matrix" 177 | ) 178 | expect_equal( 179 | dim(test_example), c(5,5) 180 | ) 181 | expect_equal( 182 | unlist(dimnames(test_example)), c("Intercept","mass","volancy","phy.var","res.var","Estimates(mode hdr)","lower.CI(2.5)","lower.CI(25)","upper.CI(75)","upper.CI(97.5)") 183 | ) 184 | # Example with different CI 185 | test_example <- summary(lifespan.mcmc, prob = 75) 186 | expect_is( 187 | test_example, "matrix" 188 | ) 189 | expect_equal( 190 | dim(test_example), c(5,3) 191 | ) 192 | expect_equal( 193 | unlist(dimnames(test_example)), c("Intercept","mass","volancy","phy.var","res.var","Estimates(mode hdr)","lower.CI(12.5)","upper.CI(87.5)") 194 | ) 195 | # Example without hdr 196 | test_example <- summary(lifespan.mcmc, use.hdr = FALSE) 197 | test_example2 <- summary(lifespan.mcmc, use.hdr = FALSE, cent.tend=mean) 198 | expect_is( 199 | test_example, "matrix" 200 | ) 201 | expect_equal( 202 | dim(test_example), c(5,5) 203 | ) 204 | expect_equal( 205 | unlist(dimnames(test_example)), c("Intercept","mass","volancy","phy.var","res.var","Estimates(median)","lower.CI(2.5)","lower.CI(25)","upper.CI(75)","upper.CI(97.5)") 206 | ) 207 | }) 208 | -------------------------------------------------------------------------------- /tests/testthat/test-tree.bind.R: -------------------------------------------------------------------------------- 1 | # TEST tree.bind 2 | # Testing get.replace 3 | test_that("get.replace works", { 4 | # Only one tree and one sample (no replace) 5 | expect_false( 6 | get.replace(rtree(3), 1) 7 | ) 8 | # Only one tree and more samples (replace) 9 | expect_true( 10 | get.replace(rtree(3), 2) 11 | ) 12 | # Only one (multi)tree and one sample (no replace) 13 | expect_false( 14 | get.replace(rmtree(1,3), 1) 15 | ) 16 | # Only one (multi)tree and one sample (no replace) 17 | expect_true( 18 | get.replace(rmtree(1,3), 2) 19 | ) 20 | # More trees than samples (no replace) 21 | expect_false( 22 | get.replace(rmtree(3,3), 2) 23 | ) 24 | # More samples than trees (replace) 25 | expect_true( 26 | get.replace(rmtree(3,3), 4) 27 | ) 28 | }) 29 | 30 | # Testing sample.trees 31 | test_that("sample.trees works", { 32 | # Equals 1 (no sample) 33 | expect_equal( 34 | sample.trees(rmtree(1,5), 1, FALSE), 1 35 | ) 36 | # Equals 3 37 | set.seed(1) 38 | expect_equal( 39 | sample.trees(rmtree(3,5), 1, FALSE), 3 40 | ) 41 | # Equals 3 42 | set.seed(1) 43 | expect_equal( 44 | sample.trees(rmtree(3,5), 1, TRUE), 3 45 | ) 46 | # is length 2 47 | expect_equal( 48 | length(sample.trees(rmtree(3,5), 2, TRUE)), 2 49 | ) 50 | # is length 2 51 | expect_equal( 52 | length(sample.trees(rmtree(3,5), 2, FALSE)), 2 53 | ) 54 | }) 55 | 56 | 57 | # Testing add.root.age 58 | test_that("add.root.edge works", { 59 | # Error 60 | expect_error( 61 | add.root.edge("bla", 10) 62 | ) 63 | # Phylo object 64 | expect_is( 65 | add.root.edge(rtree(5), 10), "phylo" 66 | ) 67 | # Correct root edge 68 | set.seed(1) 69 | expect_equal( 70 | round(add.root.edge(rtree(5), 10)$root.edge, digit = 2), 8.46 71 | ) 72 | }) 73 | 74 | # Testing lapply.bind.tree 75 | test_that("lapply.bind.tree works", { 76 | # Errors: 77 | # element is not numeric 78 | expect_error( 79 | lapply.bind.tree("a", rmtree(3,5), rmtree(3,5), c(1,2), c(1,2), 10) 80 | ) 81 | # one of the trees is not multiPhylo 82 | expect_error( 83 | lapply.bind.tree(1, rtree(5), rmtree(3,5), c(1,2), c(1,2), 10) 84 | ) 85 | # the samples are not the same size as the elements 86 | expect_error( 87 | lapply.bind.tree(3, rmtree(3,5), rmtree(3,5), c(1,2), c(1,2), 10) 88 | ) 89 | # root age is missing 90 | expect_error( 91 | lapply.bind.tree(1, rmtree(3,5), rmtree(3,5), c(1,2), c(1,2)) 92 | ) 93 | # Outputs a tree 94 | expect_is( 95 | lapply.bind.tree(1, rmtree(3,5), rmtree(3,5), c(1,2), c(1,2), 10), "phylo" 96 | ) 97 | # Outputs has 10 tips 98 | expect_equal( 99 | Ntip(lapply.bind.tree(1, rmtree(3,5), rmtree(3,5), c(1,2), c(1,2), 10)), 10 100 | ) 101 | }) 102 | 103 | # Testing tree.bind 104 | test_that("tree.bind works", { 105 | # Sanitizing 106 | # Not a tree 107 | expect_error( 108 | tree.bind("a", rtree(5), 10, 10) 109 | ) 110 | # One tree missing 111 | expect_error( 112 | tree.bind(rtree(5), 10, 10) 113 | ) 114 | # Not a sample 115 | expect_error( 116 | tree.bind(rmtree(3,5), rmtree(3,5), "a", 10) 117 | ) 118 | # Root age is not numeric 119 | expect_error( 120 | tree.bind(rtree(5), rtree(5), 3, "a") 121 | ) 122 | # Warning 123 | # same tip labels 124 | expect_warning( 125 | tree.bind(rtree(5), rtree(5)) 126 | ) 127 | # Too much sample 128 | expect_warning( 129 | tree.bind(rtree(5), rtree(5), sample = 3) 130 | ) 131 | 132 | # Testing 133 | expect_equal( 134 | Ntip(tree.bind(rtree(5, tip.label=LETTERS[1:5]), rtree(5))), 10 135 | ) 136 | expect_is( 137 | tree.bind(rtree(5, tip.label=LETTERS[1:5]), rtree(5)), "phylo" 138 | ) 139 | expect_is( 140 | tree.bind(rmtree(3,5, tip.label=LETTERS[1:5]), rmtree(3,5)), "phylo" 141 | ) 142 | expect_is( 143 | tree.bind(rmtree(3,5, tip.label=LETTERS[1:5]), rmtree(3,5), sample = 2), "multiPhylo" 144 | ) 145 | expect_equal( 146 | max(node.depth.edgelength(tree.bind(rmtree(3,5, tip.label=LETTERS[1:5]), rmtree(3,5), root.age = 10))), 10 147 | ) 148 | }) 149 | --------------------------------------------------------------------------------