---
title: "Analyzing rates of evolution"
author: "Geir H. Bolstad"
date: "`r Sys.Date()`"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Analyzing rates of evolution}
  %\VignetteEncoding{UTF-8}
  %\VignetteEngine{knitr::rmarkdown}
editor_options: 
  chunk_output_type: console
---

```{r setup, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  eval = TRUE 
)
library(evolvability)
```

This vignette shows how to analyze rates of evolution using the comparative methods implemented in `evolvability::rate_gls`. The function `rate_gls` can fit three different types of evolutionary models depending on its `model` argument. In all three models the evolutionary rate of change in the y-variable is a function of the state of the predictor x. These models can be used to test hypotheses about the effect of an evolving trait (x) on the rate of evolution in a different trait (y). The different evolutionary models outlined below are described in detail in Hansen TF, Bolstad GH, Tsuboi M. 2021. Analyzing disparity and rates of morphological evolution with model-based phylogenetic comparative methods. *Systematic Biology*. syab079. 

Note that sample sizes and number of simulations below are kept small in the interest of computational speed. With small sample sizes the parameter estimates will be inaccurate, and when performing a bootstrap in a real analysis the number of simulations is typically 1000. Hence, the below examples are only for explaining the functionality in the `evolvability` package.
  
To simulate data for the different evolutionary models, we first need an ultrametric phylogeny. Here we generate a random phylogeny using the `ape` package. In a real data analysis, you would use a molecular phylogeny of the species in your data set. 

```{r}
set.seed(999)
tree <- ape::rtree(n = 20)
tree <- ape::chronopl(tree, lambda = 1, age.min = 2)
```

Checking whether the phylogeny is ultrametric:

```{r, eval=TRUE}
ape::is.ultrametric(tree)
```

We scale the phylogeny to unit length between root and tips. This makes the parameters easier to interpret. (In our simulation this could also have been accomplished by setting `age.min = 1` in `chronopl`). 

```{r, eval=TRUE}
tree$edge.length <- tree$edge.length/diag(ape::vcv(tree))[1]
```

```{r, eval = TRUE}
plot(tree)
```

# Predictor as Brownian motion 
The first model is a model where the predictor $x$ evolves according to a Brownian motion (BM) process, while $y$ follows a Brownian motion with variance that is linear in $x$. This is referred to as model 1 in Hansen et al. (2021). The evolutionary model is 

$$dy = \sqrt{a + bx} dW_1 $$

$$dx = \sigma dW_2 $$

where $a$ is the evolutionary rate of $y$ at $x=0$, $b$ captures the influence of $x$ on the evolutionary rate, and the $dW_i$ are two uncorrelated white noise processes. This model will break down when $a + bx$ becomes negative and should be seen as an approximation that may be valid for a given range of $x$ values as spanned by the species to be used in the analysis.  
  
Using the function `simulate_rate` with `model = "predictor_BM"` we can simulate data at the tips of the phylogeny according to this model:  

```{r}
sim_data <- simulate_rate(tree, startv_x=0, sigma_x=0.25, a=1, b=1, model = "predictor_BM")
```

In our simulation we have chosen the starting value (root value) of x as $0$ (`startv_x=0`) and the parameter $a$ is set to $1$ (`a=1`). This means that, the evolutionary rate of $y$ at the root is $1$. The $b$ parameter is also set to $1$ in the simulation (`b=1`). Hence, points along the phylogeny where $x$ evolves to take the value $0.5$, the rate for $y$ is given by $\sqrt{a + bx} = \sqrt{1 + 0.5} = 1.22$, while points along the phylogeny where $x$ evolves to take the value $-0.5$, the rate of $y$ is given by $\sqrt{1 - 0.5} = 0.71$. For $x$, the rate of evolution, $\sigma$, is constant across the whole phylogeny, and set to `sigma_x=0.25` in the simulations.  

The simulation gives a warning message if $a + bx$ becomes negative in parts of the tree. In these instances, the rate parameter of $y$, $\sqrt{a + bx}$, is assigned the value $0$ in the simulation. As long as the number of these instances is low, this should not pose a problem. We can plot the evolution of the rate of $y$ (i.e. $\sqrt{a + bx}$), as well as the values of $y$ and $x$ using the inbuilt `plot.simulate_rate` function: 

