---
title: "Recla Analysis"
author: "Frederick Boehm"
date: "`r Sys.Date()`"
bibliography: "qtl2pleio.bib"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Recla Analysis}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r setup2}
is_inst <- function(pkg) {
    nzchar(system.file(package = pkg))
}
qtl2_indic <- is_inst("qtl2")
knitr::opts_chunk$set(eval = qtl2_indic)
```


```{r pkgs}
library(dplyr)
library(ggplot2)
library(qtl2pleio)
library(qtl2)
```



## Load Recla data from `qtl2data` github repository

We illustrate functions from `qtl2pleio` by analyzing data from 261 Diversity Outbred mice [@recla2014precise,@logan2013high].

```{r load-recla}
file <- paste0("https://raw.githubusercontent.com/rqtl/",
               "qtl2data/master/DO_Recla/recla.zip")
recla <- read_cross2(file)
# make sex a covariate for use in qtl2pleio::scan_pvl
recla[[6]][ , 1, drop = FALSE] -> sex
# insert pseudomarkers
insert_pseudomarkers(recla, step = 0.10) -> pseudomap
gm <- pseudomap$`8`
```


We use the hidden Markov model from @broman2012genotype and @broman2012haplotype (as implemented in @broman2019rqlt2) to calculate 36-state genotype probabilities for autosomal markers. 

```{r calc-genoprobs-code}
probs <- calc_genoprob(recla, map = pseudomap, cores = 1)
```

We then convert the genotype probabilities to haplotype dosages.

```{r calc-aprobs}
aprobs <- genoprob_to_alleleprob(probs)
```

We calculate kinship matrices, by the "leave one chromosome out (loco)" method.

```{r calc-kinship}
kinship <- calc_kinship(aprobs, "loco")
```




Before performing our QTL mapping, we transform the phenotypes. 

```{r log-phenos}
recla$pheno -> ph
log(ph) -> lph
apply(FUN = broman::winsorize, X = lph, MARGIN = 2) -> wlph
as_tibble(wlph) -> wlph_tib
```

We next perform the univariate QTL scan for all phenotypes.

```{r scan1}
sex2 <- matrix(as.numeric(sex == "female"), ncol = 1)
colnames(sex2) <- "female"
rownames(sex2) <- rownames(aprobs[[1]])
out <- scan1(genoprobs = aprobs, 
             pheno = wlph, 
             kinship = kinship, 
             addcovar = sex2, 
             reml = TRUE
             )
```

We want to look closely at those peaks on Chromosome 8. We'll save the positions of peaks for our two traits of interest.


```{r get-peaks}
(peaks <- find_peaks(out, pseudomap, threshold = 5) %>%
  dplyr::arrange(chr, pos) %>%
   dplyr::select(- lodindex))
peaks8 <- peaks %>%
  dplyr::filter(chr == 8, pos > 50, pos < 60)
pos_LD_light_pct <- peaks8 %>%
  dplyr::filter(lodcolumn == "LD_light_pct") %>%
  dplyr::select(pos)
pos_HP_latency <- peaks8 %>%
  dplyr::filter(lodcolumn == "HP_latency") %>%
  dplyr::select(pos)
```

## Correlation

Given that the two traits "percent time in light" and "distance traveled in light" share a peak, we want to ask how correlated they are.

```{r cors}
cor(wlph[ , 7], wlph[ , 10], use = "complete.obs")
cor(wlph[ , 22], wlph[ , 10], use = "complete.obs")
cor(wlph[ , 7], wlph[ , 22], use = "complete.obs")
```

Since "percent time in light" and "distance traveled in light" are very highly correlated, we'll discard "distance traveled in light" and perform subsequent analyses with only "percent time in light" and the second trait, "hot plate latency".


## Scatter plot of phenotypes

We create a scatter plot for the two phenotypes, "hot plate latency" and "percent time in light".

```{r scatter}
ggplot() + 
  geom_point(data = wlph_tib, aes(y = HP_latency, x = LD_light_pct)) +
  labs(x = "Percent time in light", y = "Hot plate latency")
```

## Genome-wide LOD plots for the traits from Recla

Let's plot the results of the univariate QTL scans for our two traits.

```{r lod10-plot}
plot(out, map = pseudomap, 
     lodcolumn = 10, 
     main = "percent time in light"
     )
