library("statgenMPP")

#### Step 1: read data
# phenotype data
phenotypes_full_set <- c("phenotype_full_set.txt")
phenotypes_full_set <- read.delim(phenotypes_full_set)

# genotype data
crosses_full_set <- paste0("N61x", c("N01", "N02", "N03", "N04", "N06", "N07", "N09", "N11", "N15", "N17", "N18", "N22", "N23"))
cross_NAM <- c("N01_genotype.txt", "N02_genotype.txt", "N03_genotype.txt", "N04_genotype.txt", 
               "N06_genotype.txt", "N07_genotype.txt", "N09_genotype.txt", "N11_genotype.txt", 
               "N15_genotype.txt", "N17_genotype.txt", "N18_genotype.txt", "N22_genotype.txt", 
               "N23_genotype.txt")

# consensus map
consensus_map <- c("consensus_map.txt")


#### Step 2: IBD calculations
IBD <- calcIBDMPP(crossNames = crosses_full_set, 
                       markerFiles = cross_NAM,
                       pheno = phenotypes_full_set,
                       popType = "F7",
                       mapFile = consensus_map,
                       evalDist = 1,
                       verbose = T)


#### Step 3: kinship matrix
kinship_matrix <- kinshipIBD(markers = IBD$markers, map = IBD$map)

# create a file that contains only rows with phenotypes missing for a specific trait
missing_phenotypes <- phenotypes_full_set[is.na(phenotypes_full_set$YR_Toluca_21),]      ###### adjust and create one for each phenotype!