```{r, fig.width=7}
par(mfrow = c(1,3))
plot(sim_data) # defaults to response = "rate_y" 
plot(sim_data, response = "y")
plot(sim_data, response = "x")
```

As shown in the above figure, the simulation is discrete and done over 1000 time steps. The $y$ and $x$ values at the tips are stored as a data frame in `sim_data$tips`.

```{r}
d <- sim_data$tips
head(d)
```

We can now fit the GLS (generalized least squares) model to these data and their phylogeny: 

```{r}
gls_mod <- rate_gls(x=d$x, y=d$y, species=d$species, tree, 
                    model = "predictor_BM", silent = TRUE)
round(gls_mod$param, 3)
```

This output gives the GLS estimates of the parameters of the evolutionary model (`sigma(x)^2` is the squared $\sigma$). Because of the low sample size, the estimates of the parameters diverges quite a lot from their true values (the input of the simulation). Note that the analytic standard error of $a$ and $b$ (shown in the `SE` column) does not take into account the error in $\sigma^2$. Parametric bootstrapping can be used to get 95% confidence intervals taking into account error in the entire process. In the bootstrap, warning messages are given if $a + bx$ becomes negative in the simulations. Again, as long as the number of these instances is low, this should not be a problem. However, as the number of negative roots increases in the simulations, the biological model underlying the bootstrap will increasingly differ from the biological model underlying the GLS and the two will start to deviate in their parameter estimates due to this.

```{r}
bootout <- rate_gls_boot(gls_mod, n = 5, silent = TRUE)
```

The bootstrap output, below, gives the GLS estimates (`Estimate`) and its analytic standard errors (`SE`) in the first two columns followed by the mean, the median and the standard deviation (`boot_SD`) of the bootstrap distribution for each parameter, followed by the 2.5\% and the 97.7\% quantiles. The bootstrap standard deviation is an estimate of the standard error of the parameter. Note that number of bootstrap samples, `n`, must be much larger to give reliable estimates.  

```{r}
round(bootout$summary, 3)
```

Using the customized plotting function `plot.rate_gls` we can investigate the model fit. Having $y^2$ on the y-axis, we can visualize how the variance of $y$ is changing with $x$. The estimates of $a$ and $b$ are printed in the plot. However because the plot is for illustrating the fit of the model to the data, and the intercept of the regression line is not equal to $a$, but  the intercept as defined in equation 3 in Hansen et al. 2021 (stored as the first element in `gls_mod$Beta`). The intercept of the plotted line includes components of variance in $y$ arising from estimation error, which are controlled for in the estimation of $a$. The slope of the regression, however, is the parameter $b$, as the plotted x-variable is transformed (see below).

```{r, fig.height=5, fig.width=5}
plot(gls_mod, scale = "VAR", ylab = expression(y^2), xlab = "x*")
```
      
Alternatively, we can plot the regression with $|y|=\sqrt{y^2}$ on the y-axis to visualize how the standard deviation of $y$ is changing with $x$. This is the default of the plot function. 

```{r, fig.height=5, fig.width=5}
plot(gls_mod, ylab = "|y|", xlab = "x*") # with the default: scale = "SD"
```

Note that the predictor $x^*$ in both plots is a transformed $x$. Each species $x^*$ is a weighted sum of the complete (mean centered) $x$-vector. This is because the variance of $y$ depends on the historical values of $x$ and not its extant value. $x^*$ is calculated by the second term in equation 3 in Hansen et al. (2021). The relationship between the original $x$ and $x^*$ can be plotted by:

```{r, fig.height=5, fig.width=5}
plot(gls_mod$data$x_original, gls_mod$data$x, xlab = "x", ylab = "x*")
```

# Predictor as geometric Brownian motion
The second model is a model where the predictor $x$ evolves according to a geometric Brownian motion (gBM) process, which is equivalent to Brownian motions of the natural logarithm of $x$, while $y$ is following a Brownian motion with a variance that is linear in $x$. This is referred to as model 2 in Hansen et al. (2021). The evolutionary model is 

$$dy = \sqrt{a + bx} dW_1 $$

