-
Notifications
You must be signed in to change notification settings - Fork 1
/
characterizeTotalApaQtls.Rmd
236 lines (145 loc) · 8.61 KB
/
characterizeTotalApaQtls.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
---
title: "Characterize Total ApaQTLs"
author: "Briana Mittleman"
date: "10/11/2018"
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
This analysis will be used to characterize the total ApaQTLs. I will run the analysis on the total APAqtls in this analysis and will then run a similar analysis on the nuclear APAqtls in another analysis. I would like to study:
* Distance metrics:
+ distance from snp to TSS of gene
+ Distance from snp to peak
* Expression metrics:
+ expression of genes with significant QTLs vs other genes (by rna seq)
+ expression of genes with significant QTLs vs other genes (peak coverage)
* Chrom HMM metrics:
+ look at the chrom HMM interval for the significant QTLs
##Upload Libraries and Data:
Library
```{r}
library(workflowr)
library(reshape2)
library(tidyverse)
library(VennDiagram)
library(data.table)
library(cowplot)
```
Permuted Results from APA:
I will add a column to this dataframe that will tell me if the association is significant at 10% FDR. This will help me plot based on significance later in the analysis. I am also going to seperate the PID into relevant pieces.
```{r}
totalAPA=read.table("../data/perm_QTL_trans/filtered_APApeaks_merged_allchrom_refseqGenes_pheno_Total_transcript_permResBH.txt", stringsAsFactors = F, header=T) %>% mutate(sig=ifelse(-log10(bh)>=1, 1,0 )) %>% separate(pid, sep = ":", into=c("chr", "start", "end", "id")) %>% separate(id, sep = "_", into=c("gene", "strand", "peak"))
totalAPA$sig=as.factor(totalAPA$sig)
print(names(totalAPA))
```
##Distance Metrics
### Distance from snp to TSS
I ran the QTL analysis based on the starting position of the gene.
```{r}
ggplot(totalAPA, aes(x=dist, fill=sig, by=sig)) + geom_density(alpha=.5) + labs(title="Distance from snp to TSS", x="Base Pairs") + scale_fill_discrete(guide = guide_legend(title = "Significant QTL"))
```
It looks like most of the signifcant values are 100,000 bases. This makes sense. I can zoom in on this portion.
```{r}
ggplot(totalAPA, aes(x=dist, fill=sig, by=sig)) + geom_density(alpha=.5)+coord_cartesian(xlim = c(-150000, 150000))
```
### Distance from snp to peak
To perform this analysis I need to recover the peak positions.
The peak file I used for the QTL analysis is: /project2/gilad/briana/threeprimeseq/data/mergedPeaks_comb/filtered_APApeaks_merged_allchrom_refseqTrans.noties_sm.fixed.bed
```{r}
peaks=read.table("../data/PeaksUsed/filtered_APApeaks_merged_allchrom_refseqTrans.noties_sm.fixed.bed", col.names = c("chr", "peakStart", "peakEnd", "PeakNum", "PeakScore", "Strand", "Gene")) %>% mutate(peak=paste("peak", PeakNum,sep="")) %>% mutate(PeakCenter=peakStart+ (peakEnd- peakStart))
```
I want to join the peak start to the totalAPA file but the peak column. I will then create a column that is snppos-peakcenter.
```{r}
totalAPA_peakdist= totalAPA %>% inner_join(peaks, by="peak") %>% separate(sid, into=c("snpCHR", "snpLOC"), by=":")
totalAPA_peakdist$snpLOC= as.numeric(totalAPA_peakdist$snpLOC)
totalAPA_peakdist= totalAPA_peakdist %>% mutate(DisttoPeak= snpLOC-PeakCenter)
```
Plot this by significance.
```{r}
ggplot(totalAPA_peakdist, aes(x=DisttoPeak, fill=sig, by=sig)) + geom_density(alpha=.5) + labs(title="Distance from snp peak", x="log10 absolute value Distance to Peak") + scale_fill_discrete(guide = guide_legend(title = "Significant QTL"))
```
Look at the summarys based on significance:
```{r}
totalAPA_peakdist_sig=totalAPA_peakdist %>% filter(sig==1)
totalAPA_peakdist_notsig=totalAPA_peakdist %>% filter(sig==0)
summary(totalAPA_peakdist_sig$DisttoPeak)
summary(totalAPA_peakdist_notsig$DisttoPeak)
```
```{r}
ggplot(totalAPA_peakdist, aes(y=DisttoPeak,x=sig, fill=sig, by=sig)) + geom_boxplot() + scale_fill_discrete(guide = guide_legend(title = "Significant QTL"))
```
Look like there are some outliers that are really far. I will remove variants greater than 1*10^6th away
```{r}
totalAPA_peakdist_filt=totalAPA_peakdist %>% filter(abs(DisttoPeak) <= 1*(10^6))
ggplot(totalAPA_peakdist_filt, aes(y=DisttoPeak,x=sig, fill=sig, by=sig)) + geom_boxplot() + scale_fill_discrete(guide = guide_legend(title = "Significant QTL")) + facet_grid(.~strand)
ggplot(totalAPA_peakdist_filt, aes(x=DisttoPeak, fill=sig, by=sig)) + geom_density() + scale_fill_discrete(guide = guide_legend(title = "Significant QTL")) + facet_grid(.~strand)
```
This gives a similar distribution.
I did snp - peak. This means if the peak is downstream of the snp on the positive strand the number will be negative.
In this case the peak is downstream of the snp.
```{r}
totalAPA_peakdist %>% filter(sig==1) %>% filter(strand=="+") %>% filter(DisttoPeak < 0) %>% nrow()
totalAPA_peakdist %>% filter(sig==1) %>% filter(strand=="-") %>% filter(DisttoPeak > 0) %>% nrow()
```
Peak is upstream of the snp.
```{r}
totalAPA_peakdist %>% filter(sig==1) %>% filter(strand=="+") %>% filter(DisttoPeak > 0) %>% nrow()
totalAPA_peakdist %>% filter(sig==1) %>% filter(strand=="-") %>% filter(DisttoPeak < 0) %>% nrow()
```
This means there is about 50/50 distribution around the peak start.
I am going to plot a violin plot for just the significant ones.
```{r}
ggplot(totalAPA_peakdist_sig, aes(x=DisttoPeak)) + geom_density()
```
Within 1000 bases of the peak center.
```{r}
totalAPA_peakdist_sig %>% filter(abs(DisttoPeak) < 1000) %>% nrow()
totalAPA_peakdist_sig %>% filter(abs(DisttoPeak) < 10000) %>% nrow()
totalAPA_peakdist_sig %>% filter(abs(DisttoPeak) < 100000) %>% nrow()
```
29 QTLs are within 1000 bp of the peak center, 57 within 10,000bp and 98 within 100,000bp
##Expression metrics
Next I want to pull in the expression values and compare the expression of genes with a total APA qtl in comparison to genes without one. I will also need to pull in the gene names file to add in the gene names from the ensg ID.
Remove the # from the file.
```{r}
expression=read.table("../data/mol_pheno/fastqtl_qqnorm_RNAseq_phase2.fixed.noChr.txt", header = T,stringsAsFactors = F)
expression_mean=apply(expression[,5:73],1,mean,na.rm=TRUE)
expression_var=apply(expression[,5:73],1,var,na.rm=TRUE)
expression$exp.mean= expression_mean
expression$exp.var=expression_var
expression= expression %>% separate(ID, into=c("Gene.stable.ID", "ver"), sep ="[.]")
```
Now I can pull in the names and join the dataframes.
```{r}
geneNames=read.table("../data/ensemble_to_genename.txt", sep="\t", header=T,stringsAsFactors = F)
expression=expression %>% inner_join(geneNames,by="Gene.stable.ID")
expression=expression %>% select(Chr, start, end, Gene.name, exp.mean,exp.var) %>% rename("gene"=Gene.name)
```
Now I can join this with the qtls.
```{r}
totalAPA_wExp=totalAPA %>% inner_join(expression, by="gene")
```
```{r}
ggplot(totalAPA_wExp, aes(x=exp.mean, by=sig, fill=sig)) + geom_density(alpha=.3)
```
This is not exactly what I want because there are multiple peaks in a gene so some genes are plotted multiple times. I want to group the QTLs by gene and see if there is 1 sig QTL for that gene.
```{r}
gene_wQTL= totalAPA_wExp %>% group_by(gene) %>% summarise(sig_gene=sum(as.numeric(as.character(sig)))) %>% ungroup() %>% inner_join(expression, by="gene") %>% mutate(sigGeneFactor=ifelse(sig_gene>=1, 1,0))
gene_wQTL$sigGeneFactor= as.factor(as.character(gene_wQTL$sigGeneFactor))
```
Therea are 92 genes in this set with a QTL.
```{r}
ggplot(gene_wQTL, aes(x=exp.mean, by=sigGeneFactor, fill=sigGeneFactor)) + geom_density(alpha=.3) +labs(title="Mean in RNA expression by genes with significant QTL", x="Mean in normalized expression") + scale_fill_discrete(guide = guide_legend(title = "Significant QTL"))
```
I can do a similar analysis but test the variance in the gene expression.
```{r}
ggplot(gene_wQTL, aes(x=exp.var, by=sigGeneFactor, fill=sigGeneFactor)) + geom_density(alpha=.3) + labs(title="Varriance in RNA expression by genes with significant QTL", x="Variance in normalized expression") + scale_fill_discrete(guide = guide_legend(title = "Significant QTL"))
```
### Peak coverage for QTLs
I can also look at peak coverage for peaks with QLTs and those without. I will first look at this on peak level then mvoe to gene level. The peak scores come from the coverage in the peaks.
The totalAPA_peakdist data frame has the information I need for this.
```{r}
ggplot(totalAPA_peakdist, aes(x=PeakScore,fill=sig,by=sig)) + geom_density(alpha=.5)+ scale_x_log10() + labs(title="Peak score by significance")
```
This is expected. It makes sense that we have more power to detect qtls in higher expressed peaks. This leads me to beleive that filtering out low peaks may add power but will not mitigate the effect.