├── src ├── Makevars ├── covar.h ├── utils.c ├── mvmorph.h ├── functions_complex.h ├── quadprod.c ├── spherical.c ├── mvmorph-covar-ou.c ├── givens.c ├── root2tip.c ├── chol_rpf_row.c ├── mvMORPH_init.c ├── mvmorph_ou_mat_rpf.c ├── covar-matrix-simmap.c ├── chol_rpf_univ.c ├── weight-matrix-mvmorph.c └── sqrtMat.c ├── vignettes ├── root.png ├── ellipses.png ├── constraints.png ├── Phylo-eigenvectors.png └── Computational_details.pdf ├── data └── phyllostomid.rda ├── R ├── zzz.r ├── pruning.r ├── utils.r ├── mvgls.pca.r ├── mvols.r └── mvmorphPrecalc.r ├── inst └── CITATION ├── man ├── fitted.mvgls.Rd ├── coef.mvgls.Rd ├── residuals.mvgls.Rd ├── vcov.mvgls.Rd ├── predict.mvgls.Rd ├── phyllostomid.Rd ├── pairwise.contrasts.Rd ├── predict.mvgls.dfa.Rd ├── pcaShape.Rd ├── mvMORPH-package.Rd ├── GIC.Rd ├── dfaShape.Rd ├── mvqqplot.Rd ├── ancestral.Rd ├── halflife.Rd ├── aicw.Rd ├── stationary.Rd ├── mvgls.dfa.Rd ├── mvgls.pca.Rd ├── effectsize.Rd ├── LRT.Rd ├── mv.Precalc.Rd ├── EIC.Rd ├── estim.Rd ├── pruning.Rd ├── pairwise.glh.Rd ├── mvSIM.Rd ├── manova.gls.Rd ├── mvEB.Rd ├── mvols.Rd └── mvRWTS.Rd ├── DESCRIPTION ├── NAMESPACE ├── README.md └── NEWS.md /src/Makevars: -------------------------------------------------------------------------------- 1 | PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) 2 | -------------------------------------------------------------------------------- /vignettes/root.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JClavel/mvMORPH/HEAD/vignettes/root.png -------------------------------------------------------------------------------- /data/phyllostomid.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JClavel/mvMORPH/HEAD/data/phyllostomid.rda -------------------------------------------------------------------------------- /vignettes/ellipses.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JClavel/mvMORPH/HEAD/vignettes/ellipses.png -------------------------------------------------------------------------------- /vignettes/constraints.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JClavel/mvMORPH/HEAD/vignettes/constraints.png -------------------------------------------------------------------------------- /vignettes/Phylo-eigenvectors.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JClavel/mvMORPH/HEAD/vignettes/Phylo-eigenvectors.png -------------------------------------------------------------------------------- /vignettes/Computational_details.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JClavel/mvMORPH/HEAD/vignettes/Computational_details.pdf -------------------------------------------------------------------------------- /R/zzz.r: -------------------------------------------------------------------------------- 1 | ## Echo a message when loading the package 2 | .onAttach <- function(...) { 3 | # echo output to screen 4 | packageStartupMessage("##\n## mvMORPH package (1.2.2) - beta version 04/04/25") 5 | packageStartupMessage("## Multivariate evolutionary models") 6 | packageStartupMessage("##\n## See the tutorials: browseVignettes(\"mvMORPH\")") 7 | packageStartupMessage("##\n## To cite package 'mvMORPH': citation(\"mvMORPH\")\n##") 8 | 9 | } 10 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citHeader("To cite package 'mvMORPH' in publications use:") 2 | 3 | bibentry(bibtype = "Article", 4 | author = c(as.person("Julien Clavel"), as.person("Gilles Escarguel"), as.person("Gildas Merceron")), 5 | title = "mvMORPH: an R package for fitting multivariate evolutionary models to morphometric data", 6 | year = "2015", 7 | journal = "Methods in Ecology and Evolution", 8 | volume = "6", 9 | pages = "1311-1319", 10 | textVersion = paste("Clavel, J., Escarguel, G., and Merceron, G. (2015)", 11 | "mvMORPH: an R package for fitting multivariate evolutionary models to morphometric data.", 12 | "Methods in Ecology and Evolution, 6(11):1311-1319. doi: 10.1111/2041-210X.12420")) 13 | -------------------------------------------------------------------------------- /src/covar.h: -------------------------------------------------------------------------------- 1 | /* mvmorph.h 2015-01-01 */ 2 | /* Julien Clavel */ 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | // transform complex R structure to C structure 12 | #define comp(x) ((x.r) + ((x.i)*I)) 13 | 14 | 15 | /* from OUCH package */ 16 | static SEXP makearray (int rank, int *dim) { 17 | int nprotect = 0; 18 | int *dimp, k; 19 | SEXP dimx, x; 20 | PROTECT(dimx = NEW_INTEGER(rank)); nprotect++; 21 | dimp = INTEGER(dimx); 22 | for (k = 0; k < rank; k++) dimp[k] = dim[k]; 23 | PROTECT(x = allocArray(REALSXP,dimx)); nprotect++; 24 | UNPROTECT(nprotect); 25 | return x; 26 | } 27 | 28 | 29 | -------------------------------------------------------------------------------- /man/fitted.mvgls.Rd: -------------------------------------------------------------------------------- 1 | \name{fitted} 2 | \alias{fitted.mvgls} 3 | 4 | \title{ 5 | Extract multivariate gls (or ols) model fitted values 6 | } 7 | \description{ 8 | Returns the fitted values of a linear model of class 'mvgls'. 9 | } 10 | \usage{ 11 | 12 | \method{fitted}{mvgls}(object, ...) 13 | 14 | } 15 | \arguments{ 16 | \item{object}{ 17 | an object of class 'mvgls' obtained from a \code{mvgls} or \code{mvols} fit. 18 | } 19 | 20 | \item{...}{ 21 | other arguments (not used). 22 | } 23 | 24 | } 25 | 26 | \value{ 27 | The fitted values extracted from the model. 28 | } 29 | 30 | 31 | \author{J. Clavel} 32 | 33 | \seealso{ 34 | %% add later \code{\link{simulate_t_env}} 35 | \code{\link{vcov.mvgls}} 36 | \code{\link{residuals.mvgls}} 37 | \code{\link{coef.mvgls}} 38 | \code{\link{mvgls}} 39 | \code{\link{mvols}} 40 | } 41 | 42 | -------------------------------------------------------------------------------- /man/coef.mvgls.Rd: -------------------------------------------------------------------------------- 1 | \name{coef} 2 | \alias{coef.mvgls} 3 | 4 | \title{ 5 | Extract multivariate gls (or ols) model coefficients 6 | } 7 | \description{ 8 | Returns the coefficients of a linear model fit of class 'mvgls' or 'mvols'. 9 | } 10 | \usage{ 11 | 12 | \method{coef}{mvgls}(object, ...) 13 | 14 | } 15 | \arguments{ 16 | \item{object}{ 17 | an object of class 'mvgls' obtained from a \code{mvgls} or \code{mvols} fit. 18 | } 19 | 20 | \item{...}{ 21 | other arguments (not used). 22 | } 23 | 24 | } 25 | 26 | \note{ 27 | For an intercept only model with phylogenetic structure this correspond to the ancestral states. 28 | } 29 | 30 | 31 | \value{ 32 | The coefficients extracted from the model fit. 33 | } 34 | 35 | 36 | \author{J. Clavel} 37 | 38 | \seealso{ 39 | %% add later \code{\link{simulate_t_env}} 40 | \code{\link{vcov.mvgls}} 41 | \code{\link{residuals.mvgls}} 42 | \code{\link{fitted.mvgls}} 43 | \code{\link{mvgls}} 44 | \code{\link{mvols}} 45 | } 46 | 47 | -------------------------------------------------------------------------------- /src/utils.c: -------------------------------------------------------------------------------- 1 | // 2 | // time_mvmorph.c 3 | // 4 | // 5 | // Created by Julien Clavel on 14/11/2014. 6 | // 7 | // 8 | 9 | #include "mvmorph.h" 10 | 11 | 12 | 13 | SEXP times_root(SEXP brlength, SEXP edge1, SEXP edge2, SEXP ntip, SEXP Nnode){ 14 | 15 | 16 | int i, nt, ind, e1, e2, nod, ntot; 17 | 18 | nt=INTEGER(ntip)[0]; 19 | nod=INTEGER(Nnode)[0]; 20 | ind=nt*2-2; 21 | ntot=nt+nod; 22 | 23 | 24 | // Edge and alloc vector 25 | // !! edge must be in postorder or prunningwise order 26 | PROTECT(edge1 = coerceVector(edge1,INTSXP)); 27 | PROTECT(edge2 = coerceVector(edge2,INTSXP)); 28 | PROTECT(brlength = coerceVector(brlength,REALSXP)); 29 | SEXP times = PROTECT(allocVector(REALSXP,ntot)); 30 | memset(REAL(times),0,(ntot)*sizeof(double)); 31 | 32 | for(i=ind; i-->0;){ 33 | e2=INTEGER(edge2)[i]-1; 34 | e1=INTEGER(edge1)[i]-1; 35 | REAL(times)[e2]=REAL(times)[e1]+REAL(brlength)[i]; 36 | } 37 | 38 | UNPROTECT(4); 39 | return times; 40 | 41 | } 42 | -------------------------------------------------------------------------------- /src/mvmorph.h: -------------------------------------------------------------------------------- 1 | /* mvmorph.h 2015-01-01 */ 2 | /* Julien Clavel */ 3 | #define USE_FC_LEN_T 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #ifndef FCONE 13 | # define FCONE 14 | #endif 15 | 16 | #define down(x,y) ((x) & ~((y)-1)) 17 | #define square(x) (data[(x)]*data[(x)]) 18 | 19 | La_extern void F77_NAME(dtrttf)(const char* transr, const char* uplo, const int* n, 20 | const double* a, const int* lda, 21 | double* arf, int* info FCLEN FCLEN); 22 | 23 | La_extern void F77_NAME(dpftrf)(const char* transr, const char* uplo, const int* n, 24 | double* a, int* info FCLEN FCLEN); 25 | 26 | La_extern void F77_NAME(dtfsm)(const char* transr, const char* side, const char* uplo, const char* trans, const char* diag, 27 | const int* m, const int* n, const double* alpha, const double* a, 28 | double* b, const int* ldb FCLEN FCLEN FCLEN FCLEN FCLEN); 29 | 30 | 31 | -------------------------------------------------------------------------------- /src/functions_complex.h: -------------------------------------------------------------------------------- 1 | /* functions_complex.h 2016-01-01 */ 2 | /* Julien Clavel - mvMORPH */ 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #define sq(x) ((x)*(x)) 9 | // transform complex R structure to C structure 10 | #define comp(x) ((x.r) + ((x.i)*I)) 11 | 12 | // complex exponential of negative eigenvalues 13 | static void cexpti(Rcomplex *eigvalues, double complex *elt, double t, int *ind, int *ind2){ 14 | int n=*ind, i=*ind2; 15 | // exponential with complex numbers Gockenbach 2010, p. 259 16 | elt[n] = exp(-eigvalues[i].r*t) * (cos(-eigvalues[i].i*t) + sin(-eigvalues[i].i*t)*I); 17 | } 18 | 19 | // Mix the C and R complex objects... allow the use of dynamic vectors. To optimize later with special structures. 20 | static void cMulti(Rcomplex *mat1, double complex *mat2, Rcomplex *mat3, double complex *results, double complex *tmp, int *ind1, int *ind2, int *ind3, int *ind4){ 21 | tmp[0] = comp(mat1[*ind1]) * mat2[*ind2]; 22 | results[*ind4] = tmp[0] * comp(mat3[*ind3]); 23 | } 24 | -------------------------------------------------------------------------------- /man/residuals.mvgls.Rd: -------------------------------------------------------------------------------- 1 | \name{residuals} 2 | \alias{residuals.mvgls} 3 | 4 | \title{ 5 | Extract gls (or ols) model residuals 6 | } 7 | \description{ 8 | Returns the residuals of a linear model of class 'mvgls'. 9 | } 10 | \usage{ 11 | 12 | \method{residuals}{mvgls}(object, type, ...) 13 | 14 | } 15 | \arguments{ 16 | \item{object}{ 17 | an object of class 'mvgls' obtained from a \code{mvgls} or \code{mvols} fit. 18 | } 19 | \item{type}{ 20 | an optional character string specifying the type of residuals to be used. To match conventions used in the \emph{nlme} package: if "\code{response}", the "raw" residuals (observed-fitted) are used; else, if "normalized", the normalized residuals (the residuals pre-multiplied by the inverse square-root factor of the estimated (between observations) covariance matrix) are used. Note however that there is still between variables correlations with both types. 21 | } 22 | 23 | \item{...}{ 24 | other arguments for this generic function (not used). 25 | } 26 | 27 | } 28 | 29 | 30 | \value{ 31 | A matrix with the residuals for the linear model fitted by \code{mvgls} or \code{mvols}. 32 | } 33 | 34 | 35 | \author{J. Clavel} 36 | 37 | \seealso{ 38 | %% add later \code{\link{simulate_t_env}} 39 | \code{\link{vcov.mvgls}} 40 | \code{\link{residuals.mvgls}} 41 | \code{\link{coef.mvgls}} 42 | \code{\link{mvgls}} 43 | \code{\link{mvols}} 44 | } 45 | 46 | -------------------------------------------------------------------------------- /man/vcov.mvgls.Rd: -------------------------------------------------------------------------------- 1 | \name{vcov} 2 | \alias{vcov.mvgls} 3 | 4 | \title{ 5 | Calculate variance-covariance matrix for a fitted object of class 'mvgls' 6 | } 7 | \description{ 8 | Returns the variance-covariance matrix of the coefficients or the traits. 9 | } 10 | \usage{ 11 | 12 | \method{vcov}{mvgls}(object, ...) 13 | 14 | } 15 | \arguments{ 16 | \item{object}{ 17 | an object of class 'mvgls' obtained from a \code{mvgls} or \code{mvols} fit. 18 | } 19 | 20 | \item{...}{ 21 | additional arguments for methods function. See \emph{details} below. 22 | } 23 | 24 | } 25 | 26 | \details{ 27 | The \code{vcov} function returns by default the variance-covariance matrix of the main parameters of a fitted model object. The main parameters are the coefficients (this correspond to the argument \code{type="coef"}; see also \code{coef.mvgls}). With \code{type="covariance"}, the \code{vcov.mvgls} function returns the estimated traits covariance matrix (possibly regularized for PL approaches) while \code{type="precision"} return the precision matrix (i.e. the inverse of the covariance). 28 | } 29 | 30 | 31 | \value{ 32 | A matrix of the estimated covariances between the parameter estimates (of type "coef", "covariance", or "precision"). 33 | 34 | } 35 | 36 | 37 | \author{J. Clavel} 38 | 39 | \seealso{ 40 | %% add later 41 | \code{\link{coef.mvgls}} 42 | \code{\link{residuals.mvgls}} 43 | \code{\link{fitted.mvgls}} 44 | \code{\link{mvgls}} 45 | \code{\link{mvols}} 46 | } 47 | 48 | -------------------------------------------------------------------------------- /man/predict.mvgls.Rd: -------------------------------------------------------------------------------- 1 | \name{predict} 2 | \alias{predict.mvgls} 3 | 4 | \title{ 5 | Predictions from (multivariate) gls or ols model fit 6 | } 7 | \description{ 8 | Returns the prediction(s) of a linear model of class 'mvgls'. 9 | } 10 | \usage{ 11 | 12 | \method{predict}{mvgls}(object, newdata, ...) 13 | 14 | } 15 | \arguments{ 16 | \item{object}{ 17 | an object of class 'mvgls' obtained from a \code{mvgls} or \code{mvols} fit. 18 | } 19 | \item{newdata}{ 20 | a dataframe with new observation(s). The column names must match the names of the predictors in the model fit object. The type (e.g. factors, numeric) must also match the type of the predictors in the model fit object. 21 | Note: the fitted values are simply returned if "newdata" is not provided. 22 | } 23 | 24 | \item{...}{ 25 | further arguments for this generic function. For models fit by \code{mvgls}, if \code{tree} is provided (with tip name(s) matching rowname(s) in newdata and in the training (model fit) dataset), then the best unbiased linear prediction (BLUP) for the model is returned. Otherwise the GLS coefficients are used to predict "newdata". 26 | } 27 | 28 | } 29 | 30 | 31 | \value{ 32 | A matrix with the predictions for the linear model fitted by \code{mvgls} or \code{mvols}. 33 | } 34 | 35 | 36 | \author{J. Clavel} 37 | 38 | \seealso{ 39 | 40 | \code{\link{fitted.mvgls}} 41 | \code{\link{vcov.mvgls}} 42 | \code{\link{residuals.mvgls}} 43 | \code{\link{coef.mvgls}} 44 | \code{\link{mvgls}} 45 | \code{\link{mvols}} 46 | } 47 | 48 | -------------------------------------------------------------------------------- /src/quadprod.c: -------------------------------------------------------------------------------- 1 | /* Solve linear system with RPF Cholesky - Julien Clavel - mvMORPH 1.0.3 - 2014 */ 2 | /* Fast computation of the quadratic product e'V^-1e with the residuals and the */ 3 | /* factorized matrix A. */ 4 | /* The result is used to compute the log-likelihood */ 5 | 6 | #include "mvmorph.h" 7 | 8 | // function to compute the quadratic product 9 | SEXP Chol_RPF_quadprod(SEXP U, SEXP resid, SEXP nterm){ 10 | int n, info = 0, one = 1; 11 | double alpha = 1.; 12 | char up = 'U', trans = 'T', diag = 'N', side = 'L'; 13 | n = INTEGER(nterm)[0]; 14 | PROTECT(U = coerceVector(U,REALSXP)); 15 | SEXP Ddat = PROTECT(isReal(resid) ? duplicate(resid): coerceVector(resid, REALSXP)); 16 | SEXP Bet = PROTECT(allocVector(REALSXP,1)); 17 | double *beta = REAL(Bet), *data = REAL(Ddat), *chol = REAL(U); 18 | // systeme lineaire U'x=dat 19 | F77_CALL(dtfsm)(&trans, &side, &up, &trans, &diag, &n, &one, &alpha, chol, data, &n FCONE FCONE FCONE FCONE FCONE); 20 | if (info != 0){ 21 | error("the %d argument had an illegal value",info); 22 | } 23 | // initialize 24 | beta[0]=0; 25 | int i = 0, round = down(n,4); 26 | // loop unrolling 27 | for(; i 17 | Description: Fits multivariate (Brownian Motion, Early Burst, ACDC, Ornstein-Uhlenbeck and Shifts) models of continuous traits evolution on trees and time series. 'mvMORPH' also proposes high-dimensional multivariate comparative tools (linear models using Generalized Least Squares and multivariate tests) based on penalized likelihood. See 18 | Clavel et al. (2015) , Clavel et al. (2019) , and Clavel & Morlon (2020) . 19 | Depends: R(>= 2.9.1), phytools, ape, corpcor, subplex 20 | Imports: stats, utils, spam, graphics, glassoFast, parallel, pbmcapply, pbapply 21 | Suggests: knitr, car 22 | License: GPL (>= 2.0) 23 | URL: https://github.com/JClavel/mvMORPH 24 | VignetteBuilder: knitr 25 | NeedsCompilation: yes 26 | Repository: CRAN -------------------------------------------------------------------------------- /R/pruning.r: -------------------------------------------------------------------------------- 1 | # Pruning algorithm (Felsenstein 1973) used to compute the matrix square-root and the variance component of a phylogenetic tree 2 | # See also Stone 2011 - Syst. Bio. and Khabazzian et al. 2016 - Meth. Ecol. Evol.; for computing the matrix square root from the prunning algorithm 3 | # inv = TRUE compute the square root of the inverse covariance matrix, inv=FALSE compute the square root of the covariance matrix 4 | 5 | pruning <- function(tree, inv=TRUE, scaled=TRUE, trans=TRUE, check=TRUE){ 6 | # check the order of the tree; prunning algorithm use "postorder" 7 | if(check==TRUE){ 8 | if(!is.binary.phylo(tree)) tree <- multi2di(tree, random=FALSE) 9 | if(attr(tree,"order")!="postorder") tree <- reorder.phylo(tree, "postorder") 10 | } 11 | 12 | invMat=1*inv 13 | normalized=1*scaled 14 | mode(invMat)="integer" 15 | mode(normalized)="integer" 16 | 17 | prunRes <- .Call(squareRootM, as.integer(tree$edge[,1]), as.integer(tree$edge[,2]), 18 | tree$edge.length, as.integer(Ntip(tree)), as.integer(invMat), as.integer(normalized)) 19 | 20 | logdet <- sum(log(c(prunRes[[2]], prunRes[[3]]))) # log-determinant 21 | 22 | contrastMatrix <- prunRes[[1]] # faster to use crossprod in output 23 | if(trans==TRUE) contrastMatrix <- t(contrastMatrix) 24 | 25 | results <- list(sqrtMat=contrastMatrix, varNode=prunRes[[2]], varRoot=prunRes[[3]], det=logdet) 26 | # we can also just rename the list slots (names(prunRes) = c("sqrtMat","varNode","varRoot","det")) 27 | class(results) <- c("mvmorph.var") 28 | return(results) 29 | } 30 | -------------------------------------------------------------------------------- /man/phyllostomid.Rd: -------------------------------------------------------------------------------- 1 | \name{phyllostomid} 2 | \alias{phyllostomid} 3 | \title{ 4 | Phylogeny and trait data for a sample of Phyllostomid bats 5 | %% ~~ data name/kind ... ~~ 6 | } 7 | \description{ 8 | Phylogeny, diet, and morphological variables for 49 species of Phyllostomid bats. 9 | %% ~~ A concise (1-5 lines) description of the dataset. ~~ 10 | } 11 | \usage{data("phyllostomid")} 12 | 13 | \details{ 14 | Illustrative phylogeny (\emph{phyllostomid$tree}) and morphological data (\emph{phyllostomid$mandible} - 73 variables composed of the superimposed procrustes 2D-coordinates for the mandible and the condylobasal length) of 49 species of Phyllostomid bats from Monteiro & Nogueira (2011). The firsts 22 coordinates represent anatomical landmarks and the last 50 coordinates are semilandmarks. 15 | 16 | The four grouping factor variables (e.g., \emph{phyllostomid$grp1}, \emph{phyllostomid$grp2}, ...) are the adaptive regime models for association between mandible morphology and diet considered in Monteiro & Nogueira (2011). 17 | %% ~~ If necessary, more details than the __description__ above ~~ 18 | } 19 | 20 | \references{ 21 | Monteiro L.R., Nogueira M.R. 2011. Evolutionary patterns and processes in the radiation of phyllostomid bats. BMC Evolutionary Biology. 11:1-23. 22 | 23 | Clavel, J., Morlon, H. 2020. Reliable phylogenetic regressions for multivariate comparative data: illustration with the MANOVA and application to the effect of diet on mandible morphology in phyllostomid bats. Systematic Biology 69(5): 927-943. 24 | 25 | %% ~~ possibly secondary sources and usages ~~ 26 | } 27 | \examples{ 28 | data(phyllostomid) 29 | plot(phyllostomid$tree) 30 | head(phyllostomid$mandible) 31 | 32 | \donttest{ 33 | # Fit a linear model by PL 34 | fit1 <- mvgls(mandible~grp1, data=phyllostomid, phyllostomid$tree, model="lambda", method="LOO") 35 | 36 | # regularized MANOVA test 37 | (manova.gls(fit1, test="Wilks", verbose=TRUE)) 38 | } 39 | } 40 | 41 | \keyword{mvgls} 42 | \keyword{manova.gls} 43 | \keyword{datasets} 44 | \keyword{bats} -------------------------------------------------------------------------------- /src/spherical.c: -------------------------------------------------------------------------------- 1 | /*---------Matrix parameterization for shared eigenvectors comparison-----------------*/ 2 | /*---------through the use of spherical Cholesky parameterization---------------------*/ 3 | /*-mvMORPH 1.0.5 - 2015 - Julien Clavel - julien.clavel@hotmail.fr--------------------*/ 4 | 5 | #include "mvmorph.h" 6 | 7 | 8 | 9 | SEXP spherical(SEXP param, SEXP variance, SEXP dim){ 10 | int i, j, p, ind, index, f, col_start; 11 | char transa = 'T', transb = 'N'; 12 | double one = 1.0 , zero = 0.0; 13 | p = INTEGER(dim)[0]; 14 | 15 | SEXP U = PROTECT(allocMatrix(REALSXP,p,p)); 16 | SEXP R = PROTECT(allocMatrix(REALSXP,p,p)); 17 | SEXP V = PROTECT(allocMatrix(REALSXP,p,p)); 18 | PROTECT(coerceVector(param,REALSXP)); 19 | PROTECT(coerceVector(variance,REALSXP)); 20 | // define pointers 21 | double *x = REAL(param), *upt = REAL(U), *corrMat = REAL(R), *varMat = REAL(V), *var_val = REAL(variance); 22 | // before the loop we fix the index of the param list 23 | upt[0]=1; // Fixed to 1 for computing the cholesky factor of a correlation matrix 24 | ind=0; 25 | col_start=0; 26 | index=0; 27 | 28 | // Compute the Cholesky factor through spherical parameterization (See Pinheiro & Bates 1996) 29 | for(i=1; i=2.0)\cr 18 | } 19 | } 20 | \author{ 21 | Julien Clavel 22 | 23 | Maintainer: Julien Clavel 24 | } 25 | \references{ 26 | Clavel et al. (2015). mvMORPH: an R package for fitting multivariate evolutionary models to morphometric data. Methods in Ecology and Evolution, 6(11):1311-1319. doi: 10.1111/2041-210X.12420. 27 | 28 | Clavel et al. (2019). A Penalized Likelihood framework for high-dimensional phylogenetic comparative methods and an application to new-world monkeys brain evolution. Systematic Biology 68(1): 93-116. doi: 10.1093/sysbio/syy045. 29 | 30 | Clavel & Morlon (2020). Reliable phylogenetic regressions for multivariate comparative data: illustration with the MANOVA and application to the effect of diet on mandible morphology in Phyllostomid bats. Systematic Biology 69(5): 927-943. doi: 10.1093/sysbio/syaa010 31 | } 32 | \keyword{ mvols } 33 | \keyword{ mvgls } 34 | \keyword{ manova } 35 | \keyword{ pairwise tests } 36 | \keyword{ OU } 37 | \keyword{ BM } 38 | \keyword{ EB } 39 | \keyword{ Shifts } 40 | \keyword{ Measurement error } 41 | \keyword{ Simulations } 42 | \keyword{ Evolutionary rates } 43 | \keyword{ SIMMAP } 44 | \seealso{ 45 | \code{\link{mvols}} 46 | \code{\link{mvgls}} 47 | \code{\link{mvgls.pca}} 48 | \code{\link{mvgls.dfa}} 49 | \code{\link{manova.gls}} 50 | \code{\link{pairwise.glh}} 51 | \code{\link{mvOU}} 52 | \code{\link{mvBM}} 53 | \code{\link{mvEB}} 54 | \code{\link{mvSHIFT}} 55 | \code{\link{mvOUTS}} 56 | \code{\link{mvRWTS}} 57 | \code{\link{mvSIM}} 58 | \code{\link{mvLL}} 59 | \code{\link{LRT}} 60 | \code{\link{halflife}} 61 | \code{\link{stationary}} 62 | \code{\link{estim}} 63 | \code{\link{aicw}} 64 | \code{\link{GIC}} 65 | \code{\link{EIC}} 66 | \code{\link{mvqqplot}} 67 | } 68 | 69 | 70 | 71 | -------------------------------------------------------------------------------- /man/GIC.Rd: -------------------------------------------------------------------------------- 1 | \name{GIC} 2 | \alias{GIC} 3 | 4 | \title{ 5 | Generalized Information Criterion (GIC) to compare models fit with \code{mvgls} (or \code{mvols}) by Maximum Likelihood (ML) or Penalized Likelihood (PL) 6 | } 7 | \description{ 8 | The GIC (Konishi & Kitagawa 1996) allows comparing models fit by Maximum Likelihood (ML) or Penalized Likelihood (PL). 9 | } 10 | \usage{ 11 | 12 | 13 | GIC(object, ...) 14 | 15 | 16 | } 17 | \arguments{ 18 | \item{object}{ 19 | An object of class 'mvgls'. See ?mvgls or ?mvols} 20 | \item{...}{ 21 | Options to be passed through.} 22 | } 23 | 24 | 25 | \value{ 26 | a list with the following components 27 | 28 | \item{LogLikelihood}{the log-likelihood estimated for the model with estimated parameters} 29 | \item{GIC}{the GIC criterion} 30 | \item{bias}{the value of the bias term estimated to compute the GIC} 31 | 32 | } 33 | 34 | \details{ 35 | The Generalized Information Criterion (\code{GIC}) allows comparing the fit of various models estimated by Penalized Likelihood (see ?\code{mvgls} or ?\code{mvols}). See also the \code{gic_criterion} function in the RPANDA package. Under maximum likelihood (\code{method="LL"} in \code{mvgls} or \code{mvols}) and on large sample sizes, the GIC should converges to the classical AIC (Akaike Information Criterion). 36 | Note that the current implementation of the criterion has not been tested for multiple predictors comparison (especially under REML). Prefer simulation based comparisons or the \code{EIC} criterion instead. 37 | } 38 | 39 | 40 | \references{ 41 | Clavel, J., Aristide, L., Morlon, H., 2019. A Penalized Likelihood framework for high-dimensional phylogenetic comparative methods and an application to new-world monkeys brain evolution. Systematic Biology 68(1): 93-116. 42 | 43 | Konishi S., Kitagawa G. 1996. Generalised information criteria in model selection. Biometrika. 83:875-890. 44 | 45 | 46 | } 47 | 48 | \author{J. Clavel} 49 | 50 | \seealso{ 51 | \code{\link{mvgls}} 52 | \code{\link{mvols}} 53 | \code{\link{manova.gls}} 54 | } 55 | 56 | \examples{ 57 | \donttest{ 58 | 59 | set.seed(1) 60 | n <- 32 # number of species 61 | p <- 50 # number of traits 62 | 63 | tree <- pbtree(n=n) # phylogenetic tree 64 | R <- crossprod(matrix(runif(p*p), ncol=p)) # a random symmetric matrix (covariance) 65 | # simulate a dataset 66 | Y <- mvSIM(tree, model="BM1", nsim=1, param=list(sigma=R)) 67 | 68 | fit1 <- mvgls(Y~1, tree=tree, model="BM", method="H&L") 69 | fit2 <- mvgls(Y~1, tree=tree, model="OU", method="H&L") 70 | 71 | 72 | GIC(fit1); GIC(fit2) 73 | } 74 | } 75 | 76 | % Add one or more standard keywords, see file 'KEYWORDS' in the 77 | % R documentation directory. 78 | \keyword{ Model comparison } 79 | \keyword{ GLS } 80 | \keyword{ OLS } 81 | \keyword{ High dimensions }% __ONLY ONE__ keyword per line 82 | -------------------------------------------------------------------------------- /R/utils.r: -------------------------------------------------------------------------------- 1 | ################################################################################ 2 | ## ## 3 | ## mvMORPH: util.r ## 4 | ## ## 5 | ## Internal functions for the mvMORPH package ## 6 | ## ## 7 | ## Created by Julien Clavel - 26-05-2016 ## 8 | ## (julien.clavel@hotmail.fr/ julien.clavel@biologie.ens.fr) ## 9 | ## require: phytools, ape, corpcor, subplex, spam ## 10 | ## ## 11 | ################################################################################ 12 | 13 | # Function to extract the aic-weights 14 | aicw <- function(x,...){ 15 | 16 | args <- list(...) 17 | if(is.null(args[["aicc"]])) args$aicc <- FALSE 18 | 19 | if(inherits(x, "list")){ 20 | if(inherits(x[[1]],"mvmorph")){ 21 | 22 | if(args$aicc==TRUE){ 23 | aic_model <- sapply(1:length(x),function(i) x[[i]]$AICc) 24 | }else{ 25 | aic_model <- sapply(x,AIC) 26 | } 27 | 28 | models_names <- sapply(1:length(x),function(i){ 29 | if(!is.null(x[[i]]$param[["constraint"]])){ 30 | paste(x[[i]]$param$model[length(x[[i]]$param$model)],x[[i]]$param$constraint,i) 31 | }else{ 32 | paste(x[[i]]$param$model[length(x[[i]]$param$model)],i)} 33 | }) 34 | }else{ 35 | aic_model <- unlist(x) 36 | models_names <- as.character(1:length(aic_model)) 37 | } 38 | 39 | aics <- data.frame(models=models_names, AIC=aic_model, diff=aic_model) 40 | row.names(aics) <- as.character(models_names) 41 | 42 | }else{ 43 | if(is.null(names(x))){ 44 | models_names <- as.character(1:length(x)) 45 | }else{ 46 | models_names <- names(x) 47 | } 48 | 49 | aics <- data.frame(models=models_names, AIC=x, diff=x) 50 | row.names(aics) <- as.character(models_names) 51 | } 52 | 53 | aics <- aics[order(-aics$AIC),] 54 | for(i in 1:length(x)){aics$diff[i] <- aics$AIC[i]-min(aics$AIC)} 55 | aics$wi <- exp(-0.5*aics$diff) 56 | aics$aicweights <- aics$wi/sum(aics$wi) 57 | aics <- aics[models_names,] # reorder the results to the original order 58 | 59 | 60 | class(aics) <- c("mvmorph.aicw") 61 | return(aics) 62 | } 63 | 64 | 65 | -------------------------------------------------------------------------------- /man/dfaShape.Rd: -------------------------------------------------------------------------------- 1 | \name{dfaShape} 2 | \alias{dfaShape} 3 | 4 | \title{ 5 | Projection of 2D and 3D shapes (from geometric morphometric datasets) on Discriminant axes 6 | } 7 | \description{ 8 | The function extracts the shape changes along discriminant axes computed by a DFA (\code{mvgls.dfa}). 9 | } 10 | 11 | \usage{ 12 | 13 | dfaShape(object, reference, axis=1, ndim=3, spp=NULL, scaling=1, plot=FALSE, ...) 14 | 15 | } 16 | \arguments{ 17 | \item{object}{ 18 | A discriminant analysis obtained by the \code{mvgls.dfa} function. 19 | } 20 | \item{reference}{ 21 | The reference shape used to compare the deformations. Usually the mean shape.} 22 | 23 | \item{axis}{ 24 | The discriminant axis on which morphological changes are projected.} 25 | 26 | \item{ndim}{ 27 | The number of dimensions of the GMM data set (2 for 2D and 3 for 3D).} 28 | 29 | \item{spp}{ 30 | Names of the species (should match names in the dataset) shape to project onto the PC axis. If null, the two extreme shapes along \code{axis} are reported. 31 | } 32 | 33 | \item{scaling}{ 34 | An arbitrary factor used to multiply the effects (for better visualization) 35 | } 36 | 37 | \item{plot}{ 38 | Should the projected landmarks be plotted? 39 | } 40 | 41 | \item{...}{ 42 | Further options.} 43 | } 44 | 45 | \details{ 46 | The function will project the shape changes along discriminant axes obtained from a DFA by \code{mvgls.dfa}. This can be used to display morphological changes (for 2D and 3D geometric morphometric data) that best separate individuals from distinct groups. 47 | } 48 | 49 | \value{ 50 | a list with 2D or 3D coordinates for the shape projected on the selected PC axis. 51 | } 52 | 53 | 54 | 55 | \references{ 56 | 57 | Claude, J., 2008. Morphometrics with R. Springer Science. 58 | 59 | Clavel, J., Aristide, L., Morlon, H., 2019. A Penalized Likelihood framework for high-dimensional phylogenetic comparative methods and an application to new-world monkeys brain evolution. Systematic Biology 68(1): 93-116. 60 | 61 | } 62 | 63 | \author{J. Clavel} 64 | 65 | \seealso{ 66 | \code{\link{mvgls}}, 67 | \code{\link{mvols}}, 68 | \code{\link{mvgls.dfa}} 69 | \code{\link{pcaShape}} 70 | } 71 | 72 | \examples{ 73 | \donttest{ 74 | data(phyllostomid) 75 | 76 | # Fit a linear model by PL 77 | fit <- mvgls(mandible[,-1]~grp1, data=phyllostomid, phyllostomid$tree, model="lambda", method="PL") 78 | 79 | # Discriminant analysis 80 | da <- mvgls.dfa(fit) 81 | 82 | # Project the mandible shape extremes on the first discriminant axe 83 | proj_shape <- dfaShape(da, reference=coef(fit), axis=1, ndim=2, plot=TRUE) 84 | 85 | polygon(proj_shape$min) 86 | polygon(proj_shape$max, border="red") 87 | 88 | } 89 | } 90 | 91 | \keyword{ DFA projections } 92 | \keyword{ GLS } 93 | \keyword{ OLS } 94 | \keyword{ Geometric Morphometrics } 95 | \keyword{ High dimensions }% __ONLY ONE__ keyword per line 96 | -------------------------------------------------------------------------------- /src/givens.c: -------------------------------------------------------------------------------- 1 | /* ---------- Orthogonal matrix using Givens rotations ----------- */ 2 | /* Julien Clavel - clavel@biologie.ens.fr/julien.clavel@hotmail.fr */ 3 | /* mvMORPH 1.0.3 --2015------------------------------------------- */ 4 | 5 | // Compute an orthogonal matrix using Givens rotations 6 | // Use for SVD parametrization using eigenvectors and eigenvalues 7 | // Avoid trigonometric functions following Golub & Van Loan 2013 and Stewart 1976 8 | #include "mvmorph.h" 9 | 10 | // Get sine and cosine of the Givens angle without trigonometrics functions 11 | // Stewart (1976) - 3 / Golub & Van Loan (2013) - 5.1.10 12 | // macro to get the sign 13 | // #define sign(a) ( ( (a) > 0 ) ? 1 : (( (a) < 0 ) ? -1 : 0) ) 14 | 15 | /*static void getZ(double *p, double *s, double *c){ 16 | // Avoid undefined values while using the non-trigonometric function 17 | // if(p[0]>0.5 & p[0]<2 & p[0]!=1){p[0]=p[0]/4} 18 | if (abs(p[0])<1.5){ 19 | p[0]<-p[0]/3; 20 | }else{ 21 | p[0]<-p[0]*1.5; 22 | } 23 | 24 | if(p[0]==1.0){ 25 | c[0]=0; 26 | s[0]=1; 27 | }else if(abs(p[0])<1.0){ 28 | s[0]=2*p[0]; 29 | c[0]=sqrt(1-s[0]*s[0]); 30 | }else{ 31 | c[0]=2/p[0]; 32 | s[0]=sqrt(1-c[0]*c[0]); 33 | } 34 | }*/ 35 | 36 | // Get sine and cosine for the Givens angle 37 | static void getZ(double *p, double *s, double *c){ 38 | c[0]=cos(p[0]); 39 | s[0]=sin(p[0]); 40 | } 41 | 42 | // Golub & Van Loan (2013) p. 241 43 | static void updateA(double *A, double *c, double *s, int *ci, int *ck, int *ndim){ 44 | int j, i=*ci, k=*ck, n=*ndim; 45 | double t1, t2; 46 | 47 | for(j=0; j Ntip) continue; 64 | lt = LENGTH(VECTOR_ELT(seqnod, x[i] - Ntip - 1)); 65 | tmp_vec = allocVector(INTSXP, lt + 1); 66 | for (j = 0; j < lt; j++) 67 | INTEGER(tmp_vec)[j] = INTEGER(VECTOR_ELT(seqnod, x[i] - Ntip - 1))[j]; 68 | INTEGER(tmp_vec)[lt] = x[i + Nedge]; 69 | SET_VECTOR_ELT(ans, x[i + Nedge] - 1, tmp_vec); 70 | } 71 | 72 | UNPROTECT(5); 73 | return ans; 74 | } /* EOF seq_root2tip */ 75 | -------------------------------------------------------------------------------- /man/mvqqplot.Rd: -------------------------------------------------------------------------------- 1 | \name{mvqqplot} 2 | \alias{mvqqplot} 3 | 4 | \title{ 5 | Quantile-Quantile plots for multivariate models fit with \code{mvgls} or \code{mvols} 6 | } 7 | \description{ 8 | The quantile-quantile plots of the Chi square distribution is used to assess multivariate normality and detect outliers using the squared Mahalanobis distances from the models residuals. 9 | } 10 | \usage{ 11 | 12 | mvqqplot(object, conf=0.95, ...) 13 | 14 | } 15 | \arguments{ 16 | \item{object}{ 17 | A model fit obtained by the \code{mvgls} or \code{mvols} function. 18 | } 19 | \item{conf}{ 20 | Confidence interval for the approximate envelope. Default is 0.95.} 21 | 22 | \item{...}{ 23 | Graphical options.} 24 | } 25 | 26 | \details{ 27 | The empirical quantiles of standardized Mahalanobis distances (Caroni 1987) estimated from models fit by \code{mvgls} (or \code{mvols}) are compared to the quantiles of a Chi square distribution with 'p' degrees of freedom (where 'p' is the number of dimensions) when models are fit by maximum likelihood (\code{method='LL'}). For penalized likelihood model fit (regularized covariance), a matching moments method is used to map the standardized Mahalanobis distances to the Chi square distribution (Clavel, in prep.). This last option is experimental and still under development. 28 | } 29 | 30 | \value{ 31 | a list with components 32 | 33 | \item{squared_dist}{the squared Mahalanobis distances (standardized)} 34 | \item{chi2q}{the chi squared quantiles} 35 | } 36 | 37 | 38 | \note{ 39 | Chi square Q-Q plots may be outperformed by F based Q-Q plots for identifying outliers (Hardin & Rocke 2005). The function is still under development.} 40 | 41 | \references{ 42 | Caroni, C. 1987. Residuals and Influence in the multivariate linear model. Journal of the Royal Statistical Society 36(4): 365-370. 43 | 44 | Clavel, J., Aristide, L., Morlon, H., 2019. A Penalized Likelihood framework for high-dimensional phylogenetic comparative methods and an application to new-world monkeys brain evolution. Systematic Biology 68(1): 93-116. 45 | 46 | Clavel, J., Morlon, H. 2020. Reliable phylogenetic regressions for multivariate comparative data: illustration with the MANOVA and application to the effect of diet on mandible morphology in phyllostomid bats. Systematic Biology 69(5): 927-943. 47 | } 48 | 49 | \author{J. Clavel} 50 | 51 | \seealso{ 52 | \code{\link{mvgls}}, 53 | \code{\link{mvols}}, 54 | \code{\link{manova.gls}} 55 | } 56 | 57 | \examples{ 58 | \donttest{ 59 | data(phyllostomid) 60 | 61 | # Fit a linear model by PL 62 | fit <- mvgls(mandible~grp1, data=phyllostomid, phyllostomid$tree, model="lambda", method="PL") 63 | 64 | # QQ plots 65 | mvqqplot(fit, lty=2, conf=0.99) 66 | } 67 | } 68 | 69 | \keyword{ QQ plots } 70 | \keyword{ GLS } 71 | \keyword{ OLS } 72 | \keyword{ Mahalanobis } 73 | \keyword{ Regularization } 74 | \keyword{ Penalized likelihood } 75 | \keyword{ High dimensions }% __ONLY ONE__ keyword per line 76 | -------------------------------------------------------------------------------- /R/mvgls.pca.r: -------------------------------------------------------------------------------- 1 | ################################################################################ 2 | ## ## 3 | ## mvMORPH: mvgls.pca.r ## 4 | ## ## 5 | ## PCA on the Multivariate Generalized Least Squares ## 6 | ## covariance matrix estimator ## 7 | ## ## 8 | ## Created by Julien Clavel - 31-07-2018 ## 9 | ## (julien.clavel@hotmail.fr/ julien.clavel@biologie.ens.fr) ## 10 | ## require: phytools, ape, corpcor, subplex, spam, glassoFast, stats ## 11 | ## ## 12 | ################################################################################ 13 | 14 | mvgls.pca <- function(object, plot=TRUE, ...){ 15 | 16 | # optional arguments 17 | args <- list(...) 18 | if(is.null(args[["axes"]])) axes <- c(1,2) else axes <- args$axes 19 | if(is.null(args[["col"]])) col <- "black" else col <- args$col 20 | if(is.null(args[["pch"]])) pch <- 19 else pch <- args$pch 21 | if(is.null(args[["cex"]])) cex <- 0.7 else cex <- args$cex 22 | if(is.null(args[["las"]])) las <- 1 else las <- args$las 23 | if(is.null(args[["main"]])) { 24 | if(object$method=="LL") main <- "Phylogenetic PCA" else main <- "Regularized Phylogenetic PCA" 25 | }else{ main <- args$main } 26 | if(is.null(args[["mode"]])) mode <- "cov" else mode <- args$mode 27 | 28 | # if correlation matrix? 29 | if(!inherits(object,"mvgls")) stop("only works with \"mvgls\" or \"mvols\" class objects. See ?mvgls or ?mvols") 30 | covR <- object$sigma$Pinv 31 | 32 | # for OU process, we should instead take the stationary covariance 33 | if(object$model=="OU" & mode!="corr") covR <- covR/2*object$param # because alpha is scalar diagonal otherwise use "stationary" 34 | if(mode=="corr") covR <- cov2cor(covR) 35 | 36 | # compute the scores 37 | eig <- eigen(covR) 38 | values <- eig$values 39 | U <- eig$vectors 40 | resids <- object$residuals 41 | S <- resids%*%U 42 | 43 | # plot 44 | if(plot){ 45 | # contribution % variance 46 | tot<-sum(values) 47 | valX<-round(values[axes[1]]*100/tot,digits=2) 48 | valY<-round(values[axes[2]]*100/tot, digits=2) 49 | xlabel <- paste("PC",axes[1]," (",valX," %)", sep="") 50 | ylabel <- paste("PC",axes[2]," (",valY," %)", sep="") 51 | plot(S[,axes], main=main, xlab=xlabel, ylab=ylabel, pch=pch, col=col, las=las) 52 | abline(h=0,v=0) 53 | text(S[,axes],object$corrSt$phy$tip.label, pos=2, cex=cex) 54 | } 55 | 56 | res <- list(scores=S, values=values, vectors=U, rank=qr(covR)$rank) 57 | class(res) <- "mvgls.pca" 58 | invisible(res) 59 | } 60 | 61 | 62 | -------------------------------------------------------------------------------- /man/ancestral.Rd: -------------------------------------------------------------------------------- 1 | \name{ancestral} 2 | \alias{ancestral} 3 | 4 | \title{ 5 | Estimation of traits ancestral states. 6 | } 7 | \description{ 8 | Reconstruct the ancestral states at each node of a phylogenetic tree from models fit obtained using the \code{mvgls} function. For models of the class \code{mvXX} this is a wrapper to the function \code{estim}} 9 | \usage{ 10 | 11 | ancestral(object, ...) 12 | 13 | } 14 | \arguments{ 15 | \item{object}{ 16 | A model fit object obtained by the \code{mvgls} function. 17 | } 18 | \item{...}{ 19 | Further options to be passed through. For instance, if a regression model is used, values for the predictor(s) at each node of the tree should be given in a matrix to the \code{newdata} argument. If a model of the type \code{mvXX} is used, the argument \code{tree} and \code{data} should be provided like in \code{estim} function. 20 | } 21 | } 22 | 23 | 24 | \value{ 25 | a matrix of reconstructed ancestral states for each node (note that the numerotation of the ancestral states starts at "N+1" [for the root], where N is the number of species in the tree) 26 | 27 | } 28 | 29 | \details{ 30 | \code{ancestral} is an S3 method that reconstruct the ancestral states at each nodes of a phylogenetic tree from the models fit obtained by the \code{mvgls} function (Clavel et al. 2019). Ancestral states are estimated using generalized least squares (GLS; Martins & Hansen 1997, Cunningham et al. 1998 ). Note that when a regression model (rather than an intercept only model of the form Y~1) is provided, an argument "newdata" with a matrix of regressor values for each node should be provided (similar to what is done in the "predict" function). 31 | 32 | } 33 | 34 | \note{ 35 | The function is similar to the one used with \code{fit_t_pl} from the RPANDA package (Clavel et al. 2019).} 36 | \references{ 37 | 38 | Clavel, J., Aristide, L., Morlon, H., 2019. A Penalized Likelihood framework for high-dimensional phylogenetic comparative methods and an application to new-world monkeys brain evolution. Syst. Biol. 68: 93-116. 39 | 40 | Cunningham C.W., Omland K.E., Oakley T.H. 1998. Reconstructing ancestral character states: a critical reappraisal. Trends Ecol. Evol. 13:361-366. 41 | 42 | Martins E.P., Hansen T.F. 1997. Phylogenies and the comparative method: a general approach to incorporating phylogenetic information into the analysis of interspecific data. Am. Nat. 149:646-667. 43 | } 44 | 45 | \author{J. Clavel} 46 | 47 | \seealso{ 48 | \code{\link{mvgls}}, 49 | \code{\link{estim}}, 50 | \code{\link{predict.mvgls}} 51 | } 52 | 53 | \examples{ 54 | \donttest{ 55 | 56 | set.seed(1) 57 | n <- 32 # number of species 58 | p <- 5 # number of traits 59 | 60 | tree <- pbtree(n=n, scale=1) # phylogenetic tree 61 | R <- crossprod(matrix(runif(p*p), ncol=p)) # a random covariance matrix 62 | # simulate a BM dataset 63 | Y <- mvSIM(tree, model="BM1", nsim=1, param=list(sigma=R, theta=rep(0,p))) 64 | data=list(Y=Y) 65 | 66 | fit <- mvgls(Y~1, data=data, tree, model="BM", method="LL") 67 | 68 | # Perform the ancestral states reconstruction 69 | anc <- ancestral(fit) 70 | 71 | # retrieve the ancestral states 72 | head(anc) 73 | 74 | } 75 | } 76 | -------------------------------------------------------------------------------- /man/halflife.Rd: -------------------------------------------------------------------------------- 1 | \name{halflife} 2 | \alias{halflife} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{ 5 | The phylogenetic half-life for an Ornstein-Uhlenbeck process 6 | %% ~~function to do ... ~~ 7 | } 8 | \description{ 9 | This function returns the phylogenetic half-life for an Ornstein-Uhlenbeck process (object of class "ou"). 10 | %% ~~ A concise (1-5 lines) description of what the function does. ~~ 11 | } 12 | \usage{ 13 | halflife(object) 14 | } 15 | %- maybe also 'usage' for other objects documented here. 16 | \arguments{ 17 | \item{object}{ 18 | Object fitted with the "mvOU" function. 19 | %% ~~Describe \code{tree} here~~ 20 | } 21 | } 22 | 23 | \details{ 24 | The phylogenetic half-life describes the time to move halfway from the ancestral state to the primary optimum (Hansen, 1997). 25 | The multivariate counterpart is computed on the eigenvalues of the "selection" matrix (Bartoszek et al. 2012). 26 | %% ~~ If necessary, more details than the description above ~~ 27 | } 28 | \value{ 29 | The phylogenetic half-life computed from each eigenvalues (or alpha for the univariate case) 30 | %% ~Describe the value returned 31 | %% If it is a LIST, use 32 | %% \item{comp1 }{Description of 'comp1'} 33 | %% \item{comp2 }{Description of 'comp2'} 34 | %% ... 35 | } 36 | \references{ 37 | Bartoszek K., Pienaar J., Mostad P., Andersson S., Hansen T.F. 2012. A phylogenetic comparative method for studying multivariate adaptation. J. Theor. Biol. 314:204-215. 38 | 39 | Hansen T.F. 1997. Stabilizing selection and the comparative analysis of adaptation. Evolution. 51:1341-1351. 40 | 41 | %% ~put references to the literature/web site here ~ 42 | } 43 | \author{ 44 | Julien Clavel 45 | %% ~~who you are~~ 46 | } 47 | 48 | %% ~Make other sections like Warning with \section{Warning }{....} ~ 49 | 50 | \seealso{ 51 | \code{\link{mvMORPH}} 52 | \code{\link{mvOU}} 53 | \code{\link{stationary}} 54 | %% ~~objects to See Also as \code{\link{help}}, ~~~ 55 | } 56 | \examples{ 57 | # Simulated dataset 58 | set.seed(14) 59 | # Generating a random tree 60 | tree<-pbtree(n=50) 61 | 62 | # Setting the regime states of tip species 63 | sta<-as.vector(c(rep("Forest",20),rep("Savannah",30))); names(sta)<-tree$tip.label 64 | 65 | # Making the simmap tree with mapped states 66 | tree<-make.simmap(tree,sta , model="ER", nsim=1) 67 | col<-c("blue","orange"); names(col)<-c("Forest","Savannah") 68 | 69 | # Plot of the phylogeny for illustration 70 | plotSimmap(tree,col,fsize=0.6,node.numbers=FALSE,lwd=3, pts=FALSE) 71 | 72 | # Simulate the traits 73 | alpha<-matrix(c(2,0.5,0.5,1),2) 74 | sigma<-matrix(c(0.1,0.05,0.05,0.1),2) 75 | theta<-c(2,3,1,1.3) 76 | data<-mvSIM(tree, param=list(sigma=sigma, alpha=alpha, ntraits=2, theta=theta, 77 | names_traits=c("head.size","mouth.size")), model="OUM", nsim=1) 78 | 79 | ## Fitting the models 80 | # OUM - Analysis with multiple optima 81 | result<-mvOU(tree, data) 82 | 83 | halflife(result) 84 | 85 | } 86 | 87 | % Add one or more standard keywords, see file 'KEYWORDS' in the 88 | % R documentation directory. 89 | \keyword{ Ornstein Uhlenbeck } 90 | \keyword{ half-life } 91 | \keyword{ OU }% __ONLY ONE__ keyword per line 92 | -------------------------------------------------------------------------------- /man/aicw.Rd: -------------------------------------------------------------------------------- 1 | \name{aicw} 2 | \alias{aicw} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{ 5 | Akaike weights 6 | %% ~~function to do ... ~~ 7 | } 8 | \description{ 9 | This function return the Akaike weights for a set of fitted models. 10 | %% ~~ A concise (1-5 lines) description of what the function does. ~~ 11 | } 12 | \usage{ 13 | aicw(x,...) 14 | } 15 | %- maybe also 'usage' for other objects documented here. 16 | \arguments{ 17 | \item{x}{ 18 | A list with the fitted objects or a list/vector of AIC 19 | %% ~~Describe \code{tree} here~~ 20 | } 21 | \item{...}{ 22 | Options to be passed through; e.g. aicc=TRUE when a list of fitted objects is provided. 23 | %% ~~Describe \code{tree} here~~ 24 | } 25 | } 26 | 27 | \details{ 28 | This function compute the Akaike weights for a set of model AIC or AICc. Akaike weights can be used for model comparison and model averaging. 29 | %% ~~ If necessary, more details than the description above ~~ 30 | } 31 | \value{ 32 | \item{models }{List of models} 33 | \item{AIC }{Akaike Information Criterion} 34 | \item{diff }{AIC difference with the best fit model} 35 | \item{wi }{Absolute weight} 36 | \item{aicweights }{Akaike weights (relative weights)} 37 | %% ~Describe the value returned 38 | %% If it is a LIST, use 39 | %% \item{comp1 }{Description of 'comp1'} 40 | %% \item{comp2 }{Description of 'comp2'} 41 | %% ... 42 | } 43 | \references{ 44 | Burnham K.P., Anderson D.R. 2002. Model selection and multi-model inference: a practical information-theoric approach. New York: Springer-Verlag. 45 | 46 | %% ~put references to the literature/web site here ~ 47 | } 48 | \author{ 49 | Julien Clavel 50 | %% ~~who you are~~ 51 | } 52 | 53 | %% ~Make other sections like Warning with \section{Warning }{....} ~ 54 | 55 | \seealso{ 56 | \code{\link{AIC}} 57 | \code{\link{mvMORPH}} 58 | %% ~~objects to See Also as \code{\link{help}}, ~~~ 59 | } 60 | \examples{ 61 | set.seed(1) 62 | # Generating a random tree 63 | tree<-pbtree(n=50) 64 | 65 | #simulate the traits 66 | sigma <- matrix(c(0.01,0.005,0.003,0.005,0.01,0.003,0.003,0.003,0.01),3) 67 | theta<-c(0,0,0) 68 | data<-mvSIM(tree, model="BM1", nsim=1, param=list(sigma=sigma, theta=theta)) 69 | 70 | ## Fitting the models 71 | # BM1 - General structure 72 | fit1 <- mvBM(tree, data, model="BM1", method="pic") 73 | 74 | # BM1 - No covariations 75 | fit2 <- mvBM(tree, data, model="BM1", method="pic", param=list(constraint="diagonal")) 76 | 77 | # BM1 - Equal variances/rates 78 | fit3 <- mvBM(tree, data, model="BM1", method="pic", param=list(constraint="equal")) 79 | 80 | results <- list(fit1,fit2,fit3) 81 | 82 | # or 83 | # results <- c(AIC(fit1), AIC(fit2), AIC(fit3)) 84 | 85 | # Akaike weights 86 | aicw(results) 87 | 88 | # AICc weights 89 | aicw(results, aicc=TRUE) 90 | 91 | # we can compare the MSE... 92 | # mean((fit1$sigma-sigma)^2) 93 | # mean((fit3$sigma-sigma)^2) 94 | 95 | } 96 | 97 | % Add one or more standard keywords, see file 'KEYWORDS' in the 98 | % R documentation directory. 99 | \keyword{ AIC } 100 | \keyword{ Akaike weights } 101 | % __ONLY ONE__ keyword per line 102 | -------------------------------------------------------------------------------- /man/stationary.Rd: -------------------------------------------------------------------------------- 1 | \name{stationary} 2 | \alias{stationary} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{ 5 | The stationary variance of an Ornstein-Uhlenbeck process 6 | %% ~~function to do ... ~~ 7 | } 8 | \description{ 9 | This function returns the stationary variance for an Ornstein-Uhlenbeck process (object of class "ou"). 10 | %% ~~ A concise (1-5 lines) description of what the function does. ~~ 11 | } 12 | \usage{ 13 | stationary(object) 14 | } 15 | %- maybe also 'usage' for other objects documented here. 16 | \arguments{ 17 | \item{object}{ 18 | Object fitted with the "mvOU" function. 19 | %% ~~Describe \code{tree} here~~ 20 | } 21 | } 22 | 23 | \details{ 24 | This function computes the dispersion parameter of the Ornstein-Uhlenbeck process (i.e., the expected variance when the process is stationary). 25 | The multivariate normal stationary distribution of the Ornstein-Uhlenbeck process is computed following Bartoszek et al. (2012). 26 | %% ~~ If necessary, more details than the description above ~~ 27 | } 28 | \value{ 29 | The stationary variance-covariance matrix of the OU process 30 | %% ~Describe the value returned 31 | %% If it is a LIST, use 32 | %% \item{comp1 }{Description of 'comp1'} 33 | %% \item{comp2 }{Description of 'comp2'} 34 | %% ... 35 | } 36 | \references{ 37 | Bartoszek K., Pienaar J., Mostad P., Andersson S., Hansen T.F. 2012. A phylogenetic comparative method for studying multivariate adaptation. J. Theor. Biol. 314:204-215. 38 | 39 | %% ~put references to the literature/web site here ~ 40 | } 41 | \author{ 42 | Julien Clavel 43 | %% ~~who you are~~ 44 | } 45 | 46 | %% ~Make other sections like Warning with \section{Warning }{....} ~ 47 | 48 | \seealso{ 49 | \code{\link{mvMORPH}} 50 | \code{\link{mvOU}} 51 | \code{\link{halflife}} 52 | %% ~~objects to See Also as \code{\link{help}}, ~~~ 53 | } 54 | \examples{ 55 | # Simulated dataset 56 | set.seed(14) 57 | # Generating a random tree 58 | tree<-pbtree(n=50) 59 | 60 | # Setting the regime states of tip species 61 | sta<-as.vector(c(rep("Forest",20),rep("Savannah",30))); names(sta)<-tree$tip.label 62 | 63 | # Making the simmap tree with mapped states 64 | tree<-make.simmap(tree,sta , model="ER", nsim=1) 65 | col<-c("blue","orange"); names(col)<-c("Forest","Savannah") 66 | 67 | # Plot of the phylogeny for illustration 68 | plotSimmap(tree,col,fsize=0.6,node.numbers=FALSE,lwd=3, pts=FALSE) 69 | 70 | # Simulate the traits 71 | alpha<-matrix(c(2,0.5,0.5,1),2) 72 | sigma<-matrix(c(0.1,0.05,0.05,0.1),2) 73 | theta<-c(2,3,1,1.3) 74 | data<-mvSIM(tree, param=list(sigma=sigma, alpha=alpha, ntraits=2, theta=theta, 75 | names_traits=c("head.size","mouth.size")), model="OUM", nsim=1) 76 | 77 | ## Fitting the models 78 | # OUM - Analysis with multiple optima 79 | result<-mvOU(tree, data) 80 | 81 | stationary(result) 82 | 83 | # Expected values when the process is stationary 84 | expected<-list(alpha=alpha,sigma=sigma) 85 | class(expected)<-c("mvmorph","mvmorph.ou") 86 | stationary(expected) 87 | 88 | } 89 | 90 | % Add one or more standard keywords, see file 'KEYWORDS' in the 91 | % R documentation directory. 92 | \keyword{ Ornstein Uhlenbeck } 93 | \keyword{ stationary } 94 | \keyword{ OU }% __ONLY ONE__ keyword per line 95 | -------------------------------------------------------------------------------- /man/mvgls.dfa.Rd: -------------------------------------------------------------------------------- 1 | \name{mvgls.dfa} 2 | \alias{mvgls.dfa} 3 | 4 | \title{ 5 | Discriminant Function Analysis (DFA) - also called Linear Discriminant Analysis (LDA) or Canonical Variate Analysis (CVA) - based on multivariate GLS (or OLS) model fit 6 | } 7 | \description{ 8 | Performs a discriminant analysis (DFA) on a regularized variance-covariance matrix obtained using either the \code{mvgls} or \code{mvols} function. 9 | } 10 | \usage{ 11 | 12 | mvgls.dfa(object, ...) 13 | 14 | } 15 | \arguments{ 16 | \item{object}{ 17 | A model fit obtained by the \code{mvgls} or the \code{mvols} function. 18 | } 19 | 20 | \item{...}{ 21 | Options to be passed through. (e.g., \code{term="the term corresponding to the factor of interest"}, \code{type="I"} for the type of decomposition of the hypothesis matrix (see also manova.gls) , etc.) 22 | } 23 | } 24 | 25 | 26 | \value{ 27 | a list with the following components 28 | 29 | \item{coeffs}{a matrix containing the raw discriminants} 30 | \item{coeffs.std}{a matrix containing the standardized discriminants} 31 | \item{scores}{a matrix containing the discriminant scores [residuals X coeffs]} 32 | \item{residuals}{the centered [with GLS or OLS] response variables} 33 | \item{H}{the hypothesis (or between group model matrix)} 34 | \item{E}{the error (or residual model matrix)} 35 | \item{rank}{the rank of \eqn{HE^{-1}}} 36 | \item{pct}{the percentage of the discriminant functions} 37 | 38 | } 39 | 40 | \details{ 41 | \code{mvgls.dfa} allows computing a discriminant analysis based on GLS (or OLS) estimates from a regression model (see \code{mvgls} and \code{mvols}). Discriminant functions can be used for dimensionality reduction, to follow up a MANOVA analysis to describe group separation, or for group prediction. 42 | } 43 | 44 | \note{ 45 | Still in development, may not handle special designs. } 46 | 47 | \references{ 48 | Clavel, J., Aristide, L., Morlon, H., 2019. A Penalized Likelihood framework for high-dimensional phylogenetic comparative methods and an application to new-world monkeys brain evolution. Systematic Biology 68(1): 93-116. 49 | 50 | Clavel, J., Morlon, H., 2020. Reliable phylogenetic regressions for multivariate comparative data: illustration with the MANOVA and application to the effect of diet on mandible morphology in Phyllostomid bats. Systematic Biology 69(5): 927-943. 51 | 52 | } 53 | 54 | \author{J. Clavel} 55 | 56 | \seealso{ 57 | \code{\link{mvgls}}, 58 | \code{\link{mvols}}, 59 | \code{\link{manova.gls}}, 60 | \code{\link{mvgls.pca}}, 61 | \code{\link{predict.mvgls.dfa}}, 62 | } 63 | 64 | \examples{ 65 | \donttest{ 66 | library(mvMORPH) 67 | n=64 68 | p=4 69 | 70 | tree <- pbtree(n=n) 71 | sigma <- crossprod(matrix(runif(p*p),p,p)) 72 | resid <- mvSIM(tree, model="BM1", param=list(sigma=sigma)) 73 | Y <- rep(c(0,1.5), each=n/2) + resid 74 | grp <- as.factor(rep(c("gp1","gp2"),each=n/2)) 75 | names(grp) = rownames(Y) 76 | data <- list(Y=Y, grp=grp) 77 | mod <- mvgls(Y~grp, data=data, tree=tree, model="BM") 78 | 79 | # fda 80 | da1 <- mvgls.dfa(mod) 81 | 82 | plot(da1) 83 | } 84 | } 85 | 86 | \keyword{ LDA } 87 | \keyword{ CVA } 88 | \keyword{ DFA } 89 | \keyword{ Discriminant } 90 | \keyword{ Regularization } 91 | \keyword{ Penalized likelihood } 92 | \keyword{ High dimensions }% __ONLY ONE__ keyword per line 93 | -------------------------------------------------------------------------------- /man/mvgls.pca.Rd: -------------------------------------------------------------------------------- 1 | \name{mvgls.pca} 2 | \alias{mvgls.pca} 3 | 4 | \title{ 5 | Principal Component Analysis (PCA) based on GLS (or OLS) estimate of the traits variance-covariance matrix (possibly regularized) 6 | } 7 | \description{ 8 | Performs a principal component analysis (PCA) on a regularized variance-covariance matrix obtained using the \code{mvgls} or the \code{mvols} function. With "evolutionary" models in \code{mvgls}, this performs the so-called phylogenetic PCA.} 9 | \usage{ 10 | 11 | mvgls.pca(object, plot=TRUE, ...) 12 | 13 | } 14 | \arguments{ 15 | \item{object}{ 16 | A model fit obtained by the \code{mvgls} or \code{mvols} function. 17 | } 18 | \item{plot}{ 19 | Plot of the PC's axes. Default is TRUE (see details).'} 20 | 21 | \item{...}{ 22 | Options to be passed through. (e.g., \code{axes=c(1,2)}, \code{col}, \code{pch}, \code{cex}, \code{mode="cov"} or \code{"corr"}, etc.)} 23 | } 24 | 25 | 26 | \value{ 27 | a list with the following components 28 | 29 | \item{scores}{the PC scores} 30 | \item{values}{the eigenvalues of the variance-covariance matrix estimated by mvgls or mvols} 31 | \item{vectors}{the eigenvectors of the variance-covariance matrix estimated by mvgls or mvols} 32 | \item{rank}{the rank of the estimated variance-covariance matrix} 33 | } 34 | 35 | \details{ 36 | \code{mvgls.pca} allows computing a principal component analysis based on a GLS (or OLS) estimate of the covariance matrix (see \code{mvgls} and \code{mvols}). The phylogenetic PCA (following Revell 2009) is a special case obtained from the (possibly regularized) evolutionary variance-covariance matrix (see also the \code{phyl.pca_pl} function in RPANDA). In the high-dimensional case the contribution of the firsts PC axes tend to be overestimated with traditional maximum likelihood approaches. Penalized/regularized model fit reduce this bias and allow incorporating various residuals structures (see Clavel et al. 2019). 37 | Plotting options, the number of axes to display (\code{axes=c(1,2)} is the default), and whether the covariance (\code{mode="cov"}) or correlation (\code{mode="corr"}) should be used can be specified through the ellipsis "\code{...}" argument. 38 | } 39 | 40 | \note{ 41 | Contrary to conventional PCA (for instance using \code{mvols} with "LL" method), the principal axes of the gls PCA are not orthogonal, they represent the main axes of independent (according to a given phylogenetic or time-series model) evolutionary changes.} 42 | 43 | \references{ 44 | Clavel, J., Aristide, L., Morlon, H., 2019. A Penalized Likelihood framework for high-dimensional phylogenetic comparative methods and an application to new-world monkeys brain evolution. Systematic Biology 68(1): 93-116. 45 | 46 | Revell, L.J., 2009. Size-correction and principal components for intraspecific comparative studies. Evolution, 63:3258-3268. 47 | } 48 | 49 | \author{J. Clavel} 50 | 51 | \seealso{ 52 | \code{\link{mvgls}}, 53 | \code{\link{mvols}}, 54 | \code{\link{GIC}}, 55 | \code{\link{EIC}} 56 | } 57 | 58 | \examples{ 59 | \donttest{ 60 | set.seed(1) 61 | n <- 32 # number of species 62 | p <- 30 # number of traits 63 | 64 | tree <- pbtree(n=n) # phylogenetic tree 65 | R <- crossprod(matrix(runif(p*p),p)) # a random symmetric matrix (covariance) 66 | 67 | # simulate a dataset 68 | Y <- mvSIM(tree, model="BM1", nsim=1, param=list(sigma=R)) 69 | 70 | # The conventional phylogenetic PCA 71 | phylo_pca <- mvgls(Y~1, tree=tree, model="BM", method="LL") 72 | mvgls.pca(phylo_pca, plot=TRUE) 73 | 74 | 75 | 76 | 77 | # fit a multivariate Pagel lambda model with Penalized likelihood 78 | fit <- mvgls(Y~1, tree=tree, model="lambda", method="LOO", penalty="RidgeAlt") 79 | 80 | # Perform a regularized phylogenetic PCA using the model fit (Pagel lambda model) 81 | pca_results <- mvgls.pca(fit, plot=TRUE) 82 | 83 | # retrieve the scores 84 | head(pca_results$scores) 85 | } 86 | } 87 | 88 | \keyword{ GIC } 89 | \keyword{ GLS } 90 | \keyword{ OLS } 91 | \keyword{ PCA } 92 | \keyword{ Regularization } 93 | \keyword{ Penalized likelihood } 94 | \keyword{ High dimensions }% __ONLY ONE__ keyword per line 95 | -------------------------------------------------------------------------------- /man/effectsize.Rd: -------------------------------------------------------------------------------- 1 | \name{effectsize} 2 | \alias{effectsize} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{ 5 | Multivariate measure of association/effect size for objects of class "manova.gls" 6 | %% ~~function to do ... ~~ 7 | } 8 | \description{ 9 | This function estimate the multivariate effectsize for all the outcomes variables of a multivariate analysis of variance 10 | %% ~~ A concise (1-5 lines) description of what the function does. ~~ 11 | } 12 | \usage{ 13 | effectsize(x,...) 14 | } 15 | %- maybe also 'usage' for other objects documented here. 16 | \arguments{ 17 | 18 | \item{x}{ 19 | An object of class "manova.gls" 20 | %% ~~Describe \code{model2} here~~ 21 | } 22 | \item{...}{ 23 | One can specify \code{adjusted=TRUE} to obtain Serlin' adjustment to Pillai trace effect size, or Tatsuoka' adjustment for Wilks' lambda. These adjustments are correcting positive bias with increasing number of variables. 24 | %% ~~Describe \code{model1} here~~ 25 | } 26 | } 27 | \details{ 28 | This function allows estimating multivariate effect size / multivariate measure of association for the four multivariate statistics implemented in \code{manova.gls} (Pillai, Wilks, Roy, Hotelling-Lawley). These multivariate measures are common generalizations of univariate measures such as the squared-multiple correlation, with values ranging between 0 and 1 (see for instance details in Rencher 2002). Note that these measures are known to be upwardly biased with increased dimensionality (Kim and Olejnik 2005), and several adjustments were proposed (e.g., Serlin 1982, Tatsuoka 1973; see \code{adjusted=TRUE} argument above). For models fit by PL, the adjustments is done by estimating the bias from the permuted statistics under the null. Note that adjusted measures might be sligthly negative, in such a case the measure should be interpreted as virtually 0 (accordingly, statistical tests from the \code{manova.gls} function should be non-significant in these situations). 29 | %% ~~ If necessary, more details than the description above ~~ 30 | } 31 | 32 | \value{ 33 | Return the effect size for all the terms of the MANOVA or pairwise tests. 34 | %% ~Describe the value returned 35 | %% If it is a LIST, use 36 | %% \item{comp1 }{Description of 'comp1'} 37 | %% \item{comp2 }{Description of 'comp2'} 38 | %% ... 39 | } 40 | 41 | \note{ 42 | This function is still under development.} 43 | 44 | \references{ 45 | 46 | Clavel et al. in prep. 47 | 48 | Kim, S., Olejnik S., 2005. Bias and precision of measures of association for a fixed-effect multivariate analysis of variance model. Multivariate Behavioral Research, 40(4):401-421. 49 | 50 | Rencher, 2002. Methods of Multivariate Analysis (Second Edition). Wiley and Sons. pp. 705. 51 | 52 | Serlin, R. C., 1982. A multivariate measure of association based on the Pillai-Bartlett procedure. Psycological Bulletin 91(2):413-417. 53 | 54 | Tatsuoka, M. M. 1973. An examination of the statistical properties of a multivariate measure of strength of relationship (final report). Project No. 2-E-020, Grant No. OEG-5-72-0027(509). 55 | 56 | } 57 | 58 | \author{ 59 | Julien Clavel 60 | %% ~~who you are~~ 61 | } 62 | %% ~Make other sections like Warning with \section{Warning }{....} ~ 63 | \seealso{ 64 | \code{\link{manova.gls}} 65 | \code{\link{mvgls}} 66 | \code{\link{mvols}} 67 | \code{\link{pairwise.glh}} 68 | %% ~~objects to See Also as \code{\link{help}}, ~~~ 69 | } 70 | \examples{ 71 | set.seed(123) 72 | n <- 32 # number of species 73 | p <- 3 # number of traits 74 | tree <- pbtree(n=n) # phylogenetic tree 75 | R <- crossprod(matrix(runif(p*p),p)) # a random symmetric matrix (covariance) 76 | 77 | # simulate a dataset 78 | Y <- mvSIM(tree, model="BM1", nsim=1, param=list(sigma=R)) 79 | X <- rnorm(n) # continuous 80 | grp <- rep(1:2, each=n/2) 81 | dataset <- list(y=Y, x=X, grp=as.factor(grp)) 82 | 83 | # Model fit 84 | model1 <- mvgls(y~x+grp, data=dataset, tree=tree, model="BM", method="LL") 85 | 86 | # Multivariate test 87 | (multivariate_test <- manova.gls(model1, test="Pillai")) 88 | effectsize(multivariate_test) 89 | } 90 | % Add one or more standard keywords, see file 'KEYWORDS' in the 91 | % R documentation directory. 92 | \keyword{ Effect size } 93 | \keyword{ R-squared } 94 | \keyword{ Multivariate measure of association }% __ONLY ONE__ keyword per line -------------------------------------------------------------------------------- /R/mvols.r: -------------------------------------------------------------------------------- 1 | ################################################################################ 2 | ## ## 3 | ## mvMORPH: mvlm.r/mvols.r ## 4 | ## ## 5 | ## Multivariate Ordinary Least Squares Linear Models by ML and PL ## 6 | ## ## 7 | ## This is a wrapper to the mvgls function when there's no trees ## 8 | ## Created by Julien Clavel - 31-09-2020 (terminated 6-06-2022) ## 9 | ## (julien.clavel@hotmail.fr/ julien.clavel@univ-lyon1.fr) ## 10 | ## require: phytools, ape, corpcor, subplex, spam, glassoFast, stats ## 11 | ## ## 12 | ################################################################################ 13 | 14 | 15 | mvols <- function(formula, data=list(), method=c("PL-LOOCV","LL"), REML=TRUE, ...){ 16 | 17 | # Recover options 18 | args <- list(...) 19 | if(is.null(args[["weights"]])) weights <- NULL else weights <- args$weights 20 | 21 | # Retrieve the dataset 22 | model_fr = model.frame(formula=formula, data=data) 23 | Y = model.response(model_fr) 24 | 25 | # Number of observations 26 | n = nrow(Y) 27 | 28 | # For now I'm using a simple wrapper to mvgls. The idea is to fix the tree structure to a star tree 29 | # (with possibly different lengths if a weighted least squares approach is required), and use the BM model. 30 | phylo_struct <- generate_tree_structure(n, names_tips = rownames(Y)) 31 | 32 | # Weighted least squares 33 | if(!is.null(weights)){ 34 | if(!is.null(rownames(Y))){ 35 | if(any(!phylo_struct$tip.label%in%names(weights))) stop("weights vector should be named and match the names of the observations in the response variable.") 36 | weights <- weights[phylo_struct$tip.label] 37 | phylo_struct$edge.length[sapply(1:n,function(x) which(x==phylo_struct$edge[,2]))] <- weights 38 | }else{ 39 | phylo_struct$edge.length[phylo_struct$edge[,2]<=n] <- weights 40 | } 41 | } 42 | 43 | # Call mvgls => force BM on a star tree 44 | results <- mvgls(formula = formula, data = data, tree = phylo_struct, model = "BM", method = method, REML = REML, ...) 45 | 46 | # Define a broader class 47 | results$call = match.call() 48 | class(results) <- c("mvols","mvgls") 49 | return(results) 50 | } 51 | 52 | # ------------------------------------------------------------------------- # 53 | # generate_tree_structure # 54 | # options: n, names_tips, ... # 55 | # ------------------------------------------------------------------------- # 56 | generate_tree_structure <- function(n, names_tips=NULL, ...){ 57 | 58 | # bar & foo functions from 'rtree' in 'ape' package v.5.6-2 59 | bar <- function(n) sample.int(n - 1L, 1L, FALSE, NULL, FALSE) 60 | foo <- function(n, pos) { 61 | n1 <- bar(n) 62 | n2 <- n - n1 63 | po2 <- pos + 2L * n1 - 1L 64 | edge[c(pos, po2), 1L] <<- nod 65 | nod <<- nod + 1L 66 | if (n1 > 2L) { 67 | edge[pos, 2L] <<- nod 68 | foo(n1, pos + 1L) 69 | } 70 | else if (n1 == 2L) { 71 | edge[pos + 1:2, 1L] <<- edge[pos, 2L] <<- nod 72 | nod <<- nod + 1L 73 | } 74 | if (n2 > 2L) { 75 | edge[po2, 2L] <<- nod 76 | foo(n2, po2 + 1L) 77 | } 78 | else if (n2 == 2L) { 79 | edge[po2 + 1:2, 1L] <<- edge[po2, 2L] <<- nod 80 | nod <<- nod + 1L 81 | } 82 | } 83 | 84 | # generate the edge matrix 85 | nbr <- 2L * n - 2L 86 | edge <- matrix(NA_integer_, nbr, 2L) 87 | 88 | # are the data named? 89 | if (is.null(names_tips)) { 90 | names_tips <- paste0("obs", 1:n) 91 | } 92 | 93 | # populate the edge matrix 94 | if (n == 2L) { 95 | edge[] <- c(3L, 3L, 1L, 2L) 96 | } 97 | else if (n == 3L) { 98 | edge[] <- c(4L, 5L, 5L, 4L, 5L, 1:3) 99 | } 100 | else if (n > 3L) { 101 | nod <- n + 1L 102 | foo(n, 1L) 103 | i <- which(is.na(edge[, 2L])) 104 | edge[i, 2L] <- 1:n 105 | } 106 | 107 | # make the "tree" object 108 | phy_struct <- list(edge = edge, tip.label = names_tips) 109 | phy_struct$Nnode <- if (n == 1L) 1L else n - 1L 110 | class(phy_struct) <- c("phylo", "phylOLS") 111 | attr(phy_struct, "order") <- "cladewise" 112 | 113 | # create branch lengths 114 | phy_struct$edge.length <- numeric(nbr) 115 | phy_struct$edge.length[edge[,2]<=n] <- 1 116 | 117 | return(phy_struct) 118 | } 119 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | ## mvMORPH 1.2.1 2 | + fix type for integer in C header file 3 | ## mvMORPH 1.2.0 4 | + update tolerance value for mvgls tuning parameter search 5 | + changes to Fortran routines calls following CRAN policies 6 | + wrapper to BIC 7 | ## mvMORPH 1.1.9 8 | + reverse change for zero branch lengths in "penalized" file. A typo was introduced. Now a check is performed first in the "mvgls" function. 9 | ## mvMORPH 1.1.8 10 | + add the pcaShape and dfaShape functions 11 | + add wrapper "simulate()" to simulate from 'mvgls' or 'mvols' fit 12 | + fix error in "estim" for BM with trend 13 | + fix issues with zero branch lengths in the pruning algorithm used in 'mvgls' 14 | + fix typo on factor labels in DFA predictions 15 | + fix CRAN requests (typo on Rd file and arguments in error function in C code) 16 | ## mvMORPH 1.1.7 17 | + fix error in handling pairwise glh tests with the "effectSize" function 18 | + fix error in mvols with EIC - no use of the pruning algorithm now 19 | + add ploting option for pairwise tests 20 | + add AIC extractor 21 | ## mvMORPH 1.1.6 22 | + fix error in the estimation of GIC with "BMM" model in mvgls. Now the 'mvgls' function uses a more robust parameterization of BMM which ease the computation of GIC. 23 | + mvols function - wrapper to mvgls to fit OLS (or WLS) multivariate models (possibly regularized) 24 | ## mvMORPH 1.1.5 25 | + mvqqplot (multivariate normality and outliers assessment - beta) 26 | + effectsize (multivariate measures of association - beta) 27 | + pairs.contrasts (build a matrix of pairwise contrasts) 28 | + pairwise.glh (performs multivariate pairwises tests) 29 | + predict.mvgls.dfa (predict option for DFA - beta) 30 | + manova.gls (implements now contrasts for repeated measures designs) 31 | + fix error in estim 32 | + add "ancestral" function to estimate ancestral states for mvgls objects 33 | ## mvMORPH 1.1.4 34 | + model BMM in mvgls 35 | + "predict" function for mvgls 36 | + plot function for mvgls objects 37 | + dfa on gls fit (beta) 38 | + fix typo in mvSHIFT output print 39 | + fix error in estimation of OU with n-ultrametric trees in mvgls + new adjusted bounds for parameters search 40 | + fix typo in summary.mvgls print option in the calculation of the AIC. 41 | + handling of design matrices with deficient ranks in regressions 42 | ## mvMORPH 1.1.3 43 | + CRAN request to remove the export statements for S3 classes 44 | + replace is.binary.tree to is.binary.phylo, the former being deprecated from "ape". 45 | + fix error in mvSHIFT. The wrong values were returned (but not printed) for "beta" in BMEB models. 46 | ## mvMORPH 1.1.2 47 | + replaced "F" by "FALSE" in example files to follow CRAN policies 48 | + optimization of some diagonal matrices computations 49 | + bug fix in mvSIM (SHIFT model without simmap tree provided) 50 | ## mvMORPH 1.1.1 51 | + update help pages of various functions 52 | + Bugs fixes for bounds in the parameter search in "mvgls", and missing values estimation in "estim" with OU1 model. 53 | + manova.gls: MANOVA methods and multivariate statistics based on ML (n=LRT_stat) 123 | 124 | plot(density(simulations), main="Non-parametric LRT"); 125 | abline(v=LRT_stat, col="red") 126 | } 127 | 128 | } 129 | 130 | % Add one or more standard keywords, see file 'KEYWORDS' in the 131 | % R documentation directory. 132 | \keyword{ LRT } 133 | \keyword{ Loglikelihood ratio test } 134 | \keyword{ Models comparison }% __ONLY ONE__ keyword per line 135 | -------------------------------------------------------------------------------- /man/mv.Precalc.Rd: -------------------------------------------------------------------------------- 1 | \name{mv.Precalc} 2 | \alias{mv.Precalc} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{ 5 | Model parameterization for the various mvMORPH functions 6 | %% ~~function to do ... ~~ 7 | } 8 | \description{ 9 | This function allows computing the fixed parameters or objects needed by the mvMORPH functions. This could be useful for bootstrap-like computations (see exemple) 10 | %% ~~ A concise (1-5 lines) description of what the function does. ~~ 11 | } 12 | \usage{ 13 | mv.Precalc(tree, nb.traits = 1, scale.height = FALSE, param = list(pivot = "MMD", 14 | method = c("sparse"), smean = TRUE, model = "OUM")) 15 | } 16 | %- maybe also 'usage' for other objects documented here. 17 | \arguments{ 18 | \item{tree}{ 19 | A "phylo" (or SIMMAP like) object representing the tree for which we want to precalculate parameters. 20 | %% ~~Describe \code{tree} here~~ 21 | } 22 | \item{nb.traits}{ 23 | The number of traits involved in the subsequent analysis. 24 | %% ~~Describe \code{nb.traits} here~~ 25 | } 26 | \item{scale.height}{ 27 | Whether the tree should be scaled to unit length or not. 28 | %% ~~Describe \code{scale.height} here~~ 29 | } 30 | \item{param}{ 31 | A list of parameters used in the computations (see details) 32 | %% ~~Describe \code{param} here~~ 33 | } 34 | } 35 | \details{ 36 | The mv.Precalc function allows the pre-computation of the fixed parameters required by the different mvMORPH models (e.g., the design matrix, the vcv matrix, the sparsity structure...). 37 | In the "param" list you should provide the details about the model fit: 38 | 39 | -model name (e.g., "OUM", "OU1") 40 | 41 | -method (which kind of algorithm is used for computing the log-likelihood). 42 | 43 | -smean (whether there is one ancestral state per trait or per selective regimes - for mvBM only). 44 | 45 | Additional parameters can be fixed: 46 | 47 | -root (estimation of the ancestral state for the Ornstein-Uhlenbeck model; see ?mvOU). 48 | 49 | -pivot (pivot method used by the "sparse" matrix method for computing the log-likelihood; see ?spam). 50 | %% ~~ If necessary, more details than the description above ~~ 51 | } 52 | \value{ 53 | An object of class "mvmorph.precalc" which can be used in the "precalc" argument of the various mvMORPH functions. 54 | %% ~Describe the value returned 55 | %% If it is a LIST, use 56 | %% \item{comp1 }{Description of 'comp1'} 57 | %% \item{comp2 }{Description of 'comp2'} 58 | %% ... 59 | } 60 | 61 | \author{ 62 | Julien Clavel 63 | %% ~~who you are~~ 64 | } 65 | \note{ 66 | This function is mainly used internally; it is still in development. A misuse of this functions can result in a crash of the R session. 67 | %% ~~further notes~~ 68 | } 69 | 70 | %% ~Make other sections like Warning with \section{Warning }{....} ~ 71 | 72 | \seealso{ 73 | \code{\link{mvMORPH}} 74 | \code{\link{mvOU}} 75 | \code{\link{mvEB}} 76 | \code{\link{mvBM}} 77 | \code{\link{mvSHIFT}} 78 | \code{\link{mvLL}} 79 | 80 | %% ~~objects to See Also as \code{\link{help}}, ~~~ 81 | } 82 | \examples{ 83 | set.seed(14) 84 | # Generating a random tree 85 | tree<-pbtree(n=50) 86 | 87 | # Simulate two correlated traits evolving along the phylogeny according to a 88 | # Ornstein-Uhlenbeck process 89 | alpha<-matrix(c(2,1,1,1.3),2,2) 90 | sigma<-matrix(c(1,0.5,0.5,0.8),2,2) 91 | theta<-c(3,1) 92 | nsim<-50 93 | simul<-mvSIM(tree,param=list(sigma=sigma, alpha=alpha, ntraits=2, theta=theta, 94 | names_traits=c("head.size","mouth.size")), model="OU1", nsim=nsim) 95 | 96 | # Do the pre-calculations 97 | precal<-mv.Precalc(tree,nb.traits=2, param=list(method="sparse",model="OU1", root=FALSE)) 98 | 99 | mvOU(tree, simul[[1]], method="sparse", model="OU1", precalc=precal, 100 | param=list(decomp="cholesky")) 101 | 102 | ### Bootstrap 103 | \donttest{ 104 | # Fit the model to the "nsim" simulated datasets 105 | results<-lapply(1:nsim,function(x){ 106 | mvOU(tree, simul[[x]], method="sparse", model="OU1", precalc=precal, 107 | param=list(decomp="cholesky"), 108 | echo=FALSE, diagnostic=FALSE) 109 | }) 110 | 111 | ### Use parallel package 112 | library(parallel) 113 | if(.Platform$OS.type == "unix"){ 114 | number_of_cores<-2L # Only working on Unix systems 115 | }else{ 116 | number_of_cores<-1L 117 | } 118 | 119 | results<-mclapply(simul, function(x){ 120 | mvOU(tree, x, method="sparse", model="OU1", precalc=precal, 121 | param=list(decomp="cholesky"), echo=FALSE, diagnostic=FALSE) 122 | }, mc.cores = getOption("mc.cores", number_of_cores)) 123 | 124 | 125 | # Summarize (we use the generic S3 method "logLik" to extract the log-likelihood) 126 | loglik<-sapply(results,logLik) 127 | hist(loglik) 128 | } 129 | } 130 | 131 | % Add one or more standard keywords, see file 'KEYWORDS' in the 132 | % R documentation directory. 133 | \keyword{ precalculation } 134 | \keyword{ parameters }% __ONLY ONE__ keyword per line 135 | -------------------------------------------------------------------------------- /man/EIC.Rd: -------------------------------------------------------------------------------- 1 | \name{EIC} 2 | \alias{EIC} 3 | 4 | \title{ 5 | Extended Information Criterion (EIC) to compare models fit with \code{mvgls} (or \code{mvols}) by Maximum Likelihood (ML) or Penalized Likelihood (PL) 6 | } 7 | 8 | \description{ 9 | The EIC (Ishiguro et al. 1997, Kitagawa & Konishi 2010), uses bootstrap to estimate the bias term of the Extended Information Criterion. This criterion allows comparing models fit by Maximum Likelihood (ML) or Penalized Likelihood (PL). 10 | } 11 | 12 | \usage{ 13 | 14 | EIC(object, nboot=100L, nbcores=1L, ...) 15 | 16 | } 17 | 18 | \arguments{ 19 | \item{object}{ 20 | An object of class 'mvgls'. See \code{?mvgls} or \code{?mvols}} 21 | \item{nboot}{ 22 | The number of boostrap replicates used for estimating the EIC.} 23 | \item{nbcores}{ 24 | The number of cores used to speed-up the computations (uses the 'parallel' package)} 25 | \item{...}{ 26 | Options to be passed through.} 27 | } 28 | 29 | 30 | \value{ 31 | a list with the following components 32 | 33 | \item{LogLikelihood}{the log-likelihood estimated for the model with estimated parameters} 34 | \item{EIC}{the EIC criterion} 35 | \item{se}{the standard error of the bias term estimated by bootstrap} 36 | \item{bias}{the values of the bias term estimated from the boostrapped replicates to compute the EIC} 37 | 38 | } 39 | 40 | \details{ 41 | The Extended Information Criterion (\code{EIC}) allows comparing the fit of various models estimated by Penalized Likelihood or Maximum Likelihood (see ?\code{mvgls}). Similar to the GIC or the more common AIC, the EIC has the form: 42 | 43 | \deqn{EIC = -2*(Likelihood) + 2*bias} 44 | 45 | Where \emph{Likelihood} corresponds to either the full or the restricted likelihood (see the note below), and the bias term is estimated by (semi-parametric) bootstrap simulations rather than by using analytical or approximate solutions (see for instance ?\code{GIC}). The smaller the EIC, the better is the model. With small sample sizes, the variability around the bootstrap estimate is expected to be high, and one must increase the number of bootstrap replicates. Parallel computation (argument \code{nbcores}) allows to speed-up the computations. 46 | 47 | Note: for models estimated by REML, it is generally not possible to compare the restricted likelihoods when the models fit have different fixed effects. However, it is possible to compare models with different fixed effects by using the full likelihood evaluated at the REML estimates (see e.g. Yafune et al. 2006, Verbyla 2019). Both options - evaluating the restricted likelihood or the full likelihood with parameters estimated by REML - are available through the \code{REML} argument in the \code{EIC} function. The default has been set to \code{REML=FALSE} to allow the comparison of models with different fixed effects using the full likelihood evaluated with the REML estimates (see Verbyla 2019). 48 | } 49 | 50 | 51 | \references{ 52 | Clavel J., Aristide L., Morlon H., 2019. A Penalized Likelihood framework for high-dimensional phylogenetic comparative methods and an application to new-world monkeys brain evolution. Syst. Biol. 68:93-116. 53 | 54 | Ishiguro M., Sakamoto Y., Kitagawa G., 1997. Bootstrapping log likelihood and EIC, an extension of AIC. Ann. Inst. Statist. Math. 49:411-434. 55 | 56 | Kitagawa G., Konishi S., 2010. Bias and variance reduction techniques for bootstrap information criterion. Ann. Inst. Stat. Math. 62:209-234. 57 | 58 | Konishi S., Kitagawa G., 1996. Generalised information criteria in model selection. Biometrika. 83:875-890. 59 | 60 | Verbyla A. P., 2019. A note on model selection using information criteria for general linear models estimated using REML. Aust. N. Z. J. Stat. 61:39-50. 61 | 62 | Yafune A., Funatogawa T., Ishiguro M., 2005. Extended information criterion (EIC) approach for linear mixed effects models under restricted maximum likelihood (REML) estimation. Statist. Med. 24:3417-3429. 63 | 64 | } 65 | 66 | \author{J. Clavel} 67 | 68 | \seealso{ 69 | \code{\link{GIC}} 70 | \code{\link{mvgls}} 71 | \code{\link{mvols}} 72 | \code{\link{manova.gls}} 73 | } 74 | 75 | \examples{ 76 | \donttest{ 77 | 78 | set.seed(1) 79 | n <- 32 # number of species 80 | p <- 50 # number of traits 81 | 82 | tree <- pbtree(n=n) # phylogenetic tree 83 | R <- crossprod(matrix(runif(p*p), ncol=p)) # a random symmetric matrix (covariance) 84 | # simulate a dataset 85 | Y <- mvSIM(tree, model="BM1", nsim=1, param=list(sigma=R)) 86 | 87 | fit1 <- mvgls(Y~1, tree=tree, model="BM", method="H&L") 88 | fit2 <- mvgls(Y~1, tree=tree, model="OU", method="H&L") 89 | 90 | 91 | EIC(fit1); EIC(fit2) 92 | 93 | # We can improve accuracy by increasing the number of bootstrap samples 94 | # EIC(fit1, nboot=5000, nbcores=8L) 95 | # EIC(fit2, nboot=5000, nbcores=8L) 96 | } 97 | } 98 | 99 | % Add one or more standard keywords, see file 'KEYWORDS' in the 100 | % R documentation directory. 101 | \keyword{ Model comparison } 102 | \keyword{ GLS } 103 | \keyword{ OLS } 104 | \keyword{ High dimensions }% __ONLY ONE__ keyword per line -------------------------------------------------------------------------------- /man/estim.Rd: -------------------------------------------------------------------------------- 1 | \name{estim} 2 | \alias{estim} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{ 5 | Ancestral states reconstructions and missing value imputation with phylogenetic/time-series models 6 | %% ~~function to do ... ~~ 7 | } 8 | \description{ 9 | This function imputes the missing cases (NA values) according to a given phylogenetic model (object of class "mvmorph"); it can also do ancestral state reconstruction. 10 | %% ~~ A concise (1-5 lines) description of what the function does. ~~ 11 | } 12 | \usage{ 13 | estim(tree, data, object, error=NULL, asr=FALSE) 14 | } 15 | %- maybe also 'usage' for other objects documented here. 16 | \arguments{ 17 | 18 | \item{tree}{ 19 | Phylogenetic tree (an object of class "phylo" or "simmap") or a time-series. 20 | %% ~~Describe \code{model2} here~~ 21 | } 22 | \item{data}{ 23 | Matrix or data frame with species in rows and continuous traits with missing cases (NA values) in columns (preferentially with names and in the same order than in the tree). 24 | %% ~~Describe \code{model1} here~~ 25 | } 26 | \item{object}{ 27 | A fitted object from an mvMORPH model (class "mvmorph"). 28 | %% ~~Describe \code{echo} here~~ 29 | } 30 | \item{error}{ 31 | Matrix or data frame with species in rows and continuous traits sampling variance (squared standard errors) in columns. 32 | %% ~~Describe \code{echo} here~~ 33 | } 34 | 35 | \item{asr}{ 36 | If asr=TRUE, the ancestral states are estimated instead of the missing cases. 37 | %% ~~Describe \code{echo} here~~ 38 | } 39 | } 40 | \details{ 41 | Missing observations for species in a phylogenetic tree are estimated according to a given evolutionary model (and parameters). Multivariate models are useful to recover the variance and covariance structure of the dataset to be imputed. 42 | 43 | When \emph{asr=TRUE}, the estimates, their variances and standard errors are those of the ancestral states at each node of the tree (this option is not available for the time-series). Note that if there are missing cases, they are first imputed before estimating the ancestral states. 44 | 45 | Estimation of missing cases and ancestral states is performed using GLS (Generalized Least Squares) solution (See Cunningham et al. 1998). 46 | %% ~~ If necessary, more details than the description above ~~ 47 | } 48 | \value{ 49 | 50 | \item{estimates}{The imputed dataset } 51 | \item{var }{Variance of the estimates} 52 | \item{se }{Standard error of the estimates} 53 | \item{NA_index }{Position of the missing cases in the dataset} 54 | 55 | %% ~Describe the value returned 56 | %% If it is a LIST, use 57 | %% \item{comp1 }{Description of 'comp1'} 58 | %% \item{comp2 }{Description of 'comp2'} 59 | %% ... 60 | } 61 | \references{ 62 | Clavel J., Merceron G., Escarguel G. 2014. Missing Data Estimation in Morphometrics: How Much is Too Much? Syst. Biol. 63:203-218. 63 | 64 | Cunningham C.W., Omland K.E., Oakley T.H. 1998. Reconstructing ancestral character states: a critical reappraisal. Trends Ecol. Evol. 13:361-366. 65 | %% ~put references to the literature/web site here ~ 66 | } 67 | \author{ 68 | Julien Clavel 69 | %% ~~who you are~~ 70 | } 71 | 72 | 73 | %% ~Make other sections like Warning with \section{Warning }{....} ~ 74 | 75 | \seealso{ 76 | \code{\link{mvMORPH}} 77 | \code{\link{mvOU}} 78 | \code{\link{mvEB}} 79 | \code{\link{mvBM}} 80 | \code{\link{mvSHIFT}} 81 | 82 | %% ~~objects to See Also as \code{\link{help}}, ~~~ 83 | } 84 | \examples{ 85 | 86 | ## Simulated dataset 87 | set.seed(14) 88 | # Generating a random tree 89 | tree<-pbtree(n=50) 90 | 91 | # Setting the regime states of tip species 92 | sta<-as.vector(c(rep("Forest",20),rep("Savannah",30))); names(sta)<-tree$tip.label 93 | 94 | # Making the simmap tree with mapped states 95 | tree<-make.simmap(tree,sta , model="ER", nsim=1) 96 | col<-c("blue","orange"); names(col)<-c("Forest","Savannah") 97 | 98 | # Plot of the phylogeny for illustration 99 | plotSimmap(tree,col,fsize=0.6,node.numbers=FALSE,lwd=3, pts=FALSE) 100 | 101 | # Simulate two correlated traits evolving along the phylogeny 102 | traits<-mvSIM(tree,nsim=1, model="BMM", param=list(sigma=list(matrix(c(2,1,1,1.5),2,2), 103 | matrix(c(4,1,1,4),2,2)), names_traits=c("head.size","mouth.size"))) 104 | 105 | # Introduce some missing cases (NA values) 106 | data<-traits 107 | data[8,2]<-NA 108 | data[25,1]<-NA 109 | 110 | # Fit of model 1 111 | fit<-mvBM(tree,data,model="BMM") 112 | 113 | # Estimate the missing cases 114 | imp<-estim(tree, data, fit) 115 | 116 | # Check the imputed data 117 | imp$estim[1:10,] 118 | 119 | ## We want the ancestral states values at each nodes: 120 | nodelabels() # To see where the nodes are situated 121 | 122 | imp2<-estim(tree, data, fit, asr=TRUE) 123 | 124 | # Check the 10 firsts ancestral states 125 | imp2$estim[1:10,] 126 | } 127 | 128 | % Add one or more standard keywords, see file 'KEYWORDS' in the 129 | % R documentation directory. 130 | \keyword{ Estim } 131 | \keyword{ Imputation } 132 | \keyword{ Missing values }% __ONLY ONE__ keyword per line 133 | -------------------------------------------------------------------------------- /man/pruning.Rd: -------------------------------------------------------------------------------- 1 | \name{pruning} 2 | \alias{pruning} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{ 5 | Pruning algorithm to compute the square root of the phylogenetic covariance matrix and its determinant. 6 | %% ~~function to do ... ~~ 7 | } 8 | \description{ 9 | This function uses the pruning algorithm (Felsenstein 1973) to efficiently compute the determinant of the phylogenetic covariance matrix as well as the square root of this matrix (or its inverse; Stone 2011, Khabbazian et al. 2016). This algorithm is faster than using "eigen" or "cholesky" function to compute the determinant or the square root (see e.g., Clavel et al. 2015) and can be used to compute independent contrasts scores and the log-likelihood of a model in linear time. 10 | 11 | %% ~~ A concise (1-5 lines) description of what the function does. ~~ 12 | } 13 | \usage{ 14 | pruning(tree, inv=TRUE, scaled=TRUE, trans=TRUE, check=TRUE) 15 | } 16 | %- maybe also 'usage' for other objects documented here. 17 | \arguments{ 18 | 19 | \item{tree}{ 20 | Phylogenetic tree (an object of class "phylo" or "simmap"). 21 | } 22 | 23 | \item{inv}{ 24 | Return the matrix square root of either the covariance matrix (inv=FALSE) or its inverse (inv=TRUE, the default). This matrix is a "contrasts" matrix. 25 | } 26 | 27 | \item{scaled}{ 28 | Indicates whether the contrasts should be scaled with their expected variances (default to TRUE). 29 | } 30 | 31 | \item{trans}{ 32 | Return the transpose (trans=TRUE) of the matrix square root/contrasts matrix. 33 | (by default - i.e., trans=TRUE - it returns a matrix equivalent to the upper triangular Cholesky factor) 34 | } 35 | 36 | \item{check}{ 37 | Check if the input tree is dichotomous and in "postorder" (see ?is.binary.tree and ?reorder.phylo). 38 | } 39 | 40 | } 41 | \details{ 42 | The tree is assumed to be fully dichotomic and in "postorder", otherwise the functions \emph{multi2di} and \emph{reorder.phylo} are used internally when \emph{check=TRUE}. 43 | 44 | %% ~~ If necessary, more details than the description above ~~ 45 | } 46 | \value{ 47 | 48 | \item{sqrtMat }{The matrix square root (contrasts matrix) } 49 | \item{varNode }{Variance associated to each node values (similar to "contrasts" variance)} 50 | \item{varRoot }{Variance associated to the root value (similar to the ancestral state variance)} 51 | \item{det }{Log-determinant of the phylogenetic covariance of the tree} 52 | 53 | %% ~Describe the value returned 54 | %% If it is a LIST, use 55 | %% \item{comp1 }{Description of 'comp1'} 56 | %% \item{comp2 }{Description of 'comp2'} 57 | %% ... 58 | } 59 | \references{ 60 | Clavel J., Escarguel G., Merceron G. 2015. mvMORPH: an r package for fitting multivariate evolutionary models to morphometric data. Methods Ecol. Evol. 6:1311-1319. 61 | 62 | Felsenstein J. 1973. Maximum-likelihood estimation of evolutionary trees from continuous characters. Am. J. Hum. Genet. 25:471-492. 63 | 64 | Khabbazian M., Kriebel R., Rohe K., Ane C. 2016. Fast and accurate detection of evolutionary shifts in Ornstein-Uhlenbeck models. Methods Ecol. Evol. 7:811-824. 65 | 66 | Stone E.A. 2011. Why the phylogenetic regression appears robust to tree misspecification. Syst. Biol. 60:245-260 67 | 68 | %% ~put references to the literature/web site here ~ 69 | } 70 | \author{ 71 | Julien Clavel 72 | %% ~~who you are~~ 73 | } 74 | 75 | 76 | %% ~Make other sections like Warning with \section{Warning }{....} ~ 77 | 78 | \seealso{ 79 | \code{\link{mvLL}} 80 | \code{\link{mvgls}} 81 | %% ~~objects to See Also as \code{\link{help}}, ~~~ 82 | } 83 | 84 | \examples{ 85 | 86 | ## Simulated dataset 87 | set.seed(14) 88 | # Generating a random tree 89 | tree<-pbtree(n=50) 90 | Y <- mvSIM(tree, model="BM1", param=list(sigma=1, theta=0)) # trait 91 | X <- matrix(1, nrow=Ntip(tree), ncol=1) # design matrix 92 | 93 | ## Use the GLS trick 94 | # Compute the matrix square root 95 | C <- vcv.phylo(tree) 96 | D <- chol(C) 97 | Cinv <- solve(C) 98 | Di <- chol(Cinv) 99 | 100 | # transform the traits 101 | Xi <- Di\%*\%X 102 | Yi <- Di\%*\%Y 103 | 104 | # Compute the GLS estimate and determinant (see Clavel et al. 2015) 105 | # GLS estimate for the root 106 | print(pseudoinverse(Xi)\%*\%Yi) 107 | 108 | # Determinant of the phylogenetic covariance matrix 109 | print(sum(log(diag(D)^2))) 110 | 111 | 112 | ## Use the pruning algorithm (much faster) 113 | 114 | M <- pruning(tree, inv=TRUE) 115 | 116 | Xi <- M$sqrtMat\%*\%X 117 | Yi <- M$sqrtMat\%*\%Y 118 | 119 | # GLS estimate 120 | print(pseudoinverse(Xi)\%*\%Yi) 121 | 122 | # determinant 123 | print(M$det) 124 | 125 | ## REML determinant (without variance of the root state; see Felsenstein 1973) 126 | # full REML 127 | log(det(C)) + log(det(t(X)\%*\%Cinv\%*\%X)) 128 | 129 | # pruning REML 130 | sum(log(M$varNode)) 131 | 132 | } 133 | 134 | 135 | % Add one or more standard keywords, see file 'KEYWORDS' in the 136 | % R documentation directory. 137 | \keyword{ Matrix square root } 138 | \keyword{ Determinant } 139 | \keyword{ GLS } 140 | \keyword{ Independent contrasts }% __ONLY ONE__ keyword per line 141 | -------------------------------------------------------------------------------- /man/pairwise.glh.Rd: -------------------------------------------------------------------------------- 1 | \name{pairwise.glh} 2 | \alias{pairwise.glh} 3 | 4 | \title{ 5 | Pairwise multivariate tests between levels of a factor 6 | } 7 | \description{ 8 | Performs pairwise multivariate tests (e.g. "Pillai") on levels of a factor in a model fitted by the \code{mvgls} or \code{mvols} function. This is achieved by evaluating all the pairwise contrasts using generalized linear hypothesis tests (see also ?manova.gls).} 9 | 10 | \usage{ 11 | 12 | pairwise.glh(object, term=1, test=c("Pillai", "Wilks", "Hotelling-Lawley", "Roy"), 13 | adjust="holm", nperm=1000L, ...) 14 | 15 | } 16 | \arguments{ 17 | \item{object}{ 18 | A model fit obtained by the \code{mvgls} or \code{mvols} function. 19 | } 20 | \item{term}{ 21 | The factor term in the "object" model fit on which the pairwise tests should be evaluated. 22 | } 23 | \item{test}{ 24 | The multivariate test statistic to compute - "Wilks", "Pillai", "Hotelling-Lawley", or "Roy"} 25 | 26 | \item{adjust}{ 27 | The multiple comparison adjustment. See \code{?p.adjust}.} 28 | 29 | \item{nperm}{ 30 | The number of permutations used for building the null distribution of the chosen statistic. Permutation is the only available approach for high-dimensional PL models, but either permutations or parametric tests can be used with maximum likelihood (method "LL" in \code{mvgls} and \code{mvols})} 31 | 32 | \item{...}{ 33 | Further arguments to be passed through. (e.g., \code{nbcores=2L} to provide the number of cores used for parallel calculus; \code{parametric=FALSE} to obtain permutation instead of parametric tests for maximum likelihood fit; \code{verbose=TRUE} to display a progress bar during permutations; \code{rhs=0} the "right-hand-side" vector for general linear hypothesis testing. See details)} 34 | } 35 | 36 | 37 | \value{ 38 | An object of class 'pairs.mvgls' which is usually printed. It contains a list including the following components: 39 | 40 | \item{test}{the multivariate test statistic used} 41 | \item{L}{the contrasts used for all the pairwise tests} 42 | \item{stat}{the statistic calculated for each pairwise comparisons} 43 | \item{pvalue}{the p-values calculated for each pairwise comparisons} 44 | \item{adjust}{the adjusted (for multiple comparisons) p-values calculated for each pairwise comparisons} 45 | 46 | } 47 | 48 | \details{ 49 | \code{pairwise.glh} allows performing multivariate tests (e.g. Pillai's, Wilks, Hotelling-Lawley and Roy largest root) on generalized least squares (GLS) linear model (objects of class "mvgls") fit by either maximum likelihood (\code{method="LL"}) or penalized likelihood (\code{method="PL-LOO"}) using the \code{mvgls} or \code{mvols} function. 50 | 51 | General Linear Hypothesis of the form: 52 | 53 | \deqn{\bold{LB=O}} 54 | 55 | is used internally with an \bold{L} matrix specifying linear combinations ("contrasts") of the model coefficients (\bold{B}) for each pairwise comparisons. The right-hand-side matrix \bold{O} is a constant matrix (of zeros by default) that can be provided through the argument \code{rhs} (to test specific values for instance). 56 | 57 | Permutations on high-dimensional datasets is time consuming. You can use the option \code{nbcores} to parallelize the computations over several cores using forking in UNIX platforms (default is \code{nbcores=1L}). Estimated time to completion is displayed when \code{verbose=TRUE}. 58 | } 59 | 60 | \note{ 61 | For PL methods, only the "RidgeArch" penalty is allowed for now. Due to corrections for multiple comparisons, one should ensure that the number of permutations is large enough.} 62 | 63 | \references{ 64 | Clavel, J., Aristide, L., Morlon, H., 2019. A Penalized Likelihood framework for high-dimensional phylogenetic comparative methods and an application to new-world monkeys brain evolution. Systematic Biology 68(1): 93-116. 65 | 66 | Clavel, J., Morlon, H. 2020. Reliable phylogenetic regressions for multivariate comparative data: illustration with the MANOVA and application to the effect of diet on mandible morphology in phyllostomid bats. Systematic Biology 69(5): 927-943. 67 | } 68 | 69 | \author{J. Clavel} 70 | 71 | \seealso{ 72 | \code{\link{mvgls}}, 73 | \code{\link{mvols}}, 74 | \code{\link{pairwise.contrasts}}, 75 | \code{\link{manova.gls}} 76 | } 77 | 78 | \examples{ 79 | \donttest{ 80 | data("phyllostomid") 81 | 82 | # model fit with mandible~"grp2" 83 | fit <- mvgls(mandible~grp2, data=phyllostomid, phyllostomid$tree, model="lambda", method="PL") 84 | 85 | # pairwise tests 86 | pairwise.glh(fit, term="grp2", test="Pillai", adjust="holm", nperm=1000, verbose=TRUE) 87 | 88 | # fit the model by ML (p 0) error("the leading minor of order %d is not positive definite",info); 98 | error("argument %d of Lapack routine %s had invalid value",-info, "dpftrf"); 99 | } 100 | 101 | // systeme lineaire U'x=D 102 | F77_CALL(dtfsm)(&trans, &side, &up, &trans, &diag, &n, &nt, &alpha, REAL(ARF), REAL(DD), &n FCONE FCONE FCONE FCONE FCONE); 103 | // systeme lineaire U'x=dat 104 | F77_CALL(dtfsm)(&trans, &side, &up, &trans, &diag, &n, &one, &alpha, REAL(ARF), REAL(Ddat), &n FCONE FCONE FCONE FCONE FCONE); 105 | 106 | // Calcul du determinant 107 | determinant(REAL(det),REAL(ARF),&n); 108 | 109 | // Liste: determinant, cholesky, X 110 | SEXP vec = PROTECT(allocVector(VECSXP, 4)); 111 | SET_VECTOR_ELT(vec, 0, ARF); 112 | SET_VECTOR_ELT(vec, 1, det); 113 | SET_VECTOR_ELT(vec, 2, DD); 114 | SET_VECTOR_ELT(vec, 3, Ddat); 115 | 116 | UNPROTECT (7); 117 | return (vec); 118 | } 119 | 120 | 121 | // Factorisation de Cholesky RPF - avoid explicit computation of U'x=D and U'x=dat 122 | SEXP Chol_RPF_only(SEXP A, SEXP ndimA, SEXP mserr, SEXP ismserr){ 123 | int n, err, info; 124 | const char up = 'U', trans = 'T'; 125 | 126 | n = INTEGER(ndimA)[0]; 127 | err = INTEGER(ismserr)[0]; 128 | PROTECT(A = coerceVector(A,REALSXP)); 129 | PROTECT(mserr = coerceVector(mserr,REALSXP)); 130 | SEXP ARF = PROTECT(allocVector(REALSXP,(n+1)*n/2)); 131 | SEXP det = PROTECT(allocVector(REALSXP,1)); 132 | 133 | // add measurement error 134 | if(err==1){ 135 | ms_error(REAL(A),REAL(mserr), &n); 136 | } 137 | // preparation au format RPF 138 | F77_CALL(dtrttf)(&trans,&up,&n,REAL(A),&n,REAL(ARF),&info FCONE FCONE); 139 | if (info != 0){ 140 | error("the %d argument had an illegal value",info); 141 | } 142 | 143 | // decomposition de Cholesky 144 | F77_CALL(dpftrf)(&trans,&up,&n,REAL(ARF),&info FCONE FCONE); 145 | if (info != 0) { 146 | if (info > 0) error("the leading minor of order %d is not positive definite",info); 147 | error("argument %d of Lapack routine %s had invalid value",-info, "dpftrf"); 148 | } 149 | 150 | // Calcul du determinant 151 | determinant(REAL(det),REAL(ARF),&n); 152 | 153 | // Liste: cholesky, determinant 154 | SEXP vec = PROTECT(allocVector(VECSXP, 2)); 155 | SET_VECTOR_ELT(vec, 0, ARF); 156 | SET_VECTOR_ELT(vec, 1, det); 157 | 158 | UNPROTECT (5); 159 | return (vec); 160 | } 161 | 162 | -------------------------------------------------------------------------------- /src/mvMORPH_init.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include // for NULL 4 | #include 5 | 6 | 7 | /* .Call calls */ 8 | extern SEXP Chol_RPF(SEXP A, SEXP D, SEXP dat, SEXP nterm, SEXP ndimA, SEXP mserr, SEXP ismserr); 9 | extern SEXP Chol_RPF_only(SEXP A, SEXP ndimA, SEXP mserr, SEXP ismserr); 10 | extern SEXP Chol_RPF_quadprod(SEXP U, SEXP resid, SEXP nterm); 11 | extern SEXP Chol_RPF_quadprod_column(SEXP U, SEXP resid, SEXP nterm); 12 | extern SEXP Chol_RPF_univ(SEXP A, SEXP D, SEXP dat, SEXP nterm, SEXP ndimA, SEXP mserr, SEXP ismserr); 13 | extern SEXP Chol_RPF_univ_only(SEXP A, SEXP ndimA, SEXP mserr, SEXP ismserr); 14 | extern SEXP Expect_matrix(SEXP S1, SEXP S, SEXP lambda, SEXP time, SEXP theta0, SEXP theta1, SEXP matdiag); 15 | extern SEXP givens_ortho (SEXP Q, SEXP angle, SEXP ndim); 16 | extern SEXP kronecker_mvmorph(SEXP R, SEXP C, SEXP Rrows, SEXP Crows); 17 | extern SEXP kronecker_shift(SEXP R, SEXP C, SEXP Rrows, SEXP Crows, SEXP V); 18 | extern SEXP kronecker_shiftEB_BM(SEXP R1, SEXP R2, SEXP C1, SEXP C2, SEXP beta, SEXP Rrows, SEXP Crows); 19 | extern SEXP kronecker_shiftEB_OU(SEXP R, SEXP C, SEXP beta, SEXP Rrows, SEXP Crows, SEXP V); 20 | extern SEXP kroneckerEB(SEXP R, SEXP C, SEXP beta, SEXP Rrows, SEXP Crows); 21 | extern SEXP kroneckerSpar_shift(SEXP R, SEXP C, SEXP Rrows, SEXP Crows, SEXP V, SEXP IA, SEXP JA, SEXP A); 22 | extern SEXP kroneckerSpar_shift_EB_BM(SEXP R1, SEXP R2, SEXP C1, SEXP C2, SEXP beta, SEXP Rrows, SEXP Crows, SEXP IA, SEXP JA, SEXP A); 23 | extern SEXP kroneckerSpar_shift_OU_EB(SEXP R, SEXP C, SEXP beta, SEXP Rrows, SEXP Crows, SEXP V, SEXP IA, SEXP JA, SEXP A); 24 | extern SEXP kroneckerSparEB(SEXP R, SEXP C, SEXP beta, SEXP Rrows, SEXP Crows, SEXP IA, SEXP JA, SEXP A); 25 | extern SEXP kroneckerSum(SEXP R, SEXP C, SEXP Rrows, SEXP Crows, SEXP dimlist); 26 | extern SEXP kroneckerSumSpar(SEXP R, SEXP C, SEXP Rrows, SEXP Crows, SEXP dimlist, SEXP IA, SEXP JA, SEXP A); 27 | extern SEXP mvmorph_covar_mat (SEXP nterm, SEXP bt,SEXP lambda, SEXP S, SEXP sigmasq, SEXP S1); 28 | extern SEXP mvmorph_covar_ou_fixed(SEXP A, SEXP alpha, SEXP sigma); 29 | extern SEXP mvmorph_covar_ou_random(SEXP A, SEXP alpha, SEXP sigma); 30 | extern SEXP mvmorph_covar_ou_rpf_fixed(SEXP A, SEXP alpha, SEXP sigma); 31 | extern SEXP mvmorph_covar_ou_rpf_random(SEXP A, SEXP alpha, SEXP sigma); 32 | extern SEXP mvmorph_covar_ou_sparse (SEXP A, SEXP JA, SEXP IA, SEXP nterm, SEXP bt,SEXP lambda, SEXP S, SEXP sigmasq, SEXP S1); 33 | extern SEXP mvmorph_weights (SEXP nterm, SEXP epochs, SEXP lambda, SEXP S, SEXP S1, SEXP beta, SEXP root); 34 | extern SEXP PIC_gen(SEXP x, SEXP n, SEXP Nnode, SEXP nsp, SEXP edge1, SEXP edge2, SEXP edgelength, SEXP times, SEXP rate, SEXP Tmax, SEXP Model, SEXP mu, SEXP sigma); 35 | extern SEXP seq_root2tipM(SEXP edge, SEXP nbtip, SEXP nbnode); 36 | extern SEXP simmap_covar (SEXP nterm, SEXP bt, SEXP lambda, SEXP S, SEXP S1, SEXP sigmasq); 37 | extern SEXP spherical(SEXP param, SEXP variance, SEXP dim); 38 | extern SEXP squareRootM(SEXP edge1, SEXP edge2, SEXP edgelength, SEXP nsp, SEXP inverse, SEXP normalized); 39 | extern SEXP times_root(SEXP brlength, SEXP edge1, SEXP edge2, SEXP ntip, SEXP Nnode); 40 | extern SEXP Weight_matrix(SEXP S1, SEXP S, SEXP lambda, SEXP time, SEXP matdiag); 41 | 42 | static const R_CallMethodDef CallEntries[] = { 43 | {"Chol_RPF", (DL_FUNC) &Chol_RPF, 7}, 44 | {"Chol_RPF_only", (DL_FUNC) &Chol_RPF_only, 4}, 45 | {"Chol_RPF_quadprod", (DL_FUNC) &Chol_RPF_quadprod, 3}, 46 | {"Chol_RPF_quadprod_column", (DL_FUNC) &Chol_RPF_quadprod_column, 3}, 47 | {"Chol_RPF_univ", (DL_FUNC) &Chol_RPF_univ, 7}, 48 | {"Chol_RPF_univ_only", (DL_FUNC) &Chol_RPF_univ_only, 4}, 49 | {"Expect_matrix", (DL_FUNC) &Expect_matrix, 7}, 50 | {"givens_ortho", (DL_FUNC) &givens_ortho, 3}, 51 | {"kronecker_mvmorph", (DL_FUNC) &kronecker_mvmorph, 4}, 52 | {"kronecker_shift", (DL_FUNC) &kronecker_shift, 5}, 53 | {"kronecker_shiftEB_BM", (DL_FUNC) &kronecker_shiftEB_BM, 7}, 54 | {"kronecker_shiftEB_OU", (DL_FUNC) &kronecker_shiftEB_OU, 6}, 55 | {"kroneckerEB", (DL_FUNC) &kroneckerEB, 5}, 56 | {"kroneckerSpar_shift", (DL_FUNC) &kroneckerSpar_shift, 8}, 57 | {"kroneckerSpar_shift_EB_BM", (DL_FUNC) &kroneckerSpar_shift_EB_BM, 10}, 58 | {"kroneckerSpar_shift_OU_EB", (DL_FUNC) &kroneckerSpar_shift_OU_EB, 9}, 59 | {"kroneckerSparEB", (DL_FUNC) &kroneckerSparEB, 8}, 60 | {"kroneckerSum", (DL_FUNC) &kroneckerSum, 5}, 61 | {"kroneckerSumSpar", (DL_FUNC) &kroneckerSumSpar, 8}, 62 | {"mvmorph_covar_mat", (DL_FUNC) &mvmorph_covar_mat, 6}, 63 | {"mvmorph_covar_ou_fixed", (DL_FUNC) &mvmorph_covar_ou_fixed, 3}, 64 | {"mvmorph_covar_ou_random", (DL_FUNC) &mvmorph_covar_ou_random, 3}, 65 | {"mvmorph_covar_ou_rpf_fixed", (DL_FUNC) &mvmorph_covar_ou_rpf_fixed, 3}, 66 | {"mvmorph_covar_ou_rpf_random", (DL_FUNC) &mvmorph_covar_ou_rpf_random, 3}, 67 | {"mvmorph_covar_ou_sparse", (DL_FUNC) &mvmorph_covar_ou_sparse, 9}, 68 | {"mvmorph_weights", (DL_FUNC) &mvmorph_weights, 7}, 69 | {"PIC_gen", (DL_FUNC) &PIC_gen, 13}, 70 | {"seq_root2tipM", (DL_FUNC) &seq_root2tipM, 3}, 71 | {"simmap_covar", (DL_FUNC) &simmap_covar, 6}, 72 | {"spherical", (DL_FUNC) &spherical, 3}, 73 | {"squareRootM", (DL_FUNC) &squareRootM, 6}, 74 | {"times_root", (DL_FUNC) ×_root, 5}, 75 | {"Weight_matrix", (DL_FUNC) &Weight_matrix, 5}, 76 | {NULL, NULL, 0} 77 | }; 78 | 79 | void R_init_mvMORPH(DllInfo *dll) 80 | { 81 | R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); 82 | R_useDynamicSymbols(dll, FALSE); 83 | } 84 | -------------------------------------------------------------------------------- /src/mvmorph_ou_mat_rpf.c: -------------------------------------------------------------------------------- 1 | /*-----------Matrice de covariance pour un processus Ornstein-Uhlenbeck-------------------------*/ 2 | /*--Matrice stockée au format RPF "column major order" (Fortran Lapack)-------------------------*/ 3 | /*-- moins de boucles et calcul plus rapide?----------------------------------------------------*/ 4 | /*-mvMORPH 1.0.3 - 2014 - Julien Clavel - julien.clavel@hotmail.fr/julien.clavel@univ-lyon1.fr--*/ 5 | #include "mvmorph.h" 6 | 7 | // Fixed root covariance matrix 8 | static void mvmorph_covar_OU_RPF_fixed(int *na, double *A, double *ARF, double *alpha, double *sigma){ 9 | int i, j, ij, i1, i2, i3, l, n1, nx2, nt, mod, np1x2, n; 10 | double T, sij, ti, tj, tjj, temp, var; 11 | // Paramètres 12 | n = *na; 13 | nt = (1 + n)*n/2; //nbr d'elements dans le format "packed" 14 | mod = n%2; 15 | 16 | var=sigma[0]/(2.0*alpha[0]); 17 | 18 | // taille de la matrice A, N est pair 19 | if(mod == 0){ 20 | // Params 21 | n1 = n / 2; 22 | np1x2 = n + n + 2; 23 | ij = nt - n - 1; 24 | i1 = n1; 25 | 26 | for (j = n - 1; j >= i1; --j) { 27 | i2 = j; 28 | tjj = A[j + j * n]; 29 | 30 | for (i = 0; i <= i2; ++i) { 31 | sij = A[i + j * n]; 32 | tj = tjj - sij; 33 | ti = A[i + i * n] - sij; 34 | T=ti+tj; 35 | temp = (1-exp(-2.0*alpha[0]*sij))*exp(-1.0*alpha[0]*T); 36 | ARF[ij] = temp * var; 37 | ++ij; 38 | } 39 | 40 | i2 = n1 - 1; 41 | i3 = j - n1; 42 | tjj = A[i3 + i3 * n]; 43 | 44 | for (l = j - n1; l <= i2; ++l) { 45 | sij = A[i3 + l * n]; 46 | ti = A[l + l * n] - sij; 47 | tj = tjj - sij; 48 | T=ti+tj; 49 | temp = (1-exp(-2.0*alpha[0]*sij))*exp(-1.0*alpha[0]*T); 50 | ARF[ij] = temp * var; 51 | ++ij; 52 | } 53 | ij -= np1x2; 54 | }// End for j 55 | 56 | 57 | // taille de la matrice A, N impair 58 | }else{ 59 | // Parameters 60 | nx2 = n + n; 61 | n1 = n / 2; // division par un entier (dimension du triangle) 62 | ij = nt - n; 63 | i1 = n1; 64 | 65 | 66 | for (j = n - 1; j >= i1; --j) { 67 | i2 = j; 68 | tjj = A[j + j * n]; 69 | 70 | for (i = 0; i <= i2; ++i) { 71 | sij = A[i + j * n]; 72 | tj = tjj - sij; 73 | ti = A[i + i * n] - sij; 74 | T=ti+tj; 75 | temp = (1-exp(-2.0*alpha[0]*sij))*exp(-1.0*alpha[0]*T); 76 | ARF[ij] = temp * var; 77 | ++ij; 78 | } 79 | i2 = n1 - 1; 80 | i3 = j - n1; 81 | tjj = A[i3 + i3 * n]; 82 | 83 | for (l = j - n1; l <= i2; ++l) { 84 | sij = A[i3 + l * n]; 85 | ti = A[l + l * n] - sij; 86 | tj = tjj - sij; 87 | T=ti+tj; 88 | temp = (1-exp(-2.0*alpha[0]*sij))*exp(-1.0*alpha[0]*T); 89 | ARF[ij] = temp * var; 90 | ++ij; 91 | } 92 | ij -= nx2; 93 | } 94 | }// End else 95 | }// End void 96 | 97 | // Random root covariance matrix 98 | static void mvmorph_covar_OU_RPF_random(int *na, double *A, double *ARF, double *alpha, double *sigma){ 99 | int i, j, ij, i1, i2, i3, l, n1, nx2, nt, mod, np1x2, n; 100 | double T, sij, ti, tj, tjj, var; 101 | // Paramètres 102 | n = *na; 103 | nt = (1 + n)*n/2; //nbr d'elements dans le format "packed" 104 | mod = n%2; 105 | 106 | var=sigma[0]/(2.0*alpha[0]); 107 | 108 | // taille de la matrice A, N est pair 109 | if(mod == 0){ 110 | // Params 111 | n1 = n / 2; 112 | np1x2 = n + n + 2; 113 | ij = nt - n - 1; 114 | i1 = n1; 115 | 116 | for (j = n - 1; j >= i1; --j) { 117 | i2 = j; 118 | tjj = A[j + j * n]; 119 | 120 | for (i = 0; i <= i2; ++i) { 121 | sij = A[i + j * n]; 122 | tj = tjj - sij; 123 | ti = A[i + i * n] - sij; 124 | T=ti+tj; 125 | ARF[ij] = exp(-1.0*alpha[0]*T) * var; 126 | ++ij; 127 | } 128 | 129 | i2 = n1 - 1; 130 | i3 = j - n1; 131 | tjj = A[i3 + i3 * n]; 132 | 133 | for (l = j - n1; l <= i2; ++l) { 134 | sij = A[i3 + l * n]; 135 | ti = A[l + l * n] - sij; 136 | tj = tjj - sij; 137 | T=ti+tj; 138 | ARF[ij] = exp(-1.0*alpha[0]*T) * var; 139 | ++ij; 140 | } 141 | ij -= np1x2; 142 | }// End for j 143 | 144 | 145 | // taille de la matrice A, N impair 146 | }else{ 147 | // Parameters 148 | nx2 = n + n; 149 | n1 = n / 2; // division par un entier (dimension du triangle) 150 | ij = nt - n; 151 | i1 = n1; 152 | 153 | 154 | for (j = n - 1; j >= i1; --j) { 155 | i2 = j; 156 | tjj = A[j + j * n]; 157 | 158 | for (i = 0; i <= i2; ++i) { 159 | sij = A[i + j * n]; 160 | tj = tjj - sij; 161 | ti = A[i + i * n] - sij; 162 | T=ti+tj; 163 | ARF[ij] = exp(-1.0*alpha[0]*T) * var; 164 | ++ij; 165 | } 166 | i2 = n1 - 1; 167 | i3 = j - n1; 168 | tjj = A[i3 + i3 * n]; 169 | 170 | for (l = j - n1; l <= i2; ++l) { 171 | sij = A[i3 + l * n]; 172 | ti = A[l + l * n] - sij; 173 | tj = tjj - sij; 174 | T=ti+tj; 175 | ARF[ij] = exp(-1.0*alpha[0]*T) * var; 176 | ++ij; 177 | } 178 | ij -= nx2; 179 | } 180 | }// End else 181 | }// End void 182 | 183 | // Use random or fixed root covariance matrix in RPF format 184 | SEXP mvmorph_covar_ou_rpf_fixed(SEXP A, SEXP alpha, SEXP sigma) { 185 | int na; 186 | PROTECT(coerceVector(A,REALSXP)); 187 | na=INTEGER(GET_DIM(A))[0]; 188 | SEXP ARF; 189 | PROTECT(ARF = allocVector(REALSXP,(na+1)*na/2)); 190 | mvmorph_covar_OU_RPF_fixed(&na,REAL(A),REAL(ARF),REAL(alpha), REAL(sigma)); 191 | UNPROTECT(2); 192 | return ARF; 193 | } 194 | 195 | SEXP mvmorph_covar_ou_rpf_random(SEXP A, SEXP alpha, SEXP sigma) { 196 | int na; 197 | PROTECT(coerceVector(A,REALSXP)); 198 | na=INTEGER(GET_DIM(A))[0]; 199 | SEXP ARF; 200 | PROTECT(ARF = allocVector(REALSXP,(na+1)*na/2)); 201 | mvmorph_covar_OU_RPF_random(&na,REAL(A),REAL(ARF),REAL(alpha), REAL(sigma)); 202 | UNPROTECT(2); 203 | return ARF; 204 | } 205 | 206 | -------------------------------------------------------------------------------- /src/covar-matrix-simmap.c: -------------------------------------------------------------------------------- 1 | /*-Matrice de covariance pour un processus Ornstein-Uhlenbeck multivarie-version-OUCH-*/ 2 | /*-mvMORPH 1.0.2 - 2014 - Julien Clavel - julien.clavel@hotmail.fr--------------------*/ 3 | /*-modified version of the covar-matrix.c code from OUCH package----------------------*/ 4 | #include "covar.h" 5 | 6 | 7 | // stationary covariance for Complex eigenvalues 8 | static void simmap_covar_matrix_complex (int *nchar, 9 | double *bt, 10 | Rcomplex *lambda_val, 11 | Rcomplex *S_val, 12 | Rcomplex *S1_val, 13 | double *sigmasq, 14 | int *nterm, 15 | double *V) { 16 | 17 | 18 | // complex version 19 | double complex *eltj, *elti, *W, *U, *tmp1, *lambda, *S, *S1; 20 | double sij, ti, tj, tmp2; 21 | int n = *nchar, nt = *nterm; 22 | int i, j, k, l, r, s; 23 | 24 | // alloc complex vectors 25 | U = calloc(n*n,sizeof(double complex)); 26 | W = calloc(n*n,sizeof(double complex)); 27 | tmp1 = calloc(n*n,sizeof(double complex) ); 28 | eltj = calloc(n,sizeof(double complex) ); 29 | elti = calloc(n,sizeof(double complex) ); 30 | S = calloc(n*n,sizeof(double complex) ); 31 | S1 = calloc(n*n,sizeof(double complex) ); 32 | lambda = calloc(n,sizeof(double complex) ); 33 | 34 | //zeroing vectors & transform to C complex structure 35 | for(i = 0; i 0) error("the leading minor of order %d is not positive definite",info); 109 | error("argument %d of Lapack routine %s had invalid value",-info, "dpftrf"); 110 | } 111 | // systeme lineaire U'x=D 112 | F77_CALL(dtfsm)(&norm, &side, &up, &trans, &diag, &n, &nt, &alpha, REAL(A), REAL(DD), &n FCONE FCONE FCONE FCONE FCONE); 113 | // systeme lineaire U'x=dat 114 | F77_CALL(dtfsm)(&norm, &side, &up, &trans, &diag, &n, &one, &alpha, REAL(A), REAL(Ddat), &n FCONE FCONE FCONE FCONE FCONE); 115 | 116 | // Calcul du determinant 117 | determinant(REAL(det),REAL(A),&n); 118 | 119 | // Liste: determinant, cholesky, X 120 | SEXP vec = PROTECT(allocVector(VECSXP, 4)); 121 | SET_VECTOR_ELT(vec, 0, A); 122 | SET_VECTOR_ELT(vec, 1, det); 123 | SET_VECTOR_ELT(vec, 2, DD); 124 | SET_VECTOR_ELT(vec, 3, Ddat); 125 | 126 | UNPROTECT (6); 127 | return (vec); 128 | } 129 | 130 | 131 | // Factorisation de Cholesky RPF 132 | SEXP Chol_RPF_univ_only(SEXP A, SEXP ndimA, SEXP mserr, SEXP ismserr){ 133 | int n, info = 0, err; 134 | char up = 'U', norm = 'N'; 135 | 136 | n = INTEGER(ndimA)[0]; 137 | err = INTEGER(ismserr)[0]; 138 | PROTECT(A = coerceVector(A,REALSXP)); 139 | PROTECT(mserr = coerceVector(mserr,REALSXP)); 140 | SEXP det = PROTECT(allocVector(REALSXP,1)); 141 | 142 | // add measurement error 143 | if(err==1){ 144 | ms_error(REAL(A),REAL(mserr), &n); 145 | } 146 | 147 | // decomposition de Cholesky 148 | F77_CALL(dpftrf)(&norm,&up,&n, REAL(A),&info FCONE FCONE); 149 | if (info != 0) { 150 | if (info > 0) error("the leading minor of order %d is not positive definite",info); 151 | error("argument %d of Lapack routine %s had invalid value",-info, "dpftrf"); 152 | } 153 | 154 | // Calcul du determinant 155 | determinant(REAL(det),REAL(A),&n); 156 | 157 | // Liste: determinant, cholesky, X 158 | SEXP vec = PROTECT(allocVector(VECSXP, 2)); 159 | SET_VECTOR_ELT(vec, 0, A); 160 | SET_VECTOR_ELT(vec, 1, det); 161 | 162 | UNPROTECT (4); 163 | return (vec); 164 | } 165 | 166 | 167 | // function to compute the quadratic product 168 | SEXP Chol_RPF_quadprod_column(SEXP U, SEXP resid, SEXP nterm){ 169 | int n, info = 0, one = 1; 170 | double alpha = 1.; 171 | const char up = 'U', trans = 'T', diag = 'N', side = 'L', norm = 'N'; 172 | n = INTEGER(nterm)[0]; 173 | PROTECT(U = coerceVector(U,REALSXP)); 174 | SEXP Ddat = PROTECT(isReal(resid) ? duplicate(resid): coerceVector(resid, REALSXP)); 175 | SEXP Bet = PROTECT(allocVector(REALSXP,1)); 176 | double *beta = REAL(Bet), *data = REAL(Ddat), *chol = REAL(U); 177 | // systeme lineaire U'x=dat 178 | F77_CALL(dtfsm)(&norm, &side, &up, &trans, &diag, &n, &one, &alpha, chol, data, &n FCONE FCONE FCONE FCONE FCONE); 179 | if (info != 0){ 180 | error("the %d argument had an illegal value",info); 181 | } 182 | 183 | // initialize 184 | beta[0]=0; 185 | int i = 0, round = down(n,4); 186 | // loop unrolling 187 | for(; i1). 65 | %% ~Describe the value returned 66 | %% If it is a LIST, use 67 | %% \item{comp1 }{Description of 'comp1'} 68 | %% \item{comp2 }{Description of 'comp2'} 69 | %% ... 70 | } 71 | \references{ 72 | Paradis E. 2012. Analysis of Phylogenetics and Evolution with R. New York: Springer. 73 | 74 | %% ~put references to the literature/web site here ~ 75 | } 76 | \author{ 77 | Julien Clavel 78 | %% ~~who you are~~ 79 | } 80 | \note{ 81 | Ancestral states for Ornstein-Uhlenbeck processes (param$root=TRUE) should be used with non-ultrametric trees. 82 | As this method uses Multivariate Normal distribution (MVN) for simulating the traits, it is advised to avoid its use with very large datasets/trees and rely instead on recursive algorithms (see, e.g., ?rTraitCont from "ape"). 83 | %% ~~further notes~~ 84 | } 85 | 86 | %% ~Make other sections like Warning with \section{Warning }{....} ~ 87 | 88 | \seealso{ 89 | \code{\link{mvMORPH}} 90 | \code{\link{mvgls}} 91 | \code{\link{mvOU}} 92 | \code{\link{mvEB}} 93 | \code{\link{mvBM}} 94 | \code{\link{mvSHIFT}} 95 | \code{\link{mvRWTS}} 96 | \code{\link{mvOUTS}} 97 | \code{\link{mvLL}} 98 | %% ~~objects to See Also as \code{\link{help}}, ~~~ 99 | } 100 | \examples{ 101 | 102 | ## Simulated dataset 103 | set.seed(14) 104 | # Generating a random tree with 50 species 105 | tree<-pbtree(n=50) 106 | 107 | # Setting the regime states of tip species 108 | sta<-as.vector(c(rep("Forest",20),rep("Savannah",30))); names(sta)<-tree$tip.label 109 | 110 | # Making the simmap tree with mapped states 111 | tree<-make.simmap(tree,sta , model="ER", nsim=1) 112 | col<-c("blue","orange"); names(col)<-c("Forest","Savannah") 113 | 114 | # Plot of the phylogeny for illustration 115 | plotSimmap(tree,col,fsize=0.6,node.numbers=FALSE,lwd=3, pts=FALSE) 116 | 117 | ## Simulate trait evolution according to a bivariate "BMM" model 118 | # Number of traits 119 | ntraits<-2 120 | # Number of simulated (pairs of) traits 121 | nsim<-10 122 | # Rates matrices for the "Forest" and the "Savannah" regimes 123 | sigma<-list(Forest=matrix(c(2,0.5,0.5,1),2), Savannah=matrix(c(5,3,3,4),2)) 124 | # ancestral states for each traits 125 | theta<-c(0,0) 126 | 127 | # Simulate 128 | simul<-mvSIM(tree,nsim=nsim, model="BMM",param=list(ntraits=ntraits,sigma=sigma,theta=theta)) 129 | 130 | # Try to fit a "BM1" model to the first simulated dataset 131 | model_fit<-mvBM(tree,simul[[1]],model="BM1") 132 | 133 | # Use the estimated parameters to simulate new traits! 134 | simul2<-mvSIM(tree,nsim=nsim,param=model_fit) 135 | 136 | # or try with generic "simulate" function 137 | simul3<-simulate(model_fit,nsim=nsim,tree=tree) 138 | 139 | ## Just-for-fun :Comparing parameters 140 | \donttest{ 141 | simul4<-simulate(model_fit,nsim=100,tree=tree) 142 | 143 | results<-lapply(simul4,function(x){ 144 | mvBM(tree,x,model="BM1",method="pic", echo=FALSE,diagnostic=FALSE) 145 | }) 146 | 147 | sigma_simul<-sapply(results,function(x){x$sigma}) 148 | 149 | # comparison between the simulated (black) and the observed (red) multivariate rates 150 | layout(matrix(1:4, ncol=2)) 151 | for(i in 1:4){ 152 | hist(sigma_simul[i,], main=paste("Estimated sigma on simulated traits"), 153 | xlab="estimated sigma for 100 replicates");abline(v=mean(sigma_simul[i,]),lwd=2); 154 | abline(v=model_fit$sigma[i],col="red",lwd=2) 155 | } 156 | } 157 | } 158 | 159 | % Add one or more standard keywords, see file 'KEYWORDS' in the 160 | % R documentation directory. 161 | \keyword{ simulate traits } 162 | \keyword{ mvmorph object }% __ONLY ONE__ keyword per line 163 | -------------------------------------------------------------------------------- /src/sqrtMat.c: -------------------------------------------------------------------------------- 1 | // Prunning algorithm to compute the matrix square root of a phylogenetic tree covariance 2 | // See details in Stone 2011 - Syst. Biol.; and also Khabbazian et al. 2016 - Meth. Ecol. Evol. 3 | // Julien Clavel - 2017; clavel@biologie.ens.fr 4 | // NOTE : we need the transpose of D to decorrelate the traits 5 | // Return the matrix square root, the variance at the root, and variance at each nodes 6 | 7 | #include 8 | #include 9 | 10 | static void phylo_squareRoot(const int *nsp, const int *edge1, const int *edge2, double *tempbl, double *F, double *D, double *var_prun, double *root_v, double *V, int *invMat, int *normIC){ 11 | int i, j, k, l, f, anc, da, d1, d2, ntip, indice; 12 | double sumbl, tfinal, t1=0., t2=0.; 13 | 14 | ntip=*nsp; 15 | indice = 0; // counter for the columns of D (the matrix square root) 16 | 17 | // Matrix square root = chol(C) 18 | if(*invMat==0){ 19 | 20 | for (i = 0; i < ntip * 2 - 3; i += 2) { 21 | /* 22 | ntip*2-3 is the dim of the edge list. Because we take j to be i+1, we must loop up to nedge-1 23 | D is ntip*ntip 24 | F is ntip*2-1*ntip; with first part of the structure a diagonal matrix of size ntip*ntip 25 | */ 26 | j = i + 1; 27 | 28 | anc = edge1[i]; // ancestor 29 | da = anc - 1; 30 | d1 = edge2[i] - 1; // first descent 31 | d2 = edge2[j] - 1; // 2nd descent 32 | t1 = tempbl[i]; // br length for d1 33 | t2 = tempbl[j]; // br length for d2 34 | sumbl = t1 + t2; // total br length 35 | var_prun[anc - ntip - 1] = sumbl; // variance of "contrasts" 36 | 37 | // update the matrix 38 | for(f=0; f\emph{n}. Models fit can be compared using the GIC or EIC criterion (see ?\code{GIC} and ?\code{EIC}) and hypothesis testing can be performed using the \code{manova.gls} function. 44 | 45 | 46 | The various \emph{arguments} that can be passed through \bold{"..."}: 47 | 48 | \bold{"penalty"} - The "penalty" argument allows specifying the type of penalization used for regularization (described in Clavel et al. 2019). The various penalizations are: \code{penalty="RidgeArch"} (the default), \code{penalty="RidgeAlt"} and \code{penalty="LASSO"}. The "RidgeArch" penalization shrink linearly the "sample"" covariance matrix toward a given target matrix with a specific structure (see below for \code{target}). This penalization is generally fast and the tuning parameter is bounded between 0 and 1 (see van Wieringen & Peeters 2016, Clavel et al. 2019). The "RidgeAlt" penalization scheme uses a quadratic ridge penalty to shrink the covariance matrix toward a specified target matrix (see \code{target} below and also see van Wieringen & Peeters 2016). Finally, the "LASSO" regularize the covariance matrix by estimating a sparse estimate of its inverse - the precision matrix (Friedman et al. 2008). Solving the LASSO penalization is computationally intensive. Moreover, this penalization scheme is not invariant to arbitrary rotations of the data. 49 | 50 | \bold{"target"} - This argument allows specifying the target matrix toward which the covariance matrix is shrunk for "Ridge" penalties. \code{target="unitVariance"} (for a diagonal target matrix proportional to the identity) and \code{target="Variance"} (for a diagonal matrix with unequal variance) can be used with both "RidgeArch" and "RidgeAlt" penalties. \code{target="null"} (a null target matrix) is only available for "RidgeAlt". Penalization with the "Variance" target shrinks the eigenvectors of the covariance matrix and is therefore not rotation invariant. See details on the various target properties in Clavel et al. (2019). 51 | 52 | \bold{"weights"} - A (named) vector of weights (variances) for all the observations. If provided, a weighted least squares (WLS) rather than OLS fit is performed. 53 | 54 | \bold{"echo"} - Whether the results must be returned or not. 55 | 56 | \bold{"grid_search"} - A logical indicating whether or not a preliminary grid search must be performed to find the best starting values for optimizing the log-likelihood (or penalized log-likelihood). User-specified starting values can be provided through the \bold{start} argument. Default is \code{TRUE}. 57 | 58 | \bold{"tol"} - Minimum value for the regularization parameter. Singularities can occur with a zero value in high-dimensional cases. (default is \code{NULL}) 59 | 60 | 61 | %% ~~ If necessary, more details than the description above ~~ 62 | } 63 | 64 | \note{ 65 | This function is a wrapper to the \code{mvgls} function (it uses gls with a diagonal covariance). For these reasons, the function can be used with all the methods working with \code{mvgls} class objects. 66 | } 67 | 68 | 69 | \value{ 70 | 71 | An object of class '\code{mvols}'. It contains a list including the same components as the \code{mvgls} function (see ?mvgls). 72 | 73 | } 74 | \references{ 75 | 76 | Clavel, J., Aristide, L., Morlon, H., 2019. A Penalized Likelihood framework for high-dimensional phylogenetic comparative methods and an application to new-world monkeys brain evolution. Systematic Biology 68(1): 93-116. 77 | 78 | Clavel, J., Morlon, H. 2020. Reliable phylogenetic regressions for multivariate comparative data: illustration with the MANOVA and application to the effect of diet on mandible morphology in phyllostomid bats. Systematic Biology 69(5): 927-943. 79 | 80 | Friedman J., Hastie T., Tibshirani R. 2008. Sparse inverse covariance estimation with the graphical lasso. Biostatistics. 9:432-441. 81 | 82 | Hoffbeck J.P., Landgrebe D.A. 1996. Covariance matrix estimation and classification with limited training data. IEEE Trans. Pattern Anal. Mach. Intell. 18:763-767. 83 | 84 | Theiler J. 2012. The incredible shrinking covariance estimator. In: Automatic Target Recognition XXII. Proc. SPIE 8391, Baltimore, p. 83910P. 85 | 86 | van Wieringen W.N., Peeters C.F.W. 2016. Ridge estimation of inverse covariance matrices from high-dimensional data. Comput. Stat. Data Anal. 103:284-303. 87 | 88 | %% ~put references to the literature/web site here ~ 89 | } 90 | \author{ 91 | Julien Clavel 92 | %% ~~who you are~~ 93 | } 94 | 95 | 96 | %% ~Make other sections like Warning with \section{Warning }{....} ~ 97 | 98 | \seealso{ 99 | \code{\link{manova.gls}} 100 | \code{\link{mvgls}} 101 | \code{\link{EIC}} 102 | \code{\link{GIC}} 103 | \code{\link{mvgls.pca}} 104 | \code{\link{fitted.mvgls}} 105 | \code{\link{residuals.mvgls}} 106 | \code{\link{coef.mvgls}} 107 | \code{\link{vcov.mvgls}} 108 | \code{\link{predict.mvgls}} 109 | %% ~~objects to See Also as \code{\link{help}}, ~~~ 110 | } 111 | 112 | \examples{ 113 | \donttest{ 114 | set.seed(1) 115 | n <- 32 # number of species 116 | p <- 50 # number of traits (p>n) 117 | 118 | tree <- pbtree(n=n, scale=1) # phylogenetic tree 119 | R <- crossprod(matrix(runif(p*p), ncol=p)) # a random covariance matrix 120 | # simulate a BM dataset 121 | Y <- mvSIM(tree, model="BM1", nsim=1, param=list(sigma=R, theta=rep(0,p))) 122 | data=list(Y=Y) 123 | 124 | fit1 <- mvgls(Y~1, data=data, tree, model="BM", penalty="RidgeArch") 125 | 126 | # compare to OLS? 127 | fit2 <- mvols(Y~1, data=data, penalty="RidgeArch") 128 | 129 | GIC(fit1); GIC(fit2); 130 | 131 | ## Fit a model by Maximum Likelihood (rather than Penalized likelihood) when p<2 (Clavel et al. 2015). 76 | 77 | User-defined constraints can be specified through a numeric matrix (square and symmetric) with integer values taken as indices of the parameters. 78 | 79 | For instance, for three traits: 80 | 81 | \code{constraint=matrix(c(1, 3, 3, 3, 2, 3, 3, 3, 2), 3)}. 82 | 83 | Covariances constrained to be zero are introduced by NA values, e.g., 84 | 85 | \code{constraint=matrix(c(1, 4, 4, 4, 2, NA, 4, NA, 3), 3)}. 86 | 87 | Difference between two nested fitted models can be assessed using the "\code{LRT}" function. See example below and ?\code{LRT}. 88 | 89 | \bold{ "decomp"} - For the general case (unconstrained models), the sigma matrix is parameterized by various methods to ensure its positive definiteness (Pinheiro and Bates, 1996). These methods are the \code{"cholesky"}, \code{"eigen+"}, and \code{"spherical"} parameterizations. 90 | 91 | \bold{ "trend"} - Default set to FALSE. If TRUE, the ancestral state is allowed to drift leading to a directional random walk. Note that it is possible to provide a vector of integer indices to constraint the estimated trends when p>1 (see the vignettes). 92 | 93 | \bold{ "sigma"} - Starting values for the likelihood estimation. By default the trait covariances are used as starting values for the likelihood optimization. The user can specify starting values as square symmetric matrices or a simple vector of values for the upper factor of the sigma matrix. The parameterization is done using the factorization determined through the "decomp" argument (Pinheiro and Bates, 1996). Thus, you should provide p*(p+1)/2 values, with p the number of traits (e.g., random numbers or the values from the cholesky factor of a symmetric positive definite sigma matrix; see example below). If a constrained model is used, the number of starting values is (p*(p-1)/2)+1. 94 | 95 | 96 | %% ~~ If necessary, more details than the description above ~~ 97 | } 98 | \value{ 99 | \item{LogLik }{The log-likelihood of the optimal model.} 100 | \item{AIC }{Akaike Information Criterion for the optimal model.} 101 | \item{AICc }{Sample size-corrected AIC.} 102 | \item{theta }{Estimated ancestral states.} 103 | \item{sigma }{Evolutionary rate matrix for each selective regime.} 104 | \item{convergence }{Convergence status of the optimizing function; "0" indicates convergence (see ?optim for details).} 105 | \item{hess.values }{Reliability of the likelihood estimates calculated through the eigen-decomposition of the hessian matrix. "0" means that a reliable estimate has been reached (see ?mvOU).} 106 | \item{param }{List of model fit parameters (optimization, method, model, number of parameters...).} 107 | \item{llik }{The log-likelihood function evaluated in the model fit "$llik(par, root.mle=TRUE)".} 108 | %% ~Describe the value returned 109 | %% If it is a LIST, use 110 | %% \item{comp1 }{Description of 'comp1'} 111 | %% \item{comp2 }{Description of 'comp2'} 112 | %% ... 113 | } 114 | \references{ 115 | Adams D.C. 2013. Comparing evolutionary rates for different phenotypic traits on a phylogeny using likelihood. Syst. Biol. 62:181-192. 116 | 117 | Clavel J., Escarguel G., Merceron G. 2015. mvMORPH: an R package for fitting multivariate evolutionary models to morphometric data. Methods Ecol. Evol., 6(11):1311-1319. 118 | 119 | Hunt G. (2012). Measuring rates of phenotypic evolution and the inseparability of tempo and mode. Paleobiology, 38(3):351-373. 120 | 121 | Revell L.J. 2012. phytools: An R package for phylogenetic comparative biology (and other things). Methods Ecol. Evol. 3:217-223. 122 | 123 | %% ~put references to the literature/web site here ~ 124 | } 125 | \author{ 126 | Julien Clavel 127 | %% ~~who you are~~ 128 | } 129 | %% ~Make other sections like Warning with \section{Warning }{....} ~ 130 | 131 | \seealso{ 132 | \code{\link{mvMORPH}} 133 | \code{\link{mvOU}} 134 | \code{\link{mvEB}} 135 | \code{\link{mvSHIFT}} 136 | \code{\link{mvSIM}} 137 | \code{\link{mvOUTS}} 138 | \code{\link{LRT}} 139 | \code{\link{optim}} 140 | 141 | %% ~~objects to See Also as \code{\link{help}}, ~~~ 142 | } 143 | \examples{ 144 | set.seed(1) 145 | # Simulate the time series 146 | timeseries <- 0:49 147 | 148 | # Simulate the traits 149 | sigma <- matrix(c(0.01,0.005,0.005,0.01),2) 150 | theta <- c(0,1) 151 | error <- matrix(0,ncol=2,nrow=50);error[1,]=0.001 152 | data<-mvSIM(timeseries, error=error, 153 | param=list(sigma=sigma, theta=theta), model="RWTS", nsim=1) 154 | 155 | # plot the time series 156 | matplot(data, type="o", pch=1, xlab="Time (relative)") 157 | 158 | # model fit 159 | mvRWTS(timeseries, data, error=error, param=list(decomp="diagonal")) 160 | mvRWTS(timeseries, data, error=error, param=list(decomp="equal")) 161 | mvRWTS(timeseries, data, error=error, param=list(decomp="cholesky")) 162 | 163 | # Random walk with trend 164 | set.seed(1) 165 | trend <- c(0.02,0.02) 166 | data<-mvSIM(timeseries, error=error, 167 | param=list(sigma=sigma, theta=theta, trend=trend), model="RWTS", nsim=1) 168 | 169 | # plot the time serie 170 | matplot(data, type="o", pch=1, xlab="Time (relative)") 171 | 172 | # model fit 173 | mvRWTS(timeseries, data, error=error, param=list(trend=TRUE)) 174 | 175 | # we can specify a vector of indices 176 | mvRWTS(timeseries, data, error=error, param=list(trend=c(1,1))) 177 | 178 | }% Add one or more standard keywords, see file 'KEYWORDS' in the 179 | % R documentation directory. 180 | \keyword{ Brownian Motion } 181 | \keyword{ Random walk } 182 | \keyword{ Time series } 183 | \keyword{ Evolutionary rates } 184 | \keyword{ User defined constraints } 185 | \keyword{ Cholesky constraint }% __ONLY ONE__ keyword per line 186 | -------------------------------------------------------------------------------- /R/mvmorphPrecalc.r: -------------------------------------------------------------------------------- 1 | ################################################################################ 2 | ## ## 3 | ## mvMORPH: mv.precalc ## 4 | ## ## 5 | ## Created by Julien Clavel - 01-11-2014 ## 6 | ## (julien.clavel@hotmail.fr/ julien.clavel@biologie.ens.fr) ## 7 | ## require: phytools, ape, corpcor, subplex ## 8 | ## ## 9 | ################################################################################ 10 | 11 | mv.Precalc<-function(tree, nb.traits=1, scale.height=FALSE, param=list(pivot="MMD", method=c("sparse"), smean=TRUE, model="OUM")){ 12 | 13 | if(inherits(tree,"phylo") & inherits(tree,"multiPhylo")){ ## A MODIFIER??? 14 | stop("The tree is not a \"phylo\" object") 15 | } 16 | 17 | n<-length(tree$tip.label) 18 | #scale the tree 19 | if(scale.height==TRUE){ 20 | maxHeight<-max(nodeHeights(tree)) 21 | tree$edge.length<-tree$edge.length/maxHeight 22 | tree$mapped.edge<-tree$mapped.edge/maxHeight 23 | } 24 | #set data as a matrix if a vector is provided instead 25 | #if(!is.matrix(data)){data<-as.matrix(data)} 26 | #if(is.vector(data)){k<-1 }else{ k<-ncol(data)} 27 | p<-nb.traits 28 | #set tree order 29 | ind<-reorder.phylo(tree,order="postorder", index.only=TRUE) 30 | tree$edge<-tree$edge[ind,] 31 | tree$edge.length<-tree$edge.length[ind] 32 | 33 | 34 | #Is SIMMAP? 35 | if(!is.null(tree[["mapped.edge"]])){ 36 | tree$mapped.edge<-tree$mapped.edge[ind,] 37 | tree$maps<-tree$maps[ind] 38 | } 39 | 40 | #Method? 41 | if(is.null(param[["method"]])){ 42 | param$method="none" 43 | } 44 | 45 | if(param$method!="pic"){ 46 | #compute the variance-covariance matrix 47 | 48 | #if(model=="OUTS" | model=="RWTS"){ 49 | # C1<-vcvts(tree) 50 | #}else{ 51 | C1<-vcv.phylo(tree) 52 | #} 53 | 54 | 55 | 56 | if(!is.null(tree[["mapped.edge"]])){# & param[["model"]]!="OUM" & param[["model"]]!="OU1"){ 57 | #Build a list of VCV from SIMMAP trees 58 | multi.tre<-list() 59 | class(multi.tre)<-"multiPhylo" 60 | C2<-list() 61 | for(i in 1:ncol(tree$mapped.edge)){ 62 | multi.tre[[i]]<-tree 63 | multi.tre[[i]]$edge.length<-tree$mapped.edge[,i] 64 | multi.tre[[i]]$state<-colnames(tree$mapped.edge)[i] 65 | temp<-vcv.phylo(multi.tre[[i]]) 66 | # Should we provide the data object? 67 | # if(any(tree$tip.label==rownames(data))) { 68 | # C2[[i]]<-temp[rownames(data),rownames(data)] 69 | # }else{ 70 | C2[[i]]<-temp 71 | #} 72 | } 73 | }else{ 74 | C2<-NULL 75 | } 76 | 77 | #compute the design matrix 78 | if(is.null(param[["smean"]])==TRUE){ param$smean<-TRUE } 79 | D<-multD(tree,p,n,smean=param$smean) 80 | 81 | 82 | ##-----------------------Precalculate regime indexation-----------------------## 83 | if(!is.null(param[["model"]])){ 84 | 85 | # Pull (alpha) matrix decomposition 86 | if(is.null(param[["decomp"]])){ 87 | decomp<-param$decomp<-"cholesky" 88 | }else{ 89 | decomp<-param$decomp[1] 90 | } 91 | # option for computing the variance covariance matrix 92 | if(is.null(param[["vcv"]])==TRUE){ 93 | if(param$method=="sparse"){ 94 | vcvtype<-"sparse" 95 | }else{ 96 | if(is.ultrametric(tree)==TRUE){ 97 | vcvtype<-"randomRoot" 98 | }else{ 99 | vcvtype<-"fixedRoot" 100 | 101 | } 102 | } 103 | 104 | }else{ 105 | vcvtype<-param$vcv 106 | } 107 | 108 | if(vcvtype!="sparse" & param$method=="sparse"){ 109 | vcvtype<-"sparse" 110 | cat("Only \"sparse\" VCV could be used with the \"sparse\" method. See ?mvOU","\n") 111 | #method<-"sparse" 112 | } 113 | 114 | # root estimation 115 | if(is.null(param[["root"]])!=TRUE){ 116 | if(param[["root"]]==TRUE || param[["root"]]==FALSE || param[["root"]]=="stationary"){ 117 | root<-param$root 118 | }else{ 119 | stop("Only TRUE,FALSE or \"stationary\" are accepted for the \"root\" argument in \"param\"") 120 | } 121 | if(param[["root"]]=="stationary" & param$model=="OU1"){ 122 | root<-param$root<-FALSE 123 | } 124 | }else{ 125 | root<-TRUE 126 | } 127 | 128 | 129 | if(param$model=="OU1"){ 130 | k<-1 131 | }else{ 132 | k<-length(colnames(tree$mapped.edge)) 133 | } 134 | # root to tip lineage indexation 135 | root2tip <- .Call(seq_root2tipM, tree$edge, n, tree$Nnode) 136 | # Si OU1 sur un objet 'phylo' 137 | if(param$model=="OU1"){ 138 | 139 | valLineage<-sapply(1:n,function(z){rev(unlist( 140 | sapply(1:(length(root2tip[[z]])-1),function(x){vec<-root2tip[[z]][x:(x+1)]; val<-which(tree$edge[,1]==vec[1] & tree$edge[,2]==vec[2]); tree$edge.length[val]<-tree$edge.length[val]},simplify=FALSE))) 141 | } ,simplify=FALSE) 142 | 143 | }else{ 144 | # Donnees de temps par regimes et par branches 145 | 146 | valLineage<-sapply(1:n,function(z){rev(unlist( 147 | sapply(1:(length(root2tip[[z]])-1),function(x){vec<-root2tip[[z]][x:(x+1)]; val<-which(tree$edge[,1]==vec[1] & tree$edge[,2]==vec[2]); tree$maps[[val]]<-tree$maps[[val]]},simplify=FALSE))) 148 | } ,simplify=FALSE) 149 | 150 | } 151 | 152 | # Indexer les regimes 153 | if(param$model=="OUM"){ 154 | if(root==FALSE | root=="stationary"){ 155 | facInd<-factor(colnames(tree$mapped.edge)) 156 | }else if(root==TRUE){ 157 | facInd<-factor(c("_root_state",colnames(tree$mapped.edge))) 158 | } 159 | 160 | indice<-lapply(1:n,function(z){rev(unlist(lapply(1:(length(root2tip[[z]])-1),function(x){vec<-root2tip[[z]][x:(x+1)]; val<-which(tree$edge[,1]==vec[1] & tree$edge[,2]==vec[2]); factor(names(tree$maps[[val]]),levels=facInd)})))}) 161 | 162 | }else if(param$model=="OU1"){ 163 | if(root==TRUE){ 164 | facInd<-factor(c("_root_state","theta_1")) 165 | indice<-lapply(1:n,function(z){ as.factor(rep(facInd[facInd=="theta_1"],length(valLineage[[z]])))}) 166 | }else{ 167 | indice<-lapply(1:n,function(z){ as.factor(rep(1,length(valLineage[[z]])))}) 168 | } 169 | } 170 | # Liste avec dummy matrix 171 | if(root==FALSE){ 172 | indiceA<-indiceReg(n,indice, facInd, FALSE) 173 | mod_stand<-0 # the root is not provided nor assumed to be one of the selected regimes, so we rowstandardize (could be optional) 174 | }else if(root==TRUE){ 175 | indiceA<-indiceReg(n,indice, facInd, TRUE) 176 | k<-k+1 177 | mod_stand<-0 178 | }else if(root=="stationary"){ 179 | indiceA<-indiceReg(n,indice, facInd, FALSE) 180 | mod_stand<-1 181 | } 182 | 183 | 184 | listReg<-sapply(1:n,function(x){sapply(1:p,function(db){regimeList(indiceA[[x]],k=k,root)},simplify=FALSE)},simplify=FALSE) 185 | # mapped epochs 186 | epochs<-sapply(1:n,function(x){lineage<-as.numeric(c(cumsum(valLineage[[x]])[length(valLineage[[x]])],(cumsum(valLineage[[x]])[length(valLineage[[x]])]-cumsum(valLineage[[x]])))); lineage[which(abs(lineage)<1e-15)]<-0; lineage },simplify=FALSE) 187 | 188 | }else{ 189 | listReg<-NULL 190 | epochs<-NULL 191 | } 192 | }else{ 193 | listReg<-NULL 194 | epochs<-NULL 195 | C1<-NULL 196 | C2<-NULL 197 | model<-"none" 198 | }# end if pic 199 | ##-----------------------Precalculate sparse method-----------------------## 200 | if(param$method=="sparse"){ 201 | #require(spam) 202 | # Temporary multivariate VCV 203 | V<-kronecker((matrix(1,p,p)+diag(p)), C1) 204 | 205 | # Check for missing cases? need to provides the data 206 | #if(any(is.na(data))){ 207 | # Indice_NA<-which(is.na(as.vector(data))) 208 | # V<-V[-Indice_NA,-Indice_NA] 209 | # } 210 | 211 | # spam object 212 | V1<-as.spam(V); 213 | # precal the cholesky 214 | if(is.null(param[["pivot"]])){pivot<-"MMD"}else{pivot<-param$pivot} 215 | ch<-chol(V1,pivot=pivot) 216 | # Yale Sparse Format indices 217 | JAr<-V1@colindices-1 218 | IAr<-V1@rowpointers-1 219 | ldv<-dim(V)[1] 220 | resume<-(length(JAr)*100)/(ldv*ldv) 221 | cat("The density of the matrix is:",resume,"%","\n") 222 | }else{ 223 | JAr<-NULL 224 | IAr<-NULL 225 | ch<-NULL 226 | V1<-NULL 227 | } 228 | ##------------------param results---------------------------------------------## 229 | param$root<-root 230 | param$nbtraits<-nb.traits 231 | ##------------------List results----------------------------------------------## 232 | 233 | results<-list(tree=tree,ch=ch, V=V1, JAr=JAr, IAr=IAr, C1=C1, C2=C2, D=D, listReg=listReg, epochs=epochs, model=param$model, param=param) 234 | class(results)<-"mvmorph.precalc" 235 | invisible(results) 236 | } 237 | --------------------------------------------------------------------------------