$$dx = \frac{1}{2} \sigma^2 xdt + \sigma xdW_2 $$
where $a$ is the evolutionary rate of $y$ at $x=0$, $b$ captures the influence of $x$ on the evolutionary rate, and the $dW_i$ are two uncorrelated white noise processes. This model will break down when $a + bx$ becomes negative and should be seen as an approximation that may be valid for a given range of $x$ values as spanned by the species to be used in the analysis. However, in contrast to the above model $x$ takes positive values only, which limits the problem of negative $a + bx$.  
  
We can simulate data according to the process using:

```{r}
set.seed(703) 
sim_data <- simulate_rate(tree, startv_x=1, sigma_x=1, a=1, b=1, model = "predictor_gBM")
```

In contrast to the above model, the starting value (root value) of $x$ is set to $1$ ($x$ can only take positive values in this model). In this simulation, the evolutionary rate of $y$ at the root is $\sqrt{a + bx} = \sqrt{1 + 1} = 1.41$ while the evolutionary rates of the natural logarithm of x, $\sigma$ is given by `sigma_x = 1`.

We can plot the evolutionary dynamics by:

```{r, fig.width=7}
par(mfrow = c(1,3))
plot(sim_data) # defaults to response = "rate_y" 
plot(sim_data, response = "y")
plot(sim_data, response = "x")
```

The values at the tips:

```{r}
d <- sim_data$tips
head(d)
```

Fitting the iterative GLS model to these data: 

```{r}
gls_mod <- rate_gls(x=d$x, y=d$y, species=d$species, tree, 
                    model = "predictor_gBM", silent = TRUE)
round(gls_mod$param, 3)
```

As in Model 1, this output gives the GLS estimates of the parameters of the evolutionary model, where `sigma(x)^2` means $\sigma^2$ (which equals the squared rate parameter for the Brownian motion process of ln $x$) 

Parametric bootstrapping to get 95% confidence intervals based on the complete process:

```{r}
bootout <- rate_gls_boot(gls_mod, n = 5, silent = TRUE)
round(bootout$summary, 3)
```

A plot of the generalized least squares regression fit with $y^2$ on the y-axis (i.e. on the variance scale): 
```{r, fig.height=5, fig.width=5}
plot(gls_mod, scale = "VAR", ylab = expression(y^2), xlab = "x*")
```

As with Model 1 the regression line in the plot does not have $a$ as intercept. Instead, the intercept used in the plot is given by the first term of equation 7 in Hansen et al. 2021. The intercept of the regression is the variance in $y$ at the theoretical clade mean (i.e. at x* = 0), where the variance of $y$ includes components due to estimation error. The slope of the regression is given by the parameter $b$ as the explanatory variable plotted is a x-variable transformed by the design matrix. 
   
Alternatively with $|y|$ on the y-axis (i.e. on the standard-deviation scale): 
```{r, fig.height=5, fig.width=5}
plot(gls_mod, ylab = "|y|", xlab = "x*") # with the default: scale = "SD"
```

And a plot of the transformed x-values ($x^*$) on the x-values at the tips. This is because the variance of $y$ depends on the historical values of $x$ and not its extant value (the transformed x-values are calculated by first standardizing on the root value and centering on the theoretical clade mean before employing the second term in equation 7 in Hansen et al. 2021):

```{r, fig.height=5, fig.width=5}
plot(gls_mod$data$x_original, gls_mod$data$x, xlab = "x", ylab = "x*")
```

# Predictor affects rates of recent evolution
This model stands out from the two above in that we focus on the recent evolutionary process. The species mean trait vector is modeled as $\mathbf{y} = \mathbf{y}_{macro} + \mathbf{y}_{micro}$, where $\mathbf{y}_{macro}$ is the result of a Brownian motion process and $\mathbf{y}_{micro}$ is a micro-evolutionary deviation. The variance of $\mathbf{y}_{micro}$ may depend on the predictor variable:
$$\mathbf{y}_{micro} \sim N(\mathbf{0}, a\mathbf{I} + diag(b\mathbf{x}))$$
where $a$ and $b$ are parameter, $\mathbf{I}$ is the identity matrix and $\mathbf{x}$ is a vector of species-specific predictor variables. The $diag$-function applied to a vector yields a diagonal matrix with the vector along the diagonal. The model assumes that only the recent value of the predictor matters, hence it is treated as a fixed effect in the regression. This is referred to as model 3 in Hansen et al. (2021). 

