In MoisesExpositoAlonso/popgensim: Wright Fisher simulations: C++ implementation with interactive Shiny app visualization

---

knitr::opts_chunk$set(echo = TRUE,warning=FALSE)
set.seed(1)

## Load packages
library(devtools)
library(dplyr)
library(ggplot2)
library(cowplot)
library(xtable)

devtools::load_all('.')
# library('gws')
library(moiR)
# library(bigsnpr)
# library(bigstatsr)

Define genome matrix

### high and low LD
# Right now only the selected ones

X<- get_topSNPs()
X[1:5,1:5]

How well models predict true effects

### sparse and gaussian

### additive and epistatic

Yl<-list(sparse=list(add= simupheno(X,sparsity=0.95)
                     ,epi=simupheno(X,sparsity=0.95,epistasis = 2)
                      ),
         gaussian=list(add= simupheno(X,sparsity=0.5)
                       ,epi=simupheno(X,sparsity=0.5,epistasis = 2)
                       ))
Yl

95% sparse effects additive

How good the selection estimates predict the individual fitness

sa<-data.frame( true=Yl$sparse$add$eff,
                        bgwa=gwa(X,Yl$sparse$add$Y),
                        b=cgwa(X,Yl$sparse$add$Y),
                        bridge=ridgegwa(X,Yl$sparse$add$Y,type='penalized'),
                        blasso=lassogwa(X,Yl$sparse$add$Y)
                        )


p1<-(ggdotscolor(sa$true,sa$bgwa, ylab='True effect',xlab='Inferred effect',color='grey70') %>% addggregression(se=F,lty='dashed') )+ggtitle("Marginal")
p2<-(ggdotscolor(sa$true,sa$b, ylab='True effect',xlab='Inferred effect',color='grey70') %>% addggregression(se=F,lty='dashed') )+ggtitle("Conditional")
p3<-(ggdotscolor(sa$true,sa$bridge, ylab='True effect',xlab='Inferred effect',color='grey70') %>% addggregression(se=F,lty='dashed') )+ggtitle("Ridge")
p4<-(ggdotscolor(sa$true,sa$blasso, ylab='True effect',xlab='Inferred effect',color='grey70') %>% addggregression(se=F,lty='dashed') )+ggtitle("Lasso")

plot_grid(p1,p2,p3,p4)

How well the likelihood inference approach from LD matrix works

LDobs<-ldCnext(X,Yl$sparse$add$Y) %>% cleanld()
hist(LDobs)

res<-optim(par = c(1,sa$bridge),
      fn = ld.lik,
      y=LDobs,
      method="BFGS")

MoisesExpositoAlonso/popgensim documentation built on May 7, 2019, 8:57 p.m.