```

```{r lod22-plot}
plot(out, map = pseudomap, 
     lodcolumn = 22, 
     main = "hot plate latency"
     )
```


## Allele effects plots on Chr 8 for each of the three Recla traits

We examine the allele effects plots for our two traits, in the region of interest on Chromosome 8.

```{r coefs-calc}
scan1coef(aprobs[ , 8], pheno = wlph[ , 10], kinship = kinship$`8`, 
          reml = TRUE,
          addcovar = sex2) -> s1c_10
scan1coef(aprobs[ , 8], pheno = wlph[ , 22], kinship = kinship$`8`, 
          reml = TRUE,
          addcovar = sex2) -> s1c_22
```

```{r coefs-subset}
# subset scan1output objects
s1c_10s <- s1c_10[650:999, ] 
# 650:999 is the same as the interval for the two-dimensional scan.
s1c_22s <- s1c_22[650:999, ]
```


```{r plot-coefs}
plot_coefCC(s1c_10s, scan1_output = out[ , 10, drop = FALSE], map = pseudomap, main = "percent time in light")
plot_coefCC(s1c_22s, scan1_output = out[ , 22, drop = FALSE], map = pseudomap, main = "hot plate latency")
```


## Two-dimensional scan results from github

We present the code that we ran to perform the two-dimensional scan.

```{r 2d-scan, eval = FALSE}
scan_pvl(probs = aprobs$`8`, 
         pheno = wlph[, c(10, 22)], 
         addcovar = sex2, 
         kinship = kinship$`8`, 
         start_snp = 650, 
         n_snp = 350) -> pvl1022
```

To save computing time, we read the two-dimensional scan results from Zenodo. Because the Zenodo file was created with an older version of `scan_pvl`, it contains the log (natural base) likelihoods, rather than log10 likelihoods. Thus, we'll want to rectify this, which we do with code below.

```{r 2d-scan-results, echo = TRUE}
as_tibble(read.table("https://zenodo.org/record/3210710/files/recla-10-22.txt?download=1", stringsAsFactors = FALSE)) -> pvl1022
```

We then calculate the likelihood ratio test statistic.

```{r lrt-calc}
(mylrt <- calc_lrt_tib(pvl1022))
```


## Profile LOD Plot

We create a profile LOD plot.

```{r profile-plot}
colnames(recla$pheno)[c(10, 22)] <- c("Percent time in light", "Hot plate latency")
pvl1022 %>%
  mutate(log10lik = loglik / log(10)) %>%
  dplyr::select(- loglik) %>%
  calc_profile_lods() %>%
  add_pmap(pmap = recla$pmap$`8`) %>%
  ggplot() + geom_line(aes(x = marker_position, y = profile_lod, colour = trait))
```


## Bootstrap analyses

First, we find the *pleiotropy peak* marker. This is the marker for which the log likelihood is maximized under the constraint of pleiotropy.


```{r get-pleio-peak}
find_pleio_peak_tib(pvl1022, start_snp = 650)
```

We need the *pleiotropy peak* marker in the bootstrap analyses because it is the marker used in drawing bootstrap samples.


To save computing time, we read the bootstrap results files from Github. For details of how we performed the bootstrap analyses on the University of Wisconsin-Madison Center for High-Throughput Computing, please see the documentation in the qtl2pleio-manuscript repository: https://github.com/fboehm/qtl2pleio-manuscript.


The code below creates a temporary directory "tmp" in the user's working directory. We then read results files from Github. Each text file contains a single likelihood ratio test statistic from a bootstrap sample.



```{r read-boot}
## read boot lrt files
boot_lrt <- list()
for (i in 1:1000){
  n <- i - 1
  fn <- paste0("https://raw.githubusercontent.com/fboehm/qtl2pleio-manuscript-chtc/master/Recla-bootstrap/results/recla-boot-run561_", n, ".txt")
  boot_lrt[i] <- read.table(fn)
}
# convert list to numeric vector
boot_lrt <- unlist(boot_lrt)
```

We get a bootstrap p-value by comparing the above vector's values to `mylrt`, the test statistic for the observed data.

```{r pval}
sum(boot_lrt >= mylrt) / length(boot_lrt)
```



## Session info

```{r session-info, eval = TRUE}
devtools::session_info()
```

## References

