##############################################################
# The influence of QTL allelic diversity on QTL detection in #
# multi-parent populations: a simulation study in sugar beet #
##############################################################

# Vincent Garin, Valentin Wimmer, Dietrich Borchardt,
# Marcos Malosetti, Fred van Eeuwijk

# 1. Library
############

library(devtools)
# install_github("vincentgarin/mppR", ref = "master")
library(mppR)
# You can download an archived version of the clusthaplo package here:
# https://cran.r-project.org/src/contrib/Archive/clusthaplo/
library(clusthaplo)
# install_github("vincentgarin/mppSim", ref = "BMC")
library(mppSim)
# install_github("kbroman/simcross")
library(simcross)
library(plyr)
library(Matrix)

# 2. Simulation of a reference population
#########################################

# parent genotypes

data("geno_par")
n_par <- 9
rownames(geno_par) <- paste0('P', 1:n_par)

# genetic map

data("EUNAM_map")
rownames(map) <- map[, 1]

# diallel crossing scheme with 9 parents
cross_scheme <- form_par_per_cross(n_par)
# 300 ind per crosses
n_ind_cr_ref <- 300
n_ind_cr <- rep(n_ind_cr_ref, 36)

geno_off <- sim_mpp_cross(geno_par = geno_par,  map = map,
                          cross_scheme = cross_scheme, n_ind_cr = n_ind_cr)

# 3. Format the simulated data into an mppData object (takes ~10 minutes)
#####################################################

pheno <- data.frame(t1 = rnorm(n = dim(geno_off)[1]))
pheno <- as.matrix(pheno)
rownames(pheno) <- rownames(geno_off)
cross_ind <- substr(rownames(geno_off), 1, 4)

mppData <- create.mppData(geno.off = geno_off, geno.par = geno_par, map = map,
                          pheno = pheno, cross.ind = cross_ind,
                          par.per.cross = cross_scheme)

mppData <- QC.mppData(mppData = mppData)
mppData <- IBS.mppData(mppData = mppData)
mppData <- IBD.mppData(mppData = mppData, type = 'F', F.gen = 2, BC.gen = NULL)

mppData <- parent_cluster.mppData(mppData = mppData, window = 20, plot = FALSE,
                                  method = "clusthaplo", threshold.quantile = 95)

mppData$n.anc

# the number of ancestor should be meaningful
# rule of thumb at least between 3 (2+1) and nPar-1

# If the number of ancestral group is < 3: increase the threshold.quantile
# If the number of ancestral group is > n_par-1: decrease the threshold.quantile


# 4. Select QTL positions for the simulated genetic models
##########################################################

### 4.1 General parameters of the simulation

# Simulation of a multi-QTL effect genetic model with 8 QTLs:
# Q1, Q2, Q3, Q4, Q5, Q6, Q7, Q7

nSim <- 10 # number of simulations run
nQTL <- 8
distQTL <- 30 # minimum distance between two QTL positions
Qsize <- c(6, 2, 2, 6, 6, 2, 2, 6) # QTLs % of the phenotypic variance
# vector of QTL type
Qtype <- c('cr', 'cr', 'par', 'par', 'anc', 'anc', 'biall', 'biall')
Qeff <- c(1:7, 7) # type of simulated QTL effects (Q1-7)
cross_frac = c(0.5, 1/3) # For cr QTL fraction cross with non-zero effect.

### 4.2 List of QTL positions

Q_sim <- vector(mode = "list", length = nSim)

for(i in 1:nSim){

  Qsel <- QposSelect(map = mppData$map[, -3], N = nQTL, dist = distQTL)

  Qinf <- data.frame(Qtype, Qeff, Qsize, stringsAsFactors = FALSE)
  Qinf <- Qinf[sample(1:nQTL), ]

  Qsel <- data.frame(Qsel, Qinf, stringsAsFactors = FALSE)
  colnames(Qsel) <- c("mk.id", "chr", "pos.cM", "Qtype", "Qeff", "Qsize")

  Q_sim[[i]] <- Qsel

}

# 5. Simulate phenotypes
########################

Pheno_sim <- vector(mode = "list", length = nSim)

for(i in 1:nSim){

  Pheno_sim[[i]] <- SimPheno(QTL = Q_sim[[i]], k = 1, her = sum(Qsize)/100,
                              mppData = mppData, cross_frac = cross_frac)

}

# 6. Perform the QTL analysis
#############################

### 6.1 properties of the tested designs

# type of MPP design: Dia (diallel), Chess (Chessboard), Fact (Factorial)
# NAM (nested association mapping)

MPP_design <- c("Dia", "Chess", "Fact", "NAM")
n_des <- length(MPP_design)
np_sel <- 5 # number of selected parents
N <- 800 # Total population size

### 6.2 Space to store the results

res_dir <- 'F:/PhD/Test' # specify a directory where the results will be saved

sim_fold <- file.path(res_dir, 'Sim')
data_fold <- file.path(sim_fold, 'data')
res_fold <- file.path(sim_fold, 'results')

dir.create(path = sim_fold)
dir.create(path = data_fold)
dir.create(path = res_fold)

# make folder to store the results

for(i in 1:n_des){

  res_fold_i <- file.path(res_fold, paste0("MPP_", i))
  dir.create(res_fold_i)

}

Q_res <- vector(mode = "list", length = nSim)
ind.res <- 1

