Skip to content
Snippets Groups Projects
4-qtl-integration.R 5.64 KiB
Newer Older
Hartanto, Margi's avatar
Hartanto, Margi committed
##################################################
##### integration of phQTL, mQTL, and eQTL #######
##################################################

# Set working directory and load libraries ####
  remove(list = ls())
  gc()
  
# load library
  library(dplyr)
  library(grid)
  library(scales)
  library(RColorBrewer)
  library(devtools)
  library(ggplot2)
  
# set directory
  work.dir <- "C:/Users/harta005/Projects/seed-germination-qtl"
  setwd(work.dir)
  
# gathering phQTL profile
  phqtl.peak <- readRDS('qtl-peaks/peak_phqtl_without-outliers-not-transformed.RDS') %>%
    mutate(qtl_level = 'phQTL') %>%
    mutate(stage = 'phQTL')

# gathering mQTL profile
  seed.stage <- c('pd', 'ar', 'im', 'rp')
  mqtl.peak <- data.frame(matrix(nrow = 0, ncol = 12))
  colnames(mqtl.peak) <- colnames(phqtl.peak)
  for (i in seed.stage) {
    table.tmp <- readRDS(paste0('qtl-peaks/peak_mqtl_', i, '-without-outliers-log-transformed.RDS')) %>%
      mutate(qtl_level = 'mQTL', stage = i)
      
    mqtl.peak <- rbind(mqtl.peak, table.tmp)
  }
  
# gathering eQTL profiles
  
  eqtl.peak <- data.frame(matrix(nrow = 0, ncol = 13))
  colnames(eqtl.peak) <- colnames(phqtl.peak)
  for (i in seed.stage) {
    table.tmp <- readRDS(paste0('qtl-tables/table_single-stage-eqtl_', i, '.rds')) %>%
      filter(qtl_type == 'trans') %>%
      mutate(qtl_level = 'eQTL', stage = i) %>%
      dplyr::select(colnames(phqtl.peak))
    eqtl.peak <- rbind(eqtl.peak, table.tmp)
  }

# creating the histogram plot ####
  
  # plot style ####
  presentation <- theme(axis.text.x = element_text(size=12, face="bold", color="black"),
                        axis.text.y = element_text(size=12, face="bold", color="black"),
                        axis.title.x = element_text(size=15, face="bold", color="black"),
                        axis.title.y = element_text(size=15, face="bold", color="black"),
                        strip.text.x = element_text(size=15, face="bold", color="black"),
                        strip.text.y = element_text(size=15, face="bold", color="black"),
                        plot.title = element_text(size=15, face="bold"),
                        panel.background = element_rect(fill = "white",color="black"),
                        panel.grid.major = element_line(colour = "grey80"),
                        panel.grid.minor = element_blank(),
                        legend.position = "right")
  
  myColors <- brewer.pal(9,"Set1")[c(3,5,9,6,7)] 
  myColors <- c("black",brewer.pal(9,"Set1")[c(2,9)])
  plot.colour <- c("#000000", "#E69F00", "#009E73", "#0072B2", "#D55E00")
  names(plot.colour) <- c("cis", "DryFresh", "DryAR",  "6H", "RP")
  hist.colour <-  c("#E69F00", "#009E73", "#0072B2", "#D55E00")
  names(hist.colour) <- c("DryFresh", "DryAR",  "6H", "RP")
  names(myColors) <- c("cis","trans","none")
  Snoekcols <- scale_colour_manual(name = "eQTL type",values = myColors)
  Snoekfill <- scale_fill_manual(name = "eQTL type",values = myColors)
  
# plotting ####
  
  overlap <- function(table, stage) {
    for (i in 1:length(stage)) {
      if (nrow(table) != 0) {
        table <- subset(table, table[stage[i]] == T)
      } else {
        break
      }
    }
    nrow(table)
  }
  
  all.peak <- rbind(phqtl.peak, mqtl.peak, eqtl.peak)
  all.peak$stage <- factor(all.peak$stage, levels = c('phQTL', 'pd', 'ar', 'im', 'rp'))
  qtl.hist <- ggplot(all.peak, aes(x=qtl_bp, fill = stage)) +
    geom_histogram(binwidth = 2000000, right = T, origin = 0, alpha = 1) +
    #geom_density(alpha = 0.5) +
    facet_grid(factor(qtl_level, level = c('phQTL', 'mQTL', 'eQTL')) ~ qtl_chromosome, scales="free_y") +
    presentation +
    scale_fill_manual(values = c('#964B00', '#ccbb44', '#228833', '#4477aa', '#cc3311')) +
    theme(legend.position = "top", legend.text=element_text(size=5)) +
    labs(x="QTL peak position (Mb)",y="QTL counts") +
    scale_x_continuous(breaks=c(5, 10, 15, 20, 25, 30, 35, 40)*10^6,labels=c(5, 10, 15, 20, 25, 30, 35, 40))
  
  tiff(file = paste0("figures/all-qtl-hist.tiff"), 
       width = 2250, 
       height = 1600, 
       units = 'px',
       res = 300,
       compression = 'lzw')
  qtl.hist
  dev.off()
  
  # venn diagram ####
  
  qtl.table.summary <- data.frame(matrix(ncol = 18, nrow = 0))
  window.nu <- 2e6
  maxsize <- 100e6
  chr.num <- 5
  
  all.peak2 <- all.peak %>%
    mutate(interval = findInterval(qtl_bp, seq(1, maxsize, by = window.nu))) %>%
    select(trait, qtl_chromosome, interval, qtl_significance, stage, qtl_level) %>%
    #group_by(trait, qtl_chromosome, interval, qtl_significance, stage, qtl_level) %>%
    count(qtl_chromosome, interval, qtl_level) %>%
    #ungroup() %>%
    spread(qtl_level, n) %>%
    #select(phQTL, mQTL, eQTL) %>%
    replace(is.na(.), 0)
  
  overlap <- function(table, stage) {
    for (i in 1:length(stage)) {
      if (nrow(table) != 0) {
        table <- subset(table, table[stage[i]] > 0)
      } else {
        break
      }
    }
    nrow(table)
  }
  overlap(all.peak2, c('eQTL', 'phQTL', 'mQTL'))
  draw.triple.venn(area1 = overlap(all.peak2, 'phQTL'), 
                area3 = overlap(all.peak2, 'mQTL'), 
                area2 = overlap(all.peak2, 'eQTL'), 
                n13 = overlap(all.peak2, c('phQTL', 'mQTL')), 
                n12 = overlap(all.peak2, c('phQTL', 'eQTL')), 
                n23 = overlap(all.peak2, c('mQTL', 'eQTL')), 
                n123 = overlap(all.peak2, c('phQTL', 'mQTL', 'eQTL')), 
                category = c('phQTL', 'eQTL', 'mQTL'),
                lty = 'blank', 
                fill = c('#0d98ba', '#c71585', '#f8d568'))
                #alpha = 0.9)