###################################
###Fabio Morgante
###11-2-2016
###Simulation of true QTL genotypes from pruned
###DGRP data and simulation of phenotypes
###
###Mixed scenarios (with Variance Epistasis)
###
###[For Sign Epistasis, just change the coding
###of the interaction matrix]
###################################



###Load the pruned genotype data (rows=variants (8,665 coded as 0 and 2), cols=lines) and transform it into a matrix
###Full genotype data is available at http://dgrp2.gnets.ncsu.edu
geno <- read.table("")
geno <- geno[, -c(1:4)]
geno <- as.matrix(geno)

###Calculate allele frequencies and store them in two vectors
p <- c()
q <- c()

for(i in 1:nrow(geno)){
  a <- length(which(geno[i, ]==0))
  b <- length(which(geno[i, ]==2))
  p[i] <- a/(a+b)
  q[i] <- b/(a+b)
  if((i%%10000)==1){print(paste("SNP",i))}
}

################################################
################################################
###Simulate QTLs with given DGRP allele freq####
################################################
################################################

###Number of replicates
nreps <- 30

###Number of lines
nlines <- 205

###Heritability
H2 <- 0.4 #update name of output when changing it!!!!!

###Number of additive QTLs
nQTLs <- 100

###Number of epistatic interactions
ninteractions <- 50

###ratio Epistatic/Additive variance
varRatio <- 0.75/0.25


QTLaddFinal <- NULL
QTLaddFinal <- as.list(QTLaddFinal)

QTL1epiNoCrossFinal <- NULL
QTL1epiNoCrossFinal <- as.list(QTL1epiNoCrossFinal)

QTL2epiNoCrossFinal <- NULL
QTL2epiNoCrossFinal <- as.list(QTL2epiNoCrossFinal)

variances <- matrix(NA, ncol= nreps, nrow=4)
colnames(variances) <- paste('rep_', 1:nreps, sep='')
rownames(variances) <- c('g_add', '%g_add','g_epiNoCross','%g_epiNoCross')