# delete rows and columns with missing phenotypes from every chromosome
kinship_matrix$"1A" <- kinship_matrix$"1A"[!(rownames(kinship_matrix$"1A") %in% missing_phenotypes$genotype), !(colnames(kinship_matrix$"1A") %in% missing_phenotypes$genotype)]
kinship_matrix$"1B" <- kinship_matrix$"1B"[!(rownames(kinship_matrix$"1B") %in% missing_phenotypes$genotype), !(colnames(kinship_matrix$"1B") %in% missing_phenotypes$genotype)]
kinship_matrix$"1D" <- kinship_matrix$"1D"[!(rownames(kinship_matrix$"1D") %in% missing_phenotypes$genotype), !(colnames(kinship_matrix$"1D") %in% missing_phenotypes$genotype)]
kinship_matrix$"2A" <- kinship_matrix$"2A"[!(rownames(kinship_matrix$"2A") %in% missing_phenotypes$genotype), !(colnames(kinship_matrix$"2A") %in% missing_phenotypes$genotype)]
kinship_matrix$"2B" <- kinship_matrix$"2B"[!(rownames(kinship_matrix$"2B") %in% missing_phenotypes$genotype), !(colnames(kinship_matrix$"2B") %in% missing_phenotypes$genotype)]
kinship_matrix$"2D" <- kinship_matrix$"2D"[!(rownames(kinship_matrix$"2D") %in% missing_phenotypes$genotype), !(colnames(kinship_matrix$"2D") %in% missing_phenotypes$genotype)]
kinship_matrix$"3A" <- kinship_matrix$"3A"[!(rownames(kinship_matrix$"3A") %in% missing_phenotypes$genotype), !(colnames(kinship_matrix$"3A") %in% missing_phenotypes$genotype)]
kinship_matrix$"3B" <- kinship_matrix$"3B"[!(rownames(kinship_matrix$"3B") %in% missing_phenotypes$genotype), !(colnames(kinship_matrix$"3B") %in% missing_phenotypes$genotype)]
kinship_matrix$"3D" <- kinship_matrix$"3D"[!(rownames(kinship_matrix$"3D") %in% missing_phenotypes$genotype), !(colnames(kinship_matrix$"3D") %in% missing_phenotypes$genotype)]
kinship_matrix$"4A" <- kinship_matrix$"4A"[!(rownames(kinship_matrix$"4A") %in% missing_phenotypes$genotype), !(colnames(kinship_matrix$"4A") %in% missing_phenotypes$genotype)]
kinship_matrix$"4B" <- kinship_matrix$"4B"[!(rownames(kinship_matrix$"4B") %in% missing_phenotypes$genotype), !(colnames(kinship_matrix$"4B") %in% missing_phenotypes$genotype)]
kinship_matrix$"4D" <- kinship_matrix$"4D"[!(rownames(kinship_matrix$"4D") %in% missing_phenotypes$genotype), !(colnames(kinship_matrix$"4D") %in% missing_phenotypes$genotype)]
kinship_matrix$"5A" <- kinship_matrix$"5A"[!(rownames(kinship_matrix$"5A") %in% missing_phenotypes$genotype), !(colnames(kinship_matrix$"5A") %in% missing_phenotypes$genotype)]
kinship_matrix$"5B" <- kinship_matrix$"5B"[!(rownames(kinship_matrix$"5B") %in% missing_phenotypes$genotype), !(colnames(kinship_matrix$"5B") %in% missing_phenotypes$genotype)]
kinship_matrix$"5D" <- kinship_matrix$"5D"[!(rownames(kinship_matrix$"5D") %in% missing_phenotypes$genotype), !(colnames(kinship_matrix$"5D") %in% missing_phenotypes$genotype)]
kinship_matrix$"6A" <- kinship_matrix$"6A"[!(rownames(kinship_matrix$"6A") %in% missing_phenotypes$genotype), !(colnames(kinship_matrix$"6A") %in% missing_phenotypes$genotype)]
kinship_matrix$"6B" <- kinship_matrix$"6B"[!(rownames(kinship_matrix$"6B") %in% missing_phenotypes$genotype), !(colnames(kinship_matrix$"6B") %in% missing_phenotypes$genotype)]
kinship_matrix$"6D" <- kinship_matrix$"6D"[!(rownames(kinship_matrix$"6D") %in% missing_phenotypes$genotype), !(colnames(kinship_matrix$"6D") %in% missing_phenotypes$genotype)]
kinship_matrix$"7A" <- kinship_matrix$"7A"[!(rownames(kinship_matrix$"7A") %in% missing_phenotypes$genotype), !(colnames(kinship_matrix$"7A") %in% missing_phenotypes$genotype)]
kinship_matrix$"7B" <- kinship_matrix$"7B"[!(rownames(kinship_matrix$"7B") %in% missing_phenotypes$genotype), !(colnames(kinship_matrix$"7B") %in% missing_phenotypes$genotype)]
kinship_matrix$"7D" <- kinship_matrix$"7D"[!(rownames(kinship_matrix$"7D") %in% missing_phenotypes$genotype), !(colnames(kinship_matrix$"7D") %in% missing_phenotypes$genotype)]


#### Step 4: permutation test
doParallel::registerDoParallel(cores = 8)

max_lod <- c() # create an empty vector to store the maximum LOD scores

for (i in 1:1000) {
  IBD$pheno$pheno$YR_Toluca_21 <- sample(IBD$pheno$pheno$YR_Toluca_21) # shuffle the input vector within the IBD object
  mapping <- selQTLMPP(MPPobj = IBD,
                       trait = "YR_Toluca_21",
                       maxCofactors = 0,
                       parallel = TRUE)
  max_lod[i] <- max(mapping$GWAResult$pheno$LOD) # store the maximum LOD score in the vector
  cat("maximum lod score", max_lod[i], "\n") # print the max LOD score of each iteration
}

q_1000_YR_Toluca_21 <- round(quantile(max_lod_1000,probs = c(0.95)),3) # get 95 % quantile 


#### Step 5: QTL mapping
NAMMQM_YR_Toluca_21_kin_perm <- selQTLMPP(MPPobj = IBD,
                                          trait = "YR_Toluca_21",
                                          threshold = ,                  # insert threshold defined in step 3
                                          parallel = T,
                                          verbose = T,
                                          K = kinship_matrix)

saveRDS(NAMMQM_YR_Toluca_21_kin_perm, "NAMMQM_YR_Toluca_21_kin_perm.RData")