Using the function `simulate_rate` with `model = "recent_evol"` we can simulate data with different parameter values.
```{r}
set.seed(708)
sim_data <- simulate_rate(tree, startv_x=0, sigma_x=0.25, a=1, b=1, sigma_y = 1, model = "recent_evol")
```

Here, `sigma_x` is the sample standard deviation of $x$ and `sigma_y` is the BM rate parameter of $\mathbf{y}_{macro}$. In this model, we do not simulate data along the phylogeny, so there is no such dynamics to plot. The values at the tips:

```{r}
d <- sim_data$tips
head(d)
```

We can now fit the GLS model to these data. Note that the model centers $x$ and $y$ on their respective phylogenetically weighted means. Note also that the `useLFO` argument can be set to `FALSE` to speed up the algorithm (particularly useful when bootstrapping). `useLFO` is an acronym for use "Leave Focal Out", and controls whether or not the focal species is left out when calculating the species' mean in the algorithm. The correct way is to use `TRUE`, but in practice it should have little effect. 

```{r}
gls_mod <- rate_gls(x=d$x, y=d$y, species=d$species, 
                    tree, model = "recent_evol", useLFO = TRUE, silent = TRUE)
round(gls_mod$param, 3)
```

Again, `a` and `b` are the parameters of the evolutionary model, but `sigma(x)^2` is the sample variance of $x$, and `sigma(y)^2` is the squared BM-rate parameter of $\mathbf{y}_{macro}$. The standard errors of the estimates are approximate. Parametric bootstrapping can be used to get 95% confidence intervals taking into account the error of the entire process.

```{r}
bootout <- rate_gls_boot(gls_mod, n = 5, useLFO = FALSE, silent = TRUE) 
round(bootout$summary, 3)
```

Note that $x$ is fixed in the bootstrap simulations, and therefore `sigma(x)^2` is constant across all bootstrap replicates.   

Plotting the the generalized least squares regression with $y_{micro}^2$ on the y-axis (i.e. on the variance scale). 
```{r, fig.height=5, fig.width=5}
plot(gls_mod, scale = "VAR", ylab = expression(y^2), xlab = "x*")
```
   
The intercept of the regression line shown in the plot is not $a$, but the average of all elements in the intercept vector **A** given by equation 14 in Hansen et al. 2021). The slope is given by $b$ as the explanatory variable in the plot are transformed according to the design matrix.
   
As an alternative to the plot above, we can plot the regression with with $|y_{micro}|$ on the y-axis (i.e. on the standard deviation scale). This is the default of the plot function. 

```{r, fig.height=5, fig.width=5}
plot(gls_mod, ylab = "|y|", xlab = "x*") # with the default scale == "SD"
```

Plot of the transformed x-values ($x^*$) on the x-values at the tips (the transformed x-values are calculated from the second term in equation 14 in Hansen et al. 2021):

```{r, fig.height=5, fig.width=5}
plot(gls_mod$data$x_original, gls_mod$data$x, xlab = "x", ylab = "x*")
```

Given this model it is also possible to calculate the macroevolutionary predictions of y using the function `macro_pred`, which is based on equation 10 in Hansen et al. (2021):

```{r, fig.height=5, fig.width=5}
# First, extract the relevant parameters:
a <- gls_mod$param["a",1]
b <- gls_mod$param["b",1]
sigma2_y <- gls_mod$param["sigma(y)^2",1]

# Second, compute microevolutionary variance matrix:
V_micro <- a*diag(nrow(d)) + diag(b*d$x)
diag(V_micro)[diag(V_micro) < 0] <- 0  # (Negative variances are replaced by zero)

# Third, compute macroevolutionary variance matrix:
V_macro <- ape::vcv(tree)*sigma2_y

# Last, use macro_pred() to calculate the predictions: 
y_macro_pred <- macro_pred(d$y, V=V_macro+V_micro)
plot(d$y, y_macro_pred, xlab = "y", ylab = "Macro-evolutionary predictions of y")
```

# References
Hansen TF, Bolstad GH, Tsuboi M. 2021. Analyzing disparity and rates of morphological evolution with model-based phylogenetic comparative methods. *Systematic Biology*. syab079. <https://doi.org/10.1093/sysbio/syab079> 



.
