# HG changeset patch # User immport-devteam # Date 1488217884 18000 # Node ID 78b8ab344edd0a47896ad29ebdf42ae82bc06018 Uploaded diff -r 000000000000 -r 78b8ab344edd fcs_gate_trans/FCSGateTrans.R --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/fcs_gate_trans/FCSGateTrans.R Mon Feb 27 12:51:24 2017 -0500 @@ -0,0 +1,454 @@ +###################################################################### +# Copyright (c) 2016 Northrop Grumman. +# All rights reserved. +###################################################################### +# ImmPort FCS conversion program +# Authors: Yue Liu and Yu "Max" Qian +# +# Reference: FCSTrans: An open source software system for FCS +# file conversion and data transformation +# Qian Y, Liu Y, Campbell J, Thomson E, Kong YM, +# Scheuermann RH. 2012 Cytometry Part A. 81A(5) +# doi.org/10.1002/cyto.a.22037 +# +# To run in R +# 1) library(flowCore) +# 2) source("FCSTrans.R") +# 3) transformFCS("filename") +# +# +# Automated Gating of Lymphocytes with FlowDensity +# Authors of FlowDensity: Jafar Taghiyar, Mehrnoush Malek +# +# Reference: flowDensity: reproducing manual gating of flow +# cytometry data by automated density-based cell +# population identification +# Malek M, Taghiyar MJ, Chong L, Finak G, +# Gottardo R, Brinkman RR. 2015 Bioinformatics 31(4) +# doi: 10.1093/bioinformatics/btu677 +# +# +# Version 1.5 +# March 2016 -- added lines to run directly from command line (cristel thomas) +# May 2016 -- added automated gating (cristel thomas) +# August 2016 -- added options for data transformation (cristel thomas) + +library(flowCore) +library(flowDensity) +library(GEOmap) +# +# Set output to 0 when input is less than cutoff value +# +ipfloor <- function (x, cutoff=0, target=0) { + y <- x + if (x <= cutoff) { + y <- target + } + return(y) +} +# +# Set output to 0 when input is less than cutoff value +# +ipceil <- function (x, cutoff=0, target=0) { + y <- x + if (x >= cutoff) { + y <- target + } + return(y) +} +# +# Calculation core of iplogicle +# +iplogicore <- function (x, w, r, d, scale) { + tol <- .Machine$double.eps^0.8 + maxit <- as.integer(5000) + d <- d * log(10) + scale <- scale / d + p <- if (w == 0) { + 1 + } else { + uniroot(function(p) -w + 2 * p * log(p)/(p + 1), c(.Machine$double.eps, + 2 * (w + d)))$root + } + a <- r * exp(-(d - w)) + b <- 1 + c <- r * exp(-(d - w)) * p^2 + d <- 1/p + f <- a * (p^2 - 1) + y <- .Call("flowCore_biexponential_transform", PACKAGE= 'flowCore', + as.double(x), a, b, c, d, f, w, tol, maxit) + y <- sapply(y * scale, ipfloor) + return(y) +} +# +# Function for calculating w +# +iplogiclew <- function (w, cutoff=-111, r=262144, d=4.5, scale=1) { + if (w > d) + w <- d + y <- iplogicore(cutoff, w, r, d, scale) - .Machine$double.eps^0.6 + return(y) +} +# +# ImmPort logicle function - convert fluorescent marker values to channel output +# +iplogicle <- function (x, r=262144, d=4.5, range=4096, cutoff=-111, w=-1) { + if (w > d) { + stop("Negative range decades must be smaller than total number of decades") + } + if (w < 0) { + w = uniroot(iplogiclew, c(0, d), cutoff=cutoff)$root + } + y <- iplogicore(x, w, r, d, range) + return(y) +} +# +# Convert fluorescent values to channel output using log transformation +# +iplog <- function(x) { + x <- sapply(x, ipfloor, cutoff=1, target=1) + y <- 1024 * log10(x) - 488.6 + return(y) +} +# +# ImmPort linear function - convert scatter values to channel output +# linear transformation +# +ipscatter <- function (x, channelrange=262144) { + y <- 4095.0 * x / channelrange + y <- sapply(y, ipfloor) + y <- sapply(y, ipceil, cutoff=4095, target=4095) + return(y) +} +# +# ImmPort time function - convert time values to channel output +# linear transformation +iptime <- function (x, channelrange) { + # use simple cutoff for now + y <- sapply(x, ipfloor) + return(y) +} +# +# Determine the type of marker. Marker type is used +# to determine type of transformation to apply for this channel. +# Before 2010 FLUO_AREA type used iplogicile and +# FLOU_NON_AREA type used iplog. In 2010 Yue, changed code so +# all fluorescent channels use iplogicle. Below is the note from SVN +# +# Version 1.1 +# 2010-07-02 +# ----------- +# Added data type checking on both FCS version 2 and 3 +# Removed log conversion for non-area fluorescent channel +# Applied logicle conversion for all fluorescent channels +# +# The GenePattern version uses iplog for FLOU_NON_AREA, rather +# than iplogicle. +# +getMarkerType <- function(name,debug=FALSE) { + type <- "" + prefix2 <- toupper(substr(name, 1, 2)) + prefix3 <- toupper(substr(name, 1, 3)) + prefix4 <- toupper(substr(name, 1, 4)) + if (prefix2 == "FS" || prefix2 == "SS") { + type <- "SCATTER" + } else if (prefix3 == "FSC" || prefix3 == "SSC") { + type <- "SCATTER" + } else if (prefix4 == "TIME") { + type <- "TIME" + } else { + pieces <- unlist(strsplit(name, "-")) + if (toupper(pieces[length(pieces)]) == "A") { + type <- "FLUO_AREA" + } else { + type <- "FLUO_NON_AREA" + } + } + if (debug) { + print(paste("Marker:", name, ", Type:", type)) + } + return(type) +} +# +# Scale data +# +scaleData <- function(data, channelrange=0) { + datamax <- range(data)[2] # range() returns [min, max] + if (datamax > channelrange) { + channelrange <- datamax + } + #if (channelrange == 0) { + # channelrange = range(data)[2] + #} + data <- 262144 * data / channelrange + return(data) +} +# +# Check if AccuriData. Accuri data needs different conversion +# +isAccuriData <- function(keywords) { + isTRUE(as.character(keywords$"$CYT") == "Accuri C6") +} +# +# Convert FCS file +# +convertFCS <- function(fcs,compensate=FALSE,debug=FALSE) { + # Check file type and FCS version + if (class(fcs)[1] != "flowFrame") { + print("convertFCS requires flowFrame object as input") + return(FALSE) + } + keywords <- keyword(fcs) + markers <- colnames(fcs) + params <- fcs@parameters + list_description <- fcs@description + + if (debug) { + print("****Inside convertFCS") + print(paste(" FCS version:", keywords$FCSversion)) + print(paste(" DATATYPE:", keywords['$DATATYPE'])) + } + if (keywords$FCSversion == "2" || keywords$FCSversion == "3" || + keywords$FCSversion == "3.1" ) { + datatype <- unlist(keywords['$DATATYPE']) + if (datatype == 'F') { + # Apply compensation if available and requested + spill <- keyword(fcs)$SPILL + + if (is.null(spill) == FALSE && compensate == TRUE) { + if (debug) { + print("Attempting compensation") + } + tryCatch({fcs = compensate(fcs, spill)}, + error = function(ex) {str(ex); }) + } + # Process fcs expression data, using transformation + # based on category of the marker. + fcs_exprs <- exprs(fcs) + fcs_channel <- NULL + for (i in 1:length(markers)){ + markertype <- getMarkerType(markers[i], debug) + rangekeyword <- paste("$P", i, "R", sep="") + flowcore_min <- paste("flowCore_", rangekeyword, "min", sep="") + flowcore_max <- paste("flowCore_", rangekeyword, "max", sep="") + channelrange <- as.numeric(keywords[rangekeyword]) + if (debug) { + print(paste(" Marker name:", markers[i])) + print(paste(" Marker type:", markertype)) + print(paste(" Range value:", keywords[rangekeyword])) + } + + if (markertype == "TIME") { + channel <- iptime(fcs_exprs[, i]) + } else { + if (markertype == "SCATTER") { + channel <- ipscatter(scaleData(fcs_exprs[, i], channelrange)) + } else { + # Apply logicle transformation on fluorescent channels + channel <- iplogicle(scaleData(fcs_exprs[, i], channelrange)) + } + # adjust range in parameters and list description + if (params@data$range[i] > 4096){ + params@data$range[i] <- 4096 + params@data$minRange[i] <- 0 + params@data$maxRange[i] <- 4096 + list_description[rangekeyword] <- 4096 + list_description[flowcore_min] <- 0 + list_description[flowcore_max] <- 4096 + } + } + fcs_channel <- cbind(fcs_channel, round(channel)) + } + colnames(fcs_channel) <- markers + } else { + if (datatype != 'I') { + print(paste("Data type", datatype, "in FCS 3 is not supported")) + } + fcs_channel <- exprs(fcs) + colnames(fcs_channel) <- markers + } + } else { + print(paste("FCS version", keyword(fcs)$FCSversion, "is not supported")) + fcs_channel <- exprs(fcs) + colnames(fcs_channel) <- markers + } + newfcs <- flowFrame(fcs_channel, params, list_description) + return(newfcs) +} +# +# Starting function for processing a FCS file +# +processFCSFile <- function(input_file, output_file="", compensate=FALSE, + fcsformat=FALSE, fcsfile="", + gate=FALSE, graph_file="", report="", method="", + scaling_factor, debug=FALSE) { + # + # Generate the file names for the output_file + # + pieces <- unlist(strsplit(input_file, .Platform$file.sep)) + filename <- pieces[length(pieces)] + + if (debug) { + print (paste("Converting file: ",input_file)) + print (paste("Original file name: ",filename)) + print (paste("Output file name: ",output_file)) + } + fcs <- read.FCS(input_file, transformation=F) + keywords <- keyword(fcs) + markers <- colnames(fcs) + print_markers <- as.vector(pData(parameters(fcs))$desc) + # Update print_markers if the $P?S not in the FCS file + for (i in 1:length(print_markers)) { + if (is.na(print_markers[i])) { + print_markers[i] <- markers[i] + } + } + # + # Transform the data + # + transformed_data <- fcs + if (isAccuriData(keywords)) { + print("Accuri data is not supported") + } else { + if (method == "arcsinh"){ + channels_to_exclude <- c(grep(colnames(fcs), pattern="FSC"), + grep(colnames(fcs), pattern="SSC"), + grep(colnames(fcs), pattern="Time")) + list_channels <- colnames(fcs)[-channels_to_exclude] + trans <- arcsinhTransform(transformationId="defaultArcsinhTransform", + a = 0, b = scaling_factor, c = 0) + translist <- transformList(list_channels, trans) + transformed_data <- transform(fcs, translist) + } else if (method == "logicle"){ + transformed_data <- convertFCS(fcs,compensate,debug) + } + } + trans_gated_data <- transformed_data + # + # Gate data + # + if (gate){ + # check that there are SSC and FSC channels to gate on + chans <- c(grep(colnames(transformed_data), pattern="FSC"), + grep(colnames(transformed_data), pattern="SSC")) + totalchans <- chans + if (length(chans) > 2) { + #get first FSC and corresponding SSC + chans <- c(grep(colnames(transformed_data), pattern="FSC-A"), + grep(colnames(transformed_data), pattern="SSC-A")) + if (length(chans) == 0) { + chans <- c(grep(colnames(transformed_data), pattern="FSC-H"), + grep(colnames(transformed_data), pattern="SSC-H")) + if (length(chans) == 0) { + chans <- c(grep(colnames(transformed_data), pattern="FSC-W"), + grep(colnames(transformed_data), pattern="SSC-W")) + } + } + } + if (length(chans) == 0) { + warning('No forward/side scatter channels found, gating aborted.') + } else { + # gate lymphocytes + lymph <- flowDensity(obj=transformed_data, channels=chans, + position=c(TRUE, NA), + debris.gate=c(TRUE, FALSE)) + # gate singlets if A and H/W + if (length(totalchans) > 2) { + trans_gated_data <- getflowFrame(flowDensity(obj=lymph, + singlet.gate=TRUE)) + } else { + trans_gated_data <- getflowFrame(lymph) + } + # report + pregating_summary <- capture.output(summary(transformed_data)) + pregating_dim <- capture.output(dim(transformed_data)) + postgating_summary <- capture.output(summary(trans_gated_data)) + postgating_dim <- capture.output(dim(trans_gated_data)) + sink(report) + cat("#########################\n") + cat("## BEFORE GATING ##\n") + cat("#########################\n") + cat(pregating_dim, pregating_summary, sep="\n") + cat("\n#########################\n") + cat("## AFTER GATING ##\n") + cat("#########################\n") + cat(postgating_dim, postgating_summary, sep="\n") + sink() + # plots + pdf(graph_file, useDingbats=FALSE, onefile=TRUE) + par(mfrow=c(2,2)) + time_channel <- grep(toupper(colnames(transformed_data)), pattern="TIME") + nb_markers <- length(colnames(transformed_data)) - length(time_channel) + maxrange <- transformed_data@parameters@data$range[1] + for (m in 1:(nb_markers - 1)) { + for (n in (m+1):nb_markers) { + plotDens(transformed_data, c(m,n), xlab = print_markers[m], + ylab = print_markers[n], main = "Before Gating", + ylim = c(0, maxrange), xlim = c(0, maxrange)) + plotDens(trans_gated_data, c(m,n), xlab = print_markers[m], + ylab = print_markers[n], main = "After Gating", + ylim = c(0, maxrange), xlim = c(0, maxrange)) + } + } + dev.off() + } + } + if (fcsformat) { + write.FCS(trans_gated_data, fcsfile) + } + output_data <- exprs(trans_gated_data) + colnames(output_data) <- print_markers + write.table(output_data, file=output_file, quote=F, + row.names=F,col.names=T, sep='\t', append=F) +} +# Convert FCS file using FCSTrans logicile transformation +# @param input_file FCS file to be transformed +# @param output_file FCS file transformed ".txt" extension +# @param compensate Flag indicating whether to apply compensation +# matrix if it exists. +transformFCS <- function(input_file, output_file, compensate=FALSE, + fcsformat=FALSE, fcsfile="", gate=FALSE, graph_file="", + report_file="", trans_met="", scaling_factor="", + debug=FALSE) { + isValid <- F + # Check file beginning matches FCS standard + tryCatch({ + isValid = isFCSfile(input_file) + }, error = function(ex) { + print (paste(" ! Error in isFCSfile", ex)) + }) + if (isValid) { + processFCSFile(input_file, output_file, compensate, fcsformat, fcsfile, + gate, graph_file, report_file, trans_met, scaling_factor) + } else { + print (paste(input_file, "does not meet FCS standard")) + } +} +# +# Run FCS Gate-Trans +# +args <- commandArgs(trailingOnly = TRUE) +graphs <- "" +report <- "" +fcsoutput_file <- "" +fcsoutput <- FALSE +gate <- FALSE +trans_method <- "None" +scaling_factor <- 1 / 150 +if (args[5]!="None") { + fcsoutput <- TRUE + fcsoutput_file <- args[5] +} +if (args[6]!="None") { + gate <- TRUE + graphs <- args[6] + report <- args[7] +} +if (args[8]!="None"){ + trans_method <- args[8] + if (args[8] == "arcsinh"){ + scaling_factor <- 1 / as.numeric(args[9]) + } +} +transformFCS(args[2], args[3], args[4], fcsoutput, fcsoutput_file, gate, graphs, + report, trans_method, scaling_factor) diff -r 000000000000 -r 78b8ab344edd fcs_gate_trans/FCSGateTrans.xml --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/fcs_gate_trans/FCSGateTrans.xml Mon Feb 27 12:51:24 2017 -0500 @@ -0,0 +1,191 @@ + + using FlowDensity and the FCSTrans tranformation. + + r + bioconductor-flowcore + bioconductor-flowdensity + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + format=="TRUE" + + + gate=="TRUE" + + + gate=="TRUE" + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 10.1002/cyto.a.22037 + 10.1093/bioinformatics/btu677 + 10.1186/1471-2105-10-106 + + diff -r 000000000000 -r 78b8ab344edd fcs_gate_trans/static/images/flowdensity.png Binary file fcs_gate_trans/static/images/flowdensity.png has changed diff -r 000000000000 -r 78b8ab344edd fcs_gate_trans/test-data/arcsinh150.flowtext --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/fcs_gate_trans/test-data/arcsinh150.flowtext Mon Feb 27 12:51:24 2017 -0500 @@ -0,0 +1,11 @@ +FSC-A FSC-H SSC-A SSC-H CD127 CD45RO LIVE CD4 CD3 HLA-DR CD25 CCR4 Time +9081 8811 19575.009765625 18578 -0.487166708542563 3.35237355048648 1.37750753926965 0.127057863991919 0.0255972040496283 0.866588972868883 0.760737973767117 2.53759317435759 0 +13879.5 11372 76400.875 66800 -0.455305138250274 0.963556030409229 0.915968891776551 0.511296170657329 0.339065738526448 0.531430131763512 -0.0326608602630583 -0.0783199078087399 0 +53197.5 49698 32821.8828125 30290 1.26289278746875 2.94666707290312 1.14932176211125 0.429535971137743 2.2879860496209 2.40333638820057 -0.0587661676654274 0.264762535136808 0 +94011.75 85861 46558.33203125 45425 -0.361914067420137 1.0099842999029 2.09568229265804 0.645771470660991 2.00391041851356 5.22898742425766 0.277363344871173 0.226719371107561 0.100000001490116 +56965.5 51060 42377.79296875 41492 3.34704579398504 5.11946885007392 1.24661362703293 4.79178721936253 3.51920619886312 3.47901108455652 2.12708633691257 3.11956116515719 0.100000001490116 +102877.5 91646 74486.234375 70382 3.67436877786622 4.72663049856952 1.57481462914001 1.37173870350081 5.15150145193671 4.8565806734818 1.59337073197003 1.13689659390179 0.200000002980232 +170482.5 135955 126331.6640625 106115 1.08590805588046 4.06062066240107 3.22122665934363 2.95167516373086 2.51312270311573 5.0850832349334 1.33604037616411 2.53656608596143 0.200000002980232 +140555.25 100224 108512.046875 72196 0.986973889697097 2.66146938806969 2.92800487646568 1.81362880902413 2.92526952883318 5.79683993164786 1.14069148921356 1.02981250583848 0.200000002980232 +46518.75 37218 138006.046875 113970 0.478108970811769 2.930079809471 3.47524128111705 2.31934440314287 1.78816416611445 4.6146323442977 1.1444747475952 1.25623958268597 0.200000002980232 +11892.75 11583 10502.310546875 10123 -0.245784525134546 1.17763111672424 0.362101658041819 0.322006394180742 -0.0511776555829312 0.0511776555829312 -0.0848315483504115 0.424837896402236 0.300000011920929 diff -r 000000000000 -r 78b8ab344edd fcs_gate_trans/test-data/comp_gated.fcs Binary file fcs_gate_trans/test-data/comp_gated.fcs has changed diff -r 000000000000 -r 78b8ab344edd fcs_gate_trans/test-data/graph.pdf Binary file fcs_gate_trans/test-data/graph.pdf has changed diff -r 000000000000 -r 78b8ab344edd fcs_gate_trans/test-data/nocomp.flowtext --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/fcs_gate_trans/test-data/nocomp.flowtext Mon Feb 27 12:51:24 2017 -0500 @@ -0,0 +1,11 @@ +FSC-A FSC-H SSC-A SSC-H CD127 CD45RO LIVE CD4 CD3 HLA-DR CD25 CCR4 Time +142 138 306 290 133 2178 1297 546 478 1018 955 1835 0 +217 178 1193 1043 154 1074 1047 800 688 813 438 407 0 +831 776 513 473 1237 2009 1177 747 1726 1776 421 638 0 +1469 1341 727 710 217 1100 1640 885 1598 2935 647 613 0 +890 798 662 648 2176 2891 1229 2760 2246 2230 1654 2081 0 +1607 1432 1164 1099 2310 2734 1395 1294 2904 2786 1404 1170 0 +2663 2124 1973 1658 1142 2467 2124 2011 1824 2877 1275 1834 0 +2196 1566 1695 1128 1087 1888 2001 1510 2000 3160 1172 1111 0 +727 581 2156 1780 779 2002 2228 1739 1498 2689 1174 1234 0 +186 181 164 158 295 1192 703 677 426 495 403 744 0 diff -r 000000000000 -r 78b8ab344edd fcs_gate_trans/test-data/notrans.flowtext --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/fcs_gate_trans/test-data/notrans.flowtext Mon Feb 27 12:51:24 2017 -0500 @@ -0,0 +1,11 @@ +FSC-A FSC-H SSC-A SSC-H CD127 CD45RO LIVE CD4 CD3 HLA-DR CD25 CCR4 Time +9081 8811 19575.009765625 18578 -76 2140.15991210938 278.460021972656 19.1100006103516 3.83999991416931 146.879989624023 125.440002441406 942.760009765625 0 +13879.5 11372 76400.875 66800 -70.6800003051758 167.959991455078 157.43000793457 80.0800018310547 51.8400001525879 83.5199966430664 -4.90000009536743 -11.7600002288818 0 +53197.5 49698 32821.8828125 30290 243.959991455078 1424.23999023438 212.940002441406 66.4300003051758 731.519958496094 822.719970703125 -8.81999969482422 40.1800003051758 0 +94011.75 85861 46558.33203125 45425 -55.4799995422363 178.599990844727 600.600036621094 103.740005493164 546.239990234375 13994.8798828125 42.1399993896484 34.2999992370605 0.100000001490116 +56965.5 51060 42377.79296875 41492 2128.76000976562 12543.0400390625 239.330001831055 9038.1201171875 2529.59985351562 2429.76000976562 620.340026855469 1694.42004394531 0.100000001490116 +102877.5 91646 74486.234375 70382 2954.8798828125 8467.919921875 346.710021972656 276.640014648438 12951.359375 9643.2001953125 353.779998779297 209.720001220703 0.200000002980232 +170482.5 135955 126331.6640625 106115 196.839996337891 4349.47998046875 1876.42004394531 1431.43005371094 919.679992675781 12119.0400390625 265.580017089844 941.780029296875 0.200000002980232 +140555.25 100224 108512.046875 72196 173.279998779297 1068.55993652344 1397.76000976562 447.720001220703 1393.919921875 24694.080078125 210.699996948242 183.260009765625 0.200000002980232 +46518.75 37218 138006.046875 113970 74.4799957275391 1400.67993164062 2420.60009765625 755.300048828125 435.839996337891 7570.56005859375 211.68000793457 242.059997558594 0.200000002980232 +11892.75 11583 10502.310546875 10123 -37.2399978637695 220.399993896484 55.5100021362305 49.1400032043457 -7.67999982833862 7.67999982833862 -12.7399997711182 65.6600036621094 0.300000011920929 diff -r 000000000000 -r 78b8ab344edd fcs_gate_trans/test-data/report.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/fcs_gate_trans/test-data/report.txt Mon Feb 27 12:51:24 2017 -0500 @@ -0,0 +1,39 @@ +========================= +== BEFORE GATING == +========================= + events parameters + 10 13 + FSC-A FSC-H SSC-A SSC-H APC-A APC-H7-A FITC-A PerCP-Cy5-5-A V450-A +Min. 142.0 138.0 164.0 158.0 89.0 1094 603 363 387.0 +1st Qu. 344.5 281.0 550.2 516.8 179.0 1328 1068 675 501.2 +Median 860.5 787.0 945.5 876.5 564.5 1977 1214 913 1214.0 +Mean 1093.0 911.5 1055.0 898.7 811.7 1923 1284 1183 1271.0 +3rd Qu. 1572.0 1409.0 1570.0 1121.0 1141.0 2348 1421 1505 1663.0 +Max. 2663.0 2124.0 2156.0 1780.0 2300.0 2830 2175 2756 2904.0 + V500-A PE-A PE-Cy7-A Time +Min. 0.0 0.0 140.0 0 +1st Qu. 701.2 5.0 463.2 0 +Median 1427.0 152.5 849.0 0 +Mean 1657.0 379.3 968.1 0 +3rd Qu. 2816.0 480.5 1578.0 0 +Max. 3155.0 1484.0 1835.0 0 + +========================= +== AFTER GATING == +========================= + events parameters + 9 13 + FSC-A FSC-H SSC-A SSC-H APC-A APC-H7-A FITC-A PerCP-Cy5-5-A V450-A +Min. 186 178.0 164 158.0 122 1094 603 652 387 +1st Qu. 727 581.0 662 648.0 269 1157 1042 717 676 +Median 890 798.0 1164 1043.0 623 1960 1146 1083 1473 +Mean 1198 997.4 1139 966.3 892 1901 1284 1274 1363 +3rd Qu. 1607 1432.0 1695 1128.0 1211 2424 1466 1555 1718 +Max. 2663 2124.0 2156 1780.0 2300 2830 2175 2756 2904 + V500-A PE-A PE-Cy7-A Time +Min. 0 0.0 140.0 0 +1st Qu. 613 0.0 425.0 0 +Median 1587 242.0 711.0 0 +Mean 1734 419.2 874.9 0 +3rd Qu. 2863 547.0 1087.0 0 +Max. 3155 1484.0 1835.0 0 diff -r 000000000000 -r 78b8ab344edd fcs_gate_trans/test-data/testfcs1.fcs Binary file fcs_gate_trans/test-data/testfcs1.fcs has changed diff -r 000000000000 -r 78b8ab344edd fcs_gate_trans/test-data/withcomp.flowtext --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/fcs_gate_trans/test-data/withcomp.flowtext Mon Feb 27 12:51:24 2017 -0500 @@ -0,0 +1,11 @@ +FSC-A FSC-H SSC-A SSC-H CD127 CD45RO LIVE CD4 CD3 HLA-DR CD25 CCR4 Time +142 138 306 290 89 2121 1285 363 443 966 20 1807 0 +217 178 1193 1043 122 1106 1042 743 676 613 63 370 0 +831 776 513 473 1211 1994 1144 652 1718 1267 0 425 0 +1469 1341 727 710 149 1094 603 717 387 2935 547 578 0 +890 798 662 648 1916 2830 1146 2756 2237 1587 1484 1835 0 +1607 1432 1164 1099 2300 2706 1282 1083 2904 0 1156 140 0 +2663 2124 1973 1658 623 2424 2001 1947 1497 2863 0 1741 0 +2196 1566 1695 1128 932 1840 1466 1354 1473 3155 281 987 0 +727 581 2156 1780 506 1960 2175 1555 954 2676 0 1087 0 +186 181 164 158 269 1157 701 661 421 506 242 711 0