for(k in 1:nreps){
  
  #####################
  ####Additive QTLs####
  #####################
  ###Simulate genotype
  set.seed(121+k)
  QTLfreq <- sample(p[1:2888], nQTLs, replace=F)
  
  genoQTL <- matrix(NA, nrow=length(QTLfreq), ncol=nlines)
  
  for(i in 1:length(QTLfreq)){
    set.seed(121+k+i)
    genoQTL[i, ] <- sample(c(0, 2), nlines, prob=c(QTLfreq[i], 1-QTLfreq[i]), replace=T)
  }

  
  ##Genotype matrix
  X_add <- t(genoQTL)
  ##Simulate QTL effect
  set.seed(129+k)
  beta_add <- rgamma(ncol(X_add), shape=0.4, scale=1.66)
  ##Sample sign for the effect
  set.seed(129+k)
  sign_add <- sample(size=length(beta_add), x=c(1, -1), replace=T, prob=c(0.5, 0.5))
  beta_add<- beta_add * sign_add
  ##Genetic value of lines
  g_add <- X_add %*% as.matrix((beta_add), ncol=1)
  

  ###################################################
  ####Epistatic interactions (Variance Epistasis)####
  ###################################################
  ###Simulate genotype
  ##Simulate first set of n variants to make up the interactions
  set.seed(113+k)
  QTL1freq_epiNoCross <- sample(p[2889:5776], ninteractions, replace=F)
  
  genoQTL1_epiNoCross <- matrix(NA, nrow=length(QTL1freq_epiNoCross), ncol=nlines)
  
  for(i in 1:length(QTL1freq_epiNoCross)){
    set.seed(113+k+i)
    genoQTL1_epiNoCross[i, ] <- sample(c(0, 2), nlines, prob=c(QTL1freq_epiNoCross[i], 1-QTL1freq_epiNoCross[i]), replace=T)
  }  
  
  ##Simulate second set of n variants to make up the interactions
  set.seed(114+k)
  QTL2freq_epiNoCross <- sample(p[5777:8665], ninteractions, replace=F)
  
  genoQTL2_epiNoCross <- matrix(NA, nrow=length(QTL2freq_epiNoCross), ncol=nlines)
  
  for(i in 1:length(QTL2freq_epiNoCross)){
    set.seed(114+k+i)
    genoQTL2_epiNoCross[i, ] <- sample(c(0, 2), nlines, prob=c(QTL2freq_epiNoCross[i], 1-QTL2freq_epiNoCross[i]), replace=T)
  }  

  ##Genotype matrix
  X1_epiNoCross <- t(genoQTL1_epiNoCross)
  X2_epiNoCross <- t(genoQTL2_epiNoCross)
  
  ##Compute interaction matrix
  X1X2_epiNoCross <- matrix(NA, ncol=ncol(X1_epiNoCross), nrow=nrow(X1_epiNoCross))
  for(i in 1:ncol(X1_epiNoCross)){
    for(j in 1:ncol(X2_epiNoCross)){
      a_epiNoCross <- X1_epiNoCross[, i]
      b_epiNoCross <- X2_epiNoCross[, j]
      if(i==j){X1X2_epiNoCross[, i] <- paste(a_epiNoCross, b_epiNoCross)}
    }
  }
  ##Recode interaction matrix
  for(i in 1:nrow(X1X2_epiNoCross)){
    for(j in 1:ncol(X1X2_epiNoCross)){
      if(X1X2_epiNoCross[i, j]=='0 0'){X1X2_epiNoCross[i, j] <- -1}
      if(X1X2_epiNoCross[i, j]=='2 2'){X1X2_epiNoCross[i, j] <- -1}
      if(X1X2_epiNoCross[i, j]=='0 2'){X1X2_epiNoCross[i, j] <- 1}
      if(X1X2_epiNoCross[i, j]=='2 0'){X1X2_epiNoCross[i, j] <- -1}
    }
  }
  ##Transform character to integers
  X1X2int_epiNoCross <- matrix(NA, ncol=ncol(X1_epiNoCross), nrow=nrow(X1_epiNoCross))
  for(i in 1:nrow(X1X2_epiNoCross)){
    for(j in 1:ncol(X1X2_epiNoCross)){
      X1X2int_epiNoCross[i, j] <- as.integer(X1X2_epiNoCross[i, j])
    }
  }
  
  ##Simulate QTL effect
  set.seed(128+k)
  beta_epiNoCross <- rgamma(ncol(X1X2_epiNoCross), shape=0.4, scale=1.66)
  ##Sample sign for the effect
  set.seed(128+k)
  sign_epiNoCross <- sample(size=length(beta_epiNoCross), x=c(1, -1), replace=T, prob=c(0.5, 0.5))
  beta_epiNoCross <- beta_epiNoCross * sign_epiNoCross
  ##Genetic value of lines
  g_epiNoCross <- X1X2int_epiNoCross %*% as.matrix(beta_epiNoCross, ncol=1)
  
  ##Update beta_epiNoCross and g_epiNoCross to provide the desired additive variance to epistatic variance ratio
  varG_add <- var(g_add)
  varG_epiNoCross <- var(g_epiNoCross)
  #Calculate appropriate constant given the desired variance ratio
  varG_epiNoCross1 <- varG_add*varRatio
  const <- varG_epiNoCross1/varG_epiNoCross
  #Updated effect
  beta_epiNoCross1 <- sqrt(const)*beta_epiNoCross
  #Updated epistatic genetic value
  g_epiNoCross1 <- X1X2int_epiNoCross %*% as.matrix(beta_epiNoCross1, ncol=1)
  
  ##Calculate res var given genetic var and H2
  varg <- var(g_add) + var(g_epiNoCross1)
  vare <- (varg-(varg*H2))/H2
  ##Simulate random errors
  set.seed(160+k)
  e <- rnorm(nrow(X1X2_epiNoCross), mean=0, sd=sqrt(vare))
  
  ##Get the phenotypes
  pheno <- g_add + g_epiNoCross1 + e
  
  if(k == 1){phenoFinal <- pheno}
  if(k > 1){phenoFinal <- cbind(phenoFinal, pheno)}
  
  
  QTLaddFinal[[k]] <- genoQTL
  

  
  QTL1epiNoCrossFinal[[k]] <- genoQTL1_epiNoCross
  QTL2epiNoCrossFinal[[k]] <- genoQTL2_epiNoCross
  
  variances[1, k] <- var(g_add)
  variances[3, k] <- var(g_epiNoCross1)
  variances[2, k] <- (var(g_add)/varg)*100
  variances[4, k] <- (var(g_epiNoCross1)/varg)*100
}


save(phenoFinal, variances, QTLaddFinal, QTL1epiNoCrossFinal, QTL2epiNoCrossFinal, file=paste('SimGenoData', nQTLs, 'add', ninteractions, 'inter', nlines,'lines.RData', sep=''))