comparison goseq.r @ 9:ef2ad746b589 draft

"planemo upload for repository https://github.com/galaxyproject/tools-iuc/tree/master/tools/goseq commit e230a8db9e090c6e0ea9577863ec6153df79e145"
author iuc
date Sun, 06 Jun 2021 22:47:36 +0000
parents 8b3e3657034e
children 602de62d995b
comparison
equal deleted inserted replaced
8:8b3e3657034e 9:ef2ad746b589
1 options( show.error.messages=F, error = function () { cat( geterrmessage(), file=stderr() ); q( "no", 1, F ) } ) 1 options(show.error.messages = F, error = function() {
2 cat(geterrmessage(), file = stderr())
3 q("no", 1, F)
4 })
2 5
3 # we need that to not crash galaxy with an UTF8 error on German LC settings. 6 # we need that to not crash galaxy with an UTF8 error on German LC settings.
4 loc <- Sys.setlocale("LC_MESSAGES", "en_US.UTF-8") 7 loc <- Sys.setlocale("LC_MESSAGES", "en_US.UTF-8")
5 8
6 suppressPackageStartupMessages({ 9 suppressPackageStartupMessages({
7 library("goseq") 10 library("goseq")
8 library("optparse") 11 library("optparse")
9 library("dplyr") 12 library("dplyr")
10 library("ggplot2") 13 library("ggplot2")
11 }) 14 })
12 15
13 sessionInfo() 16 sessionInfo()
14 17
15 option_list <- list( 18 option_list <- list(
16 make_option(c("-d", "--dge_file"), type="character", help="Path to file with differential gene expression result"), 19 make_option("--dge_file", type = "character", help = "Path to file with differential gene expression result"),
17 make_option(c("-lf", "--length_file"), type="character", default=NULL, help="Path to tabular file mapping gene id to length"), 20 make_option("--length_file", type = "character", default = NULL, help = "Path to tabular file mapping gene id to length"),
18 make_option(c("-g", "--genome"), type="character", default=NULL, help="Genome [used for looking up correct gene length]"), 21 make_option("--genome", type = "character", default = NULL, help = "Genome [used for looking up correct gene length]"),
19 make_option(c("-i", "--gene_id"), type="character", default=NULL, help="Gene ID format of genes in DGE file"), 22 make_option("--gene_id", type = "character", default = NULL, help = "Gene ID format of genes in DGE file"),
20 make_option(c("-fc", "--fetch_cats"), type="character", default=NULL, help="Categories to get can include one or more of GO:CC, GO:BP, GO:MF, KEGG"), 23 make_option("--fetch_cats", type = "character", default = NULL, help = "Categories to get can include one or more of GO:CC, GO:BP, GO:MF, KEGG"),
21 make_option(c("-cat_file", "--category_file"), type="character", default=NULL, help="Path to tabular file with gene_id <-> category mapping"), 24 make_option("--category_file", type = "character", default = NULL, help = "Path to tabular file with gene_id <-> category mapping"),
22 make_option(c("-w","--wallenius_tab"), type="character", default=NULL, help="Path to output file with P-values estimated using wallenius distribution"), 25 make_option("--wallenius_tab", type = "character", default = NULL, help = "Path to output file with P-values estimated using wallenius distribution"),
23 make_option(c("-n","--nobias_tab"), type="character", default=NULL, help="Path to output file with P-values estimated using hypergeometric distribution and no correction for gene length bias"), 26 make_option("--nobias_tab", type = "character", default = NULL, help = "Path to output file with P-values estimated using hypergeometric distribution and no correction for gene length bias"),
24 make_option(c("-r", "--repcnt"), type="integer", default=0, help="Number of repeats for sampling"), 27 make_option("--repcnt", type = "integer", default = 0, help = "Number of repeats for sampling"),
25 make_option(c("-s","--sampling_tab"), type="character", default=NULL, help="Path to output file with P-values estimated using sampling distribution"), 28 make_option("--sampling_tab", type = "character", default = NULL, help = "Path to output file with P-values estimated using sampling distribution"),
26 make_option(c("-p", "--p_adj_method"), type="character", default="BH", help="Multiple hypothesis testing correction method to use"), 29 make_option("--p_adj_method", type = "character", default = "BH", help = "Multiple hypothesis testing correction method to use"),
27 make_option(c("-cat", "--use_genes_without_cat"), type="logical", default=FALSE, help="A large number of gene may have no GO term annotated. If this option is set to FALSE, genes without category will be ignored in the calculation of p-values(default behaviour). If TRUE these genes will count towards the total number of genes outside the tested category (default behaviour prior to version 1.15.2)."), 30 make_option("--use_genes_without_cat", type = "logical", default = FALSE, help = "A large number of gene may have no GO term annotated. If this option is set to FALSE, genes without category will be ignored in the calculation of p-values(default behaviour). If TRUE these genes will count towards the total number of genes outside the tested category (default behaviour prior to version 1.15.2)."),
28 make_option(c("-tp", "--top_plot"), type="character", default=NULL, help="Path to output PDF with top10 over-rep GO terms"), 31 make_option("--top_plot", type = "character", default = NULL, help = "Path to output PDF with top10 over-rep GO terms"),
29 make_option(c("-plots", "--make_plots"), default=FALSE, type="logical", help="Produce diagnostic plots?"), 32 make_option("--make_plots", default = FALSE, type = "logical", help = "Produce diagnostic plots?"),
30 make_option(c("-l","--length_bias_plot"), type="character", default=NULL, help="Path to length-bias plot"), 33 make_option("--length_bias_plot", type = "character", default = NULL, help = "Path to length-bias plot"),
31 make_option(c("-sw","--sample_vs_wallenius_plot"), type="character", default=NULL, help="Path to plot comparing sampling with wallenius p-values"), 34 make_option("--sample_vs_wallenius_plot", type = "character", default = NULL, help = "Path to plot comparing sampling with wallenius p-values"),
32 make_option(c("-rd", "--rdata"), type="character", default=NULL, help="Path to RData output file"), 35 make_option("--rdata", type = "character", default = NULL, help = "Path to RData output file"),
33 make_option(c("-g2g", "--categories_genes_out_fp"), type="character", default=NULL, help="Path to file with categories (GO/KEGG terms) and associated DE genes") 36 make_option("--categories_genes_out_fp", type = "character", default = NULL, help = "Path to file with categories (GO/KEGG terms) and associated DE genes")
34 ) 37 )
35 38
36 parser <- OptionParser(usage = "%prog [options] file", option_list=option_list) 39 parser <- OptionParser(usage = "%prog [options] file", option_list = option_list)
37 args = parse_args(parser) 40 args <- parse_args(parser)
38 41
39 if (!is.null(args$fetch_cats)) { 42 if (!is.null(args$fetch_cats)) {
40 fetch_cats = unlist(strsplit(args$fetch_cats, ",")) 43 fetch_cats <- unlist(strsplit(args$fetch_cats, ","))
41 } else { 44 } else {
42 fetch_cats = "Custom" 45 fetch_cats <- "Custom"
43 } 46 }
44 47
45 # format DE genes into named vector suitable for goseq 48 # format DE genes into named vector suitable for goseq
46 # check if header is present 49 # check if header is present
47 first_line = read.delim(args$dge_file, header=FALSE, nrow=1) 50 first_line <- read.delim(args$dge_file, header = FALSE, nrow = 1)
48 second_col = toupper(first_line[, ncol(first_line)]) 51 second_col <- toupper(first_line[, ncol(first_line)])
49 if (second_col == TRUE || second_col == FALSE) { 52 if (second_col == TRUE || second_col == FALSE) {
50 dge_table = read.delim(args$dge_file, header=FALSE, sep="\t") 53 dge_table <- read.delim(args$dge_file, header = FALSE, sep = "\t")
51 } else { 54 } else {
52 dge_table = read.delim(args$dge_file, header=TRUE, sep="\t") 55 dge_table <- read.delim(args$dge_file, header = TRUE, sep = "\t")
53 } 56 }
54 genes = as.numeric(as.logical(dge_table[, ncol(dge_table)])) # Last column contains TRUE/FALSE 57 genes <- as.numeric(as.logical(dge_table[, ncol(dge_table)])) # Last column contains TRUE/FALSE
55 names(genes) = dge_table[,1] # Assuming first column contains gene names 58 names(genes) <- dge_table[, 1] # Assuming first column contains gene names
56 59
57 # gene lengths, assuming last column 60 # gene lengths, assuming last column
58 first_line = read.delim(args$length_file, header=FALSE, nrow=1) 61 first_line <- read.delim(args$length_file, header = FALSE, nrow = 1)
59 if (is.numeric(first_line[, ncol(first_line)])) { 62 if (is.numeric(first_line[, ncol(first_line)])) {
60 length_table = read.delim(args$length_file, header=FALSE, sep="\t", check.names=FALSE) 63 length_table <- read.delim(args$length_file, header = FALSE, sep = "\t", check.names = FALSE)
61 } else { 64 } else {
62 length_table = read.delim(args$length_file, header=TRUE, sep="\t", check.names=FALSE) 65 length_table <- read.delim(args$length_file, header = TRUE, sep = "\t", check.names = FALSE)
63 } 66 }
64 row.names(length_table) = length_table[,1] 67 row.names(length_table) <- length_table[, 1]
65 # get vector of gene length in same order as the genes 68 # get vector of gene length in same order as the genes
66 gene_lengths = length_table[names(genes),][, ncol(length_table)] 69 gene_lengths <- length_table[names(genes), ][, ncol(length_table)]
67 70
68 # Estimate PWF 71 # Estimate PWF
69 if (args$make_plots) { 72 if (args$make_plots) {
70 pdf(args$length_bias_plot) 73 pdf(args$length_bias_plot)
71 } 74 }
72 pwf=nullp(genes, genome=args$genome, id=args$gene_id, bias.data=gene_lengths, plot.fit=args$make_plots) 75 pwf <- nullp(genes, genome = args$genome, id = args$gene_id, bias.data = gene_lengths, plot.fit = args$make_plots)
73 if (args$make_plots) { 76 if (args$make_plots) {
74 dev.off() 77 dev.off()
75 } 78 }
76 79
77 # Fetch GO annotations if category_file hasn't been supplied: 80 # Fetch GO annotations if category_file hasn't been supplied:
78 if (is.null(args$category_file)) { 81 if (is.null(args$category_file)) {
79 go_map=getgo(genes=names(genes), genome=args$genome, id=args$gene_id, fetch.cats=fetch_cats) 82 go_map <- getgo(genes = names(genes), genome = args$genome, id = args$gene_id, fetch.cats = fetch_cats)
80 } else { 83 } else {
81 # check for header: first entry in first column must be present in genes, else it's a header 84 # check for header: first entry in first column must be present in genes, else it's a header
82 first_line = read.delim(args$category_file, header=FALSE, nrow=1) 85 first_line <- read.delim(args$category_file, header = FALSE, nrow = 1)
83 if (first_line[,1] %in% names(genes)) { 86 if (first_line[, 1] %in% names(genes)) {
84 go_map = read.delim(args$category_file, header=FALSE) 87 go_map <- read.delim(args$category_file, header = FALSE)
85 } else { 88 } else {
86 go_map = read.delim(args$category_file, header=TRUE) 89 go_map <- read.delim(args$category_file, header = TRUE)
87 } 90 }
88 } 91 }
89 92
90 results <- list() 93 results <- list()
91 94
92 runGoseq <- function(pwf, genome, gene_id, goseq_method, use_genes_without_cat, repcnt, gene2cat, p_adj_method, out_fp){ 95 run_goseq <- function(pwf, genome, gene_id, goseq_method, use_genes_without_cat, repcnt, gene2cat, p_adj_method, out_fp) {
93 out=goseq(pwf, genome=genome, id=gene_id, method=goseq_method, use_genes_without_cat=use_genes_without_cat, gene2cat=go_map) 96 out <- goseq(pwf, genome = genome, id = gene_id, method = goseq_method, use_genes_without_cat = use_genes_without_cat, gene2cat = go_map)
94 out$p.adjust.over_represented = p.adjust(out$over_represented_pvalue, method=p_adj_method) 97 out$p_adjust_over_represented <- p.adjust(out$over_represented_pvalue, method = p_adj_method)
95 out$p.adjust.under_represented = p.adjust(out$under_represented_pvalue, method=p_adj_method) 98 out$p_adjust_under_represented <- p.adjust(out$under_represented_pvalue, method = p_adj_method)
96 write.table(out, out_fp, sep="\t", row.names=FALSE, quote=FALSE) 99 write.table(out, out_fp, sep = "\t", row.names = FALSE, quote = FALSE)
97 return(out) 100 return(out)
98 } 101 }
99 102
100 # wallenius approximation of p-values 103 # wallenius approximation of p-values
101 if (!is.null(args$wallenius_tab)) results[['Wallenius']] <- runGoseq( 104 if (!is.null(args$wallenius_tab)) {
102 pwf, 105 results[["Wallenius"]] <- run_goseq(
103 genome=args$genome, 106 pwf,
104 gene_id=args$gene_id, 107 genome = args$genome,
105 goseq_method="Wallenius", 108 gene_id = args$gene_id,
106 use_genes_without_cat=args$use_genes_without_cat, 109 goseq_method = "Wallenius",
107 repcnt=args$repcnt, 110 use_genes_without_cat = args$use_genes_without_cat,
108 gene2cat=go_map, 111 repcnt = args$repcnt,
109 p_adj_method=args$p_adj_method, 112 gene2cat = go_map,
110 out_fp=args$wallenius_tab) 113 p_adj_method = args$p_adj_method,
114 out_fp = args$wallenius_tab
115 )
116 }
111 117
112 118
113 # hypergeometric (no length bias correction) 119 # hypergeometric (no length bias correction)
114 if (!is.null(args$nobias_tab)) results[['Hypergeometric']] <- runGoseq( 120 if (!is.null(args$nobias_tab)) {
115 pwf, 121 results[["Hypergeometric"]] <- run_goseq(
116 genome=args$genome, 122 pwf,
117 gene_id=args$gene_id, 123 genome = args$genome,
118 goseq_method="Hypergeometric", 124 gene_id = args$gene_id,
119 use_genes_without_cat=args$use_genes_without_cat, 125 goseq_method = "Hypergeometric",
120 repcnt=args$repcnt, 126 use_genes_without_cat = args$use_genes_without_cat,
121 gene2cat=go_map, 127 repcnt = args$repcnt,
122 p_adj_method=args$p_adj_method, 128 gene2cat = go_map,
123 out_fp=args$nobias_tab) 129 p_adj_method = args$p_adj_method,
130 out_fp = args$nobias_tab
131 )
132 }
124 133
125 # Sampling distribution 134 # Sampling distribution
126 if (args$repcnt > 0){ 135 if (args$repcnt > 0) {
127 results[['Sampling']] <- runGoseq( 136 results[["Sampling"]] <- run_goseq(
128 pwf, 137 pwf,
129 genome=args$genome, 138 genome = args$genome,
130 gene_id=args$gene_id, 139 gene_id = args$gene_id,
131 goseq_method="Sampling", 140 goseq_method = "Sampling",
132 use_genes_without_cat=args$use_genes_without_cat, 141 use_genes_without_cat = args$use_genes_without_cat,
133 repcnt=args$repcnt, 142 repcnt = args$repcnt,
134 gene2cat=go_map, 143 gene2cat = go_map,
135 p_adj_method=args$p_adj_method, 144 p_adj_method = args$p_adj_method,
136 out_fp=args$sampling_tab) 145 out_fp = args$sampling_tab
146 )
137 147
138 # Compare sampling with wallenius 148 # Compare sampling with wallenius
139 if (args$make_plots & !is.null(args$wallenius_tab)) { 149 if (args$make_plots & !is.null(args$wallenius_tab)) {
140 pdf(args$sample_vs_wallenius_plot) 150 pdf(args$sample_vs_wallenius_plot)
141 plot(log10(results[['Wallenius']][,2]), 151 plot(log10(results[["Wallenius"]][, 2]),
142 log10(results[['Sampling']][match(results[['Sampling']][,1], results[['Wallenius']][,1]), 2]), 152 log10(results[["Sampling"]][match(results[["Sampling"]][, 1], results[["Wallenius"]][, 1]), 2]),
143 xlab="log10(Wallenius p-values)", 153 xlab = "log10(Wallenius p-values)",
144 ylab="log10(Sampling p-values)", 154 ylab = "log10(Sampling p-values)",
145 xlim=c(-3,0)) 155 xlim = c(-3, 0)
146 abline(0,1,col=3,lty=2) 156 )
157 abline(0, 1, col = 3, lty = 2)
147 dev.off() 158 dev.off()
148 } 159 }
149 } 160 }
150 161
151 # Plot the top 10 162 # Plot the top 10
152 if (!is.null(args$top_plot)) { 163 if (!is.null(args$top_plot)) {
153 cats_title <- gsub("GO:","", args$fetch_cats) 164 cats_title <- gsub("GO:", "", args$fetch_cats)
154 # modified from https://bioinformatics-core-shared-training.github.io/cruk-summer-school-2018/RNASeq2018/html/06_Gene_set_testing.nb.html 165 # modified from https://bioinformatics-core-shared-training.github.io/cruk-summer-school-2018/RNASeq2018/html/06_Gene_set_testing.nb.html
155 pdf(args$top_plot) 166 pdf(args$top_plot)
156 for (m in names(results)) { 167 for (m in names(results)) {
157 p <- results[[m]] %>% 168 p <- results[[m]] %>%
158 top_n(10, wt=-over_represented_pvalue) %>% 169 top_n(10, wt = -over_represented_pvalue) %>%
159 mutate(hitsPerc=numDEInCat*100/numInCat) %>% 170 mutate(hitsPerc = numDEInCat * 100 / numInCat) %>%
160 ggplot(aes(x=hitsPerc, 171 ggplot(aes(
161 y=reorder(substr(term, 1, 40), -over_represented_pvalue), # only use 1st 40 chars of terms otherwise squashes plot 172 x = hitsPerc,
162 colour=p.adjust.over_represented, 173 y = reorder(substr(term, 1, 40), -over_represented_pvalue), # only use 1st 40 chars of terms otherwise squashes plot
163 size=numDEInCat)) + 174 colour = p_adjust_over_represented,
175 size = numDEInCat
176 )) +
164 geom_point() + 177 geom_point() +
165 expand_limits(x=0) + 178 expand_limits(x = 0) +
166 labs(x="% DE in category", y="Category", colour="Adj P value", size="Count", title=paste("Top over-represented categories in", cats_title), subtitle=paste(m, " method")) + 179 labs(x = "% DE in category", y = "Category", colour = "Adj P value", size = "Count", title = paste("Top over-represented categories in", cats_title), subtitle = paste(m, " method")) +
167 theme(plot.title=element_text(hjust = 0.5), plot.subtitle=element_text(hjust = 0.5)) 180 theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust = 0.5))
168 print(p) 181 print(p)
169 } 182 }
170 dev.off() 183 dev.off()
171 } 184 }
172 185
173 # Extract the genes to the categories (GO/KEGG terms) 186 # Extract the genes to the categories (GO/KEGG terms)
174 if (!is.null(args$categories_genes_out_fp)) { 187 if (!is.null(args$categories_genes_out_fp)) {
175 cat2gene = split(rep(names(go_map), sapply(go_map, length)), unlist(go_map, use.names = FALSE)) 188 cat2gene <- split(rep(names(go_map), sapply(go_map, length)), unlist(go_map, use.names = FALSE))
176 # extract categories (GO/KEGG terms) for all results 189 # extract categories (GO/KEGG terms) for all results
177 categories = c() 190 categories <- c()
178 for (m in names(results)) { 191 for (m in names(results)) {
179 categories = c(categories, results[[m]]$category) 192 categories <- c(categories, results[[m]]$category)
180 } 193 }
181 categories = unique(categories) 194 categories <- unique(categories)
182 # extract the DE genes for each catge term 195 # extract the DE genes for each catge term
183 categories_genes = data.frame(Categories=categories, DEgenes=rep('', length(categories))) 196 categories_genes <- data.frame(category = categories, de_genes = rep("", length(categories)))
184 categories_genes$DEgenes = as.character(categories_genes$DEgenes) 197 categories_genes$de_genes <- as.character(categories_genes$de_genes)
185 rownames(categories_genes) = categories 198 rownames(categories_genes) <- categories
186 for (cat in categories){ 199 for (cat in categories) {
187 tmp = pwf[cat2gene[[cat]],] 200 tmp <- pwf[cat2gene[[cat]], ]
188 tmp = rownames(tmp[tmp$DEgenes > 0, ]) 201 tmp <- rownames(tmp[tmp$DEgenes > 0, ])
189 categories_genes[cat, 'DEgenes'] = paste(tmp, collapse=',') 202 categories_genes[cat, "de_genes"] <- paste(tmp, collapse = ",")
190 } 203 }
191 # output 204 # output
192 write.table(categories_genes, args$categories_genes_out_fp, sep = "\t", row.names=FALSE, quote=FALSE) 205 write.table(categories_genes, args$categories_genes_out_fp, sep = "\t", row.names = FALSE, quote = FALSE)
193 } 206 }
194 207
195 # Output RData file 208 # Output RData file
196 if (!is.null(args$rdata)) { 209 if (!is.null(args$rdata)) {
197 save.image(file=args$rdata) 210 save.image(file = args$rdata)
198 } 211 }