---
title: "Solving Linear Mixed Models using LMMsolver"
date: "`r Sys.Date()`"
output: 
  rmarkdown::html_vignette:
    toc: false
    number_sections: true
bibliography: bibliography.bib
link-citations: yes
vignette: >
  %\VignetteIndexEntry{Solving Linear Mixed Models using LMMsolver}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.dim = c(7, 4)
)
```

```{r setup}
library(LMMsolver)
library(ggplot2)
```

# The LMMsolver package {.unnumbered}

The aim of the `LMMsolver` package is to provide an efficient and flexible system to estimate variance components using restricted maximum likelihood or REML [@Patterson1971], for models where the mixed model equations are sparse [@boer2023]. An example of an application is using splines to model spatial [@Rodriguez-Alvarez2018; @Boer2020] or temporal [@Bustos-Korts2019] trends. Another example is mixed model Quantitative Trait Locus (QTL) analysis for multiparental populations, allowing for heterogeneous residual variance and design matrices with Identity-By-Descent (IBD) probabilities [@Li2021].

A Linear Mixed Model (LMM) has the form

$$
  y = X \beta + Z u + e, \quad u \sim N(0,G), \quad e \sim N(0,R) 
$$ where $y$ is a vector of observations, $\beta$ is a vector with the fixed effects, $u$ is a vector with the random effects, and $e$ a vector of random residuals. $X$ and $Z$ are design matrices.

The `LMMsolve` package can fit models where the matrices $G^{-1}$ and $R^{-1}$ are a linear combination of precision matrices $Q_{G,i}$ and $Q_{R,i}$: $$
  G^{-1} = \sum_{i} \psi_i Q_{G,i} \;, \quad   R^{-1} = \sum_{i} \phi_i Q_{R,i} 
$$ where the precision parameters $\psi_i$ and $\phi_i$ are estimated using REML. For most standard mixed models $1/{\psi_i}$ are the variance components and $1/{\phi_i}$ the residual variances. We use a formulation in terms of precision parameters to allow for non-standard mixed models using tensor product splines introduced in @Rodriguez-Alvarez2015.

If the matrices $G^{-1}$ and $R^{-1}$ are sparse, the mixed model equations can be solved using efficient sparse matrix algebra implemented in the `spam` package [@Furrer2010]. To calculate the derivatives of the log-likelihood in an efficient way, the automatic differentiation of the Cholesky matrix [@Smith1995;@boer2023] was implemented in C++ using the `Rcpp` package [@Eddelbuettel2018].

# Smooth trend in one dimension.

## Oats field trial

As a first example we will use an oats field trial from the `agridat` package. There were 24 varieties in 3 replicates, each consisting of 6 incomplete blocks of 4 plots. The plots were laid out in a single row.

```{r oatsdata}
## Load data.
data(john.alpha, package = "agridat")
head(john.alpha)
```

In the following subsections we will use two methods to correct for spatial trend, to show some of the options of the package.

### Modelling spatial trend using P-splines

In this subsection we will illustrate how the package can be used to fit mixed model P-splines, for details see @Boer2020.

In the following mixed model we include rep and gen as fixed effect, and we use `spl1D` to model a one dimensional P-spline [@Eilers1996] with 100 segments, and the default choice of cubical B-splines and second order differences:

```{r Pspline1D}
## Fit mixed model with fixed and spline part.
obj1 <- LMMsolve(fixed = yield ~ rep + gen,
                 spline = ~spl1D(x = plot, nseg = 100),
                 data = john.alpha)
```

A high number of segments can be used for splines in one dimension, as the corresponding mixed model equations are sparse, and therefore can be solved fast [@Smith1995; @Furrer2010].

```{r deviance}
round(deviance(obj1), 2)
```

We can obtain a table with effective dimensions (see e.g. @Rodriguez-Alvarez2018) and penalties (the precision parameters $\psi_i$ and $\phi_i$) using the `summary` function:

```{r summaryED}
summary(obj1)
```

```{r summaryED2, echo=FALSE}
tbl <- summary(obj1)
EDs <- round(tbl$Effective[5], 1)
```

The effective dimension gives a good balance between model complexity and fit to the data for the random terms in the model. In the table above the first four terms are fixed effects and not penalized, and therefore the effective dimension is equal to the number of parameters in the model. The `splF` is the fixed part of the spline, the linear trend. The term `s(plot)` is a random effect, with effective dimension `r EDs`, indicating that is important to correct for spatial trend.

The estimated genetic effects are given by the `coef` function:

```{r coeff_example}
genEff <- coef(obj1)$gen
head(genEff, 4)
```

The first genotype (G01) is the reference, as genotypes were modelled as fixed effect in the model.

The smooth trend with the standard errors along the field on a dense grid of 1000 points can be obtained as follows:

```{r ObtainSmoothTrend1}
## Extract smooth trend from mixed model.
plotDat1 <- obtainSmoothTrend(obj1, grid = 1000, includeIntercept = TRUE)
head(plotDat1)
```

The trend can then be plotted.

```{r plot1D}
## Plot smooth trend.
ggplot(data = plotDat1, aes(x = plot, y = ypred)) +
  geom_line(color = "red", linewidth = 1) +
  labs(title = "Smooth spatial trend oats data", x = "plotnr", y = "yield") +
  theme(panel.grid = element_blank())
