changeset 0:f5526d97056c draft default tip

"planemo upload for repository https://github.com/AstraZeneca-Omics/immport-galaxy-tools/tree/master/flowtools/metacyto_histogram commit cb978232e32b64f7b0ff3c1852e708361045d268"
author azomics
date Thu, 29 Jul 2021 22:15:11 +0000
parents
children
files images/meta_histo.png metacyto_histogram.R metacyto_histogram.xml test-data/Group1.fcs
diffstat 4 files changed, 232 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
Binary file images/meta_histo.png has changed
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/metacyto_histogram.R	Thu Jul 29 22:15:11 2021 +0000
@@ -0,0 +1,123 @@
+#!/usr/bin/env Rscript
+######################################################################
+#                  Copyright (c) 2018 Northrop Grumman.
+#                          All rights reserved.
+######################################################################
+#
+# Version 1 - January 2018
+# Author: Cristel Thomas
+#
+#
+
+library(flowCore)
+library(MetaCyto)
+
+check_cluster_def <- function(cl_def) {
+  if (cl_def == "" || cl_def == "None") {
+    quit(save = "no", status = 12, runLast = FALSE)
+  } else {
+    tmp <- gsub(" ", "", cl_def, fixed = TRUE)
+    clean_def <- gsub(",", "|", tmp, fixed = TRUE)
+    return(clean_def)
+  }
+}
+
+generate_plots <- function(fpath = "", fname = "", gates = vector(), outdir = "", uc = "",
+                          flag_pdf = F) {
+  dir.create(outdir)
+  ff <- read.FCS(fpath, truncate_max_range = F)
+  markers <- markerFinder(ff)
+  colnames(ff@exprs) <- markers
+
+  sc <- searchCluster(fcsFrame = ff, clusterLabel = gates)
+
+  if (length(gates) == length(sc$clusterList)) {
+    sink(uc)
+    cat("All provided cluster definition were used.")
+    sink()
+  } else {
+    unused_cluster <- setdiff(gates, names(sc$clusterList))
+    write.table(unused_cluster, uc, quote = F, row.names = F, col.names = F)
+  }
+
+  groupname <- unlist(strsplit(fname, ".fcs"))[[1]]
+  extension <- if (flag_pdf) "plot.pdf" else "plot.png"
+  for (i in seq_len(length(sc$clusterList))) {
+    gate <- gsub("|", "", names(sc$clusterList[i]), fixed = T)
+    plotname <- paste(c(groupname, gate, extension), collapse = "_")
+    outplot <- file.path(outdir, plotname)
+    if (flag_pdf) {
+      pdf(outplot, useDingbats = F, onefile = T)
+      par(mfrow = c(2, 2))
+      for (j in seq_len(length(markers))) {
+        if (markers[[j]] != "SAMPLE_ID" && markers[[j]] != "TIME") {
+          plot_title <- paste0(markers[[j]], ", cluster definition:\n", gate)
+          x_all <- ff@exprs[, markers[[j]]]
+          b <- seq(min(x_all), max(x_all), ((max(x_all) - min(x_all)) / 100))
+          subset <- ff@exprs[sc$clusterList[[i]], markers[[j]]]
+          hist(x_all, col = rgb(0, 0, 0), xlab = markers[[j]], breaks = b, freq = T,
+               border = F, main = plot_title)
+          hist(subset, add = T, breaks = b, col = rgb(1, 0, 0), freq = T, border = F)
+          if (markers[[j]] %in% names(sc$cutoff)) {
+            abline(v = sc$cutoff[markers[[j]]])
+          }
+        }
+      }
+      dev.off()
+    } else {
+      markers_ct <- length(markers) - length(grep(x = markers, pattern = "SAMPLE_ID|TIME"))
+      nb_rows <- ceiling(markers_ct / 2)
+      h <- nb_rows * 400
+      png(outplot, type = "cairo", height = h, width = 800)
+      par(mfrow = c(nb_rows, 2))
+      for (j in seq_len(length(markers))) {
+        if (markers[[j]] != "SAMPLE_ID" && markers[[j]] != "TIME") {
+          plot_title <- paste0(markers[[j]], ", cluster definition:\n", gate)
+          x_all <- ff@exprs[, markers[[j]]]
+          b <- seq(min(x_all), max(x_all), ((max(x_all) - min(x_all)) / 100))
+          subset <- ff@exprs[sc$clusterList[[i]], markers[[j]]]
+          hist(x_all, col = rgb(0, 0, 0), xlab = markers[[j]], breaks = b, freq = T,
+               border = F, main = plot_title)
+          hist(subset, add = T, breaks = b, col = rgb(1, 0, 0), freq = T, border = F)
+          if (markers[[j]] %in% names(sc$cutoff)) {
+            abline(v = sc$cutoff[markers[[j]]])
+          }
+        }
+      }
+      dev.off()
+    }
+  }
+}
+
+check_fcs_file <- function(inputf="", inputn="", clusters=vector(),
+                         output_dir = "", unused = "", flag = F) {
+  is_valid <- FALSE
+  tryCatch({
+    is_valid <- isFCSfile(inputf)
+  }, error = function(ex) {
+    print(paste("Input file is not a valid FCS file.", ex))
+  })
+  if (is_valid) {
+    generate_plots(inputf, inputn, clusters, output_dir, unused, flag)
+  } else {
+    quit(save = "no", status = 12, runLast = FALSE)
+  }
+}
+
+################################################################################
+################################################################################
+args <- commandArgs(trailingOnly = TRUE)
+
+gates <- vector()
+if (args[6] == "F") {
+  ## obvs deal with it if file
+  cluster_file <- read.table(args[7], header = F, colClasses = "character")
+  gates <- unlist(cluster_file)
+} else {
+  cl_df <- args[7:length(args)]
+  gates <- sapply(cl_df, check_cluster_def)
+}
+
+flag_pdf <- if (args[5] == "PDF") TRUE else FALSE
+gate_list <- toupper(gates)
+check_fcs_file(args[1], args[2], gate_list, args[3], args[4], flag_pdf)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/metacyto_histogram.xml	Thu Jul 29 22:15:11 2021 +0000
@@ -0,0 +1,109 @@
+<tool id="metacyto_histogram" name="Generate histograms" version="1.0+galaxy0" profile="18.01">
+  <description>of MetaCyto's clustering results</description>
+  <requirements>
+    <requirement type="package" version="1.4.0">bioconductor-metacyto</requirement>
+  </requirements>
+  <stdio>
+    <exit_code range="1:9" />
+    <exit_code range="10" level="fatal" description="Please provide a valid input FCS file." />
+    <exit_code range="11" level="fatal" description="Please provide a valid input file for gate definitions." />
+    <exit_code range="12" level="fatal" description="Please provide a cluster definition" />
+    <exit_code range="13:" />
+  </stdio>
+  <command><![CDATA[
+    Rscript --slave --vanilla '$__tool_directory__/metacyto_histogram.R' '${input}' '${input.name}' 'metacyto_plots' '${unused}' '${outformat}'
+  #if $input_option.co == "F"
+    'F' '${input_option.gates}'
+  #else if $input_option.co == "L"
+    'L' '${input_option.first_def}'
+    #for $r in $input_option.cl_df
+      '${r.cluster_def}'
+    #end for
+  #end if
+  ]]>
+  </command>
+  <inputs>
+    <param format="fcs" name="input" type="data" label="FCS file"/>
+    <conditional name="input_option">
+      <param name="co" type="select" label="Clusters to plot">
+        <option value="F">from file</option>
+        <option value="L">manual input</option>
+      </param>
+      <when value="F">
+        <param format="metacyto_clr.txt" name="gates" type="data" label="List of cluster definition" help="One gate definition per line."/>
+      </when>
+      <when value="L">
+        <param name="first_def" type="text" label="Additional cluster definition:" help="i.e.:CD3+,CD4-,CD8+,CCR7+"/>
+        <repeat name="cl_df" title="Cluster:">
+          <param name="cluster_def" type="text" label="Additional cluster definition:" help="i.e.:CD3+,CD4-,CD8+,CCR7+"/>
+        </repeat>
+      </when>
+    </conditional>
+    <param name="outformat" type="select" label="Output Format" help="PDF will be larger files that may take some time to load.">
+      <option value="PNG" selected="true">PNG</option>
+      <option value="PDF">PDF</option>
+    </param>
+  </inputs>
+  <outputs>
+    <data format="txt" name="unused" label="List of clusters not found in ${input.name}"/>
+    <collection type="list" label="Histograms in ${input.name}, PNG format" name="output_png">
+      <discover_datasets pattern="(?P&lt;name&gt;.*)" directory="metacyto_plots" format="png" />
+      <filter>outformat=="PNG"</filter>
+    </collection>
+    <collection type="list" label="Histograms in ${input.name}, PDF format" name="output_pdf">
+      <discover_datasets pattern="(?P&lt;name&gt;.*)" directory="metacyto_plots" format="pdf" />
+      <filter>outformat=="PDF"</filter>
+    </collection>
+  </outputs>
+  <tests>
+    <test>
+      <param name="input" value="Group1.fcs"/>
+      <param name="co" value="L"/>
+      <param name="first_def" value="CD3+,CD4-"/>
+      <param name="outformat" value="PNG"/>
+      <output name="unused">
+        <assert_contents>
+          <has_n_lines n="1"/>
+        </assert_contents>
+      </output>
+      <output_collection name="output_png">
+        <element name="Group1_CD3+CD4-_plot.png" ftype="png">
+          <assert_contents>
+            <has_size value="105600" delta="30000"/>
+          </assert_contents>
+        </element>
+      </output_collection>
+    </test>
+  </tests>
+  <help><![CDATA[
+Histograms of the distribution of events after clustering with MetaCyto for provided gating definitions
+-------------------------------------------------------------------------------------------------------
+
+**Input files**
+
+This tool requires a valid FCS file and a list of clusters as input.
+
+**Output**
+
+This tool generates plots to show the distribution of cells in each cluster definition. The gray histograms show the distribution of markers in all cells. The red histograms show the distribution of markers in the identified cell subset.
+
+**Example**
+
+*Input* - Cluster List::
+
+   Marker1+|Marker3-
+   Marker1+|Marker2+|Marker3-
+   ...
+
+*Output* - Unused Cluster List::
+
+   Marker1+|Marker3-
+   Marker1-|Marker2+|Marker3-
+   ...
+
+*Graphical output*
+
+.. image:: images/meta_histo.png
+  ]]>
+  </help>
+</tool>
Binary file test-data/Group1.fcs has changed