for(i in 1:nSim){

  print(paste("Run", i))
  Rep_i_res <- vector(mode = "list", length = n_des)

  for(j in 1:n_des){

    MPP_sub <- SampleMPPDesign(np_dia = n_par, n_ind = n_ind_cr_ref,
                                MPP_des = MPP_design[j],
                                np_sel = np_sel, N = N)

    # form mppData object for design j

    mppData_j <- formMppData(geno_sim = rbind(geno_par, geno_off),
                              nPar = n_par, map = mppData$map,
                              MPP_sub = MPP_sub, pheno = Pheno_sim[[i]]$y_sim,
                              type = 'F', F.gen = 2, BC.gen = NULL, window = 20)

    folder <- file.path(res_fold, paste0("MPP_", j))
    Rep_id <- paste0("Rep_", i)

    # Perform the QTL detection with the four models (cr-spec, par, anc, biall)

    QTL_detect <- QTLDetection(mppData = mppData_j,
                                thre_cr = 4, thre_par = 4, thre_anc = 4,
                                thre_biall = 4, folder = folder,
                                Rep_id = Rep_id, win.cof = 50, win.QTL = 30,
                                n.cores = 1)

    Rep_i_res[[j]] <- QTL_detect


  }

  Q_res[[ind.res]] <- Rep_i_res
  ind.res <- ind.res + 1

  print(paste("End run", i))

}

# 7. Analyse and summary of the results
#######################################

save(Q_res, file = file.path(res_fold, "Q_res.RData"))

### 7.1 TPR and FDR

dQTL <- c(5, 10, 20) # tolerance distance between the simulated and the detected
                     # QTL positions.

res_TPR <- vector(mode = 'list', length = length(dQTL))
res_FDR <- vector(mode = 'list', length = length(dQTL))

for(i in 1:length(dQTL)){

  res_TPR[[i]] <- TPRTable(QTL_true = Q_sim, QTL_detected = Q_res, n_des = n_des,
                           n_QTL = nQTL, d_QTL = dQTL[i], des_names = MPP_design)

  res_FDR[[i]] <- FDRTable(QTL_true = Q_sim, QTL_detected = Q_res, n_des = n_des,
                           n_QTL = nQTL, d_QTL = dQTL[i], des_names = MPP_design)

}

### 7.2 dQTL

data_dQTL <- dQTLTab(QTL_true = Q_sim, QTL_detected = Q_res, n_QTL = nQTL,
                      des_names = MPP_design, n_des = n_des)


res_dQTL <- ddply(data_dQTL,~ MPP_des + Model, summarise, mean=mean(distance))

### 7.3 save the results in text file

out.file <- file.path(res_fold, 'results.txt')

# write the title

cat(rep("*", nchar('* SIMULATION RESULTS *')), sep = "", file = out.file,
    append = TRUE)
cat("\n", file = out.file, append = TRUE)
cat('* SIMULATION RESULTS *', file = out.file, append = TRUE)
cat("\n", file = out.file, append = TRUE)
cat(rep("*", nchar('* SIMULATION RESULTS *')), sep = "", file = out.file,
    append = TRUE)
cat("\n", file = out.file, append = TRUE)
cat("\n", file = out.file, append = TRUE)

# TPR results

cat('True positive rate (TPR - %)', file = out.file, append = TRUE)
cat("\n", file = out.file, append = TRUE)
cat(rep("*", nchar('True positive rate (TPR - %)')), sep = "", file = out.file,
    append = TRUE)
cat("\n", file = out.file, append = TRUE)
cat("\n", file = out.file, append = TRUE)

sink(file = out.file, append = TRUE)

for (i in 1:length(dQTL)){

  cat("\n", file = out.file, append = TRUE)
  cat("\n", file = out.file, append = TRUE)

  cat(paste(dQTL[i], 'cM'), file = out.file, append = TRUE)

  cat("\n", file = out.file, append = TRUE)
  cat("\n", file = out.file, append = TRUE)

  print(res_TPR[[i]])

  cat("\n", file = out.file, append = TRUE)
  cat("\n", file = out.file, append = TRUE)

}


# FDR results

cat('False discovery rate (FDR - %)', file = out.file, append = TRUE)
cat("\n", file = out.file, append = TRUE)
cat(rep("*", nchar('False discovery rate (FDR - %)')), sep = "", file = out.file,
    append = TRUE)
cat("\n", file = out.file, append = TRUE)
cat("\n", file = out.file, append = TRUE)

for (i in 1:length(dQTL)){

  cat("\n", file = out.file, append = TRUE)
  cat("\n", file = out.file, append = TRUE)

  cat(paste(dQTL[i], 'cM'), file = out.file, append = TRUE)

  cat("\n", file = out.file, append = TRUE)
  cat("\n", file = out.file, append = TRUE)

  print(res_FDR[[i]])

  cat("\n", file = out.file, append = TRUE)
  cat("\n", file = out.file, append = TRUE)

}

# distance to QTL

cat('Distance to QTL (cM)', file = out.file, append = TRUE)
cat("\n", file = out.file, append = TRUE)
cat(rep("*", nchar('Distance to QTL (cM)')), sep = "", file = out.file,
    append = TRUE)
cat("\n", file = out.file, append = TRUE)
cat("\n", file = out.file, append = TRUE)

print(res_dQTL)

sink()

# A summary of the results can be found in the file:
# '~/Sim/results/results.txt'