```

### Modelling spatial trend using `random` and `ginverse` arguments.

Another way to correct for spatial trend is using the Linear Variance (LV) model, which is closely connected to the P-splines model [@Boer2020]. First we need to define the precision matrix for the LV model, see Appendix in @Boer2020 for details:

```{r define LVmodel}
## Add plot as factor.
john.alpha$plotF <- as.factor(john.alpha$plot)
## Define the precision matrix, see eqn (A2) in Boer et al (2020).
N <- nrow(john.alpha)
cN <- c(1 / sqrt(N - 1), rep(0, N - 2), 1 / sqrt(N - 1))
D <- diff(diag(N), diff = 1)
Delta <- 0.5 * crossprod(D)
LVinv <- 0.5 * (2 * Delta + cN %*% t(cN))
## Add LVinv to list, with name corresponding to random term.
lGinv <- list(plotF = LVinv)
```

Given the precision matrix for the LV model we can define the model in LMMsolve using the `random` and `ginverse` arguments:

```{r modelLV}
## Fit mixed model with first degree B-splines and first order differences.
obj2 <- LMMsolve(fixed = yield ~ rep + gen,
                 random = ~plotF, 
                 ginverse = lGinv, 
                 data = john.alpha)
```

The deviance for the LV-model is `r round(deviance(obj2), 2)` and the variances

```{r summaryVAR}
summary(obj2, which = "variances")
```

as reported in @Boer2020, Table 1.

## Model biomass as function of time.

In this section we show an example of mixed model P-splines to fit biomass as function of time. As an example we use wheat data simulated with the crop growth model APSIM. This data set is included in the package. For details on this simulated data see @Bustos-Korts2019.

```{r APSIMdat}
data(APSIMdat)
head(APSIMdat)
```

The first column is the environment, Emerald in 1993, the second column the simulated genotype (g001), the third column is days after sowing (das), and the last column is the simulated biomass with medium measurement error.

The model can be fitted with

```{r APSIMmodel}
obj2 <- LMMsolve(biomass ~ 1,
                 spline = ~spl1D(x = das, nseg = 200), 
                 data = APSIMdat)
```

The effective dimensions are:

```{r APSIMmodelSummary}
summary(obj2)
```

The fitted smooth trend can be obtained as explained before, with standard error bands in blue:

```{r APSIMplot}
plotDat2 <- obtainSmoothTrend(obj2, grid = 1000, includeIntercept = TRUE)

ggplot(data = APSIMdat, aes(x = das, y = biomass)) +
  geom_point(size = 1.2) +
  geom_line(data = plotDat2, aes(y = ypred), color = "red", linewidth = 1) +
  geom_line(data = plotDat2, aes(y = ypred-2*se), col='blue', linewidth = 1) +
  geom_line(data = plotDat2, aes(y = ypred+2*se), col='blue', linewidth = 1) +
  labs(title = "APSIM biomass as function of time", 
       x = "days after sowing", y = "biomass (kg)") +
  theme(panel.grid = element_blank())
```

The growth rate (first derivative) as function of time can be obtained using `deriv = 1` in function `obtainSmoothTrend`:

```{r APSIMDeriv}
plotDatDt <- obtainSmoothTrend(obj2, grid = 1000, deriv = 1)

ggplot(data = plotDatDt, aes(x = das, y = ypred)) +
  geom_line(color = "red", linewidth = 1) +
  labs(title = "APSIM growth rate as function of time", 
       x = "days after sowing", y = "growth rate (kg/day)") +
  theme(panel.grid = element_blank())
