Mercurial > repos > iuc > volcanoplot
changeset 5:44608d0193ed draft
"planemo upload for repository https://github.com/galaxyproject/tools-iuc/tree/master/tools/volcanoplot commit 8464d1b013c316d88b37884be521c0ef50be5623"
author | iuc |
---|---|
date | Sun, 06 Jun 2021 09:12:22 +0000 |
parents | 73b8cb5bddcd |
children | 83c573f2e73c |
files | test-data/out.pdf test-data/out.rscript test-data/out2.pdf volcanoplot.R volcanoplot.xml |
diffstat | 5 files changed, 326 insertions(+), 167 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test-data/out.rscript Sun Jun 06 09:12:22 2021 +0000 @@ -0,0 +1,103 @@ + +# Galaxy settings start --------------------------------------------------- + +# setup R error handling to go to stderr +options(show.error.messages = F, error = function() {cat(geterrmessage(), file = stderr()); q("no", 1, F)}) + +# we need that to not crash galaxy with an UTF8 error on German LC settings. +loc <- Sys.setlocale("LC_MESSAGES", "en_US.UTF-8") + + +# Load packages ----------------------------------------------------------- + +suppressPackageStartupMessages({ + library(dplyr) + library(ggplot2) + library(ggrepel) +}) + + +# Import data ------------------------------------------------------------ + +# Check if header is present by checking if P value column is numeric or not + +first_line <- read.delim('/private/var/folders/zn/m_qvr9zd7tq0wdtsbq255f8xypj_zg/T/tmpfpemuuun/files/8/3/7/dataset_8374ef6b-02c7-46f1-afc9-408a2a6cbde4.dat', header = FALSE, nrow = 1) + +first_pvalue <- first_line[, 3] + +if (is.numeric(first_pvalue)) { + print("No header row detected") + results <- read.delim('/private/var/folders/zn/m_qvr9zd7tq0wdtsbq255f8xypj_zg/T/tmpfpemuuun/files/8/3/7/dataset_8374ef6b-02c7-46f1-afc9-408a2a6cbde4.dat', header = FALSE) +} else { + print("Header row detected") + results <- read.delim('/private/var/folders/zn/m_qvr9zd7tq0wdtsbq255f8xypj_zg/T/tmpfpemuuun/files/8/3/7/dataset_8374ef6b-02c7-46f1-afc9-408a2a6cbde4.dat', header = TRUE) +} + + +# Format data ------------------------------------------------------------ + +# Create columns from the column numbers specified +results <- results %>% mutate(fdr = .[[4]], + pvalue = .[[3]], + logfc = .[[2]], + labels = .[[1]]) + +# Get names for legend +down <- unlist(strsplit('Down,Not Sig,Up', split = ","))[1] +notsig <- unlist(strsplit('Down,Not Sig,Up', split = ","))[2] +up <- unlist(strsplit('Down,Not Sig,Up', split = ","))[3] + +# Set colours +colours <- setNames(c("cornflowerblue", "grey", "firebrick"), c(down, notsig, up)) + +# Create significant (sig) column +results <- mutate(results, sig = case_when( + fdr < 0.05 & logfc > 0.0 ~ up, + fdr < 0.05 & logfc < -0.0 ~ down, + TRUE ~ notsig)) + + +# Specify genes to label -------------------------------------------------- +labelfile <- read.delim('/private/var/folders/zn/m_qvr9zd7tq0wdtsbq255f8xypj_zg/T/tmpfpemuuun/files/4/2/f/dataset_42fc8a63-f9cc-435b-9bb3-dd106b708cd9.dat') +results <- mutate(results, labels = ifelse(labels %in% labelfile[, 1], labels, "")) + + +# Create plot ------------------------------------------------------------- + +pdf("out.pdf") +p <- ggplot(results, aes(x = logfc, y = -log10(pvalue))) + + geom_point(aes(colour = sig)) + + scale_color_manual(values = colours) + + scale_fill_manual(values = colours) + + theme(panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.background = element_blank(), + axis.line = element_line(colour = "black"), + legend.key = element_blank()) + + + + + + +# Set legend title +p <- p + labs(colour = "") + +# Add gene labels in boxes +p <- p + geom_label_repel(aes(label = labels, fill = sig), + segment.colour = "black", + colour = "white", + min.segment.length = 0, + show.legend = FALSE) + +print(p) +dev.off() + + +# Save RData ------------------------------------------------------------- +save.image(file="volcanoplot.RData") + + +# R and Package versions ------------------------------------------------- +sessionInfo() +
--- a/volcanoplot.R Sun Aug 04 10:53:30 2019 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,111 +0,0 @@ -# setup R error handling to go to stderr -options( show.error.messages=F, error = function () { cat( geterrmessage(), file=stderr() ); q( "no", 1, F ) } ) - -# we need that to not crash galaxy with an UTF8 error on German LC settings. -loc <- Sys.setlocale("LC_MESSAGES", "en_US.UTF-8") - -suppressPackageStartupMessages({ - library(dplyr) - library(getopt) - library(ggplot2) - library(ggrepel) -}) - -options(stringAsFactors = FALSE, useFancyQuotes = FALSE) -args <- commandArgs(trailingOnly = TRUE) - -spec <- matrix(c( - "input", "i", 1, "character", - "fdr_col", "a", 1, "integer", - "pval_col", "p", 1, "integer", - "lfc_col", "c", 1, "integer", - "label_col", "l", 1, "integer", - "signif_thresh", "s", 1, "double", - "lfc_thresh", "x", 1, "double", - "label_file", "f", 1, "character", - "top_num", "t", 1, "integer", - "title", "T", 1, "character", - "xlab", "X", 1, "character", - "ylab", "Y", 1, "character", - "xmin", "m", 1, "double", - "xmax", "M", 1, "double", - "ymax", "W", 1, "double", - "legend", "L", 1, "character", - "llabs", "z", 1, "character", - "boxes", "b", 0, "logical"), - byrow=TRUE, ncol=4) -opt <- getopt(spec) - -# Below modified from http://www.gettinggeneticsdone.com/2016/01/repel-overlapping-text-labels-in-ggplot2.html - -results <- read.delim(opt$input) -results$fdr <- results[, opt$fdr_col] -results$Pvalue <- results[, opt$pval_col] -results$logFC <- results[, opt$lfc_col] -results$labels <- as.character(results[, opt$label_col]) -label_down <- unlist(strsplit(opt$llabs, split=","))[1] -label_notsig <- unlist(strsplit(opt$llabs, split=","))[2] -label_up <- unlist(strsplit(opt$llabs, split=","))[3] -colours <- setNames(c("cornflowerblue","grey","firebrick"),c(label_down,label_notsig,label_up)) - -results <- mutate(results, sig=ifelse((fdr<opt$signif_thresh & logFC>opt$lfc_thresh), label_up, ifelse((fdr<opt$signif_thresh & logFC < -opt$lfc_thresh),label_down, label_notsig))) -results <- results[order(results$Pvalue),] -if (!is.null(opt$label_file)) { - labelfile <- read.delim(opt$label_file, stringsAsFactors=FALSE) - # label genes specified in file - results <- mutate(results, labels=ifelse(labels %in% labelfile[, 1], labels, "")) -} else if (is.null(opt$top_num)) { - # label all significant genes - results <- mutate(results, labels=ifelse(sig != label_notsig, labels, "")) -} else if (opt$top_num > 0) { - # label only top significant genes - top <- filter(results, sig != label_notsig) %>% top_n(n=-opt$top_num, Pvalue) - results <- mutate(results, labels=ifelse(labels %in% top$labels, labels, "")) -} else if (opt$top_num == 0) { - # no labels - results$labels <- NULL -} - -pdf("out.pdf") -p <- ggplot(results, aes(logFC, -log10(Pvalue))) + - geom_point(aes(col=sig)) + - scale_color_manual(values=colours) + - scale_fill_manual(values=colours) + - theme(panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), - panel.background = element_blank(), - axis.line = element_line(colour = "black"), - legend.key=element_blank()) -if (!is.null(opt$title)) { - p <- p + ggtitle(opt$title) -} -if (!is.null(opt$xlab)) { - p <- p + xlab(opt$xlab) -} -if (!is.null(opt$ylab)) { - p <- p + ylab(opt$ylab) -} -if (!is.null(opt$xmin) & !is.null(opt$xmax)) { - p <- p + xlim(opt$xmin, opt$xmax) -} -if (!is.null(opt$ymax)) { - p <- p + ylim(0, opt$ymax) -} -if (!is.null(opt$legend)) { - p <- p + labs(colour=opt$legend) -} else { - p <- p + labs(colour="") -} -if (!is.null(results$labels)) { - if (!is.null(opt$boxes)) { - p <- p + geom_label_repel(aes(label=labels, fill=sig), segment.colour="black", colour="white", min.segment.length=0, show.legend=FALSE) - } else { - p <- p + geom_text_repel(aes(label=labels, col=sig), min.segment.length=0, box.padding=0.3, point.padding=0.3, show.legend=FALSE) - } -} - -print(p) -dev.off() - -cat("Session information:\n\n") -sessionInfo() \ No newline at end of file
--- a/volcanoplot.xml Sun Aug 04 10:53:30 2019 -0400 +++ b/volcanoplot.xml Sun Jun 06 09:12:22 2021 +0000 @@ -1,61 +1,180 @@ -<tool id="volcanoplot" name="Volcano Plot" version="0.0.3"> +<tool id="volcanoplot" name="Volcano Plot" version="0.0.4"> <description>create a volcano plot</description> + <edam_topics> + <edam_topic>topic_0092</edam_topic> + </edam_topics> + <edam_operations> + <edam_operation>operation_0337</edam_operation> + </edam_operations> <requirements> - <requirement type="package" version="3.1.0">r-ggplot2</requirement> - <requirement type="package" version="0.8.0">r-ggrepel</requirement> - <requirement type="package" version="0.7.8">r-dplyr</requirement> - <requirement type="package" version="1.20.2">r-getopt</requirement> + <requirement type="package" version="3.3.3">r-ggplot2</requirement> + <requirement type="package" version="0.9.1">r-ggrepel</requirement> + <requirement type="package" version="1.0.6">r-dplyr</requirement> </requirements> <version_command><![CDATA[ -echo $(R --version | grep version | grep -v GNU)", ggplot2 version" $(R --vanilla --slave -e "library(ggplot2); cat(sessionInfo()\$otherPkgs\$ggplot2\$Version)" 2> /dev/null | grep -v -i "WARNING: ")", ggrepel version" $(R --vanilla --slave -e "library(ggrepel); cat(sessionInfo()\$otherPkgs\$ggrepel\$Version)" 2> /dev/null | grep -v -i "WARNING: ")", dplyr version" $(R --vanilla --slave -e "library(dplyr); cat(sessionInfo()\$otherPkgs\$dplyr\$Version)" 2> /dev/null | grep -v -i "WARNING: ")", getopt version" $(R --vanilla --slave -e "library(getopt); cat(sessionInfo()\$otherPkgs\$getopt\$Version)" 2> /dev/null | grep -v -i "WARNING: ") +echo $(R --version | grep version | grep -v GNU)", ggplot2 version" $(R --vanilla --slave -e "library(ggplot2); cat(sessionInfo()\$otherPkgs\$ggplot2\$Version)" 2> /dev/null | grep -v -i "WARNING: ")", ggrepel version" $(R --vanilla --slave -e "library(ggrepel); cat(sessionInfo()\$otherPkgs\$ggrepel\$Version)" 2> /dev/null | grep -v -i "WARNING: ")", dplyr version" $(R --vanilla --slave -e "library(dplyr); cat(sessionInfo()\$otherPkgs\$dplyr\$Version)" 2> /dev/null | grep -v -i "WARNING: ") ]]></version_command> <command detect_errors="exit_code"><![CDATA[ - -Rscript '${__tool_directory__}/volcanoplot.R' - - -i '$input' - -a $fdr_col - -p $pval_col - -c $lfc_col - -l $label_col - -s $signif_thresh - -x $lfc_thresh - #if $labels.label_select == 'file': - -f '$labels.label_file' - #else if $labels.label_select == 'signif': - #if $labels.top_num: - -t $labels.top_num - #end if - #else - -t 0 - #end if - #if $plot_options.boxes: - -b + #if $out_options.rscript_out: + cp '${volcanoplot_script}' rscript.txt && #end if - #if $plot_options.title: - -T '$plot_options.title' - #end if - #if $plot_options.xlab: - -X '$plot_options.xlab' - #end if - #if $plot_options.ylab: - -Y '$plot_options.ylab' - #end if - #if $plot_options.xmin: - -m '$plot_options.xmin' + Rscript '${volcanoplot_script}' +]]></command> + <configfiles> + <configfile name="volcanoplot_script"><![CDATA[ +# Galaxy settings start --------------------------------------------------- + +# setup R error handling to go to stderr +options(show.error.messages = F, error = function() {cat(geterrmessage(), file = stderr()); q("no", 1, F)}) + +# we need that to not crash galaxy with an UTF8 error on German LC settings. +loc <- Sys.setlocale("LC_MESSAGES", "en_US.UTF-8") + + +# Load packages ----------------------------------------------------------- + +suppressPackageStartupMessages({ + library(dplyr) + library(ggplot2) + library(ggrepel) +}) + + +# Import data ------------------------------------------------------------ + +# Check if header is present by checking if P value column is numeric or not + +first_line <- read.delim('$input', header = FALSE, nrow = 1) + +first_pvalue <- first_line[, $pval_col] + +if (is.numeric(first_pvalue)) { + print("No header row detected") + results <- read.delim('$input', header = FALSE) +} else { + print("Header row detected") + results <- read.delim('$input', header = TRUE) +} + + +# Format data ------------------------------------------------------------ + +# Create columns from the column numbers specified +results <- results %>% mutate(fdr = .[[$fdr_col]], + pvalue = .[[$pval_col]], + logfc = .[[$lfc_col]], + labels = .[[$label_col]]) + +# Get names for legend +down <- unlist(strsplit('$plot_options.legend_labs', split = ","))[1] +notsig <- unlist(strsplit('$plot_options.legend_labs', split = ","))[2] +up <- unlist(strsplit('$plot_options.legend_labs', split = ","))[3] + +# Set colours +colours <- setNames(c("cornflowerblue", "grey", "firebrick"), c(down, notsig, up)) + +# Create significant (sig) column +results <- mutate(results, sig = case_when( + fdr < $signif_thresh & logfc > $lfc_thresh ~ up, + fdr < $signif_thresh & logfc < -$lfc_thresh ~ down, + TRUE ~ notsig)) + +## R code below is left aligned for R script output + +#if $labels.label_select != "none" +# Specify genes to label -------------------------------------------------- + #if $labels.label_select == "file" +labelfile <- read.delim('$labels.label_file') +results <- mutate(results, labels = ifelse(labels %in% labelfile[, 1], labels, "")) + #elif $labels.label_select == "signif" + #if $labels.top_num <= 0 +results <- mutate(results, labels = "") + #elif $labels.top_num > 0 +top <- results %>% + filter(sig != notsig) %>% + slice_min(order_by = pvalue, n = $labels.top_num) +toplabels <- pull(top, labels) +results <- mutate(results, labels = ifelse(labels %in% toplabels, labels, "")) + #else +results <- mutate(results, labels = ifelse(sig != notsig, labels, "")) + #end if + #end if +#end if + + +# Create plot ------------------------------------------------------------- + +pdf("out.pdf") +p <- ggplot(results, aes(x = logfc, y = -log10(pvalue))) + + geom_point(aes(colour = sig)) + + scale_color_manual(values = colours) + + scale_fill_manual(values = colours) + + theme(panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.background = element_blank(), + axis.line = element_line(colour = "black"), + legend.key = element_blank()) + +#if not '$plot_options.title' +p <- p + ggtitle('$plot_options.title') +#end if + +#if not '$plot_options.xlab' +p <- p + xlab('$plot_options.xlab') +#end if + +#if not '$plot_options.ylab' +p <- p + ylab('$plot_options.ylab') +#end if + +#if not '$plot_options.xmin' and '$plot_options.xmax' +p <- p + xlim('$plot_options.xmin', '$plot_options.xmax') +#end if + +#if not '$plot_options.ymax' +p <- p + ylim(0, '$plot_options.ymax') +#end if + +# Set legend title +#if not '$plot_options.legend' +p <- p + labs(colour = '$plot_options.legend') +#else +p <- p + labs(colour = "") +#end if + +#if $labels.label_select != "none" +# Add gene labels in boxes + #if $plot_options.boxes +p <- p + geom_label_repel(aes(label = labels, fill = sig), + segment.colour = "black", + colour = "white", + min.segment.length = 0, + show.legend = FALSE) + #else +# Add gene labels +p <- p + geom_text_repel(aes(label = labels, col = sig), + min.segment.length = 0, + box.padding = 0.3, + point.padding = 0.3, + show.legend = FALSE) #end if - #if $plot_options.xmax: - -M '$plot_options.xmax' - #end if - #if $plot_options.ymax: - -W '$plot_options.ymax' - #end if - #if $plot_options.legend: - -L '$plot_options.legend' - #end if - -z '$plot_options.legend_labs' +#end if + +print(p) +dev.off() + -]]></command> +#if $out_options.rdata_out +# Save RData ------------------------------------------------------------- +save.image(file="volcanoplot.RData") +#end if + + +# R and Package versions ------------------------------------------------- +sessionInfo() + +]]></configfile> +</configfiles> <inputs> <param name="input" type="data" format="tabular" label="Specify an input file" /> <param name="fdr_col" type="data_column" data_ref="input" label="FDR (adjusted P value)" /> @@ -89,12 +208,25 @@ <param name="legend" type="text" optional="True" label="Label for Legend Title"/> <param name="legend_labs" type="text" value="Down,Not Sig,Up" label="Labels for Legend" help="Labels in the legend can be specified. Default: Down,Not Sig,Up"/> </section> + <section name="out_options" expanded="false" title="Output Options"> + <param name="rscript_out" type="boolean" truevalue="True" falsevalue="False" checked="False" label="Output Rscript?" + help="Output the R code used by the tool, can view and edit in R. Default: No"/> + <param name="rdata_out" type="boolean" truevalue="True" falsevalue="False" checked="False" label="Output RData file?" + help="Output the data generated by the RScript code, can be loaded into R with load(). Default: No"> + </param> + </section> </inputs> <outputs> - <data name="plot" format="pdf" from_work_dir="out.pdf" label="Volcano plot on ${on_string}"/> + <data name="plot" format="pdf" from_work_dir="out.pdf" label="${tool.name} on ${on_string}: PDF"/> + <data name="rscript" format="txt" from_work_dir="rscript.txt" label="${tool.name} on ${on_string}: Rscript"> + <filter>out_options['rscript_out']</filter> + </data> + <data name="rdata" format="rdata" from_work_dir="volcanoplot.RData" label="${tool.name} on ${on_string}: RData"> + <filter>out_options['rdata_out']</filter> + </data> </outputs> <tests> - <test> + <test expect_num_outputs="1"> <!-- Ensure default output works --> <param name="input" ftype="tabular" value="input.tab"/> <param name="fdr_col" value="4" /> @@ -102,9 +234,13 @@ <param name="lfc_col" value="2" /> <param name="label_col" value="1" /> <param name="lfc_thresh" value="0" /> - <output name="plot" value= "out.pdf" compare="sim_size" /> + <output name="plot"> + <assert_contents> + <has_size value= "933447" delta="1000" /> + </assert_contents> + </output> </test> - <test> + <test expect_num_outputs="1"> <!-- Ensure input labels and plot options work --> <param name="input" ftype="tabular" value="input.tab"/> <param name="fdr_col" value="4" /> @@ -114,7 +250,35 @@ <param name="lfc_thresh" value="0" /> <param name="label_select" value="file"/> <param name="label_file" ftype="tabular" value="labels.tab" /> - <output name="plot" value= "out2.pdf" compare="sim_size" /> + <output name="plot"> + <assert_contents> + <has_size value= "936522" delta="1000" /> + </assert_contents> + </output> + </test> + <test expect_num_outputs="3"> + <!-- Ensure rscript and rdata outputs work --> + <param name="input" ftype="tabular" value="input.tab"/> + <param name="fdr_col" value="4" /> + <param name="pval_col" value="3" /> + <param name="lfc_col" value="2" /> + <param name="label_col" value="1" /> + <param name="lfc_thresh" value="0" /> + <param name="label_select" value="file"/> + <param name="label_file" ftype="tabular" value="labels.tab" /> + <param name="rscript_out" value="True"/> + <param name="rdata_out" value="True"/> + <output name="plot"> + <assert_contents> + <has_size value= "936522" delta="1000" /> + </assert_contents> + </output> + <output name="rscript" value= "out.rscript" lines_diff="8"/> + <output name="rdata"> + <assert_contents> + <has_size value= "589613" delta="1000" /> + </assert_contents> + </output> </test> </tests> <help><![CDATA[ @@ -122,7 +286,7 @@ **What it does** -This tool creates a Volcano plot using ggplot2. Points can be labelled via ggrepel. +This tool creates a Volcano plot using ggplot2. Points can be labelled via ggrepel. It was inspired by this Getting Genetics Done `blog post`_. In statistics, a `Volcano plot`_ is a type of scatter-plot that is used to quickly identify changes in large data sets composed of replicate data. It plots significance versus fold-change on the y and x axes, respectively. These plots are increasingly common in omic experiments such as genomics, proteomics, and metabolomics where one often has a list of many thousands of replicate data points between two conditions and one wishes to quickly identify the most meaningful changes. A volcano plot combines a measure of statistical significance from a statistical test (e.g., a p value from an ANOVA model) with the magnitude of the change, enabling quick visual identification of those data-points (genes, etc.) that display large magnitude changes that are also statistically significant. @@ -134,13 +298,15 @@ **Inputs** -A tabular file with a header row containing the columns below (additional columns may be present): +A tabular file containing the columns below (additional columns may be present): * P value * FDR / adjusted P value * Log fold change * Labels (e.g. Gene symbols or IDs) +The tool will auto-detect if a header is present, by checking if the first row in the P value column is a number or not. + All significant points, those meeting the specified FDR and Log Fold Change thresholds, will be coloured, red for upregulated, blue for downregulated. Users can choose to apply labels to the points (such as gene symbols) from the Labels column. To label all significant points, select "Significant" for the **Points to label** option, or to only label the top most significant specify a number under "Only label top most significant". Users can label any points of interest through selecting **Points to label** "Input from file" and providing a tabular labels file. The labels file must contain a header row and have the labels in the first column. These labels must match the labels in the main input file. **Outputs** @@ -150,6 +316,7 @@ .. image:: $PATH_TO_IMAGES/volcano_plot.png .. _Volcano plot: https://en.wikipedia.org/wiki/Volcano_plot_(statistics) +.. _blog post: https://gettinggeneticsdone.blogspot.com/2016/01/ ]]></help> <citations>