```

# Smooth trends in two dimensions

For two-dimensional mixed P-splines we use the model defined in @Rodriguez-Alvarez2015. As an example we use the `USprecip` data set in the `spam` package [@Furrer2010], analysed in @Rodriguez-Alvarez2015.

```{r USprecip data}
## Get precipitation data from spam
data(USprecip, package = "spam")

## Only use observed data
USprecip <- as.data.frame(USprecip)
USprecip <- USprecip[USprecip$infill == 1, ]
```

The two-dimensional P-spline can be defined with the `spl2D()` function, and with longitude and latitude as covariates. The number of segments chosen here is equal to the number of segments used in @Rodriguez-Alvarez2015.

```{r runobj3}
obj3 <- LMMsolve(fixed = anomaly ~ 1,
                 spline = ~spl2D(x1 = lon, x2 = lat, nseg = c(41, 41)),
                 data = USprecip)
```

The summary function gives a table with the effective dimensions and the penalty parameters:

```{r ED_USprecip}
summary(obj3)
```

A plot for the smooth trend can be obtained in a similar way as for the one-dimensional examples:

```{r Plot_USprecip}
plotDat3 <- obtainSmoothTrend(obj3, grid = c(200, 300), includeIntercept = TRUE)
plotDat3 <- sf::st_as_sf(plotDat3, coords = c("lon", "lat"))
usa <- sf::st_as_sf(maps::map("usa", regions = "main", plot = FALSE))
sf::st_crs(usa) <- sf::st_crs(plotDat3)
intersection <- sf::st_intersects(plotDat3, usa)
plotDat3 <- plotDat3[!is.na(as.numeric(intersection)), ]

ggplot(usa) + 
  geom_sf(color = NA) +
  geom_tile(data = plotDat3, 
            mapping = aes(geometry = geometry, fill = ypred), 
            linewidth = 0,
            stat = "sf_coordinates") +
  scale_fill_gradientn(colors = topo.colors(100))+
  labs(title = "Precipitation (anomaly)", 
       x = "Longitude", y = "Latitude") +
  coord_sf() +
  theme(panel.grid = element_blank())
```

Instead of using the `grid` argument, `newdata` can be used to make predictions for locations specified in a `data.frame`:

```{r newdataARG}
## Predictions for new data, using city coordinates from maps package.
data(us.cities, package = "maps")
## Column names have to match column names used for fitting the model.
colnames(us.cities)[colnames(us.cities) == "long"] <- "lon"
## Select columns name, lat and lon
us.cities <- us.cities[, c(1,4,5)]
head(us.cities)

pred3 <- obtainSmoothTrend(obj3, newdata = us.cities, includeIntercept = TRUE)
head(pred3)
```

# QTL mapping with IBD probabilities.

In QTL-mapping for multiparental populations the Identity-By-Descent (IBD) probabilities are used as genetic predictors in the mixed model [@Li2021]. The following simulated example is for illustration. It consists of three parents (A, B, and C), and two crosses AxB, and AxC. AxB is a population of 100 Doubled Haploids (DH), AxC of 80 DHs. The probabilities, pA, pB, and pC, are for a position on the genome close to a simulated QTL. This simulated data is included in the package.

```{r multipop}
## Load data for multiparental population.
data(multipop)
head(multipop)
```

The residual (genetic) variances for the two populations can be different. Therefore we need to allow for heterogeneous residual variances, which can be defined by using the `residual` argument in `LMMsolve`:

```{r residualARG}
## Fit null model.
obj4 <- LMMsolve(fixed = pheno ~ cross, 
                 residual = ~cross, 
                 data = multipop)
dev4 <- deviance(obj4)
```

The QTL-probabilities are defined by the columns pA, pB, pC, and can be included in the random part of the mixed model by using the `group` argument:

```{r groupOPTION}
## Fit alternative model - include QTL with probabilities defined in columns 3:5 
lGrp <- list(QTL = 3:5)
obj5 <- LMMsolve(fixed = pheno ~ cross, 
                 group = lGrp,
                 random = ~grp(QTL),
                 residual = ~cross,
                 data = multipop) 
dev5 <- deviance(obj5)
```

The approximate $-log10(p)$ value is given by

```{r approxPvalue}
## Deviance difference between null and alternative model.
dev <- dev4 - dev5
## Calculate approximate p-value. 
minlog10p <- -log10(0.5 * pchisq(dev, 1, lower.tail = FALSE))
round(minlog10p, 2)
```

The estimated QTL effects of the parents A, B, and C are given by:

```{r QTLeffects}
coef(obj5)$QTL
```

## References
