flowCore: flowCore: Basic structures for flow cytometry data

Documented in arcsinhTransform asinht asinhtGml2 biexponentialTransform boundaryFilter char2ExpressionFilter compensatedParameter compensation dg1polynomial EHtrans ellipsoidGate estimateLogicle exponential expressionFilter filterList filters filtersList flowFrame flowSet hyperlog hyperlogtGml2 inverseLogicleTransform invsplitscale kmeansFilter linearTransform lintGml2 lnTransform logarithm logicletGml2 logicleTransform logtGml2 logTransform manyFilterResult normalization parameterTransform polygonGate polytopeGate quadGate quadratic quadraticTransform ratio ratiotGml2 rectangleGate sampleFilter scaleTransform sinht splitscale splitScaleTransform squareroot timeFilter transformList transformReference truncateTransform unitytransform validFilters

## =========================================================================##
## =========================================================================##
##                    Class definitions and contructors                     ##
## =========================================================================##
## =========================================================================##






## ===========================================================================
##  Some helpers
## ---------------------------------------------------------------------------
## Check for the class of object x and its length and cast error if wrong
checkClass <- function(x, class, length=NULL, verbose=FALSE,
                       mandatory=TRUE)
{
    if(mandatory && missing(x))
        stop("Argument '", substitute(x), "' missing with no default",
             call.=verbose)
    msg <- paste("'", substitute(x), "' must be object of class ",
                 paste("'", class, "'", sep="", collapse=" or "), sep="")
    fail <- !any(sapply(class, function(c, y) is(y, c), x))
    if(!is.null(length) && length(x) != length)
    {
        if(!is.null(x))
        {
            fail <- TRUE
            msg <- paste(msg, "of length", length)
        }
    }
    if(fail) stop(msg, call.=verbose) else invisible(NULL)     
}



## ===========================================================================
##  flowFrame
## ---------------------------------------------------------------------------
## A container for flow cytometry measurements with slots exprs, parameters
## and description. exprs contains measurement values, description contains 
## information from file headers of FCS file and parameters contains
## information about the FCS measurement parameters (i.e. channels) available.
## Exprs is a matrix (values are stored in internal memory) 
## ---------------------------------------------------------------------------
#' 'flowFrame': a class for storing observed quantitative properties for a
#' population of cells from a FACS run
#' 
#' This class represents the data contained in a \acronym{FCS} file or similar
#' data structure. There are three parts of the data: \enumerate{
#' \item a numeric matrix of the raw measurement values with \kbd{rows=events}
#' and \kbd{columns=parameters}
#' \item annotation for the parameters (e.g., the measurement channels, stains,
#' dynamic range)
#' \item additional annotation provided through keywords in the \acronym{FCS}
#' file
#' }
#' 
#' 
#' 
#' Objects of class \code{flowFrame} can be used to hold arbitrary data of cell
#' populations, acquired in flow-cytometry.
#' 
#' \acronym{FCS} is the Data File Standard for Flow Cytometry, the current
#' version is FCS 3.0. See the vignette of this package for additional
#' information on using the object system for handling of flow-cytometry data.
#' 
#' @name flowFrame-class
#' @aliases flowFrame-class flowFrame [,flowFrame,ANY-method
#' [,flowFrame,filter-method [,flowFrame,filterResult-method $.flowFrame exprs
#' exprs<- exprs,flowFrame-method exprs<-,flowFrame,matrix-method
#' exprs<-,flowFrame,ANY-method initialize,flowFrame-method
#' head,flowFrame-method tail,flowFrame-method description
#' description,flowFrame-method description<-,flowFrame,list-method
#' description<-,flowFrame,ANY-method show,flowFrame-method
#' plot,flowFrame,ANY-method plot,flowFrame-method summary,flowFrame-method
#' ncol,flowFrame-method nrow,flowFrame-method dim dim,flowFrame-method
#' featureNames featureNames,flowFrame-method colnames,flowFrame-method
#' colnames<- colnames<-,flowFrame-method names names,flowFrame-method range
#' range,flowFrame-method cbind2,flowFrame,matrix-method
#' cbind2,flowFrame,numeric-method
#' compensate,flowFrame,matrix-method compensate,flowFrame,data.frame-method
#' compensate,flowFrame,compensation-method ==,flowFrame,filterResult-method
#' ==,flowFrame,flowFrame-method <,flowFrame,ANY-method <=,flowFrame,ANY-method
#' >,flowFrame,ANY-method >=,flowFrame,ANY-method spillover,flowFrame-method
#' spillover
#' @docType class
#' 
#' @slot exprs {Object of class \code{matrix} containing the
#' measured intensities. Rows correspond to cells, columns to the
#' different measurement channels. The \code{colnames} attribute of
#' the matrix is supposed to hold the names or identifiers for the
#' channels. The \code{rownames} attribute would usually not be set.
#' }
#' @slot parameters {An
#' \code{\link[Biobase:class.AnnotatedDataFrame]{AnnotatedDataFrame}}
#' containing information about each column of the
#' \code{flowFrame}. This will generally be filled in by
#' \code{read.FCS} or similar functions using data from the
#' \acronym{FCS} keywords describing the parameters.}
#' @slot description {A list containing the meta data included
#' in the FCS file.}
#' 
#' @section Creating Objects: 
#' Objects can be created using\cr \code{
#' new("flowFrame",}\cr \code{ exprs = ...., Object of class matrix}\cr \code{
#' parameters = ...., Object of class AnnotatedDataFrame}\cr \code{ description
#' = ...., Object of class list}\cr \code{ )}\cr
#' 
#' or the constructor \code{flowFrame}, with mandatory arguments \code{exprs}
#' and optional arguments \code{parameters} and \code{description}.
#' 
#' \code{flowFrame(exprs, parameters, description=list())}
#' 
#' To create a \code{flowFrame} directly from an \acronym{FCS} file, use
#' function \code{\link[flowCore]{read.FCS}}. This is the recommended and
#' safest way of object creation, since \code{read.FCS} will perform basic data
#' quality checks upon import. Unless you know exactly what you are doing,
#' creating objects using \code{new} or the constructor is discouraged. 
#' 
#' @section Methods:
#'   There are separate documentation pages for most of the methods
#'   listed here which should be consulted for more details.
#'   \describe{
#'   \item{[}{Subsetting. Returns an object of class \code{flowFrame}.
#'     The subsetting is applied to the \code{exprs} slot, while the
#'     \code{description} slot is unchanged. The syntax for subsetting is
#'     similar to that of \code{\link[=data.frame]{data.frames}}. In
#'     addition to the usual index vectors (integer and logical by
#'                                          position, character by parameter names), \code{flowFrames} can be
#'     subset via \code{\link{filterResult}} and
#'     \code{\linkS4class{filter}} objects.
#'     
#'     \emph{Usage:}
#'     
#'     \code{   flowFrame[i,j]}
#'     
#'     \code{   flowFrame[filter,]}
#'     
#'     \code{   flowFrame[filterResult,]}
#'     
#'     Note that the value of argument \code{drop} is ignored when
#'     subsetting \code{flowFrames}.
#'     
#'   }
#'   \item{$}{Subsetting by channel name. This is similar to subsetting
#'     of columns of \code{\link[=data.frame]{data.frames}}, i.e.,
#'     \code{frame$FSC.H} is equivalent to \code{frame[, "FSC.H"]}. Note
#'     that column names may have to be quoted if they are no valid R
#'     symbols (e.g. \code{frame$"FSC-H"}).
#'     
#'   }
#'   \item{exprs, exprs<-}{Extract or replace the raw data
#'     intensities. The replacement value must be a numeric matrix with
#'     colnames matching the parameter definitions. Implicit subsetting
#'     is allowed (i.e. less columns in the replacement value compared to
#'                 the original \code{flowFrame}, but all have to be defined there).
#'     
#'     \emph{Usage:}
#'     
#'     \code{   exprs(flowFrame)}
#'     
#'     \code{   exprs(flowFrame) <- value}
#'     
#'   }
#'   \item{head, tail}{Show first/last elements of the raw data matrix
#'     
#'     \emph{Usage:}
#'     
#'     \code{   head(flowFrame)}
#'     
#'     \code{   tail(flowFrame)}
#'     
#'   }
#'   \item{description, description<-}{Extract the whole list
#'     of annotation keywords and their corresponding values or replace values by keyword 
#'     (\code{description<-} is equivalent to \code{keyword<-}). Usually one would only be 
#'     interested in a subset of keywords, in which case the \code{keyword} method is
#'     more appropriate. The optional \code{hideInternal} parameter can
#'     be used to exclude internal FCS parameters starting
#'     with \code{$}.
#'     
#'     \emph{Usage:}
#'     
#'     \code{   description(flowFrame)}
#'     
#'     \code{   description(flowFrame) <- value}
#'     
#'   }
#'   \item{keyword, keyword<-}{Extract ore replace one or more entries
#'     from the \code{description} slot by keyword. Methods are defined
#'     for character vectors (select a keyword by name), functions
#'     (select a keyword by evaluating a function on their content) and
#'     for lists (a combination of the above). See \code{\link{keyword}}
#'     for details.
#'     
#'     \emph{Usage:}
#'     
#'     \code{   keyword(flowFrame)}
#'     
#'     \code{   keyword(flowFrame, character)}
#'     
#'     \code{   keyword(flowFrame, list)}
#'     
#'     \code{   keyword(flowFrame) <- list(value) }
#'     
#'   }
#'   \item{parameters, parameters<-}{Extract parameters and return an
#'     object of class
#'     \code{\link[Biobase:class.AnnotatedDataFrame]{AnnotatedDataFrame}},
#'     or replace such an object. To access the actual parameter
#'     annotation, use \code{pData(parameters(frame))}. Replacement is
#'     only valid with
#'     \code{\link[Biobase:class.AnnotatedDataFrame]{AnnotatedDataFrames}}
#'     containing all varLabels \code{name}, \code{desc}, \code{range},
#'     \code{minRange} and \code{maxRange}, and matching entries in the
#'     \code{name} column to the colnames of the \code{exprs} matrix. See
#'     \code{\link{parameters}} for more details.
#'     
#'     \emph{Usage:}
#'     
#'     \code{   parameters(flowFrame)}
#'     
#'     \code{   parameters(flowFrame) <- value}
#'     
#'   }
#'   \item{show}{
#'     
#'     Display details about the \code{flowFrame} object.
#'     
#'   }
#'   \item{summary}{Return descriptive statistical summary (min, max,
#'                                                          mean and quantile) for each channel
#'     
#'     \emph{Usage:}
#'     
#'     \code{   summary(flowFrame)}
#'     
#'   }
#'   \item{plot}{Basic plots for \code{flowFrame} objects. If the object
#'     has only a single parameter this produces a
#'     \code{\link[graphics:hist]{histogram}}. For exactly two parameters
#'     we plot a bivariate density map (see
#'                                      \code{\link[graphics]{smoothScatter}}
#'                                      and for more than two parameters we produce a simple
#'                                      \code{\link[lattice]{splom}} plot. To select specific parameters
#'                                      from a \code{flowFrame} for plotting, either subset the object or
#'                                      specify the parameters as a character vector in the second
#'                                      argument to \code{plot}. The smooth parameters lets you toggle
#'                                      between density-type
#'                                      \code{\link[graphics]{smoothScatter}}
#'                                      plots and regular scatterplots.  This simple method still uses the legacy
#'                                      \code{\link[flowViz:flowViz-package]{flowViz}} package. For far more sophisticated
#'                                      plotting of flow cytometry data, see the
#'                                      \code{\link[ggcyto:ggcyto]{ggcyto}} package.
#'                                      
#'                                      \emph{Usage:}
#'                                      
#'                                      \code{   plot(flowFrame, ...)}
#'                                      
#'                                      \code{   plot(flowFrame, character, ...)}
#'                                      
#'                                      \code{   plot(flowFrame, smooth=FALSE, ...)}
#'                                      
#'   }
#'   \item{ncol, nrow, dim}{Extract the dimensions of the data matrix.
#'     
#'     \emph{Usage:}
#'     
#'     \code{   ncol(flowFrame)}
#'     
#'     \code{   nrow(flowFrame)}
#'     
#'     \code{   dim(flowFrame)}
#'     
#'   }
#'   \item{featureNames, colnames, colnames<-}{. \code{colnames} and
#'     \code{featureNames} are synonyms, they extract parameter names (i.e., the
#'                                                                     colnames of the data matrix) .
#'     For \code{colnames} there is
#'     also a replacement method. This will update the \code{name} column
#'     in the \code{parameters} slot as well.
#'     
#'     \emph{Usage:}
#'     
#'     \code{   featureNames(flowFrame)}
#'     
#'     \code{   colnames(flowFrame)}
#'     
#'     \code{   colnames(flowFrame) <- value}
#'     
#'   }
#'   \item{names}{Extract pretty formated names of the parameters
#'     including parameter descriptions.
#'     
#'     \emph{Usage:}
#'     
#'     \code{   names(flowFrame)}
#'     
#'   }
#'   \item{identifier}{Extract GUID of a \code{flowFrame}. Returns the
#'     file name if no GUID is available. See \code{\link{identifier}}
#'     for details.
#'     
#'     \emph{Usage:}
#'     
#'     \code{   identifier(flowFrame)}
#'   }
#'   \item{range}{Get instrument or actual data range of the \code{flowFame}. Note that
#'     instrument dynamic range is not necessarily the same as the range of the actual data values, but
#'     the theoretical range of values the measurement instrument was
#'     able to capture. The values of the dynamic range will be
#'     transformed when using the transformation methods for\code{flowFrames}.
#'     
#'     parameters:
#'       
#'       x: flowFrame object.
#'     
#'     type: Range type. either "instrument" or "data". Default is "instrument"
#'     
#'     \emph{Usage:}
#'     
#'     \code{   range(x, type = "data")}
#'     
#'   }
#'   \item{each_row, each_col}{Apply functions over rows or columns of
#'     the data matrix. These are convenience methods. See
#'     \code{\link{each_col}} for details.
#'     
#'     \emph{Usage:}
#'     
#'     \code{   each_row(flowFrame, function, ...)}
#'     
#'     \code{   each_col(flowFrame, function, ...)}
#'   }
#'   \item{transform}{Apply a transformation function on a
#'     \code{flowFrame} object. This uses R's
#'     \code{\link[base]{transform}} function by treating the
#'     \code{flowFrame} like a regular \code{data.frame}. \code{flowCore}
#'     provides an additional inline mechanism for transformations (see
#'     \code{\link{\%on\%}}) which is strictly more limited
#'     than the out-of-line transformation described here.
#'     
#'     \emph{Usage:}
#'     
#'     \code{   transform(flowFrame, translist, ...)}
#'     
#'   }
#'   \item{filter}{Apply a \code{\linkS4class{filter}} object on a
#'     \code{flowFrame} object. This returns an object of class
#'     \code{\link{filterResult}}, which could then be used for
#'     subsetting of the data or to calculate summary statistics. See
#'     \code{\link{filter}} for details.
#'     
#'     \emph{Usage:}
#'     
#'     \code{   filter(flowFrame, filter)}
#'     
#'     }
#'   \item{split}{Split \code{flowFrame} object according to a
#'     \code{\link{filter}}, a \code{\link{filterResult}} or a
#'     \code{factor}. For most types of filters, an optional
#'     \code{flowSet=TRUE} parameter will create a
#'     \code{\linkS4class{flowSet}} rather than a simple list. See
#'     \code{\link{split}} for details.
#'     
#'     \emph{Usage:}
#'     
#'     \code{   split(flowFrame, filter, flowSet=FALSE, ...)}
#'     
#'     \code{   split(flowFrame, filterResult, flowSet=FALSE, ...)}
#'     
#'     \code{   split(flowFrame, factor, flowSet=FALSE, ...)}
#'     
#'     }
#'   \item{Subset}{Subset a \code{flowFrame} according to a \code{filter}
#'     or a logical vector. The same can be done using the standard
#'     subsetting operator with a \code{filter}, \code{filterResult}, or
#'     a logical vector as first argument.
#'     
#'     \emph{Usage:}
#'     
#'     \code{   Subset(flowFrame, filter)}
#'     
#'     \code{   Subset(flowFrame, logical)}
#'     
#'     }
#'   \item{cbind2}{Expand a \code{flowFrame} by the data in a
#'     \code{numeric matrix} of the same length. The \code{matrix} must
#'     have column names different from those of the
#'     \code{flowFrame}. The additional method for \code{numerics} only
#'     raises a useful error message.
#'     
#'     \emph{Usage:}
#'     
#'     \code{   cbind2(flowFrame, matrix)}
#'     
#'     \code{   cbind2(flowFrame, numeric)}
#'      
#'     }
#'   \item{compensate}{Apply a compensation matrix (or a
#'     \code{\linkS4class{compensation}} object) on a \code{flowFrame}
#'     object. This returns a compensated \code{flowFrame}.
#'     
#'     \emph{Usage:}
#'     
#'     \code{   compensate(flowFrame, matrix)}
#'     \code{   compensate(flowFrame, data.frame)}
#'     
#'     }
#'   \item{decompensate}{Reverse the application of a compensation matrix (or a
#'     \code{\linkS4class{compensation}} object) on a \code{flowFrame}
#'     object. This returns a decompensated \code{flowFrame}.
#'     
#'     \emph{Usage:}
#'     
#'     \code{   decompensate(flowFrame, matrix)}
#'     \code{   decompensate(flowFrame, data.frame)}
#'     
#'     }
#'   \item{spillover}{Extract spillover matrix from description slot if
#'     present. It is equivalent to 
#'     \code{keyword(x, c("spillover", "SPILL", "$SPILLOVER"))}
#'     Thus will simply return a list of keywords value for "spillover", "SPILL" and "$SPILLOVER".
#'     
#'     \emph{Usage:}
#'     
#'     \code{   spillover(flowFrame)}
#'     
#'     }
#'   \item{==}{Test equality between two \code{flowFrames}}
#'   \item{<, >, <=, >=}{These operators basically treat the
#'     \code{flowFrame} as a numeric matrix.}
#'   \item{\code{initialize(flowFrame)}:}{Object instantiation, used
#'     by \code{new}; not to be called directly by the user.}
#' }
#' 
#' @author
#' 
#' F. Hahne, B. Ellis, P. Haaland and N. Le Meur
#' @seealso
#' 
#' \code{\linkS4class{flowSet}}, \code{\link{read.FCS}}
#' @keywords classes
#' @examples
#' 
#' ## load example data
#' data(GvHD)
#' frame <- GvHD[[1]]
#' 
#' ## subsetting
#' frame[1:4,]
#' frame[,3]
#' frame[,"FSC-H"]
#' frame$"SSC-H"
#' 
#' ## accessing and replacing raw values
#' head(exprs(frame))
#' exprs(frame) <- exprs(frame)[1:3000,]
#' frame
#' exprs(frame) <- exprs(frame)[,1:6]
#' frame
#' 
#' ## access FCS keywords
#' head(keyword(frame))
#' keyword(frame, c("FILENAME", "$FIL"))
#' 
#' ## parameter annotation
#' parameters(frame)
#' pData(parameters(frame))
#' 
#' ## summarize frame data
#' summary(frame)
#' 
#' ## plotting
#' plot(frame)
#' if(require(flowViz)){
#' plot(frame)
#' plot(frame, c("FSC-H", "SSC-H"))
#' plot(frame[,1])
#' plot(frame, c("FSC-H", "SSC-H"), smooth=FALSE)
#' }
#' 
#' ## frame dimensions
#' ncol(frame)
#' nrow(frame)
#' dim(frame)
#' 
#' ## accessing and replacing parameter names
#' featureNames(frame)
#' all(featureNames(frame) == colnames(frame))
#' colnames(frame) <- make.names(colnames(frame))
#' colnames(frame)
#' parameters(frame)$name
#' names(frame)
#' 
#' ## accessing a GUID
#' identifier(frame)
#' identifier(frame) <- "test"
#' 
#' ##  range of a frame
#' range(frame) #instrument range
#' range(frame, type = "data") #actual data range
#' range(frame)$FSC.H
#' 
#' ## iterators
#' head(each_row(frame, mean))
#' head(each_col(frame, mean))
#' 
#' ## transformation
#' opar <- par(mfcol=c(1:2))
#' if(require(flowViz))
#' plot(frame, c("FL1.H", "FL2.H"))
#' frame <- transform(frame, transformList(c("FL1.H", "FL2.H"), log))
#' if(require(flowViz))
#' plot(frame, c("FL1.H", "FL2.H"))
#' par(opar)
#' range(frame)
#' 
#' ## filtering of flowFrames
#' rectGate <- rectangleGate(filterId="nonDebris","FSC.H"=c(200,Inf))
#' fres <- filter(frame, rectGate)
#' summary(fres)
#' 
#' ## splitting of flowFrames
#' split(frame, rectGate)
#' split(frame, rectGate, flowSet=TRUE)
#' split(frame, fres)
#' f <- cut(exprs(frame$FSC.H), 3)
#' split(frame, f)
#' 
#' ## subsetting according to filters and filter results
#' Subset(frame, rectGate)
#' Subset(frame, fres)
#' Subset(frame, as.logical(exprs(frame$FSC.H) < 300))
#' frame[rectGate,]
#' frame[fres,]
#' 
#' ## accessing the spillover matrix
#' try(spillover(frame))
#' 
#' ## check equality
#' frame2 <- frame
#' frame == frame2
#' exprs(frame2) <- exprs(frame)*2
#' frame == frame2
#' 
#' 
#' @export
setClass("flowFrame",                
         representation=representation(exprs="matrix",
         parameters="AnnotatedDataFrame",
         description="list"),
         prototype=list(exprs=matrix(numeric(0),
                        nrow=0,
                        ncol=0),
         parameters=new("AnnotatedDataFrame"),
         description=list(note="empty")))

## helper function to create empty AnnotatedDataFrame for the parameters slot
parDefault <- function(exp)
{
    vm <- data.frame(labelDescription=c(name="Name of Parameter",
                     desc="Description of Parameter",
                     range="Range of Parameter",
                     minRange="Minimum Parameter Value after Transformation",
                     maxRange="Maximum Parameter Value after Transformation"))
    cols <- colnames(exp)
    pd <- data.frame(name=cols, desc=cols,
                     range=apply(exp, 2, max, na.rm=TRUE),
                     minRange=apply(exp, 2, min, na.rm=TRUE),
                     maxRange=apply(exp, 2, max, na.rm=TRUE)
                     , row.names = paste0("$P", seq_along(cols)))
    new("AnnotatedDataFrame", pd, vm)
}

## check parameter AnnotatedDataFrame for validity
isValidParameters <- function(parameters, exprs)
{
    checkClass(parameters, "AnnotatedDataFrame")
    if(!all(c("name", "desc", "range", "minRange", "maxRange")
            %in% varLabels(parameters)))
        stop("The following columns are mandatory:\n  'name', 'desc',",
             "'range', 'minRange', 'maxRange'", call.=FALSE)
    if(!missing(exprs))
        if(!all(colnames(exprs) %in% parameters$name))
            stop("parameter description doesn't match colnames of the ",
                 "data matrix", call.=FALSE)
    return(TRUE)
}

## constructor
#' @export
flowFrame <- function(exprs, parameters, description=list())
{
    if(!is.matrix(exprs) || !is.numeric(exprs) || is.null(colnames(exprs)))
        stop("Argument 'exprs' must be numeric matrix with colnames ",
             "attribute set", call.=FALSE)
    if(missing(parameters))
        parameters <- parDefault(exprs)
    else
        isValidParameters(parameters, exprs)
    checkClass(description, "list")
    fr <- new("flowFrame", exprs=exprs, parameters=parameters,description=description)
    tmp <- tempfile()
    on.exit(unlink(tmp))
    suppressMessages(write.FCS(fr, tmp))
    suppressMessages(read.FCS(tmp))
}



## ===========================================================================
##  flowSet
## ---------------------------------------------------------------------------
## A collection of several cytoFrames making up one experiment. Slots 
## frames, phenoData, colnames. Frames contains the cytoFrame objects,
## phenoData the experiment meta data and colnames the channel names.
## ---------------------------------------------------------------------------
#' 'flowSet': a class for storing flow cytometry raw data from quantitative
#' cell-based assays
#' 
#' This class is a container for a set of \code{\linkS4class{flowFrame}}
#' objects
#' 
#' 
#' @name flowSet-class
#' @aliases flowSet-class flowSet [,flowSet-method [,flowSet,ANY-method
#' $,flowSet-method [[,flowSet-method [[,flowSet,ANY-method [[<-,flowSet-method
#' [[<-,flowSet,ANY,ANY,flowFrame-method [[<-,flowFrame-method
#' fsApply,flowSet-method show,flowSet-method length,flowSet-method
#' colnames,flowSet-method colnames<-,flowSet-method identifier,flowSet-method
#' identifier<-,flowSet,ANY-method sampleNames,flowSet-method
#' sampleNames<-,flowSet,ANY-method phenoData,flowSet-method
#' phenoData<-,flowSet,ANY-method phenoData<-,flowSet,phenoData-method
#' pData,flowSet-method pData<-,flowSet,data.frame-method
#' plot,flowSet,ANY-method plot,flowSet-method varLabels,flowSet-method
#' varLabels<-,flowSet-method varLabels<-,flowSet,ANY-method
#' varMetadata,flowSet-method varMetadata<-,flowSet,ANY-method
#' compensate,flowSet,ANY-method compensate,flowSet,list-method
#' compensate,flowSet,data.frame-method
#' rbind2,flowSet,missing rbind2,flowSet,flowSet-method
#' rbind2,flowSet,flowSet,missing-method rbind2,flowSet,flowFrame-method
#' rbind2,flowFrame,flowSet-method rbind2,flowSet,missing-method
#' summary,flowSet-method
#' @docType class
#' 
#' @slot frames An \code{\link[base:environment]{environment}}
#' containing one or more \code{\linkS4class{flowFrame}} objects.
#' @slot phenoData An
#' \code{\link[Biobase:class.AnnotatedDataFrame]{AnnotatedDataFrame}}
#' containing the phenotypic data for the whole data set. Each row
#' corresponds to one of the \code{\linkS4class{flowFrame}}s in the
#' \code{frames} slot.  The \code{sampleNames} of \code{phenoData}
#' (see below) must match the names of the
#' \code{\linkS4class{flowFrame}} in the \code{frames} environment.
#' 
#' @section Creating Objects:
#' 
#' Objects can be created using\cr \code{ new('flowSet',}\cr \code{ frames =
#' ...., # environment with flowFrames}\cr \code{ phenoData = .... # object of
#' class AnnotatedDataFrame}\cr \code{ colnames = ....  # object of class
#' character}\cr \code{ )}\cr
#' 
#' or via the constructor \code{flowSet}, which takes arbitrary numbers of
#' flowFrames, either as a list or directly as arguments, along with an
#' optional \code{\link[Biobase:class.AnnotatedDataFrame]{AnnotatedDataFrame}}
#' for the \code{phenoData} slot and a \code{character} scalar for the
#' \code{name} by which the object can be referenced.
#' 
#' \code{flowSet(..., phenoData)}
#' 
#' Alternatively, \code{flowSets} can be coerced from \code{list} and
#' \code{environment} objects.
#' 
#' \code{as(list("A"=frameA,"B"=frameB),"flowSet")}
#' 
#' The safest and easiest way to create \code{flowSet}s directly from
#' \acronym{FCS} files is via the \code{\link{read.flowSet}} function, and
#' there are alternative ways to specify the files to read. See the separate
#' documentation for details.
#' 
#' @section Methods:
#'   \describe{
#' 
#' \item{[, [[}{Subsetting. \code{x[i]} where \code{i} is a scalar,
#'   returns a \code{flowSet} object, and \code{x[[i]]} a
#'   \code{\linkS4class{flowFrame}} object. In this respect the
#'   semantics are similar to the behavior of the subsetting operators
#'   for lists. \code{x[i, j]} returns a \code{flowSet} for which the
#'   parameters of each \code{\linkS4class{flowFrame}} have been subset
#'   according to \code{j}, \code{x[[i,j]]} returns the subset of a
#'   single \code{\linkS4class{flowFrame}} for all parameters in
#'   \code{j}. Similar to data frames, valid values for \code{i} and
#'   \code{j} are logicals, integers and characters.
#'   
#'   \emph{Usage:}
#'   
#'   \code{   flowSet[i]}
#'   
#'   \code{   flowSet[i,j]}
#'   
#'   \code{   flowSet[[i]]}
#'   
#' }
#' 
#' \item{$}{Subsetting by frame name. This will return a single
#'   \code{\linkS4class{flowFrame}} object. Note that names may have to
#'   be quoted if they are no valid R symbols
#'   (e.g. \code{flowSet$"sample 1"}}
#' 
#' \item{colnames, colnames<-}{Extract or replace the \code{colnames}
#'   slot.
#'   
#'   \emph{Usage:}
#'   
#'   \code{   colnames(flowSet)}
#'   
#'   \code{   colnames(flowSet) <- value}
#'   
#' }
#' 
#' \item{identifier, identifier<-}{Extract or replace the \code{name}
#'   item from the environment.
#'   
#'   \emph{Usage:}
#'   
#'   \code{   identifier(flowSet)}
#'   
#'   \code{   identifier(flowSet) <- value}
#'   
#' }
#' 
#' 
#' \item{phenoData, phenoData<-}{Extract or replace the
#'   \code{\link[Biobase:class.AnnotatedDataFrame]{AnnotatedDataFrame}}
#'   from the \code{phenoData} slot.
#'   
#'   \emph{Usage:}
#'   
#'   \code{   phenoData(flowSet)}
#'   
#'   \code{   phenoData(flowSet) <- value}
#'   
#' }
#' 
#' \item{pData, pData<-}{Extract or replace the data frame (or columns
#'                                                          thereof) containing actual phenotypic information from the
#'   \code{phenoData} slot.
#'   
#'   \emph{Usage:}
#'   
#'   \code{   pData(flowSet)}
#'   
#'   \code{   pData(flowSet)$someColumn <- value}
#'   
#' }
#' 
#' \item{varLabels, varLabels<-}{ Extract and set varLabels in the
#'   \code{\link[Biobase:class.AnnotatedDataFrame]{AnnotatedDataFrame}}
#'   of the \code{phenoData} slot.
#'   
#'   \emph{Usage:}
#'   
#'   \code{   varLabels(flowSet)}
#'   
#'   \code{   varLabels(flowSet) <- value}
#'   
#' }
#' 
#' \item{sampleNames}{Extract and replace sample names from the
#'   \code{phenoData} object. Sample names correspond to frame
#'   identifiers, and replacing them will also replace the \code{GUID}
#'   slot for each frame. Note that \code{sampleName} need to be
#'   unique.
#'   
#'   \emph{Usage:}
#'   
#'   \code{   sampleNames(flowSet)}
#'   
#'   \code{   sampleNames(flowSet) <- value}
#'   
#' }
#' 
#' \item{keyword}{Extract or replace keywords specified in a character
#'   vector or a list from the \code{description} slot of each
#'   frame. See \code{\link{keyword}} for details.
#'   
#'   \emph{Usage:}
#'   
#'   \code{   keyword(flowSet, list(keywords))}
#'   
#'   \code{   keyword(flowSet, keywords)}
#'   
#'   \code{   keyword(flowSet) <- list(foo="bar") }
#'   
#' }
#' 
#' \item{length}{number of \code{\linkS4class{flowFrame}} objects in
#'   the set.
#'   
#'   \emph{Usage:}
#'   
#'   \code{   length(flowSet)}
#'   
#' }
#' 
#' \item{show}{display object summary.}
#' 
#' \item{summary}{Return descriptive statistical summary (min, max,
#'                                                        mean and quantile) for each channel of each
#'   \code{\linkS4class{flowFrame}}
#'   
#'   \emph{Usage:}
#'   
#'   \code{   summary(flowSet)}
#'   
#' }
#' 
#' 
#' \item{fsApply}{Apply a function on all frames in a \code{flowSet}
#'   object. Similar to \code{\link{sapply}}, but with additional
#'   parameters. See separate documentation for details.
#'   
#'   \emph{Usage:}
#'   
#'   \code{   fsApply(flowSet, function, ...)}
#'   
#'   \code{   fsApply(flowSet, function, use.exprs=TRUE, ...)}
#'   
#' }
#' 
#' \item{compensate}{Apply a compensation matrix on all frames in a
#'   \code{flowSet} object. See separate documentation for details.
#'   
#'   \emph{Usage:}
#'   
#'   \code{   compensate(flowSet, matrix)}
#'   
#' }
#' 
#' \item{transform}{Apply a transformation function on all frames of a
#'   \code{flowSet} object. See separate documentation for details.
#'   
#'   \emph{Usage:}
#'   
#'   \code{   transform(flowSet, ...)}
#'   
#' }
#' 
#' \item{filter}{Apply a filter object on a \code{flowSet}
#'   object. There are methods for \code{\linkS4class{filter}}s
#'   and lists of filters. The latter has to
#'   be a named list, where names of the list items are matching
#'   sampleNames of the \code{flowSet}. See \code{\linkS4class{filter}}
#'   for details.
#'   
#'   \emph{Usage:}
#'   
#'   \code{   filter(flowSet, filter)}
#'   
#'   \code{   filter(flowSet, list(filters))}
#'   
#' }
#' 
#' \item{split}{Split all \code{flowSet} objects according to a
#'   \code{\link{filter}}, \code{\link{filterResult}} or a list of such
#'   objects, where the length of the list has to be the same as the
#'   length of the \code{flowSet}. This returns a list of
#'   \code{\linkS4class{flowFrame}}s or an object of class
#'   \code{flowSet} if the \code{flowSet} argument is set to
#'   \code{TRUE}. Alternatively, a \code{flowSet} can be split into
#'   separate subsets according to a factor (or any vector that can be
#'                                           coerced into factors), similar to the behaviour of
#'   \code{\link[base]{split}} for lists. This will return a list of
#'   \code{flowSet}s. See \code{\link{split}} for details.
#'   
#'   \emph{Usage:}
#'   
#'   \code{   split(flowSet, filter)}
#'   
#'   \code{   split(flowSet, filterResult)}
#'   
#'   \code{   split(flowSet, list(filters))}
#'   
#'   \code{   split(flowSet, factor)}
#'   
#' }
#' 
#' \item{Subset}{Returns a \code{flowSet} of
#'   \code{\linkS4class{flowFrame}}s that have been subset according
#'   to a \code{\linkS4class{filter}} or
#'   \code{\linkS4class{filterResult}}, or according to a list of such
#'   items of equal length as the \code{flowSet}.
#'   
#'   \emph{Usage:}
#'   
#'   \code{   Subset(flowSet, filter)}
#'   
#'   \code{   Subset(flowSet, filterResult)}
#'   
#'   \code{   Subset(flowSet, list(filters))}
#'   
#' }
#' 
#' 
#' \item{rbind2}{Combine two \code{flowSet} objects, or one
#'   \code{flowSet} and one \code{\linkS4class{flowFrame}} object.
#'   
#'   \emph{Usage:}
#'   
#'   \code{   rbind2(flowSet, flowSet)}
#'   
#'   \code{   rbind2(flowSet, flowFrame)}
#'   
#' }
#' 
#' \item{spillover}{Compute spillover matrix from a compensation
#'   set. See separate documentation for details.
#' }
#' }
#' 
#' @section Important note on storage and performance:
#' The bulk of the data in a \code{flowSet} object is stored in an
#' \code{\link[base:environment]{environment}}, and is therefore not
#' automatically copied when the \code{flowSet} object is copied. If
#' \code{x} is an object of class \code{flowSet}, then the code
#' \preformatted{y <- x} will create an object \code{y} that contains
#' copies of the \code{phenoData} and administrative data in \code{x},
#' but refers to the \emph{same} environment with the actual fluorescence
#' data. See below for how to create proper copies.
#' 
#' The reason for this is performance. The pass-by-value semantics of
#' function calls in \code{R} can result in numerous copies of the same
#' data object being made in the course of a series of nested function
#' calls. If the data object is large, this can result in considerable
#' cost of memory and performance. \code{flowSet} objects are intended to
#' contain experimental data in the order of hundreds of Megabytes, which
#' can effectively be treated as read-only: typical tasks are the
#' extraction of subsets and the calculation of summary statistics.  This
#' is afforded by the design of the \code{flowSet} class: an object of
#' that class contains a \code{phenoData} slot, some administrative
#' information, and a \emph{reference} to an environment with the
#' fluorescence data; when it is copied, only the reference is copied,
#' but not the potentially large set of fluorescence data themselves.
#' 
#' However, note that subsetting operations, such as \code{y <- x[i]} do
#' create proper copies, including a copy of the appropriate part of the
#' fluorescence data, as it should be expected. Thus, to make a proper
#' copy of a \code{flowSet} \code{x}, use \code{y <- x[seq(along=x)]}
#' 
#' @author
#' 
#' F. Hahne, B. Ellis, P. Haaland and N. Le Meur
#' @seealso
#' 
#' \code{\linkS4class{flowFrame}}, \code{\link{read.flowSet}}
#' @keywords classes
#' @examples
#' 
#' ## load example data and object creation
#' data(GvHD)
#' 
#' ## subsetting to flowSet
#' set <- GvHD[1:4]
#' GvHD[1:4,1:2]
#' sel <- sampleNames(GvHD)[1:2]
#' GvHD[sel, "FSC-H"]
#' GvHD[sampleNames(GvHD) == sel[1], colnames(GvHD[1]) == "SSC-H"]
#' 
#' ## subsetting to flowFrame
#' GvHD[[1]]
#' GvHD[[1, 1:3]]
#' GvHD[[1, "FSC-H"]]
#' GvHD[[1, colnames(GvHD[1]) == "SSC-H"]]
#' GvHD$s5a02
#' 
#' ## constructor
#' flowSet(GvHD[[1]], GvHD[[2]])
#' pd <- phenoData(GvHD)[1:2,]
#' flowSet(s5a01=GvHD[[1]], s5a02=GvHD[[2]],phenoData=pd)
#' 
#' ## colnames
#' colnames(set)
#' colnames(set) <- make.names(colnames(set))
#' 
#' ## object name
#' identifier(set)
#' identifier(set) <- "test"
#' 
#' ## phenoData
#' pd <- phenoData(set)
#' pd
#' pd$test <- "test"
#' phenoData(set) <- pd
#' pData(set)
#' varLabels(set)
#' varLabels(set)[6] <- "Foo"
#' varLabels(set)
#' 
#' ## sampleNames
#' sampleNames(set)
#' sampleNames(set) <- LETTERS[1:length(set)]
#' sampleNames(set)
#' 
#' ## keywords
#' keyword(set, list("transformation"))
#' 
#' ## length
#' length(set)
#' 
#' ## compensation
#' samp <- read.flowSet(path=system.file("extdata","compdata","data",
#' package="flowCore"))
#' cfile <- system.file("extdata","compdata","compmatrix", package="flowCore")
#' comp.mat <- read.table(cfile, header=TRUE, skip=2, check.names = FALSE)
#' comp.mat
#' summary(samp[[1]])
#' samp <- compensate(samp, as.matrix(comp.mat))
#' summary(samp[[1]])
#' 
#' ## transformation
#' opar <- par(mfcol=c(1:2))
#' plot(set[[1]], c("FL1.H", "FL2.H"))
#' set <- transform(set, transformList(c("FL1.H", "FL2.H"), log))
#' plot(set[[1]], c("FL1.H", "FL2.H"))
#' par(opar)
#' 
#' ## filtering of flowSets
#' rectGate <- rectangleGate(filterId="nonDebris", FSC.H=c(200,Inf))
#' fres <- filter(set, rectGate)
#' class(fres)
#' summary(fres[[1]])
#' rectGate2 <- rectangleGate(filterId="nonDebris2", SSC.H=c(300,Inf))
#' fres2 <- filter(set, list(A=rectGate, B=rectGate2, C=rectGate, D=rectGate2))
#' 
#' ## Splitting frames of a flowSet
#' split(set, rectGate)
#' split(set[1:2], rectGate, populatiuon="nonDebris2+")
#' split(set, c(1,1,2,2))
#' 
#' ## subsetting according to filters and filter results
#' Subset(set, rectGate)
#' Subset(set, filter(set, rectGate))
#' Subset(set, list(A=rectGate, B=rectGate2, C=rectGate, D=rectGate2))
#' 
#' ## combining flowSets
#' rbind2(set[1:2], set[3:4])
#' rbind2(set[1:3], set[[4]])
#' rbind2(set[[4]], set[1:2])
#' 
#' 
#' @export
setClass("flowSet",                   
         representation=representation(frames="environment",
         phenoData="AnnotatedDataFrame"),
         prototype=list(frames=new.env(hash=TRUE, parent=emptyenv()),
         phenoData=new("AnnotatedDataFrame",
         data=data.frame(),
         varMetadata=data.frame())),
         validity=function(object){
             ## Make sure that all of our samples list
             name.check <- is.na(match(sampleNames(object), ls(object@frames,
                                                               all.names=TRUE)))
             if(any(name.check)) {
                 name.list <- paste(sampleNames(object)[name.check], sep=",")
                 return(paste("These objects are not in the data environment:",
                              name.list))
             }
             
             ##Ensure that all frames match our colnames
			 sn <- sampleNames(object)
			 coln <- colnames(object@frames[[sn[1]]])
             if(!all(sapply(sn, function(i) {
                 x <- get(i, env=object@frames)
                 
                 if(all(coln == colnames(x))){
                     TRUE
                 }else{ 
                     message(i, " doesn't have the identical colnames as the other samples!")
                   FALSE
                 }
             }))){
                 return(paste("Some items identified in the data environment",
                              "either have the wrong dimension or type."))
             }
             return(TRUE)
         })

## constructor
#' @export
flowSet <- function(..., phenoData, name)
{
    x <- list(...)
    if(length(x) == 1 && is.list(x[[1]]))
        x <- x[[1]]
    if(!all(sapply(x, is, "flowFrame")))
        stop("All additional arguments must be flowFrames")
    f <- as(x, "flowSet")
    if(!missing(phenoData))
        phenoData(f) <- phenoData
    if(!missing(name))
        identifier(f) <- name
    f
}



## ===========================================================================
## transform parent class and parameters
## ---------------------------------------------------------------------------
## Parameterize transforms so that we can describe them.
## ---------------------------------------------------------------------------
#' 'transform': a class for transforming flow-cytometry data by applying scale
#' factors.
#' 
#' Transform objects are simply functions that have been extended to allow for
#' specialized dispatch. All of the ``...Transform'' constructors return
#' functions of this type for use in one of the transformation modalities.
#' 
#' 
#' @name transform-class
#' @aliases transform,missing-method transform-class
#' summary,transform-method show,transform-method
#' @docType class
#' 
#' @slot .Data Object of class \code{"function"}
#' @slot transformationId A name for the transformation
#' object
#' 
#' @section Methods:
#' \describe{
#' \item{\code{summary}}{Return the parameters}
#' }
#' 
#' @author N LeMeur
#' @seealso \code{\link[flowCore]{linearTransform}},
#' \code{\link[flowCore]{lnTransform}},
#' \code{\link[flowCore]{logicleTransform}},
#' \code{\link[flowCore]{biexponentialTransform}},
#' \code{\link[flowCore]{arcsinhTransform}},
#' \code{\link[flowCore]{quadraticTransform}},
#' \code{\link[flowCore]{logTransform}}
#' @keywords classes
#' @examples
#' 
#' cosTransform <- function(transformId, a=1, b=1){
#'   t = new("transform", .Data = function(x) cos(a*x+b))
#'   t@transformationId = transformId
#'   t
#' }
#' 
#' cosT <- cosTransform(transformId="CosT",a=2,b=1)
#' 
#' summary(cosT)
#' 
#' @export 
setClass("transform",
         representation=representation(transformationId="character",
                                       .Data="function"),
         prototype=prototype(transformationId=""))

#' Class "parameters"
#' 
#' A representation of flow parameters that allows for referencing.
#' 
#' 
#' @name parameters-class
#' @aliases parameters-class
#' @docType class
#' @section Objects from the Class: Objects will be created internally whenever
#' necessary and this should not be of any concern to the user.
#' 
#' @slot .Data A list of the individual parameters.
#' 
#' @section Extends:
#' Class \code{"\linkS4class{list}"}, from data part.
#' Class \code{"\linkS4class{vector}"}, by class "list", distance 2.
#' 
#' @author Nishant Gopalakrishnan
#' @keywords classes
#'
#' @export
setClass("parameters", contains="list")

#' Class "transformation"
#' 
#' A virtual class to abstract transformations.
#' 
#' 
#' @name transformation-class
#' @aliases transformation-class transformation
#' @docType class
#' @section Objects from the Class: A virtual Class: No objects may be created
#' from it.
#' @section Extends:
#' Class \code{"\linkS4class{characterOrTransformation}"}, directly.
#' @author N. Gopalakrishnan
#' @keywords classes
setClassUnion("transformation", "transform")


#' Class "characterOrTransformation"
#' 
#' A simple union class of \code{character} and \code{\linkS4class{transformation}}.
#' Objects will be created internally whenever necessary and the user should
#' not need to explicitly interact with this class.
#' 
#' @name characterOrTransformation-class
#' @aliases characterOrTransformation-class characterOrTransformation
#' @docType class
#' @section Objects from the Class: A virtual Class: No objects may be created
#' from it.
#' @keywords classes
#' @examples
#' 
#' showClass("characterOrTransformation")
#' 
setClassUnion("characterOrTransformation", c("character","transformation"))

#' Class "characterOrParameters"
#' 
#' A simple union class of \code{character} and \code{\linkS4class{parameters}}.
#' Objects will be created internally whenever necessary and the user should
#' not need to explicitly interact with this class.
#' 
#' @name characterOrParameters-class
#' @aliases characterOrParameters-class characterOrParameters
#' @docType class
#' @section Objects from the Class: A virtual Class: No objects may be created
#' from it.
#' @keywords classes
#' @examples
#' 
#' showClass("characterOrParameters")
#' 
setClassUnion("characterOrParameters", c("character","parameters"))

#' Class "singleParameterTransform"
#' 
#' A transformation that operates on a single parameter
#' 
#' 
#' @name singleParameterTransform-class
#' @aliases singleParameterTransform-class
#' initialize,singleParameterTransform-method
#' parameters,singleParameterTransform-method
#' @docType class
#' @section Objects from the Class:
#' 
#' Objects can be created by calls of the form
#' \code{new("singleParameterTransform", ...)}.
#' 
#' @slot .Data Object of class \code{"function"}. The transformation.
#' @slot parameters Object of class \code{"transformation"}. The 
#' parameter to transform. Can be a derived parameter from another 
#' transformation.
#' @slot transformationId Object of class \code{"character"}. An 
#' identifier for the object.
#' 
#' @section Extends:
#' Class \code{"\linkS4class{transform}"}, directly.
#' Class \code{"\linkS4class{transformation}"}, by class "transform", distance 2.
#' Class \code{"\linkS4class{characterOrTransformation}"}, by class "transform", distance 3.
#' 
#' @author F Hahne
#' @keywords classes
#' @examples
#' 
#' showClass("singleParameterTransform")
#' 
setClass("singleParameterTransform",
         representation=representation(parameters="transformation"),
         contains="transform")

#' Class "nullParameter"
#' 
#' A class used internally for coercing transforms to characters for a return
#' value when a coercion cannot be performed. The user should never need to
#' interact with this class.
#' 
#' @name nullParameter-class
#' @aliases nullParameter-class nullParameter
#' @docType class
#' @section Objects from the Class: Objects will be created internally whenever
#' necessary and this should not be of any concern to the user.
#' @keywords classes
setClass("nullParameter",
         representation=representation(dummy="numeric"))



## ===========================================================================
## Virtual filter and derived concreteFilter and parameterFilter
## ---------------------------------------------------------------------------
## A class describing a selection applied to a flow data matrix. Consist of
## a filterId and the names of the parameters to operate on (for parameter
## filters only). More specific filters all inherit from either of these two
## classes.
## ---------------------------------------------------------------------------
#' A class for representing filtering operations to be applied to flow data.
#' 
#' The \code{filter} class is the virtual base class for all filter/gating
#' objects in \code{flowCore}. In general you will want to subclass or create a
#' more specific filter.
#' 
#'
#' @name filter-class
#' @aliases filter-class filtergate,filter-class rectangleGate,filter-class
#' polygonGate,filter-class ellipsoidGate,filter-class norm2Filter,filter-class
#' decisionTreeGate,filter-class booleanGate,filter-class filter,filter-method
#' |,filter,filter-method !,filter-method |,filter,list-method
#' |,list,filter-method
#' @docType class
#' 
#' @slot filterId A character vector that identifies this \code{filter}. 
#' This is typically user specified but can be automatically deduced by 
#' certain filter operations, particularly boolean and
#' set operations.
#' 
#' @section Objects from the Class:
#' 
#' All \code{\link[flowCore:filter-class]{filter}} objects in \code{flowCore}
#' should be instantiated through their constructors. These are functions
#' that share the same name with the respective \code{filter}
#' classes. E.g.,
#' \code{\link[flowCore:rectangleGate]{rectangleGate()}} is the 
#' constructor function for rectangular gates, and
#' \code{\link[flowCore:kmeansFilter]{kmeansFilter()}} creates
#' objects of class \code{\link{kmeansFilter}}. Usually these
#' constructors can deal with various different inputs, allowing to
#' utilize the same function in different programmatic or interactive
#' settings. For all \code{filters} that operate on specific flow
#' parameters (i.e., those inheriting from 
#'             \code{\link[flowCore:parameterFilter-class]{parameterFilter}}), the parameters
#' need to be passed to the constructor, either as names or colnames of
#' additional input arguments or explicitly as separate arguments.  See
#' the documentation of the respective \code{filter} classes for
#' details. If parameters are explicitly defined as separate arguments,
#' they may be of class \code{character}, in which case they will be
#' evaluated literally as colnames in a \code{\link{flowFrame}}, or of
#' class \code{\link[flowCore:transform-class]{transform}}, in which case the
#' filtering is performed on a temporarily transformed copy of the input
#' data. See \code{\link[flowCore:parameterFilter-class]{here}} for details.
#' 
#' @section Methods:
#' \describe{
#' \item{\code{\%in\%}}{Used in the usual way this returns a vector of
#'   values that identify which events were accepted by the filter. A
#'   single filter may encode several populations so this can return
#'   either a \code{logical} vector, a \code{factor} vector or a
#'   \code{numeric} vector of probabilities that the event is accepted
#'   by the filter. Minimally, you must implement this method when
#'   creating a new type of filter}
#' 
#' \item{\code{&}, \code{|}, \code{!}}{Two filters can be composed
#'   using the usual boolean operations returning a \code{filter} class
#'   of a type appropriate for handling the operation. These methods
#'   attempt to guess an appropriate \code{filterId} for the new
#'   \code{filter}}
#' 
#' \item{\code{\%subset\%}, \code{\%&\%}}{Defines a filter as being a
#'   subset of another filter. For deterministic filters the results
#'   will typically be equivalent to using an \code{\&} operation to
#'   compose the two filters, though summary methods will use subset
#'   semantics when calculating proportions. Additionally, when the
#'   filter is data driven, such as
#'   \code{\link[flowStats:norm2Filter-class]{norm2Filter}}, the subset
#'   semantics are 
#'   applied to the data used to fit the filter possibly resulting in
#'   quite different, and usually more desirable, results.}
#' 
#' \item{\code{\%on\%}}{Used in conjunction with a
#'   \code{\link[flowCore:transformList-class]{transformList}} to create a
#'   \code{transformFilter}. This filter is similar to the subset
#'   filter in that the filtering operation takes place on transformed
#'   values rather than the original values.}
#' 
#' \item{\code{filter}}{A more formal version of \code{\%in\%}, this
#'   method returns a
#'   \code{\link[flowCore:filterResult-class]{filterResult}} object
#'   that can be used in subsequent filter operations as well as providing
#'   more metadata about the results of the filtering operation. See 
#'   the documenation for \code{\link[flowCore:filter-methods]{filter}} 
#'   methods for details.}
#' 
#' \item{\code{summarizeFilter}}{When implementing a new filter this
#'   method is used to update the \code{filterDetails} slot of a
#'   \code{filterResult}. It is optional and typically only needs to be
#'   implemented for data-driven filters.}
#' 
#' }
#' 
#' @author B. Ellis, P.D. Haaland and N. LeMeur
#' @seealso \code{\link[flowCore:transform-class]{transform}},
#' \code{\link[flowCore:filter-methods]{filter}}
#' @keywords classes
#'
#' @export
setClass("filter", 
         representation=representation("VIRTUAL",
         filterId="character"),
         prototype=prototype(filterId=""))

#' Class "concreteFilter"
#' 
#' The \code{concreteFilter} serves as a base class for all filters that
#' actually implement a filtering process. At the moment this includes all
#' filters except \code{\linkS4class{filterReference}}, the only non-concrete
#' filter at present.
#' 
#' 
#' @name concreteFilter-class
#' @aliases concreteFilter-class concreteFilter
#' @docType class
#' @section Objects from the Class: Objects of this class should never be
#' created directly. It serves only as a point of inheritance.
#' 
#' @slot filterId The identifier associated with this class.
#' 
#' @section Extends:
#' Class \code{"\linkS4class{filter}"}, directly.
#' 
#' @author B. Ellis
#' @seealso \code{\linkS4class{parameterFilter}}
#' @keywords classes
#'
#' @export
setClass("concreteFilter",
         contains="filter")

                                        # setClass("parameterFilter",
                                        #          representation=representation(parameters="character"),
                                        #          contains="concreteFilter",
                                        #          prototype=prototype(parameters=""))
#' Class "parameterFilter"
#' 
#' A concrete filter that acts on a set of parameters.
#' 
#' 
#' @name parameterFilter-class
#' @aliases parameterFilter-class initialize,parameterFilter-method
#' @docType class
#' @section Objects from the Class: \code{parameterFilter} objects are never
#' created directly. This class serves as an inheritance point for filters that
#' depends on particular parameters.
#' 
#' @slot parameters The names of the parameters employed by this filter.
#' @slot filterId The filter identifier.
#' 
#' @section Extends:
#' Class \code{"\linkS4class{concreteFilter}"}, directly.
#' Class \code{"\linkS4class{filter}"}, by class "concreteFilter", distance 2.
#' 
#' @author B. Ellis
#' @keywords classes
#'
#' @export
setClass("parameterFilter", 
         representation(parameters="parameters"),
         contains="concreteFilter",
         prototype=prototype(parameters=new("parameters",.Data="NULL"))
         )

#########################################################################
#filters is a list of filters for the same flowFrame
#thus is different from filerList which is for a flowSet
#---------------------------------------------------------------------
#which are supposed to be gated on the same parent population.
#It is mainly for plotting multiple gates per flowFramein flowViz::xyplot.
#These gates should have the same parameters(channels)
###########################################################################
#' Class "filters" and "filtersList"
#' 
#' The \code{filters} class is the container for a list of
#' \code{\link[flowCore:filter-methods]{filter}} objects.\cr\cr
#' The \code{filtersList}
#' class is the container for a list of \code{filters} objects. 
#' 
#' The \code{filters} class mainly
#' exists for displaying multiple filters/gates on one single panel(flowFrame)
#' of \code{\link[flowViz:xyplot]{xyplot}}. Note that it is different from
#' \code{\link[flowCore:filterList]{filterList}} class which is to be applied to
#' a flowSet. In other words, \code{filter} objects of a \code{fliterList} are
#' to be applied to different flowFrames. However,all of \code{filter} objects
#' of a \code{filters} object are for one single flowFrame, more specifically for one
#' pair of projections(parameters).So these filters should share the common
#' parameters.\cr\cr
#' And \code{filtersList} is a list of \code{filters} objects, which are to be
#' applied to a flowSet.
#' 
#' 
#' @name filters-class
#' @aliases filters-class filters filtersList-class filtersList
#' show,filters-method show,filtersList-method
#' @docType class
#' 
#' @usage 
#' filters(x)
#' 
#' filtersList(x)
#' 
#' @param   x A list of \code{filter} or \code{filters} objects.
#' 
#' @return  A \code{filters} or \code{filtersList} object from the constructor 
#' 
#' @slot .Data Object of class
#' \code{"list"}. The class directly extends \code{list}, and this slot holds
#' the list data.
#' 
#' @section Extends:
#' Class \code{"\linkS4class{list}"}
#' 
#' @section Objects from the Class:
#' Objects are created from regular lists using the constructors 
#' \code{filters} and \code{filtersList}:
#' 
#' \code{filters(x)}
#' 
#' \code{filtersList(x)}
#' 
#' @author Mike Jiang
#' @seealso \code{\link[flowCore:filter-class]{filter}},
#' \code{\link[flowCore:filterList-class]{filterList}}
#' @keywords classes
#' 
#' @export
setClass("filters",
		 contains="list"
		 )
 ## Constructor
#' @export
 filters <- function(x)
 {
	 checkClass(x, "list")
	 x <- new("filters", .Data=x)
	 validFilters(x)
	 return(x)
 }
 #' Check if all filters in a filters matches same paramters
 #' @param flist a filters object
 #' @return TRUE or FALSE
 validFilters<- function(flist)
 {
	 res <- TRUE
	 checkClass(flist, "filters")
		
     
     fParams <- lapply(flist, function(x) sort(parameters(x)))
     nParam <- length(unique(fParams))
     
     valid <- FALSE
     #validity check for 1d gate (nParam up to 2 is allowed)
     if(all(sapply(fParams, length) == 1)){
       valid <- nParam <= 2
     }else{
       #otherwise consider them as 2d
      valid <- nParam == 1 
     }
     if(!valid)
     {
       stop("Not all filter objects in the list have the same paramters", call.=FALSE)
       res <- FALSE
     }  
     
	 
	 if(any(sapply(flist, is, "filterResult")))
	 {
		 stop("filterResults are not allowed in a filterList") 
		 res <- FALSE
	 }
	 return(res)
 
 }
		 
		
		 
#########################################################################
#filtersList is a list filters to be applied to a flowSet
#---------------------------------------------------------------------
 
#' @export
setClass("filtersList",
		 contains="list"
		 )
		 
 ## Check if a filtersList matches a flowSet.
 validFiltersList <- function(flist, set, strict=TRUE)
 {
	 res <- TRUE
	 checkClass(flist, "filtersList")
	 checkClass(strict, "logical", 1)
	 if(!missing(set)){
		 checkClass(set, "flowSet")
		 if(res <- !all(names(flist) == sampleNames(set)))
			 warning("Sample names don't match between flowSet and ",
					 "filterResultList", call.=FALSE)
	 }
	 
	 if(strict){
		 fTypes <- unname(sapply(flist, class,simplify=F))
		 if(length(unique(fTypes)) != 1)
		 {
			 warning("Not all filter objects in the list are of equal",
					 " type.", call.=FALSE)
			 res <- FALSE
		 }
		 if(any(sapply(flist, is, "filterResult")))
		 {
			 stop("filterResults are not allowed in a filterList") 
				 res <- FALSE
		 }
		 return(res)
	}
 }
 
 ## Constructor
#' @export
 filtersList <- function(x)
 {
	 checkClass(x, "list")
	 
	 if(is.null(names(x)))
		 stop("Names missing in input list.")
	 x <- new("filtersList", .Data=x)
	 validFiltersList(x)
	 return(x)
 }
## ===========================================================================
## Rectangular gate
## ---------------------------------------------------------------------------
## A class describing a 2D rectangular region in the parameter space. Slots
## min and max hold the boundaries in the two dimensions.
## ---------------------------------------------------------------------------
#' Class "rectangleGate"
#' 
#' 
#' Class and constructor for n-dimensional rectangular
#' \code{\linkS4class{filter}} objects.
#' 
#' 
#' This class describes a rectangular region in n dimensions, which is a
#' Cartesian product of \code{n} orthogonal intervals in these dimensions.
#' \code{n=1} corresponds to a range gate, \code{n=2} to a rectangle gate,
#' \code{n=3} corresponds to a box region and \code{n>3} to a hyper-rectangular
#' regions. Intervals may be open on one side, in which case the value for the
#' boundary is supposed to be \code{Inf} or \code{-Inf}, respectively.
#' \code{rectangleGates} are inclusive, that means that events on the
#' boundaries are considered to be in the gate.
#' 
#' The constructor is designed to be useful in both direct and programmatic
#' usage. To use it programmatically, you may either construct a named list or
#' you may construct a matrix with \code{n} columns and \code{2} rows.  The
#' first row corresponds to the minimal value for each parameter while the
#' second row corresponds to the maximal value for each parameter.  The names
#' of the parameters are taken from the column names or from the list names,
#' respectively. Alternatively, the boundaries of the \code{rectangleGate} can
#' be given as additional named arguments, where each of these arguments should
#' be a numeric vector of length \code{2}; the function tries to collapse these
#' boundary values into a matrix.
#' 
#' Note that boundaries of \code{rectangleGates} where \code{min > max} are
#' syntactically valid, however when evaluated they will always be empty.
#' 
#' \code{rectangleGate} objects can also be multiplied using the \code{*}
#' operator, provided that both gates have orthogonal axes. This results in
#' higher-dimensional \code{rectangleGates}. The inverse operation of
#' subsetting by parameter name(s) is also available.
#' 
#' Evaluating a \code{rectangleGate} generates an object of class
#' \code{\linkS4class{logicalFilterResult}}. Accordingly, \code{rectangleGates}
#' can be used to subset and to split flow cytometry data sets.
#' 
#' @name rectangleGate-class
#' @aliases rectangleGate-class rectangleGate summary,rectangleGate-method
#' show,rectangleGate-method [,rectangleGate,character-method
#' [,rectangleGate,ANY-method *,rectangleGate,rectangleGate-method
#' @docType class
#' 
#' 
#' @usage rectangleGate(\dots, .gate, filterId="defaultRectangleGate")
#' 
#' @param filterId An optional parameter that sets the \code{filterId} of this
#' gate. The object can later be identified by this name.
#' @param .gate A definition of the gate. This can be either a list, or a
#' matrix, as described below.
#' @param \dots You can also directly provide the boundaries of a
#' \code{rectangleGate} as additional named arguments, as described below.
#' @return
#' 
#' Returns a \code{\link{rectangleGate}} object for use in filtering
#' \code{\link{flowFrame}}s or other flow cytometry objects.
#' @note
#' 
#' See the documentation in the \code{\link[flowViz:flowViz-package]{flowViz}}
#' package for details on plotting of \code{rectangleGates}.
#' @section Extends:
#' 
#' Class \code{"\linkS4class{parameterFilter}"}, directly.
#' 
#' Class \code{"\linkS4class{concreteFilter}"}, by class
#' \code{parameterFilter}, distance 2.
#' 
#' Class \code{"\linkS4class{filter}"}, by class \code{parameterFilter},
#' distance 3.
#' 
#' @slot min,max Objects of class \code{"numeric"}. The
#' minimum and maximum values of the n-dimensional rectangular
#' region.
#' 
#' @slot parameters Object of class \code{"character"},
#' indicating the parameters for which the \code{rectangleGate} is
#' defined.
#' 
#' @slot filterId Object of class \code{"character"},
#' referencing the filter.
#' 
#' @section Objects from the Class:
#' 
#' Objects can be created by calls of the form \code{new("rectangleGate",
#' ...)}, by using the constructor \code{rectangleGate} or by combining
#' existing \code{rectangleGates} using the \code{*} method.  Using the
#' constructor is the recommended way of object instantiation.
#' 
#' @section Methods:
#' \describe{
#'    \item{\%in\%}{\code{signature(x = "flowFrame", table =
#'      "rectangleGate")}: The workhorse used to evaluate the filter on
#'      data. This is usually not called directly by the user, but
#'      internally by calls to the \code{\link{filter}} methods. }
#'    
#'    \item{show}{\code{signature(object = "rectangleGate")}: Print
#'      information about the filter. }
#'    
#'    \item{*}{\code{signature(e1 = "rectangleGate", e2 =
#'      "rectangleGate")}: combining two \code{rectangleGates} into one
#'      higher dimensional representation. }
#'    
#'    \item{[}{\code{signature(x = "rectangleGate", i = "character")}:
#'      Subsetting of a \code{rectangleGate} by parameter name(s). This
#'      is essentially the inverse to \code{*}. }
#' }
#' 
#' @author F.Hahne, B. Ellis N. Le Meur
#' @family Gate classes
#' @seealso
#' 
#' \code{\link{flowFrame}}, \code{\link{polygonGate}},
#' \code{\link{ellipsoidGate}}, \code{\link{polytopeGate}},
#' \code{\link{filter}} for evaluation of \code{rectangleGates} and
#' \code{\link{split}} and \code{\link{Subset}}for splitting and subsetting of
#' flow cytometry data sets based on that.
#' @keywords methods classes
#' @examples
#' 
#' ## Loading example data
#' dat <- read.FCS(system.file("extdata","0877408774.B08",
#' package="flowCore"))
#' 
#' #Create directly. Most likely from a command line
#' rectangleGate(filterId="myRectGate", "FSC-H"=c(200, 600), "SSC-H"=c(0, 400))
#' 
#' #To facilitate programmatic construction we also have the following
#' rg <- rectangleGate(filterId="myRectGate", list("FSC-H"=c(200, 600),
#' "SSC-H"=c(0, 400)))
#' mat <- matrix(c(200, 600, 0, 400), ncol=2, dimnames=list(c("min", "max"),
#' c("FSC-H", "SSC-H")))
#' rg <- rectangleGate(filterId="myRectGate", .gate=mat)
#' 
#' ## Filtering using rectangleGates
#' fres <- filter(dat, rg)
#' fres
#' summary(fres)
#' 
#' ## The result of rectangle filtering is a logical subset
#' Subset(dat, fres)
#' 
#' ## We can also split, in which case we get those events in and those
#' ## not in the gate as separate populations
#' split(dat, fres)
#' 
#' ## Multiply rectangle gates
#' rg1 <- rectangleGate(filterId="FSC-", "FSC-H"=c(-Inf, 50))
#' rg2 <- rectangleGate(filterId="SSC+", "SSC-H"=c(50, Inf))
#' rg1 * rg2
#' 
#' ## Subset rectangle gates
#' rg["FSC-H"]
#' 
#' ##2d rectangleGate can be coerced to polygonGate
#' as(rg, "polygonGate")
#' 
#' 
#' @export
setClass("rectangleGate",
         representation=representation(min="numeric",
         max="numeric"),
         contains="parameterFilter",
         prototype=list(filterId="defaultRectangleGate",
         min=-Inf,
         max=Inf)
         )

## parse '...' argument of a gate constructor. The return value is a list
## with parameters (as transforms) and values.
parseDots <- function(dl, collapseFirst=TRUE, len=NULL){
    parseItem <- function(i, x, len){
        ## We can return transforms directly
        y <- x[[i]]
        if(is(y, "transform")){
            dl[[i]] <<- NA
            y
        }else{
            li <- length(y)
            if(!is.character(y) && !is.null(len) && li!=len)
                stop("All additional arguments must be of length ",
                     len, call.=FALSE)
            if(!is.character(y) && li!=allLen)
                stop("All additional arguments must be of equal length ",
                     call.=FALSE)     
            if(!is.character(y) && is.null(names(x)[i]))
                stop("Additional arguments have to be named.",
                     call.=FALSE)
            if(is.character(y)){
                ## We return character scalars as unitytransforms
                dl[[i]] <<- NA
                unitytransform(y) 
            }else{
                ## For eerything else we make unitytransforms from the
                ## argument names
                unitytransform(names(x)[i])
            }
        }
    }
    ## We only parse ..1 if it is a list and drop all other arguments
    if(collapseFirst && length(dl) && is.list(dl[[1]]))
        dl <- dl[[1]]
    if(length(dl)){
        ## If ..1 is a character vector we return unitytransforms only
        if(is.character(dl[[1]]) && length(dl[[1]])>1)
            return(list(parameters=sapply(dl[[1]], unitytransform,
                        simplify=FALSE),
                        values=as.list(rep(NA, length(dl[[1]])))))
        ## If ..1 is a matrix we return unitytransforms and the matrix
        if(is.matrix(dl[[1]])){
            if(is.null(colnames(dl[[1]])))
                stop("Matrix of gate boundaries must have colnames.",
                     call.=FALSE)
            return(list(parameters=sapply(colnames(dl[[1]]), unitytransform,
                        simplify=FALSE), values=dl[[1]]))
        }
        ## All items in dl must be of equal length
        allLen <- if(is.character(dl[[1]])) length(dl[[min(length(dl), 2)]]) 
        else length(dl[[1]])
       
    }
    parms <- sapply(seq_along(dl), parseItem, dl, len, simplify=FALSE)
    return(list(parameters=parms, values=dl))
}

## Further process the output of parseDots to collapse individual arguments
prepareInputs <- function(parsed, .gate, ...)
{
    parms <- parsed$parameters
    values <- parsed$values
    if(missing(.gate)){
        if(any(sapply(values, is.na)))
            stop("The gate boundaries has to be provides as argument",
                 " '.gate'", call.=FALSE)
        if(!is.matrix(values)){
            sel <- sapply(values, is, "numeric")
            if(any(sel)){
                values <- matrix(sapply(values[sel], function(x){
                    if(length(x) ==2)
                        x <- sort(x)
                    x}), ncol=length(parms))
                parms <- parms[sel]
                colnames(values) <- sapply(parms, parameters)
            }
            return(list(parameters=parms, values=values))
        }
        if(!length(parms))
            stop("No arguments provided.", call.=FALSE)
        return(parsed)
    }else{
        if(is.matrix(.gate) && !is.null(colnames(.gate)))
            return(parseDots(list(.gate), ...))
        if(any(sapply(values, is.na))){
            if(ncol(.gate) != length(parms))
                stop("Number of parameters and dimensions of supplied",
                     " gate boundaries don't match.", call.=FALSE)
            return(list(parameters=parms, values=.gate))
        }
        if(!length(parms) || !all(sapply(parms, is, "unityTranform"))){
            return(prepareInputs(parseDots(list(.gate), ...)))
        }else{
            return(parsed)
        }
    }
}


## Constructor. We allow for the following inputs:
##  ... are named numerics, each of length 2
##  ... are transforms or a mix of transforms and characters, .gate is
##      the associated matrix of min and max values
##  ..1 is a named list of numerics
##  ..1 is a list of transformations or characters and .gate is the
##      associated matrix of min and max values, each of length 2
##  .gate is a matrix of min and max values with colnames = parameters
##  .gate is a named list of numerics, each of lenght 2
#' @export
rectangleGate <- function(..., .gate, filterId="defaultRectangleGate")
{
    checkClass(filterId, "character", 1)
    parms <- parseDots(list(...), len=2)
    parms <- prepareInputs(parms, .gate, len=2)
    parms$values <- apply(parms$values, 2, sort)
    new("rectangleGate", filterId = filterId, parameters=parms$parameters,
        min=parms$value[1, ], max=parms$value[2, ])
}



## ===========================================================================
## Quadrant gate
## ---------------------------------------------------------------------------
## A class describing a gate which separates a 2D parameter space into
## four quadrants. Slot boundary holds a vector of length two indicating
## the quadrant boundaries in each of the two dimensions.
## ---------------------------------------------------------------------------
#' Class "quadGate"
#' 
#' 
#' Class and constructors for quadrant-type \code{\link{filter}} objects.
#' 
#' 
#' \code{quadGates} are defined by two parameters, which specify a separation
#' of a two-dimensional parameter space into four quadrants. The
#' \code{quadGate} function is designed to be useful in both direct and
#' programmatic usage.
#' 
#' For the interactive use, these parameters can be given as additional named
#' function arguments, where the names correspond to valid parameter names in a
#' \code{\link{flowFrame}} or \code{\link{flowSet}}. For a more programmatic
#' approach, a named list or numeric vector of the gate boundaries can be
#' passed on to the function as argument \code{.gate}.
#' 
#' Evaluating a \code{quadGate} results in four sub-populations, and hence in
#' an object of class \code{\link{multipleFilterResult}}. Accordingly,
#' \code{quadGates} can be used to split flow cytometry data sets.
#' 
#' @name quadGate-class
#' @aliases quadGate-class quadGate show,quadGate-method
#' @docType class
#' 
#' @usage quadGate(\dots, .gate, filterId="defaultQuadGate")
#' 
#' @param filterId An optional parameter that sets the \code{filterId} of this
#' \code{\link{filter}}. The object can later be identified by this name.
#' @param .gate A definition of the gate for programmatic access. This can be
#' either a named list or a named numeric vector, as described below.
#' @param \dots The parameters of \code{quadGates} can also be directly
#' described using named function arguments, as described below.
#' @return
#' 
#' Returns a \code{quadGate} object for use in filtering
#' \code{\link{flowFrame}}s or other flow cytometry objects.
#' @note
#' 
#' See the documentation in the \code{\link[flowViz:flowViz-package]{flowViz}}
#' package for plotting of \code{quadGates}.
#' @section Extends:
#' 
#' Class \code{"\linkS4class{parameterFilter}"}, directly.
#' 
#' Class \code{"\linkS4class{concreteFilter}"}, by class
#' \code{parameterFilter}, distance 2.
#' 
#' Class \code{"\linkS4class{filter}"}, by class \code{parameterFilter},
#' distance 3.
#' 
#' @slot boundary Object of class \code{"numeric"}, length
#' 2. The boundaries of the quadrant regions.
#' @slot parameters Object of class \code{"character"},
#' describing the parameter used to filter the \code{flowFrame}.
#' @slot filterId Object of class \code{"character"},
#' referencing the gate.
#' 
#' @section Objects from the Class:
#' Objects can be created by calls of the form \code{new("quadGate",
#' ...)} or using the constructor \code{quadGate}. The latter is the
#' recommended way.
#' 
#' @section Methods:
#' \describe{
#'   
#'   \item{\%in\%}{\code{signature(x = "flowFrame", table =
#'                                   "quadGate")}: The workhorse used to evaluate the gate on
#'     data. This is usually not called directly by the user, but
#'     internally by calls to the \code{\link{filter}} methods. }
#'   
#'   \item{show}{\code{signature(object = "quadGate")}: Print
#'     information about the gate. }
#'   
#' }
#' 
#' @author F.Hahne, B. Ellis N. Le Meur
#' @family Gate classes
#' @seealso
#' 
#' \code{\link{flowFrame}}, \code{\link{flowSet}}, \code{\link{filter}} for
#' evaluation of \code{quadGates} and \code{\link{split}} for splitting of flow
#' cytometry data sets based on that.
#' @keywords classes methods
#' @examples
#' 
#' ## Loading example data
#' dat <- read.FCS(system.file("extdata","0877408774.B08",
#' package="flowCore"))
#' 
#' ## Create directly. Most likely from a command line
#' quadGate(filterId="myQuadGate1", "FSC-H"=100, "SSC-H"=400)
#' 
#' ## To facilitate programmatic construction we also have the following
#' quadGate(filterId="myQuadGate2", list("FSC-H"=100, "SSC-H"=400))
#' ## FIXME: Do we want this?
#' ##quadGate(filterId="myQuadGate3", .gate=c("FSC-H"=100, "SSC-H"=400))
#' 
#' ## Filtering using quadGates
#' qg <- quadGate(filterId="quad", "FSC-H"=600, "SSC-H"=400)
#' fres <- filter(dat, qg)
#' fres
#' summary(fres)
#' names(fres)
#' 
#' ## The result of quadGate filtering are multiple sub-populations
#' ## and we can split our data set accordingly
#' split(dat, fres)
#' 
#' ## We can limit the splitting to one or several sub-populations
#' split(dat, fres, population="FSC-H-SSC-H-")
#' split(dat, fres, population=list(keep=c("FSC-H-SSC-H-",
#' "FSC-H-SSC-H+")))
#' 
#' 
#' @export
setClass("quadGate",
         representation=representation(boundary="numeric"),        
         contains="parameterFilter",
         prototype=list(filterId="defaultQuadGate",
         boundary=c(Inf, Inf)))

## Constructor. We allow for the following inputs:
##  ..1 and ..2 are named numerics of length 1
##  ..1 and ..2 are transforms or a mix of transforms and characters, .gate
##      is the associated numeric vector of boundary values of length 2
##  ..1 is a named list of numerics of length 1
##  ..1 is a list of transformations or characters and .gate is the
##      associated numeric vector of boundary values of length 2
##  .gate is a named list of numerics, each of lenght 1
#' @export
quadGate <- function(..., .gate, filterId="defaultQuadGate")
{
    checkClass(filterId, "character", 1)
    if(!missing(.gate) && !is.list(.gate) && !is.matrix(.gate))
        .gate <- matrix(.gate, nrow=1, dimnames=list(NULL, names(.gate)))
    parms <- prepareInputs(parseDots(list(...), len=1), .gate, len=1)
    p <- as.numeric(parms$values)
    names(p) <- colnames(parms$values)
    if(length(parms$parameters) !=2 || nrow(parms$value)!=1)
        stop("Expecting two named arguments or a single named vector\n",
             "of length 2 as input for gate boundaries.", call.=FALSE)
    new("quadGate", filterId=filterId, parameters=parms$parameters,
        boundary=p)
}



## ===========================================================================
## Polygon gate
## ---------------------------------------------------------------------------
## A class describing a 2D polygonal region in the parameter space. Slot
## boundary holds the vertices of the polygon in a 2 colum matrix.
## ---------------------------------------------------------------------------
#' Class "polygonGate"
#' 
#' 
#' Class and constructor for 2-dimensional polygonal \code{\link{filter}}
#' objects.
#' 
#' 
#' Polygons are specified by the coordinates of their vertices in two
#' dimensions. The constructor is designed to be useful in both direct and
#' programmatic usage. It takes either a list or a named matrix with \code{2}
#' columns and at least \code{3} rows containing these coordinates.
#' Alternatively, vertices can be given as named arguments, in which case the
#' function tries to convert the values into a matrix.
#' 
#' @name polygonGate-class
#' @aliases polygonGate-class polygonGate show,polygonGate-method
#' @docType class
#' 
#' @usage polygonGate(\dots, .gate, boundaries, filterId="defaultPolygonGate")
#' 
#' @param filterId An optional parameter that sets the \code{filterId} of this
#' gate.
#' @param .gate,boundaries A definition of the gate. This can be either a list
#' or a named matrix as described below. Note the argument boundaries is
#' deprecated and will go away in the next release.
#' @param \dots You can also directly describe a gate without wrapping it in a
#' list or matrix, as described below.
#' @return
#' 
#' Returns a \code{\link{polygonGate}} object for use in filtering
#' \code{\link{flowFrame}}s or other flow cytometry objects.
#' @note
#' 
#' See the documentation in the \code{\link[flowViz:flowViz-package]{flowViz}}
#' package for plotting of \code{polygonGates}.
#' @section Extends:
#' 
#' Class \code{"\linkS4class{parameterFilter}"}, directly.
#' 
#' Class \code{"\linkS4class{concreteFilter}"}, by class
#' \code{parameterFilter}, distance 2.
#' 
#' Class \code{"\linkS4class{filter}"}, by class \code{parameterFilter},
#' distance 3.
#' 
#' @slot boundaries Object of class \code{"matrix"}. The
#' vertices of the polygon in two dimensions. There need to be at
#' least 3 vertices specified for a valid polygon.
#' @slot parameters Object of class \code{"character"},
#' describing the parameter used to filter the \code{flowFrame}.
#' @slot filterId Object of class \code{"character"},
#' referencing the filter.
#' 
#' @section Objects from the Class:
#' Objects can be created by calls of the form \code{new("polygonGate",
#' ...)} or by using the constructor \code{polygonGate}. Using the
#' constructor is the recommended way.
#' 
#' @section Methods:
#' \describe{
#'   
#'   \item{\%in\%}{\code{signature(x = "flowFrame", table =
#'                                   "polygonGate")}: The workhorse used to evaluate the filter on
#'     data. This is usually not called directly by the user, but
#'     internally by calls to the \code{\link{filter}} methods. }
#'   
#'   \item{show}{\code{signature(object = "polygonGate")}: Print
#'     information about the filter. }
#'   
#' }
#' 
#' @author F.Hahne, B. Ellis N. Le Meur
#' @family Gate classes
#' @seealso
#' 
#' \code{\link{flowFrame}}, \code{\link{rectangleGate}},
#' \code{\link{ellipsoidGate}}, \code{\link{polytopeGate}},
#' \code{\link{filter}} for evaluation of \code{rectangleGates} and
#' \code{\link{split}} and \code{\link{Subset}}for splitting and subsetting of
#' flow cytometry data sets based on that.
#' @keywords methods
#' @examples
#' 
#' ## Loading example data
#' dat <- read.FCS(system.file("extdata","0877408774.B08",
#' package="flowCore"))
#' 
#' ## Defining the gate
#' sqrcut <- matrix(c(300,300,600,600,50,300,300,50),ncol=2,nrow=4)
#' colnames(sqrcut) <- c("FSC-H","SSC-H")
#' pg <- polygonGate(filterId="nonDebris", boundaries= sqrcut)
#' pg
#' 
#' ## Filtering using polygonGates
#' fres <- filter(dat, pg)
#' fres
#' summary(fres)
#' 
#' ## The result of polygon filtering is a logical subset
#' Subset(dat, fres)
#' 
#' ## We can also split, in which case we get those events in and those
#' ## not in the gate as separate populations
#' split(dat, fres)
#' 
#' @export
setClass("polygonGate",
         representation(boundaries="matrix"),
         contains="parameterFilter",
         prototype=list(filterId="defaultPolygonGate",
         boundaries=matrix(ncol=2, nrow=3)),
         validity=function(object)
     {
         msg <- TRUE
         if(!is.matrix(object@boundaries) || nrow(object@boundaries)<3 ||
            ncol(object@boundaries)!=2
            )
             msg <- paste("\nslot 'boundaries' must be a numeric matrix",
                          "of at least 3 rows and exactly 2 columns")
         return(msg)
     })

## Constructor. We allow for the following inputs:
##  ..1 and ..2 are named numerics, each of the same length
##  ..1 and ..2  are transforms or a mix of transforms and characters, .gate is
##      the associated matrix of polygon vertices of ncol=2
##  ..1 is a named list of numerics, each of the same length
##  ..1 is a list of transformations or characters and .gate is the
##      associated matrix of polygon vertices of ncol=2
##  .gate is a matrix of polygon vertices of ncol=2, colnames = parameters
##  .gate is a named list of two numerics, both of the same length
#' @export
polygonGate <- function(..., .gate, boundaries, filterId="defaultPolygonGate")
{
    checkClass(filterId, "character", 1)
    if(missing(.gate))
        if(!missing(boundaries)){
            .Deprecated(msg=paste("The 'boundaries' argument is deprecated,",
                        "please use '.gate' instead."))
            .gate=boundaries
        }     
    parms <- prepareInputs(parseDots(list(...)), .gate)
    if(length(parms$parameters) !=2)
        stop("Polygon gates are only defined in two dimensions.",
             call.=FALSE)
    new("polygonGate", filterId=filterId, parameters=parms$parameters,
        boundaries=parms$values)
}



## ===========================================================================
## Polytope gate
## ---------------------------------------------------------------------------
## A class describing a nD polytope region in the parameter space. Slot a
## holds the coefficients of the linear equations for m halfspaces in n
## dimensions and b is a vector of m intercepts.
## ---------------------------------------------------------------------------
#' Define filter boundaries
#' 
#' 
#' Convenience methods to facilitate the construction of \code{\link{filter}}
#' objects
#' 
#' 
#' These functions are designed to be useful in both direct and programmatic
#' usage.
#' 
#' For rectangle gate in n dimensions, if n=1 the gate correspond to a range
#' gate. If n=2, the gate is a rectangle gate. To use this function
#' programmatically, you may either construct a list or you may construct a
#' matrix with \code{n} columns and \code{2} rows.  The first row corresponds
#' to the minimal value for each parameter while the second row corresponds to
#' the maximal value for each parameter.  The names of the parameters are taken
#' from the column names as in the third example.
#' 
#' Rectangle gate objects can also be multiplied together using the \code{*}
#' operator, provided that both gate have orthogonal axes.
#' 
#' For polygon gate, the boundaries are specified as vertices in 2 dimensions,
#' for polytope gate objects as vertices in n dimensions. 
#' 
#' Polytope gate objects will represent the convex polytope determined
#' by the vertices and parameter b which together specify the polytope as 
#' an intersection of half-spaces represented as a system of linear inequalities,
#' \eqn{Ax\le b}
#' 
#' For quadrant gates, the boundaries are specified as a named list or vector
#' of length two.
#' 
#' 
#' @name polytopeGate-class
#' @aliases polytopeGate-class polytopeGate show,polytopeGate-method
#' @docType class
#' 
#' @usage polytopeGate(\dots, .gate, b, filterId="defaultPolytopeGate")
#' 
#' @param filterId An optional parameter that sets the \code{filterId} of this
#' gate.
#' @param .gate A definition of the gate. This can be either a list, vector or
#' matrix, described below.
#' @param b Need documentation
#' @param \dots You can also directly describe a gate without wrapping it in a
#' list or matrix, as described below.
#' @return
#' 
#' Returns a \code{\link{rectangleGate}} or \code{\link{polygonGate}} object
#' for use in filtering \code{\link{flowFrame}}s or other flow cytometry
#' objects.
#' @author F.Hahne, B. Ellis N. Le Meur
#' @family Gate classes
#' @seealso \code{\link{flowFrame}}, \code{\link{filter}}
#' @keywords methods
#'
#' @export
setClass("polytopeGate",
         representation(a="matrix",b="numeric"),
         contains="parameterFilter",
         prototype=list(filterId="defaultPolytopeGate", a=matrix(), b=1))

## Constructor. We allow for the following inputs:
##  b is always a numeric of length = ncol(a)
##  ... are named numerics, each of the same length
##  ...  are transforms or a mix of transforms and characters, a is
##      the associated matrix of coefficients
##  ..1 is a named list of numerics, each of the same length
##  ..1 is a list of transformations or characters and a is the
##      associated matrix of coefficients
##  .gate is a matrix of coefficients , colnames = parameters
##  .gate is a named list of numerics, all of the same length
#' @export
polytopeGate <- function(..., .gate, b, filterId="defaultPolytopeGate")
{
    checkClass(filterId, "character", 1)
    checkClass(b, "numeric")
    parms <- prepareInputs(parseDots(list(...)), .gate)
    colnames(parms$values) <- sapply(parms$parameters, parameters)
    new("polytopeGate", filterId=filterId, parameters=parms$parameters,
        a=parms$values, b=b)
}



## ===========================================================================
## Ellipsoid gate
## ---------------------------------------------------------------------------
## A class describing an ellipsoid region in the parameter space. Slots
## mean and cov contain the mean values and the covariance matrix describing
## the ellipse, slot distance holds a scaling factor, i.e., the Mahalanobis
## distance.
## ---------------------------------------------------------------------------
#' Class "ellipsoidGate"
#' 
#' 
#' Class and constructor for n-dimensional ellipsoidal \code{\link{filter}}
#' objects.
#' 
#' 
#' A convenience method to facilitate the construction of a ellipsoid
#' \code{\link{filter}} objects. Ellipsoid gates in n dimensions (n >= 2) are
#' specified by a a covarinace matrix and a vector of mean values giving the
#' center of the ellipse.
#' 
#' This function is designed to be useful in both direct and programmatic
#' usage. In the first case, simply describe the covariance matrix through
#' named arguments. To use this function programmatically, you may pass a
#' covarince matrix and a mean vector directly, in which case the parameter
#' names are the colnames of the matrix.
#' 
#' @name ellipsoidGate-class
#' @aliases ellipsoidGate-class ellipsoidGate show,ellipsoidGate-method
#' @docType class
#' @usage
#' ellipsoidGate(\dots, .gate, mean, distance=1, filterId="defaultEllipsoidGate")
#' @param filterId An optional parameter that sets the \code{filterId} of this
#' gate.
#' @param .gate A definition of the gate via a covariance matrix.
#' @param mean Numeric vector of equal length as dimensions in \code{.gate}.
#' @param distance Numeric scalar giving the Mahalanobis distance defining the
#' size of the ellipse. This mostly exists for compliance reasons to the
#' gatingML standard as \code{mean} and \code{gate} should already uniquely
#' define the ellipse. Essentially, \code{distance} is merely a factor that
#' gets applied to the values in the covariance matrix.
#' @param \dots You can also directly describe the covariance matrix through
#' named arguments, as described below.
#' @return
#' Returns a \code{\link{ellipsoidGate}} object for use in filtering
#' \code{\link{flowFrame}}s or other flow cytometry objects.
#' 
#' @section Extends:
#' Class \code{"\linkS4class{parameterFilter}"}, directly.
#' 
#' Class \code{"\linkS4class{concreteFilter}"}, by class
#' \code{parameterFilter}, distance 2.
#' 
#' Class \code{"\linkS4class{filter}"}, by class \code{parameterFilter},
#' distance 3.
#' 
#' @slot mean Objects of class \code{"numeric"}. Vector giving
#' the location of the center of the ellipse in n dimensions.
#' @slot cov Objects of class \code{"matrix"}. The covariance
#' matrix defining the shape of the ellipse.
#' @slot distance Objects of class \code{"numeric"}. The
#' Mahalanobis distance defining the size of the ellipse.
#' @slot parameters Object of class \code{"character"},
#' describing the parameter used to filter the \code{flowFrame}.
#' @slot filterId Object of class \code{"character"},
#' referencing the filter.
#' 
#' @section Objects from the Class:
#' Objects can be created by calls of the form \code{new("ellipsoidGate",
#' ...)} or by using the constructor \code{ellipsoidGate}.  Using the
#' constructor is the recommended way.
#' 
#' @section Methods:
#' \describe{
#'     \item{\%in\%}{\code{signature(x = "flowFrame", table =
#'                                     "ellipsoidGate")}: The workhorse used to evaluate the filter on
#'       data. This is usually not called directly by the user, but
#'       internally by calls to the \code{\link{filter}} methods. }
#' 
#'     \item{show}{\code{signature(object = "ellipsoidGate")}: Print
#'      information about the filter. }
#' }
#' @note
#' See the documentation in the \code{\link[flowViz:flowViz-package]{flowViz}}
#' package for plotting of \code{ellipsoidGates}.
#' 
#' @author F.Hahne, B. Ellis, N. LeMeur
#' @family Gate classes
#' @seealso
#' 
#' \code{\link{flowFrame}}, \code{\link{polygonGate}},
#' \code{\link{rectangleGate}}, \code{\link{polytopeGate}},
#' \code{\link{filter}} for evaluation of \code{rectangleGates} and
#' \code{\link{split}} and \code{\link{Subset}}for splitting and subsetting of
#' flow cytometry data sets based on that.
#' @keywords methods
#' @examples
#' 
#' ## Loading example data
#' dat <- read.FCS(system.file("extdata","0877408774.B08",
#' package="flowCore"))
#' 
#' ## Defining the gate
#' cov <- matrix(c(6879, 3612, 3612, 5215), ncol=2,
#' dimnames=list(c("FSC-H", "SSC-H"), c("FSC-H", "SSC-H")))
#' mean <- c("FSC-H"=430, "SSC-H"=175)
#' eg <- ellipsoidGate(filterId= "myEllipsoidGate", .gate=cov, mean=mean)
#' 
#' ## Filtering using ellipsoidGates
#' fres <- filter(dat, eg)
#' fres
#' summary(fres)
#' 
#' ## The result of ellipsoid filtering is a logical subset
#' Subset(dat, fres)
#' 
#' ## We can also split, in which case we get those events in and those
#' ## not in the gate as separate populations
#' split(dat, fres)
#' 
#' ##ellipsoidGate can be converted to polygonGate by interpolation
#' pg <- as(eg, "polygonGate")
#' pg
#' 
#' 
#' 
#' @export
setClass("ellipsoidGate",
         representation(mean="numeric",
                        cov="matrix",
			distance="numeric"),
         contains="parameterFilter",
         prototype=list(filterId="defaultEllipsoidGate",
         mean=numeric(), cov=matrix(), distance=1),
         validity=function(object){
             msg <- TRUE
             if(!is.matrix(object@cov) ||
                nrow(object@cov) != ncol(object@cov) ||
                nrow(object@cov) < 2) 
                 msg <- "\nslot 'cov' must be a symmetric matrix of at least 2 rows"
             if(!is.numeric(object@mean) ||
                length(object@mean) != nrow(object@cov))
                 msg <- paste("\nslot 'mean' must be numeric vector of",
                              "same length as dimensions in 'cov'")
             if(!is.numeric(object@distance) ||	length(object@distance)!=1)
                 msg <- "'distance' must be numeric of length 1"      
             return(msg)
         })

## Constructor. We allow for the following inputs:
##  mean always is a numeric of the same length as number of dimensions,
##  distance is always a vector of length 1
##  ... are named numerics, each of the same length
##  ...  are transforms or a mix of transforms and characters, .gate is
##      the associated covariance matrix
##  ..1 is a named list of numerics, each of the same length
##  ..1 is a list of transformations or characters and .gate is the
##      associated covariance matrix
##  .gate is the covariance matrix, colnames=parameters
##  .gate is a named list of numerics, each of the same length
#' @export
ellipsoidGate <- function(..., .gate, mean, distance=1,
                          filterId="defaultEllipsoidGate")
{
    checkClass(filterId, "character", 1)
    checkClass(mean, "numeric")
    checkClass(distance, "numeric", 1)
    parms <- prepareInputs(parseDots(list(...)), .gate)
    names(mean) <- sapply(parms$parameters, parameters)
    new("ellipsoidGate", filterId=filterId, parameters=parms$parameters,
        cov=parms$values, mean=mean, distance=distance)
}



## ===========================================================================
## kmeansFilter
## ---------------------------------------------------------------------------
## Apply kmeans clustering on a single parameter. The number k of clusters
## is given by the length of the 'populations' slot. This generates a
## multipleFilterResult
## ---------------------------------------------------------------------------
#' Class "kmeansFilter"
#' 
#' 
#' A filter that performs one-dimensional k-means (Lloyd-Max) clustering on a
#' single flow parameter.
#' 
#' 
#' The one-dimensional k-means filter is a multiple population filter capable
#' of operating on a single flow parameter. It takes a parameter argument
#' associated with two or more populations and results in the generation of an
#' object of class \code{\link{multipleFilterResult}}.  Populations are
#' considered to be ordered such that the population with the smallest mean
#' intensity will be the first population in the list and the population with
#' the highest mean intensity will be the last population listed.
#' 
#' @name kmeansFilter-class
#' @aliases kmeansFilter kmeansFilter-class length,kmeansFilter-method
#' show,kmeansFilter-method
#' @docType class
#' @usage 
#' kmeansFilter(\dots, filterId="defaultKmeansFilter")
#' @param \dots \code{kmeansFilter} are defined by a single flow parameter and
#' an associated list of \code{k} population names. They can be given as a
#' character vector via a named argument, or as a list with a single named
#' argument. In both cases the name will be used as the flow parameter and the
#' content of the list or of the argument will be used as population names,
#' after coercing to character. For example
#' 
#' \code{kmeansFilter(FSC=c("a", "b", "c"))}
#' 
#' or
#' 
#' \code{kmeansFilter(list(SSC=1:3))}
#' 
#' If the parameter is not fully realized, but instead is the result of a
#' \code{\link[flowCore:transform-class]{transformation}} operation, two
#' arguments need to be passed to the constructor: the first one being the
#' \code{\link[flowCore:transform-class]{transform}} object and the second
#' being a vector of population names which can be coerced to a character. For
#' example
#' 
#' \code{kmeansFilter(tf, c("D", "E"))}
#' 
#' @param filterId An optional parameter that sets the \code{filterId} of the
#' object. The filter can later be identified by this name.
#' @return
#' 
#' Returns a \code{kmeansFilter} object for use in filtering
#' \code{\link[flowCore:flowFrame-class]{flowFrames}} or other flow cytometry
#' objects.
#' @note
#' 
#' See the documentation in the \code{\link[flowViz:flowViz-package]{flowViz}}
#' package for plotting of \code{kmeansFilters}.
#' @section Extends:
#' 
#' Class \code{\linkS4class{parameterFilter}}, directly.
#' 
#' Class \code{\linkS4class{concreteFilter}}, by class \code{parameterFilter},
#' distance 2.
#' 
#' Class \code{\linkS4class{filter}}, by class \code{parameterFilter},
#' distance3.
#' 
#' @slot populations Object of class \code{character}. The
#' names of the \code{k} populations (or clusters) that will be
#' created by the \code{kmeansFilter}. These names will later be used
#' for the respective subpopulations in \code{\link{split}}
#' operations and for the summary of the \code{\link{filterResult}}.
#' @slot parameters Object of class \code{\link{parameters}},
#' defining a single parameter for which the data in the
#' \code{\linkS4class{flowFrame}} is to be clustered. This may also
#' be a \code{\link[flowCore:transform-class]{transformation}} object.
#' @slot filterId Object of class \code{character}, an
#' identifier or name to reference the \code{kmeansFilter} object
#' later on.
#' 
#' @section Objects from the Class:
#' Like all other \code{\linkS4class{filter}} objects in \code{flowCore},
#' \code{kmeansFilter} objects should be instantiated through their
#' constructor \code{kmeansFilter()}. See the \code{Usage} section for
#' details.
#' 
#' @section Methods:
#' 
#' \describe{
#'   
#'   \item{\%in\%}{\code{signature(x = "flowFrame", table =
#'                                   "kmeansFilter")}: The workhorse used to evaluate the filter on
#'     data.
#'     
#'     \emph{Usage:}
#'     
#'     This is usually not called directly by the user, but internally by
#'     the \code{\link{filter}} methods. }
#'   
#'   \item{show}{\code{signature(object = "kmeansFilter")}: Print
#'     information about the filter.
#'     
#'     \emph{Usage:}
#'     
#'     The method is called automatically whenever the object is printed
#'     on the screen. }
#'   
#' }
#' 
#' 
#' @author F. Hahne, B. Ellis, N. LeMeur
#' @seealso
#' 
#' \code{\link{flowFrame}}, \code{\link{flowSet}}, \code{\link{filter}} for
#' evaluation of \code{kmeansFilters} and \code{\link{split}} for splitting of
#' flow cytometry data sets based on the result of the filtering operation.
#' @keywords methods classes
#' @examples
#' 
#' ## Loading example data
#' dat <- read.FCS(system.file("extdata","0877408774.B08",
#' package="flowCore"))
#' 
#' ## Create the filter
#' kf <- kmeansFilter("FSC-H"=c("Pop1","Pop2","Pop3"), filterId="myKmFilter")
#' 
#' ## Filtering using kmeansFilters
#' fres <- filter(dat, kf)
#' fres
#' summary(fres)
#' names(fres)
#' 
#' ## The result of quadGate filtering are multiple sub-populations
#' ## and we can split our data set accordingly
#' split(dat, fres)
#' 
#' ## We can limit the splitting to one or several sub-populations
#' split(dat, fres, population="Pop1")
#' split(dat, fres, population=list(keep=c("Pop1","Pop2")))
#' 
#' 
#' @export
setClass("kmeansFilter",
         representation=representation(populations="character"),
         prototype=list(filterId="defaultKmeansFilter"),
         contains="parameterFilter")

## Constructor. We allow for the following inputs:
##  ..1 is transform and .2 is some vector that can be coerced to character
##  ..1 is some vector that can be coerced to character
#' @export
kmeansFilter <- function(..., filterId="defaultKmeansFilter")
{
    checkClass(filterId, "character", 1)
    ll <- list(...)
    if(length(ll)){
        n <- names(ll)[1]
        if(is.list(ll[[1]])){
            n <- names(ll[[1]])[1]
            ll[[1]] <- unlist(ll[[1]], recursive=FALSE)
        }
        parameter <- if(is(ll[[1]], "transform")) ll[[1]] else n
        populations <- if(is(parameter, "transform")){
            if(length(ll)==1)
                stop("List of populations needs to be provided as ",
                     "an additional argument.", call.=FALSE) 
            as.character(unlist(ll[[2]]))} else as.character(unlist(ll[[1]]))
    }else{
        stop("No arguments provided.", .call=FALSE)
    }
    new("kmeansFilter", parameters=parameter,
        populations=populations, filterId=filterId)
}


## ===========================================================================
## sampleFilter
## ---------------------------------------------------------------------------
## Sample 'size' rows from a flowFrame. 
## ---------------------------------------------------------------------------
#' Class "sampleFilter"
#' 
#' 
#' This non-parameter filter selects a number of events from the primary
#' \code{\link{flowFrame}}.
#' 
#' 
#' Selects a number of events without replacement from a \code{flowFrame}.
#' 
#' @name sampleFilter-class
#' @aliases sampleFilter-class sampleFilter show,sampleFilter-method
#' @docType class
#' @usage 
#' sampleFilter(size, filterId="defaultSampleFilter")
#' @param filterId An optional parameter that sets the \code{filterId} of this
#' \code{\link{filter}}. The object can later be identified by this name.
#' @param size The number of events to select.
#' @return
#' 
#' Returns a \code{sampleFilter} object for use in filtering
#' \code{\link{flowFrame}}s or other flow cytometry objects.
#' @section Extends:
#' 
#' Class \code{"\linkS4class{concreteFilter}"}, directly.
#' 
#' Class \code{"\linkS4class{filter}"}, by class \code{concreteFilter},
#' distance 2.
#' 
#' @slot size Object of class \code{"numeric"}. Then number of
#' events that are to be selected.
#' @slot filterId A character vector that identifies this
#' \code{filter}.
#' 
#' @section Objects from the Class:
#' Objects can be created by calls of the form \code{new("sampleFilter",
#' ...)} or using the constructor \code{sampleFilter}. The latter is the
#' recommended way.
#' 
#' @section Methods:
#' \describe{
#'   
#'   \item{\%in\%}{\code{signature(x = "flowFrame", table =
#'                                   "sampleFilter")}: The workhorse used to evaluate the gate on
#'     data. This is usually not called directly by the user, but
#'     internally by calls to the \code{\link{filter}} methods. }
#'   
#'   \item{show}{\code{signature(object = "sampleFilter")}: Print
#'     information about the gate. }
#'   
#' }
#' 
#' @author B. Ellis, F.Hahne
#' @seealso
#' 
#' \code{\link{flowFrame}}, \code{\link{filter}} for evaluation of
#' \code{sampleFilters} and \code{\link{split}} and \code{\link{Subset}}for
#' splitting and subsetting of flow cytometry data sets based on that.
#' @keywords methods classes
#' @examples
#' 
#' ## Loading example data
#' dat <- read.FCS(system.file("extdata","0877408774.B08",
#' package="flowCore"))
#' 
#' #Create the filter
#' sf <- sampleFilter(filterId="mySampleFilter", size=500)
#' sf
#' 
#' ## Filtering using sampleFilters
#' fres <- filter(dat, sf)
#' fres
#' summary(fres)
#' 
#' ## The result of sample filtering is a logical subset
#' Subset(dat, fres)
#' 
#' ## We can also split, in which case we get those events in and those
#' ## not in the gate as separate populations
#' split(dat, fres)
#' 
#' 
#' @export
setClass("sampleFilter",
         representation=representation(size="numeric"),
         contains="concreteFilter",
         prototype=list(size=10000, filterId="defaultSampleFilter"))

##Constructor: We allow for the following inputs:
##  size is always a numeric of length 1
#' @export
sampleFilter <- function(size, filterId="defaultSampleFilter")
{
    checkClass(filterId, "character", 1)
    checkClass(size, "numeric", 1)
    new("sampleFilter", filterId=filterId, size=size)
}

## ===========================================================================
## boundaryFilter
## ---------------------------------------------------------------------------
## Remove events piled up on the margins of a particular channel
## ---------------------------------------------------------------------------
#' Class "boundaryFilter"
#' 
#' 
#' Class and constructor for data-driven \code{\link{filter}} objects that
#' discard margin events.
#' 
#' 
#' Flow cytomtery instruments usually operate on a given data range, and the
#' limits of this range are stored as keywords in the FSC files. Depending on
#' the amplification settings and the dynamic range of the measured signal,
#' values can occur that are outside of the measurement range, and most
#' instruments will simply pile those values at the minimum or maximum range
#' limit. The \code{boundaryFilter} removes these values, either for a single
#' parameter, or for a combination of parameters. Note that it is often
#' desirable to treat boundary events on a per-parameter basis, since their
#' values might be uninformative for one particular channel, but still be
#' useful in all of the other channels.
#' 
#' The constructor \code{boundaryFilter} is a convenience function for object
#' instantiation. Evaluating a \code{boundaryFilter} results in a single
#' sub-populations, an hence in an object of class \code{\link{filterResult}}.
#' 
#' @name boundaryFilter-class
#' @aliases boundaryFilter-class boundaryFilter show,boundaryFilter-method
#' @docType class
#' @usage 
#' boundaryFilter(x, tolerance=.Machine$double.eps, side=c("both", "lower",
#' "upper"), filterId="defaultBoundaryFilter")
#' @param x Character giving the name(s) of the measurement parameter(s) on
#' which the filter is supposed to work. Note that all events on the margins of
#' ay of the channels provided by \code{x} will be discarded, which is often
#' not desired. Such events may not convey much information in the particular
#' channel on which their value falls on the margin, however they may well be
#' informative in other channels.
#' @param tolerance Numeric vector, used to set the \code{tolerance} slot of
#' the object. Can be set separately for each element in \code{x}. R's
#' recycling rules apply.
#' @param side Character vector, used to set the \code{side} slot of the
#' object.  Can be set separately for each element in \code{x}. R's recycling
#' rules apply.
#' @param filterId An optional parameter that sets the \code{filterId} slot of
#' this filter. The object can later be identified by this name.
#' @return
#' 
#' Returns a \code{boundaryFilter} object for use in filtering
#' \code{\link{flowFrame}}s or other flow cytometry objects.
#' @section Extends:
#' 
#' Class \code{"\linkS4class{parameterFilter}"}, directly.
#' 
#' Class \code{"\linkS4class{concreteFilter}"}, by class
#' \code{parameterFilter}, distance 2.
#' 
#' Class \code{"\linkS4class{filter}"}, by class \code{parameterFilter},
#' distance 3.
#' 
#' @slot tolerance Object of class \code{"numeric"}. The
#' machine tolerance used to decide whether an event is on the
#' measurement boundary. Essentially, this is done by evaluating
#' \code{x>minRange+tolerance & x<maxRange-tolerance}.
#' @slot side Object of class \code{"character"}. The margin
#' on which to evaluate the filter. Either \code{upper} for the
#' upper margin or \code{lower} for the lower margin or \code{both}
#' for both margins.
#' 
#' @section Objects from the Class:
#' Objects can be created by calls of the form \code{new("boundaryFilter",
#' ...)} or using the constructor \code{boundaryFilter}.  Using the
#' constructor is the recommended way.
#' 
#' @section Methods:
#' \describe{
#'   
#'   \item{\%in\%}{\code{signature(x = "flowFrame", table =
#'                                   "boundaryFilter")}: The workhorse used to evaluate the filter on
#'     data. This is usually not called directly by the user, but
#'     internally by calls to the \code{\link{filter}} methods. }
#'   
#'   \item{show}{\code{signature(object = "boundaryFilter")}: Print
#'     information about the filter. }
#'   
#' }
#' 
#' @author Florian Hahne
#' @seealso
#' 
#' \code{\link{flowFrame}}, \code{\link{flowSet}},
#' \code{\link[flowCore:filter-methods]{filter}} for evaluation of
#' \code{boundaryFilters} and \code{\link{Subset}} for subsetting of flow
#' cytometry data sets based on that.
#' @keywords classes methods
#' @examples
#' 
#' ## Loading example data
#' dat <- read.FCS(system.file("extdata","0877408774.B08",
#' package="flowCore"))
#' 
#' ## Create directly. Most likely from a command line
#' boundaryFilter("FSC-H", filterId="myBoundaryFilter")
#' 
#' ## To facilitate programmatic construction we also have the following
#' bf <- boundaryFilter(filterId="myBoundaryFilter", x=c("FSC-H"))
#' 
#' ## Filtering using boundaryFilter
#' fres <- filter(dat, bf)
#' fres
#' summary(fres)
#' 
#' ## We can subset the data with the result from the filtering operation.
#' Subset(dat, fres)
#' 
#' ## A boundaryFilter on the lower margins of several channels
#' bf2 <- boundaryFilter(x=c("FSC-H", "SSC-H"), side="lower")
#' 
#' 
#' @export
setClass("boundaryFilter",
         representation=representation(tolerance="numeric", side="character"),
         contains="parameterFilter",
         prototype=list(tolerance=.Machine$double.eps, filterId="defaultBoundaryFilter",
         side="both"))

##Constructor: We allow for the following inputs:
##  tolerance is always a numeric of length 1
#' @export
boundaryFilter <- function(x, tolerance=.Machine$double.eps, side=c("both", "lower", "upper"),
                           filterId="defaultBoundaryFilter")
{
    checkClass(filterId, "character")
    checkClass(tolerance, "numeric")
    side <- rep(match.arg(side), length(x))[1:length(x)]
    tolerance <- rep(tolerance, length(x))[1:length(x)]
    names(tolerance) <- names(side) <- as.character(x)
    new("boundaryFilter", parameters=x, filterId=filterId, tolerance=tolerance,
        side=side)
}




## ===========================================================================
## expressionFilter
## ---------------------------------------------------------------------------
## Let's us encapsulate an expression as a gate. There also is a constructor
## to create the filter from a character representation of the expression
## which is helpful for programmatic use. The args slot can contain additional
## arguments that are passed on to the evaluation environment. deparse stores
## a deparsed version of the expression.
## ---------------------------------------------------------------------------
#' Class "expressionFilter"
#' 
#' 
#' A \code{\link{filter}} holding an expression that can be evaluated to a
#' logical vector or a vector of factors.
#' 
#' 
#' The expression is evaluated in the environment of the flow cytometry values,
#' hence the parameters of a \code{\link{flowFrame}} can be accessed through
#' regular R symbols. The convenience function \code{char2ExpressionFilter}
#' exists to programmatically construct expressions.
#' 
#' @name expressionFilter-class
#' @aliases expressionFilter-class expressionFilter
#' show,expressionFilter-method char2ExpressionFilter
#' @docType class
#' @usage 
#' expressionFilter(expr, ..., filterId="defaultExpressionFilter")
#' char2ExpressionFilter(expr, ..., filterId="defaultExpressionFilter")
#' @param filterId An optional parameter that sets the \code{filterId} of this
#' \code{\link{filter}}. The object can later be identified by this name.
#' @param expr A valid R expression or a character vector that can be parsed
#' into an expression.
#' @param \dots Additional arguments that are passed to the evaluation
#' environment of the expression.
#' @return
#' 
#' Returns a \code{expressionFilter} object for use in filtering
#' \code{\link{flowFrame}}s or other flow cytometry objects.
#' @section Extends:
#' 
#' Class \code{"\linkS4class{concreteFilter}"}, directly.
#' 
#' Class \code{"\linkS4class{filter}"}, by class \code{concreteFilter},
#' distance 2.
#' 
#' @slot expr The expression that will be evaluated in the
#' context of the flow cytometry values.
#' @slot args An environment providing additional parameters.
#' @slot deparse A character scalar of the deparsed expression.
#' @slot filterId The identifier of the filter.
#' 
#' @section Objects from the Class:
#' Objects can be created by calls of the form
#' \code{new("expressionFilter", ...)}, using the
#' \code{\link{expressionFilter}} constructor or, programmatically, from a
#' character string using the \code{char2ExpressionFilter} function.
#' 
#' @section Methods:
#' \describe{
#'   
#'   \item{\%in\%}{\code{signature(x = "flowFrame", table =
#'                                   "expressionFilter")}: The workhorse used to evaluate the gate on
#'     data. This is usually not called directly by the user, but
#'     internally by calls to the \code{\link{filter}} methods. }
#'   
#'   \item{show}{\code{signature(object = "expressionFilter")}: Print
#'     information about the gate. }
#'   
#' }
#' 
#' @author F. Hahne, B. Ellis
#' @seealso
#' 
#' \code{\link{flowFrame}}, \code{\link{filter}} for evaluation of
#' \code{sampleFilters} and \code{\link{split}} and \code{\link{Subset}}for
#' splitting and subsetting of flow cytometry data sets based on that.
#' @keywords methods classes classes
#' @examples
#' 
#' ## Loading example data
#' dat <- read.FCS(system.file("extdata","0877408774.B08",
#' package="flowCore"))
#' 
#' #Create the filter
#' ef <- expressionFilter(`FSC-H` > 200, filterId="myExpressionFilter")
#' ef
#' 
#' ## Filtering using sampeFilters
#' fres <- filter(dat, ef)
#' fres
#' summary(fres)
#' 
#' ## The result of sample filtering is a logical subset
#' newDat <- Subset(dat, fres)
#' all(exprs(newDat)[,"FSC-H"] > 200)
#' 
#' ## We can also split, in which case we get those events in and those
#' ## not in the gate as separate populations
#' split(dat, fres)
#' 
#' ## Programmatically construct an expression
#' dat <- dat[,-8]
#' r <- range(dat)
#' cn <- paste("`", colnames(dat), "`", sep="")
#' exp <- paste(cn, ">", r[1,], "&", cn, "<", r[2,], collapse=" & ")
#' ef2 <- char2ExpressionFilter(exp, filterId="myExpressionFilter")
#' ef2
#' fres2 <- filter(dat, ef2)
#' fres2
#' summary(fres2)
#' 
#' 
#' @export
setClass("expressionFilter",
         representation=representation(expr="expression",
         args="list",
         deparse="character"),
         contains="concreteFilter",
         prototype=list(filterId="defaultExpressionFilter",
         expr=expression(rep(TRUE, length(get(ls()[1])))),
         args=list(),
         deparse="default"))

## Constructor: We allow for the following inputs:
##  expr is always an expression
##  ... are further arguments to the expression
#' @export
expressionFilter <- function(expr, ..., filterId="defaultExpressionFilter")
{
    subs <- substitute(expr)
    if(missing(filterId)){
        filterId <- deparse(subs)
        if(length(filterId)>1)
            filterId <- paste(gsub("^ *", "", filterId[2]), "...", sep="")
    }else checkClass(filterId, "character", 1)
    new("expressionFilter", filterId=filterId, expr=as.expression(subs),
        args=list(...), deparse=deparse(subs))
}

## Constructor from a character string: We allow for the following inputs:
##  expr is always a character string
#' @export
char2ExpressionFilter <- function(expr, ...,
                                  filterId="defaultExpressionFilter")
{
    checkClass(expr, "character", 1)
    subs <- parse(text=expr)
    if(missing(filterId))
        filterId <- expr
    else
        checkClass(filterId, "character", 1)
    new("expressionFilter", filterId=filterId, expr=subs,
        args=list(...), deparse=expr)
}



## ===========================================================================
## timeFilter
## ---------------------------------------------------------------------------
## Detect turbulences and abnormalities in the aquisition of flow data over
## time and gate them out. Argument 'bandwidth' sets the sensitivity, i.e.,
## the amount of local variance of the signal we want to allow. 'binSize'
## controls the size of the bins for the local variance and location
## estimation, 'timeParameter' can be used to explicitely give the paramter
## name of the time parameter (we will make an educated guess if this is not
## given).
## ---------------------------------------------------------------------------
#' Class "timeFilter"
#' 
#' 
#' Define a \code{\link{filter}} that removes stretches of unusual data
#' distribution within a single parameter over time. This can be used to
#' correct for problems during data acquisition like air bubbles or clods.
#' 
#' 
#' Clods and disturbances in the laminar flow of a FACS instrument can cause
#' temporal aberrations in the data acquisition that lead to artifactual
#' values. \code{timeFilters} try to identify such stretches of disturbance by
#' computing local variance and location estimates and to remove them from the
#' data.
#' 
#' @name timeFilter-class
#' @aliases timeFilter-class timeFilter timeFilter-class show,timeFilter-method
#' @docType class
#' @usage 
#' timeFilter(..., bandwidth=0.75, binSize, timeParameter,
#' filterId="defaultTimeFilter")
#' @param \dots The names of the parameters on which the filter is supposed to
#' work on. Names can either be given as individual arguments, or as a list or
#' a character vector.
#' @param filterId An optional parameter that sets the \code{filterId} slot of
#' this gate. The object can later be identified by this name.
#' @param bandwidth,binSize Numerics used to set the \code{bandwidth} and
#' \code{binSize} slots of the object.
#' @param timeParameter Character used to set the \code{timeParameter} slot of
#' the object.
#' @return
#' 
#' Returns a \link{timeFilter} object for use in filtering
#' \code{\link{flowFrame}}s or other flow cytometry objects.
#' @note
#' 
#' See the documentation of \code{\link[flowViz:timeLinePlot]{timeLinePlot}} in
#' the \code{\link[flowViz:flowViz-package]{flowViz}} package for details on
#' visualizing temporal problems in flow cytometry data.
#' @section Extends:
#' 
#' Class \code{"\linkS4class{parameterFilter}"}, directly.
#' 
#' Class \code{"\linkS4class{concreteFilter}"}, by class
#' \code{parameterFilter}, distance 2.
#' 
#' Class \code{"\linkS4class{filter}"}, by class \code{parameterFilter},
#' distance 3.
#' 
#' @slot bandwidth Object of class \code{"numeric"}. The
#' sensitivity of the filter, i.e., the amount of local variance of
#' the signal we want to allow.
#' @slot binSize Object of class \code{"numeric"}. The size
#' of the bins used for the local variance and location
#' estimation. If \code{NULL}, a reasonable default is used when
#' evaluating the filter.
#' @slot timeParameter Object of class \code{"character"},
#' used to define the time domain parameter. If \code{NULL}, the
#' filter tries to guess the time domain from the  \code{flowFrame}.
#' @slot parameters Object of class \code{"character"},
#' describing the parameters used to filter the \code{flowFrame}.
#' @slot filterId Object of class \code{"character"},
#' referencing the filter.
#' 
#' @section Objects from the Class:
#' Objects can be created by calls of the form \code{new("timeFilter",
#' ...)} or using the constructor \code{timeFilter}. Using the
#' constructor is the recommended way.
#' 
#' @section Methods:
#' \describe{
#'   
#'   \item{\%in\%}{\code{signature(x = "flowFrame", table =
#'                                   "timeFilter")}: The workhorse used to evaluate the filter on
#'     data. This is usually not called directly by the user. }
#'   
#'   \item{show}{\code{signature(object = "timeFilter")}: Print
#'     information about the filter. }
#'   
#' } 
#' 
#' @author Florian Hahne
#' @seealso
#' 
#' \code{\link{flowFrame}}, \code{\link[flowCore:filter-class]{filter}} for
#' evaluation of \code{timeFilters} and \code{\link{split}} and
#' \code{\link{Subset}}for splitting and subsetting of flow cytometry data sets
#' based on that.
#' @keywords classes methods
#' @examples
#' 
#' ## Loading example data
#' data(GvHD)
#' dat <- GvHD[1:10]
#' 
#' ## create the filter
#' tf <- timeFilter("SSC-H", bandwidth=1, filterId="myTimeFilter")
#' tf
#' 
#' ## Visualize problems
#' \dontrun{
#' library(flowViz)
#' timeLinePlot(dat, "SSC-H")
#' }
#' 
#' ## Filtering using timeFilters
#' fres <- filter(dat, tf)
#' fres[[1]]
#' summary(fres[[1]])
#' summary(fres[[7]])
#' 
#' ## The result of rectangle filtering is a logical subset
#' cleanDat <- Subset(dat, fres)
#' 
#' ## Visualizing after cleaning up
#' \dontrun{
#' timeLinePlot(cleanDat, "SSC-H")
#' }
#' 
#' ## We can also split, in which case we get those events in and those
#' ## not in the gate as separate populations
#' allDat <- split(dat[[7]], fres[[7]])
#' 
#' par(mfcol=c(1,3))
#' plot(exprs(dat[[7]])[, "SSC-H"], pch=".")
#' plot(exprs(cleanDat[[7]])[, "SSC-H"], pch=".")
#' plot(exprs(allDat[[2]])[, "SSC-H"], pch=".")
#' 
#' @export 
setClass("timeFilter",
         representation=representation(bandwidth="numeric",
         binSize="numeric",
         timeParameter="character"),
         contains="parameterFilter",
         prototype=list(filterId="defaultTimeFilter",
         bandwidth=0.75,
         binSize=NULL,
         timeParameter=NULL))

## Constructor: We allow for the following inputs:
##  bandwidth and binSize are always numerics of lenght 1, timeParameter
##      is always a character of length 1
##  ..1 is a character
##  ..1 is a list of character and/or transformations
##  ... are characters and/or transformations
#' @export
timeFilter <- function(..., bandwidth=0.75, binSize, timeParameter,
                       filterId="defaultTimeFilter")
{
    checkClass(bandwidth, "numeric", 1)
    
    if(!missing(binSize))
        checkClass(binSize, "numeric", 1)
    else
        binSize <- NULL
    if(!missing(timeParameter))
        checkClass(timeParameter, "character", 1)
    else
        timeParameter <- NULL
    checkClass(filterId, "character", 1)
    parms <- parseDots(list(...))
    new("timeFilter", parameters=parms$parameters,
        bandwidth=bandwidth, binSize=as.numeric(binSize),
        timeParameter=as.character(timeParameter), filterId=filterId)
}



## ===========================================================================
## filterReference
## ---------------------------------------------------------------------------
## References a filter (contained within a filterSet). Everything is just
## passed to the referenced filter. This may be better handled by the type
## system by having "real" filters inherit from concreteFilter (or something)
## and then simply having a setAs(), but I think that will be too much work
## for filter authors.
## ---------------------------------------------------------------------------
#' Class filterReference
#' 
#' A reference to another filter inside a reference. Users should generally not
#' be aware that they are using this class.
#' 
#' 
#' @name filterReference-class
#' @aliases filterReference-class filterReference
#' filterReference,environment,character-method summary,filterReference-method
#' length,filterReference-method show,filterReference-method
#' eval,filterReference,missing-method
#' @docType class
#' @section Objects from the Class: Objects are generally not created by users
#' so there is no constructor function.
#' 
#' @slot name The R name of the referenced filter.
#' @slot env The environment where the filter must live.
#' @slot filterId The filterId, not really used since you always resolve.
#' 
#' @section Extends:
#' 
#' Class \code{"\linkS4class{filter}"}, directly.
#' 
#' @author B. Ellis
#' @keywords classes
#'
#' @export
setClass("filterReference",
         representation=representation(name="character",
         env="environment"),
         contains="filter")

## Constructor from an environment
#' @export
setMethod("filterReference",
          signature("environment", "character"),
          function(from, name) {
              new("filterReference", name=name, env=from)
          })



## ===========================================================================
## setOperationFilter
## ---------------------------------------------------------------------------
## Superclass for union intersect, complement and subset filter, which all
## consist of two or more component filters
## ---------------------------------------------------------------------------
#' Class "setOperationFilter"
#' 
#' This is a Superclass for the unionFilter, intersectFilter, complementFilter
#' and subsetFilter classes, which all consist of two or more component filters
#' and are constructed using set operators (\code{&}, \code{|}, \code{!}, and
#' \code{\%&\%} or \code{\%subset\%} respectively).
#' 
#' 
#' @name setOperationFilter-class
#' @aliases setOperationFilter-class setOperationFilter
#' @docType class
#' 
#' @slot filters Object of class \code{"list"}, containing the component filters.
#' @slot filterId Object of class \code{"character"}
#' referencing the filter applied.
#' 
#' @section Extends:
#' 
#' Class \code{"\linkS4class{filter}"}, directly.
#' @author B. Ellis
#' @family setOperationFilter classes
#' @seealso \code{\link[flowCore:filter-methods]{filter}}
#' @keywords classes
#'
#' @export
setClass("setOperationFilter",
         representation=representation(filters="list"),
         contains="concreteFilter")



## ===========================================================================
## unionFilter 
## ---------------------------------------------------------------------------
## The union of two filters, .i.e, the logical | operation.
## A simple optimization would be to linearize the union of a filter and
## another union filter.
## ---------------------------------------------------------------------------
#' Class unionFilter
#' 
#' This class represents the union of two filters, which is itself a filter
#' that can be incorporated in to further set operations. \code{unionFilter}s
#' are constructed using the binary set operator \code{"|"} with operands
#' consisting of a single \code{filter} or list of \code{filters}.
#' 
#' @name unionFilter-class
#' @aliases unionFilter-class unionFilter show,unionFilter-method
#' @docType class
#' 
#' @slot filters Object of class \code{"list"}, containing the component filters.
#' @slot filterId Object of class \code{"character"}
#' referencing the filter applied.
#' 
#' @section Extends:
#' 
#' Class \code{"\linkS4class{filter}"}, directly.
#' @author B. Ellis
#' @family setOperationFilter classes
#' @seealso \code{\link[flowCore:filter-methods]{filter}}, \code{\linkS4class{setOperationFilter}}
#' @keywords classes
#' 
#' @export 
setClass("unionFilter",
         representation=representation("setOperationFilter"))

## constructor from two filters
#' @export
setMethod("|",
          signature=signature(e1="filter",
          e2="filter"),
          definition=function(e1, e2)
      {
          new("unionFilter", filters=list(e1, e2),
              filterId=paste(identifier(e1), "or", identifier(e2)))
      })

## constructor from a list of filters and a filter and vice versa
#' @export
setMethod("|",
          signature=signature(e1="list",
          e2="filter"),
          definition=function(e1, e2) lapply(e1, "|", e2=e2))
#' @export
setMethod("|",
          signature=signature(e1="filter",
          e2="list"),
          definition=function(e1, e2) lapply(e2, "|", e1=e1))



## ===========================================================================
## intersectFilter 
## ---------------------------------------------------------------------------
## The intersection of two filters, i.e, the logical & operation.
## This is somewhat different from the %subset% operation because
## some filters depend on the data and would return different results
## when applied to the full dataset.
## --------------------------------------------------------------------------
#' Class intersectFilter
#' 
#' This class represents the intersection of two filters, which is itself a filter
#' that can be incorporated in to further set operations. \code{intersectFilter}s
#' are constructed using the binary set operator \code{"&"} with operands consisting
#' of a single filter or list of filters.
#' 
#' @name intersectFilter-class
#' @aliases intersectFilter-class intersectFilter show,intersectFilter-method
#' @docType class
#' 
#' @slot filters Object of class \code{"list"}, containing the component filters.
#' @slot filterId Object of class \code{"character"}
#' referencing the filter applied.
#' 
#' @section Extends:
#' 
#' Class \code{"\linkS4class{filter}"}, directly.
#' @author B. Ellis
#' @family setOperationFilter classes
#' @seealso \code{\link[flowCore:filter-methods]{filter}}, \code{\linkS4class{setOperationFilter}}
#' @keywords classes
#' 
#' @export
setClass("intersectFilter",
         representation=representation("setOperationFilter"))

## constructor from two filters
#' @export
setMethod("&",
          signature=signature(e1="filter",
          e2="filter"),
          definition=function(e1, e2)
      {
          new("intersectFilter", filters=list(e1, e2),
              filterId=paste(identifier(e1), "and", identifier(e2)))
      })

## constructor from a list of filters and a filter and vice versa
#' @export
setMethod("&",
          signature=signature(e1="list",
          e2="filter"),
          definition=function(e1, e2) lapply(e1, "&", e2=e2))
#' @export
setMethod("&",
          signature=signature(e1="filter",
          e2="list"),
          definition=function(e1, e2) lapply(e2, "&", e1=e1))



## ===========================================================================
## complementFilter 
## ---------------------------------------------------------------------------
## The complement of a filters, i.e, the logical ! operation.
## ---------------------------------------------------------------------------
#' Class complementFilter
#' 
#' This class represents the logical complement of a single filter, which is 
#' itself a filter that can be incorporated in to further set operations. 
#' \code{complementFilter}s are constructed using the prefix unary set operator 
#' \code{"!"} with a single filter operand.
#' 
#' @name complementFilter-class
#' @aliases complementFilter-class complementFilter show,complementFilter-method
#' @docType class
#' 
#' @slot filters Object of class \code{"list"}, containing the component filters.
#' @slot filterId Object of class \code{"character"}
#' referencing the filter applied.
#' 
#' @section Extends:
#' 
#' Class \code{"\linkS4class{filter}"}, directly.
#' @author B. Ellis
#' @family setOperationFilter classes
#' @seealso \code{\link[flowCore:filter-methods]{filter}}, \code{\linkS4class{setOperationFilter}}
#' @keywords classes
#' 
#' @export
setClass("complementFilter",
         representation=representation("setOperationFilter"),
         validity=function(object)
     { 
         if(length(object@filters) != 1) {
             warning("Complement filters can only operate on a ",
                     "single filter")
             return(FALSE)
         }
         TRUE
     })


## constructor
#' @export
setMethod("!",
          signature=signature(x="filter"),
          definition=function(x)
      {
          new("complementFilter",filters=list(x),
              filterId=paste("not",identifier(x)))
      })



## ===========================================================================
## subsetFilter 
## ---------------------------------------------------------------------------
## Combining two filters in a way that the RHS filter  takes the subset
## of the LHS filter as input. For many cases this is equivalent to an
## intersection filter, the only difference is in data-driven filters.
## ---------------------------------------------------------------------------
#' Class subsetFilter
#' 
#' This class represents the action of applying a filter on the subset of
#' data resulting from another filter. This is itself a filter that can be 
#' incorporated in to further set operations. This is similar to an
#' intersectFilter, with behavior only differing if the component filters
#' are data-driven.
#' 
#' \code{subsetFilter}s are constructed using the equivalent binary set operators 
#' \code{"\%&\%"} or \code{"\%subset\%"}. The operator is not symmetric, as the
#' filter on the right-hand side will take the subset of the filter on the
#' left-hand side as input. Left-hand side operands can be a filter or list of
#' filters, while the right-hand side operand must be a single
#' filter.
#' 
#' @name subsetFilter-class
#' @aliases subsetFilter-class subsetFilter show,subsetFilter-method
#' summary,subsetFilter-method
#' @docType class
#' 
#' @slot filters Object of class \code{"list"}, containing the component filters.
#' @slot filterId Object of class \code{"character"}
#' referencing the filter applied.
#' 
#' @section Extends:
#' 
#' Class \code{"\linkS4class{filter}"}, directly.
#' @author B. Ellis
#' @family setOperationFilter classes
#' @seealso \code{\link[flowCore:filter-methods]{filter}}, \code{\linkS4class{setOperationFilter}}
#' @keywords classes
#' 
#' @export
setClass("subsetFilter",
         representation=representation("setOperationFilter"),
         validity=function(object)
     {
         if(length(object@filters) != 2) {
             warning("Subset filters are only defined as binary operators")
             return(FALSE)
         }
         TRUE
     })

#' Take the intersection of two filters
#' 
#' 
#' There are two notions of intersection in \code{flowCore}. First, there is
#' the usual intersection boolean operator \code{&} that has been overridden to
#' allow the intersection of two filters or of a filter and a list for
#' convenience. There is also the \code{\%&\%} or \code{\%subset\%} operator that
#' takes an intersection, but with subset semantics rather than simple
#' intersection semantics. In other words, when taking a subset, calculations
#' from \code{\link[flowCore:filterSummary-class]{summary}} and other methods
#' are taken with respect to the right hand filter. This primarily affects
#' calculations, which are ordinarily calculated with respect to the entire
#' population as well as data-driven gating procedures which will operate only
#' on elements contained by the right hand filter.  This becomes especially
#' important when using filters such as
#' \code{\link[flowStats:norm2Filter-class]{norm2Filter}}
#' 
#' 
#' @name filter-and-methods
#' @aliases intersectFilter-method subsetFilter-method %&% %&%-methods
#' %&%,ANY-method %&%,filter,filter-method %subset%,ANY-method %subset%
#' &,filter,filter-method &,filter,list-method &,list,filter-method
#' %subset%,filter,filter-method %subset%,list,filter-method
#' coerce,intersectFilter,call-method
#' @docType methods
#' 
#' @param e1,e2 \code{\linkS4class{filter}} objects or lists of filter objects
#' 
#' @usage 
#' e1 \%&\% e2
#' e1 \%subset\% e2
#' 
#' @author B. Ellis
#' @keywords methods
## constructor from two filters. %&% is an alias for %subset%
#' @export
setMethod("%subset%",
          signature=signature(e1="filter",
          e2="filter"),
          definition=function(e1, e2)
      {
          new("subsetFilter",
              filters=list(e1, e2), filterId=paste(identifier(e1),"in",
                                    identifier(e2)))
      })
#' @export
setMethod("%&%",
          signature=signature(e1="filter",
          e2="filter"),
          definition=function(e1, e2) e1 %subset% e2)

## constructor from a list of filters and a filter
#' @export
setMethod("%subset%",
          signature=signature(e1="list",
          e2="filter"),
          definition=function(e1, e2) lapply(e1, "%subset%", e2=e2))


## ===========================================================================
## filterResult
## ---------------------------------------------------------------------------
## A container for the results after applying a filter to flow cytometry
## data with slots frameId (identifier of the object) and filterDetails,
## which is a list containing and further describing the input filter.
## ---------------------------------------------------------------------------
#' Class "filterResult"
#' 
#' Container to store the result of applying a \code{filter} on a
#' \code{flowFrame} object
#' 
#' 
#' @name filterResult-class
#' @aliases filterResult-class filterResult ==,filterResult,flowFrame-method
#' show,filterResult-method [[,filterResult,ANY-method
#' @docType class
#' 
#' @slot frameId Object of class \code{"character"}
#' referencing the \code{flowFrame} object filtered. Used for sanity checking.
#' @slot filterDetails Object of class \code{"list"}
#' describing the filter applied.
#' @slot filterId Object of class \code{"character"}
#' referencing the filter applied.
#' 
#' @section Extends:
#' 
#' Class \code{"\linkS4class{filter}"}, directly.
#' 
#' @section Methods:
#' \describe{
#'   \item{==}{test equality}
#' }
#' 
#' @author B. Ellis, N. LeMeur
#' @seealso \code{\link[flowCore:filter-methods]{filter}},
#' \code{"\linkS4class{logicalFilterResult}"},
#' \code{"\linkS4class{multipleFilterResult}"},
#' \code{"\linkS4class{randomFilterResult}"}
#' @keywords classes
#' @examples
#' 
#' showClass("filterResult")
#' 
#' @export
setClass("filterResult",
         representation=representation(frameId="character",
         filterDetails="list"),
         contains="concreteFilter",
         prototype=list(frameId="Filter Result",
         filterDetails=list()))



## ===========================================================================
## logicalFilterResult
## ---------------------------------------------------------------------------
## Resuls from a filtering operation that only produces a single population.
## Slot subSet is a logical vector indicating the population membership of the
## data in the gated flowFrame.
## ---------------------------------------------------------------------------
#' Class "logicalFilterResult"
#' 
#' Container to store the result of applying a \code{filter} on a
#' \code{flowFrame} object
#' 
#' 
#' @name logicalFilterResult-class
#' @aliases logicalFilterResult-class logicalFilterResult
#' summary,logicalFilterResult-method names,logicalFilterResult-method
#' length,logicalFilterResult-method [[,logicalFilterResult,ANY-method
#' @docType class
#' 
#' @slot subSet Object of class \code{"numeric"}, which is a logical
#' vector indicating the population membership of the data in the gated
#' flowFrame.
#' @slot frameId Object of class \code{"character"}  referencing the 
#' \code{flowFrame} object filtered. Used for sanity checking.
#' @slot filterDetails Object of class \code{"list"} describing the filter 
#' applied.
#' @slot filterId Object of class \code{"character"} referencing the filter 
#' applied.
#' 
#' @section Extends:
#' 
#' Class \code{"\linkS4class{filterResult}"}, directly.
#' Class \code{"\linkS4class{filter}"}, by class "filterResult", distance 2.
#' 
#' @author B. Ellis
#' @seealso \code{\link[flowCore:filter-methods]{filter}}
#' @keywords classes
#' @examples
#' 
#' showClass("logicalFilterResult")
#' 
#' @export
setClass("logicalFilterResult",
         representation=representation(subSet="logical"),
         contains="filterResult")



## ===========================================================================
## multipleFilterResult
## ---------------------------------------------------------------------------
## Results from a filtering operation that produces multiple populations.
## Slot subSet is a factor vector indicating the population membership of the
## data in the gated flowFrame. Factor names are used as population names.
## ---------------------------------------------------------------------------
#' Class "multipleFilterResult"
#' 
#' Container to store the result of applying \code{filter} on set of
#' \code{flowFrame} objects
#' 
#' 
#' @name multipleFilterResult-class
#' @aliases multipleFilterResult-class multipleFilterResult
#' length,multipleFilterResult-method names,multipleFilterResult-method
#' names<-,multipleFilterResult-method names<-,multipleFilterResult,ANY-method
#' [[,multipleFilterResult-method [[,multipleFilterResult,ANY-method
#' [,multipleFilterResult,ANY-method summary,multipleFilterResult-method
#' show,multipleFilterResult-method
#' @docType class
#' 
#' @slot subSet Object of class \code{"factor"} indicating the population
#' membership of the data in the gated flowFrame.
#' @slot frameId Object of class \code{"character"}
#' referencing the \code{flowFrame} object filtered. Used for
#' sanity checking.
#' @slot filterDetails Object of class \code{"list"}
#' describing the filter applied.
#' @slot filterId Object of class \code{"character"}
#' referencing the filter applied.
#' 
#' @section Extends:
#' 
#' Class \code{"\linkS4class{filterResult}"}, directly.
#' Class \code{"\linkS4class{filter}"}, by class "filterResult", distance 2.
#' 
#' @section Methods:
#' 
#' \describe{
#'   \item{[, [[}{subsetting. If \code{x} is \code{multipleFilterResult},
#'     then \code{x[[i]]} a \code{FilterResult}  object. The semantics is
#'     similar to the behavior of the subsetting operators for lists.}
#'   \item{length}{number of \code{FilterResult} objects in the set.}
#'   \item{names}{names of the  \code{FilterResult} objects in the set.}
#'   \item{summary}{summary \code{FilterResult} objects in the set.}
#' }
#' 
#' @author B. Ellis
#' @seealso \code{\link[flowCore:filterResult-class]{filterResult}}
#' @keywords classes
#' @examples
#' 
#' showClass("multipleFilterResult")
#' 
setClass("multipleFilterResult",
         representation=representation(subSet="factor"),
         contains="filterResult")



## ===========================================================================
## manyFilterResult
## ---------------------------------------------------------------------------
## A special case of multipleFilterResult that arises when there are
## overlapping sets. The subset indices are stored as a matrix, where
## each row contains the results of a single filtering operation.
## ---------------------------------------------------------------------------
#' Class "manyFilterResult"
#' 
#' The result of a several related, but possibly overlapping filter results.
#' The usual creator of this object will usually be a \code{\link{filter}}
#' operation on a \code{\link{flowFrame}} object.
#' 
#' 
#' @name manyFilterResult-class
#' @aliases manyFilterResult-class length,manyFilterResult-method
#' names,manyFilterResult-method [[,manyFilterResult-method
#' [[,manyFilterResult,ANY-method summary,manyFilterResult-method
#' show,manyFilterResult-method as.data.frame.manyFilterResult manyFilterResult
#' parameters,manyFilterResult-method
#' @docType class
#' 
#' @slot subSet Object of class \code{"matrix"}.
#' @slot frameId Object of class \code{"character"} referencing the 
#' \code{flowFrame} object filtered. Used for sanity checking.
#' @slot filterDetails Object of class \code{"list"} describing the
#' filter applied.
#' @slot filterId Object of class \code{"character"} referencing the
#' filter applied.
#' @slot dependency Any dependencies between the filters. Currently
#' not used.
#' 
#' @section Extends:
#' 
#' Class \code{"\linkS4class{filterResult}"}, directly.
#' Class \code{"\linkS4class{filter}"}, by class "filterResult", distance 2.
#' 
#' @section Methods:
#' 
#' \describe{
#'   \item{[, [[}{subsetting. If \code{x} is \code{manyFilterResult},
#'     then \code{x[[i]]} a \code{filterResult}  object. The semantics is
#'     similar to the behavior of the subsetting operators for lists.}
#'   \item{length}{number of \code{filterResult} objects in the set.}
#'   \item{names}{names of the  \code{filterResult} objects in the set.}
#'   \item{summary}{summary \code{filterResult} objects in the set.}
#' }
#' 
#' @author B. Ellis
#' @seealso \code{\link[flowCore:filterResult-class]{filterResult}}
#' @keywords classes
#' @examples
#' 
#' showClass("manyFilterResult")
#' 
#' @export
setClass("manyFilterResult",
         representation=representation(subSet="matrix",
         dependency="ANY"),
         contains="filterResult")

##constructor
#' @export
manyFilterResult <- function(filters, frameId, dependency=NULL)
{
    q <- new("manyFilterResult",
             filterDetails=lapply(filters, slot, "filterDetails"),
             subSet=do.call(cbind, lapply(filters, as, "logical")),
             dependency=dependency)
    colnames(q@subSet) <- sapply(filters, slot, "filterId")
    q
}



## ===========================================================================
## randomFilterResult
## ---------------------------------------------------------------------------
## A result of a filtering operation where the population membership is
## considered to be stochastic rather than absolute. Currently there is no
## implementation of a filter that produces such a filterResult, although
## norm2Filter, curvFilters and the t-mixture filters in flowClust are
## obvious candidates.
## ---------------------------------------------------------------------------
#' Class "randomFilterResult"
#' 
#' Container to store the result of applying a \code{filter} on a
#' \code{flowFrame} object, with the population membership considered to be
#' stochastic rather than absolute. Currently not utilized.
#' 
#' @name randomFilterResult-class
#' @aliases randomFilterResult-class randomFilterResult
#' @docType class
#' 
#' @slot subSet Object of class \code{"numeric"}, which is a logical vector 
#' indicating the population membership of the data in the gated flowFrame.
#' @slot frameId Object of class \code{"character"} referencing the
#' \code{flowFrame} object filtered. Used for sanity checking.
#' @slot filterDetails Object of class \code{"list"} describing the filter applied.
#' @slot filterId Object of class \code{"character"} referencing the filter applied.
#' 
#' @section Extends:
#' 
#' Class \code{"\linkS4class{filterResult}"}, directly.
#' Class \code{"\linkS4class{filter}"}, by class "filterResult", distance 2.
#' 
#' @author B. Ellis
#' @seealso \code{\link[flowCore:filter-methods]{filter}}
#' @keywords classes
#'
#' @export
setClass("randomFilterResult",
         representation=representation(subSet="numeric"),
         contains="filterResult")



## ===========================================================================
## filterResultList
## ---------------------------------------------------------------------------
## A list of filterResults which typically is generated when applying a
## filter to a whole flowSet. This is a class union of list and filterResult
## and mainly exists to allow for method dispatch and sanity checking.
## FIXME: Do we want to allow for mixed filter classes in the list?
## ---------------------------------------------------------------------------
#' Class "filterResultList"
#' 
#' Container to store the result of applying a \code{filter} on a
#' \code{flowSet} object
#' 
#' 
#' @name filterResultList-class
#' @aliases filterResultList-class filterResultList
#' [,filterResultList,ANY-method [[,filterResultList,ANY-method
#' names,filterResultList-method parameters,filterResultList-method
#' show,filterResultList-method split,flowSet,filterResultList-method
#' summary,filterResultList-method
#' @docType class
#' @section Objects from the Class:
#' 
#' Objects are created by applying a \code{\link{filter}} on a
#' \code{\link{flowSet}}. The user doesn't have to deal with manual object
#' instantiation.
#' 
#' @slot .Data Object of class \code{"list"}. The class
#' directly extends \code{list}, and this slot holds the list data.
#' @slot frameId Object of class \code{"character"} The IDs of
#' the \code{\link[flowCore:flowFrame-class]{flowFrames}} in the filtered
#' \code{\link{flowSet}}.
#' @slot filterDetails Object of class \code{"list"}. Since
#' \code{filterResultList} inherits from \code{\link{filterResult}},
#' this slot has to be set. It contains only the input filter.
#' @slot filterId Object of class \code{"character"}. The
#' identifier for the object.
#' 
#' @section Extends:
#' Class \code{"\linkS4class{list}"}, from data part.
#' Class \code{"\linkS4class{filterResult}"}, directly.
#' Class \code{"\linkS4class{concreteFilter}"}, by class "filterResult", distance 2.
#' Class \code{"\linkS4class{filter}"}, by class "filterResult", distance 3.
#' 
#' @section Methods:
#' \describe{
#'   \item{[}{\code{signature(x = "filterResultList", i = "ANY")}: Subset
#'     to \code{filterResultList}. }
#'   \item{[[}{\code{signature(x = "filterResultList", i = "ANY")}: Subset
#'     to individual \code{\link{filterResult}}. }
#'   
#'   \item{names}{\code{signature(x = "filterResultList")}: Accessor to
#'     the frameId slot. }
#'   
#'   \item{parameters}{\code{signature(object = "filterResultList")}:
#'       Return parameters on which data has been filtered. }
#'   
#'   \item{show}{\code{signature(object = "filterResultList")}: Print
#'     details about the object. }
#'   
#'   \item{split}{\code{signature(x = "flowSet", f =
#'                                  "filterResultList")}: Split a \code{\link{flowSet}} based on the
#'     results in the \code{filterResultlIst}. See \code{\link{split}}
#'     for details. }
#'   
#'   \item{summary}{\code{signature(object = "filterResultList")}:
#'       Summarize the filtering operation. This creates a
#'     \code{\link[flowCore:filterSummaryList-class]{filterSummaryList}}
#'     object. } 
#' }
#' 
#' @author Florian Hahne
#' @seealso \code{\linkS4class{filter}}, \code{\linkS4class{filterResult}},
#' \code{\linkS4class{logicalFilterResult}},
#' \code{\linkS4class{multipleFilterResult}},
#' \code{\linkS4class{randomFilterResult}}
#' @keywords classes
#' @examples
#' 
#' library(flowStats)
#' ## Loading example data and creating a curv1Filter
#' data(GvHD)
#' dat <- GvHD[1:3]
#' c1f <- curv1Filter(filterId="myCurv1Filter", x=list("FSC-H"), bwFac=2)
#' 
#' ## applying the filter
#' fres <- filter(dat, c1f)
#' fres
#' 
#' ## subsetting the list
#' fres[[1]]
#' fres[1:2]
#' 
#' ## details about the object
#' parameters(fres)
#' names(fres)
#' summary(fres)
#' 
#' ## splitting based on the filterResults
#' split(dat, fres)
#' 
#' @export
setClass("filterResultList",
         contains=c("list", "filterResult"))

## Check if a filterResultList matches a flowSet. If strict=TRUE, the
## function will also check whether all items in the filterResultSet
## are of equal type and produce the same number of populations.
validFilterResultList <- function(fres, set, strict=TRUE)
{
    res <- TRUE
    checkClass(fres, "filterResultList")
    checkClass(strict, "logical", 1)
    if(!missing(set)){
        #checkClass(set, "flowSet")
        if(res <- !all(names(fres) == sampleNames(set)))
            warning("Sample names don't match between flowSet and ",
                    "filterResultList", call.=FALSE)
    }
    if(strict){
        fTypes <- sapply(fres, function(x) class(x))
        if(length(unique(fTypes)) != 1){
            warning("Not all filterResults in the list are of equal",
                    " type.", call.=FALSE)
            res <- FALSE
        }
        nrPops <- sapply(fres, function(x) length(x))
        if(length(unique(nrPops)) != 1){
            warning("Not all filterResults in the list share the",
                    " same number of sub-populations.", call.=FALSE)
            res <- FALSE
        }
        return(res)
    }
}


## ---------------------------------------------------------------------------
## A list of filters serving as input for a filtering operation of whole
## flowSets. This directly extends class 'list' and mainly exists to allow for 
## method dispatch and sanity checking. The filterId slot is supposed to 
## contain a unique identifier for all individual filter objects in the list. 
## Names of the list items should always correspond to sampleNames of the flowSet.
## ---------------------------------------------------------------------------
#' Class "filterList"
#' 
#' Container for a list of \code{\link[flowCore:filter-methods]{filter}}
#' objects. The class mainly exists for method dispatch.
#' 
#' 
#' @name filterList-class
#' @aliases filterList-class filterList show,filterList-method
#' identifier,filterList-method identifier<-,filterList,character-method
#' @docType class
#' @usage filterList(x, filterId=identifier(x[[1]]))
#' @param x A list of \code{\link{filter}} objects.
#' @param filterId The global identifier of the filter list. As default, we
#' take the filterId of the first \code{filter} object in \code{x}.
#' @return
#' 
#' A \code{filterList} object for the constructor.
#' @section Objects from the Class: Objects are created from regular lists
#' using the constructor \code{filterList}.
#' 
#' @slot .Data Object of class \code{"list"}. The class
#' directly extends \code{list}, and this slot holds the list data.
#' @slot filterId Object of class \code{"character"}. The
#' identifier for the object.
#' 
#' @section Extends:
#' 
#' Class \code{"\linkS4class{list}"}, from data part.
#' 
#' @section Methods:
#' 
#' \describe{
#'  \item{show}{\code{signature(object = "filterList")}: Print
#'  details about the object. }
#'  
#'  \item{identifier, identifier<-}{\code{signature(object =
#'  "filterList")}: Accessor and replacement method for the object's
#'  filterId slot. }
#'  }
#' 
#' @author Florian Hahne
#' @seealso \code{\link[flowCore:filter-methods]{filter}},
#' @keywords classes
#' @examples
#' 
#' f1 <- rectangleGate(FSC=c(100,200), filterId="testFilter")
#' f2 <- rectangleGate(FSC=c(200,400))
#' fl <- filterList(list(a=f1, b=f2))
#' fl
#' identifier(fl)
#' 
#'
#' @export
setClass("filterList",
         contains="list",
         representation=representation(filterId="character"))

## Check if a filteList matches a flowSet. If strict=TRUE, the
## function will also check whether all items in the filterResultSet
## are of equal type and produce the same number of populations.
validFilterList <- function(flist, set, strict=TRUE)
{
    res <- TRUE
    checkClass(flist, "filterList")
    checkClass(strict, "logical", 1)
    if(!missing(set)){
        checkClass(set, "flowSet")
        if(res <- !all(names(flist) == sampleNames(set)))
            warning("Sample names don't match between flowSet and ",
                    "filterResultList", call.=FALSE)
    }
    if(strict){
        fTypes <- sapply(flist, function(x) class(x))
        if(length(unique(fTypes)) != 1)
        {
            warning("Not all filter objects in the list are of equal",
                    " type.", call.=FALSE)
            res <- FALSE
        }
        if(any(sapply(flist, is, "filterResult")))
        {
            stop("filterResults are not allowed in a filterList") 
            res <- FALSE
        }
        return(res)
    }
}

## Constructor
#' @export
filterList <- function(x, filterId=identifier(x[[1]]))
{
    checkClass(x, "list")
    checkClass(filterId, "character", 1)
    if(is.null(names(x)))
        stop("Names missing in input list.")
    x <- new("filterList", .Data=x, filterId=filterId)
    validFilterList(x)
    return(x)
}


## ===========================================================================
## filterSummary
## ---------------------------------------------------------------------------
## A class containing the results of calling summary methods on filterResult.
## In the case of multipleFilterResults, the individual slots(except 'count')
## will be vectors.
## Slots are:
##   - name:  The name of the summary, usually this will be set to be the
##            identifier of the filterResult, or the names of the individual
##            populations for a multipleFilterResult
##   - true:  The number of events in the filter (or the individual
##            populations)
##   - count: The total number of events the filter was applied on
##   - p:     The ratio of events within the filter (i.e., true/count)
## ---------------------------------------------------------------------------
#' Class "filterSummary"
#' 
#' Class and methods to handle the summary information of a gating operation.
#' 
#' 
#' Calling \code{summary} on a \code{\link{filterResult}} object prints summary
#' information on the screen, but also creates objects of class
#' \code{filterSummary} for computational access.
#' 
#' @name filterSummary-class
#' @aliases filterSummary-class filterSummary summary,filterResult-method
#' [[,filterSummary,numeric-method [[,filterSummary,character-method
#' $,filterSummary-method coerce,filterSummary,data.frame-method
#' length,filterSummary-method names,filterSummary-method
#' print,filterSummary-method show,filterSummary-method toTable
#' toTable,filterSummary-method
#' @docType class
#' @usage
#' \S4method{summary}{filterResult}(object, \dots)
#' @param object An object inheriting from class \code{\link{filterResult}}
#' which is to be summarized.
#' @param \dots Further arguments that are passed to the generic.
#' @return
#' 
#' An object of class \code{filterSummary} for the \code{summary} constructor,
#' a named list for the subsetting operators. The \code{$} operator returns a
#' named vector of the respective value, where each named element corresponds
#' to one sub-population.
#' @section Objects from the Class:
#' 
#' Objects are created by calling \code{summary} on a \code{link{filterResult}}
#' object. The user doesn't have to deal with manual object instantiation.
#' 
#' @slot name Object of class \code{"character"} The name(s) of
#' the populations created in the filtering operation. For a
#' \code{\link{logicalFilterResult}} this is just a single value; the
#' name of the \code{link{filter}}.
#' @slot true Object of class \code{"numeric"}. The number of
#' events within the population(s).
#' @slot count Object of class \code{"numeric"}. The total
#' number of events in the gated \code{\link{flowFrame}}.
#' @slot p Object of class \code{"numeric"} The percentage of
#' cells in the population(s).
#' 
#' @section Methods:
#' 
#' \describe{
#'   \item{[[}{\code{signature(x = "filterSummary", i = "numeric")}:
#'       Subset the \code{filterSummary} to a single population. This only
#'     makes sense for
#'     \code{\link[flowCore:multipleFilterResult-class]{multipleFilterResults}}.
#'     The output is a list of summary statistics. }
#'   
#'   \item{[[}{\code{signature(x = "filterSummary", i = "character")}:
#'       see above }
#'   
#'   \item{$}{\code{signature(x = "filterSummary", name = "ANY")}: A
#'     list-like accessor to the slots and more. Valid values are
#'     \code{n} and \code{count} (those are identical), \code{true} and
#'     \code{in} (identical), \code{false} and \code{out} (identical),
#'     \code{name}, \code{p} and \code{q} (\code{1-p}).  }
#'   
#'   \item{coerce}{\code{signature(from = "filterSummary", to =
#'                                   "data.frame")}: Coerce object to \code{data.frame}. }
#'   
#'   \item{length}{\code{signature(x = "filterSummary")}: The number of
#'     populations in the \code{fitlerSummary}. }
#'   
#'   \item{names}{\code{signature(x = "filterSummary")}: The names of the
#'     populations in the \code{filterSummary}. }
#'   
#'   \item{print}{\code{signature(x = "filterSummary")}: Print details
#'     about the object. }
#'   
#'   \item{show}{\code{signature(object = "filterSummary")}: Print
#'     details about the object.}
#'   
#'   \item{toTable}{\code{signature(x = "filterSummary")}: Coerce object
#'     to \code{data.frame}. }
#' }
#' 
#' @author Florian Hahne, Byron Ellis
#' @seealso
#' 
#' \code{\linkS4class{filterResult}}, \code{\linkS4class{logicalFilterResult}},
#' \code{\linkS4class{multipleFilterResult}}, \code{\linkS4class{flowFrame}}
#' \code{\linkS4class{filterSummaryList}}
#' @keywords classes
#' @examples
#' 
#' library(flowStats)
#' 
#' ## Loading example data, creating and applying a curv1Filter
#' dat <- read.FCS(system.file("extdata","0877408774.B08",
#' package="flowCore"))
#' c1f <- curv1Filter(filterId="myCurv1Filter", x=list("FSC-H"), bwFac=2)
#' fres <- filter(dat, c1f)
#' 
#' ## creating and showing the summary
#' summary(fres)
#' s <- summary(fres)
#' 
#' ## subsetting
#' s[[1]]
#' s[["peak 2"]]
#' 
#' ##accessing details
#' s$true
#' s$n
#' toTable(s)
#' 
#' 
#' @export
setClass("filterSummary",
         representation=representation(name="character",
         true="numeric",
         count="numeric",
         p="numeric"))



## ===========================================================================
## filterSummaryList
## ---------------------------------------------------------------------------
## A list of filterSummaries which typically is generated when summarizing a
## filterResultList. This directly extends the list class  and mainly exists
## to allow for method dispatch.
## ---------------------------------------------------------------------------
#' Class "filterSummaryList"
#' 
#' 
#' Class and methods to handle summary statistics for from filtering operations
#' on whole \code{\link[flowCore:flowSet-class]{flowSets}}.
#' 
#' 
#' Calling \code{summary} on a \code{\link{filterResultList}} object prints summary
#' information on the screen, but also creates objects of class
#' \code{filterSummaryList} for computational access.
#' 
#' @name filterSummaryList-class
#' @aliases filterSummaryList-class filterSummaryList
#' toTable,filterSummaryList-method
#' @docType class
#' @section Usage:
#' summary(object, \dots)
#' @param object An object of class.
#' \code{\link[flowCore:filterResultList-class]{filterResultList}} which is to
#' be summarized.
#' @param \dots Further arguments that are passed to the generic.
#' @return
#' 
#' An object of class \code{filterSummaryList}.
#' @section Objects from the Class:
#' 
#' Objects are created by calling \code{summary} on a
#' \code{link{filterResultList}} object. The user doesn't have to deal with
#' manual object instantiation.
#' 
#' @slot .Data Object of class \code{"list"}. The class
#' directly extends \code{list}, and this slot holds the list data.
#' 
#' @section Extends:
#' Class \code{"\linkS4class{list}"}, from \code{.Data} part.
#' 
#' @section Methods:
#' \describe{
#'   
#'   \item{toTable}{\code{signature(x = "filterSummaryList")}: Coerce
#'     object to \code{data.frame}. Additional factors are added to
#'     indicate list items in the original object. }
#'   
#' }
#' 
#' @author Florian Hahne
#' @seealso
#' 
#' \code{\linkS4class{filterResult}}, \code{\linkS4class{filterResultList}},
#' \code{\linkS4class{logicalFilterResult}},
#' \code{\linkS4class{multipleFilterResult}}, \code{\linkS4class{flowFrame}}
#' \code{\linkS4class{filterSummary}}
#' @keywords classes
#' @examples
#' 
#' library(flowStats)
#' 
#' ## Loading example data, creating and applying a curv1Filter
#' data(GvHD)
#' dat <- GvHD[1:3]
#' c1f <- curv1Filter(filterId="myCurv1Filter", x=list("FSC-H"), bwFac=2)
#' fres <- filter(dat, c1f)
#' 
#' ## creating and showing the summary
#' summary(fres)
#' s <- summary(fres)
#' 
#' ## subsetting
#' s[[1]]
#' 
#' ##accessing details
#' toTable(s)
#' 
#' 
#' @export
setClass("filterSummaryList",
         contains="list")



## ===========================================================================
## transform functions
## ---------------------------------------------------------------------------
## Constructors for the different varieties of transforms. All of these
## create objects of the basic class 'transform', unless stated otherwise.
## ---------------------------------------------------------------------------
#' Create the definition of a linear transformation function to be applied on a
#' data set
#' 
#' Create the definition of the linear Transformation that will be applied on
#' some parameter via the \code{transform} method.  The definition of this
#' function is currently x <- a*x+b
#' 
#' @usage linearTransform(transformationId="defaultLinearTransform", a = 1, b = 0)
#' @param transformationId character string to identify the transformation
#' @param a double that corresponds to the multiplicative factor in the
#' equation
#' @param b double that corresponds to the additive factor in the equation
#' @return Returns an object of class \code{transform}.
#' @author N. LeMeur
#' @family Transform functions
#' @seealso \code{\link{transform-class}}, \code{\link{transform}}
#' @keywords methods
#' @examples
#' 
#' samp <- read.FCS(system.file("extdata",
#'    "0877408774.B08", package="flowCore"))
#'   linearTrans <- linearTransform(transformationId="Linear-transformation", a=2, b=0)
#'   dataTransform <- transform(samp, transformList('FSC-H' ,linearTrans))
#' 
#' 
#' @export
linearTransform <- function(transformationId="defaultLinearTransform",
                            a=1, b=0)
{
    checkClass(a, "numeric")
    checkClass(b, "numeric")
    t <- new("transform", .Data=function(x)  x <- a*x+b)
    t@transformationId <- transformationId
    t
}

## Quadratic transformation constructor
#' Create the definition of a quadratic transformation function to be applied
#' on a data set
#' 
#' Create the definition of the quadratic Transformation that will be applied
#' on some parameter via the \code{transform} method.  The definition of this
#' function is currently x <- a*x\^2 + b*x + c
#' 
#' @usage quadraticTransform(transformationId="defaultQuadraticTransform", a = 1, b = 1, c = 0)
#' @param transformationId character string to identify the transformation
#' @param a double that corresponds to the quadratic coefficient in the
#' equation
#' @param b double that corresponds to the linear coefficient in the equation
#' @param c double that corresponds to the intercept in the equation
#' @return Returns an object of class \code{transform}.
#' @author N. Le Meur
#' @family Transform functions
#' @seealso \code{\link{transform-class}}, \code{\link{transform}}
#' @keywords methods
#' @examples
#' 
#' samp <- read.FCS(system.file("extdata",
#'    "0877408774.B08", package="flowCore"))
#'   quadTrans <- quadraticTransform(transformationId="Quadratic-transformation", a=1, b=1, c=0)
#'   dataTransform <- transform(samp, transformList('FSC-H', quadTrans))
#' 
#' 
#' @export
quadraticTransform <- function(transformationId="defaultQuadraticTransform",
                               a=1, b=1, c=0)
{
    if(!is.double(a)) 
        stop("a must be numeric")
    if(!is.double(b))
        stop("b must be numeric")
    if(!is.double(c))
        stop("c must be numeric")
    t <- new("transform", .Data=function(x) x <- a*x^2 + b*x + c)
    t@transformationId <- transformationId
    t
}

## Natural logarithm transformation constructor
#' Create the definition of a ln transformation function (natural logarthim) to
#' be applied on a data set
#' 
#' Create the definition of the ln Transformation that will be applied on some
#' parameter via the \code{transform} method.  The definition of this function
#' is currently x<-log(x)*(r/d).  The transformation would normally be used to
#' convert to a linear valued parameter to the natural logarithm scale.
#' Typically r and d are both equal to 1.0. Both must be positive.
#' 
#' @usage lnTransform(transformationId="defaultLnTransform", r=1, d=1)
#' @param transformationId character string to identify the transformation
#' @param r positive double that corresponds to a scale factor.
#' @param d positive double that corresponds to a scale factor
#' @return Returns an object of class \code{transform}.
#' @author B. Ellis and N. LeMeur
#' @family Transform functions
#' @seealso \code{\link{transform-class}}, \code{\link{transform}}
#' @keywords methods
#' @examples
#' 
#'   data(GvHD)
#'   lnTrans <- lnTransform(transformationId="ln-transformation", r=1, d=1)
#'   ln1 <- transform(GvHD, transformList('FSC-H', lnTrans))
#' 
#' opar = par(mfcol=c(2, 1))
#' plot(density(exprs(GvHD[[1]])[ ,1]), main="Original")
#' plot(density(exprs(ln1[[1]])[ ,1]), main="Ln Transform")
#' 
#' 
#' @export
lnTransform <- function(transformationId="defaultLnTransform",
                        r=1, d=1)
{
    if(!is.double(r) || r <= 0)
        stop("r must be numeric and positive")
    if(!is.double(d) || d <=0)
        stop("d must be numeric")
    t <- new("transform", .Data=function(x)
             x<-log(x)*(r/d))
    t@transformationId <- transformationId
    t
}

## Logarithm transformation constructor
#' Create the definition of a log transformation function (base specified by
#' user) to be applied on a data set
#' 
#' Create the definition of the log Transformation that will be applied on some
#' parameter via the \code{transform} method.  The definition of this function
#' is currently x<-log(x,logbase)*(r/d).  The transformation would normally be
#' used to convert to a linear valued parameter to the natural logarithm scale.
#' Typically r and d are both equal to 1.0. Both must be positive.  logbase =
#' 10 corresponds to base 10 logarithm.
#' 
#' @usage logTransform(transformationId="defaultLogTransform", logbase=10, r=1, d=1)
#' @param transformationId character string to identify the transformation
#' @param logbase positive double that corresponds to the base of the
#' logarithm.
#' @param r positive double that corresponds to a scale factor.
#' @param d positive double that corresponds to a scale factor
#' @return Returns an object of class \code{transform}.
#' @author B. Ellis, N. LeMeur
#' @family Transform functions
#' @seealso \code{\link{transform-class}}, \code{\link{transform}}
#' @keywords methods
#' @examples
#' 
#' samp <- read.FCS(system.file("extdata",
#'    "0877408774.B08", package="flowCore"))
#'   logTrans <- logTransform(transformationId="log10-transformation", logbase=10, r=1, d=1)
#'   trans <- transformList('FSC-H', logTrans)
#'   dataTransform <- transform(samp, trans)
#' 
#' @export
logTransform <- function(transformationId="defaultLogTransform",
                         logbase=10, r=1, d=1)
{
    if(!is.double(r) || r <= 0)
        stop("r must be numeric and positive")
    if(!is.double(d) || d <=0)
        stop("d must be numeric")
    if(!is.double(r) || r <=0)
        stop("r must be numeric and positive")
    if(!is.double(logbase) || logbase <= 1)
        stop("logabse must be a pnumeric greater than 1")
    t <- new("transform", .Data=function(x) x <- log(x, logbase)*(r/d))
    t@transformationId <- transformationId
    t
}


## General biexponential transformation constructor
#' Compute a transform using the 'biexponential' function
#' 
#' The 'biexponential' is an over-parameterized inverse of the hyperbolic sine.
#' The function to be inverted takes the form biexp(x) =
#' a*exp(b*(x-w))-c*exp(-d*(x-w))+f with default parameters selected to
#' correspond to the hyperbolic sine.
#' 
#' @usage
#' biexponentialTransform(transformationId="defaultBiexponentialTransform", 
#'                        a = 0.5, b = 1, c = 0.5, d = 1, f = 0, w = 0, 
#'                        tol = .Machine$double.eps^0.25, maxit = as.integer(5000))
#' @param transformationId A name to assign to the transformation. Used by the
#' transform/filter integration routines.
#' @param a See the function description above. Defaults to 0.5
#' @param b See the function description above. Defaults to 1.0
#' @param c See the function description above. Defaults to 0.5 (the same as
#' \code{a})
#' @param d See the function description above. Defaults to 1 (the same as
#' \code{b})
#' @param f A constant bias for the intercept. Defaults to 0.
#' @param w A constant bias for the 0 point of the data. Defaults to 0.
#' @param tol A tolerance to pass to the inversion routine
#' (\code{\link{uniroot}} usually)
#' @param maxit A maximum number of iterations to use, also passed to
#' \code{\link{uniroot}}
#' @return Returns values giving the inverse of the biexponential within a
#' certain tolerance. This function should be used with care as numerical
#' inversion routines often have problems with the inversion process due to the
#' large range of values that are essentially 0. Do not be surprised if you end
#' up with population splitting about \code{w} and other odd artifacts.
#' @author B. Ellis, N Gopalakrishnan
#' @family Transform functions
#' @seealso \code{\link{transform}}
#' @keywords methods
#' @examples
#' 
#' # Construct some "flow-like" data which tends to be hetereoscedastic.
#' data(GvHD)
#' biexp  <- biexponentialTransform("myTransform")
#' 
#' after.1 <- transform(GvHD, transformList('FSC-H', biexp))
#' 
#' biexp  <- biexponentialTransform("myTransform",w=10)
#' after.2 <- transform(GvHD, transformList('FSC-H', biexp))
#' 
#' opar = par(mfcol=c(3, 1))
#' plot(density(exprs(GvHD[[1]])[, 1]), main="Original")
#' plot(density(exprs(after.1[[1]])[, 1]), main="Standard Transform")
#' plot(density(exprs(after.2[[1]])[, 1]), main="Shifted Zero Point")
#'
#' @export
biexponentialTransform <-
    function(transformationId="defaultBiexponentialTransform",
             a=.5, b=1, c=.5, d=1, f=0, w=0,
             tol=.Machine$double.eps^0.25, maxit=as.integer(5000))
{
    t <- new("transform", .Data=function(x)
             x <- biexponential_transform(x, a, b, c, d, f, w, tol, maxit))
    t@transformationId <- transformationId
    t
}

## Logicle transformation constructor
## Input parameters are to be provided in decades
#' Computes a transform using the 'logicle_transform' function
#' 
#' 
#' Logicle transformation creates a subset of
#' \code{\link{biexponentialTransform}} hyperbolic sine transformation
#' functions that provides several advantages over linear/log transformations
#' for display of flow cytometry data. (The logicleTransform method makes use
#' of the C++ implementation of the logicle transform contributed by Wayne
#' Moore et al.)
#' 
#' 
#' @aliases logicleTransform estimateLogicle
#' @usage 
#' logicleTransform(transformationId="defaultLogicleTransform", w = 0.5, t = 262144,
#'                  m = 4.5, a = 0)
#'                  estimateLogicle(x, channels,...) 
#' @param transformationId A name to assign to the transformation. Used by the
#' transform/filter routines.
#' @param w w is the linearization width in asymptotic decades. w should be > 0
#' and determines the slope of transformation at zero.  w can be estimated
#' using the equation w=(m-log10(t/abs(r)))/2, where r is the most negative
#' value to be included in the display
#' @param t Top of the scale data value, e.g, 10000 for common 4 decade data or
#' 262144 for a 18 bit data range. t should be greater than zero
#' @param m m is the full width of the transformed display in asymptotic
#' decades. m should be greater than zero
#' @param a Additional negative range to be included in the display in
#' asymptotic decades. Positive values of the argument brings additional
#' negative input values into the transformed display viewing area. Default
#' value is zero corresponding to a Standard logicle function.
#' @param x Input flow frame for which the logicle transformations are to be
#' estimated.
#' @param channels channels or markers for which the logicle transformation is
#' to be estimated.
#' @param ... other arguments:
#' 
#' q: a numeric type specifying quantile value, default is 0.05
#' @author Wayne Moore, N Gopalakrishnan
#' @family Transform functions
#' @seealso \code{\link[flowCore]{inverseLogicleTransform}},
#' \code{\link[flowCore]{estimateLogicle} }
#' @references Parks D.R., Roederer M., Moore W.A.(2006) A new "logicle"
#' display method avoids deceptive effects of logarithmic scaling for low
#' signals and compensated data. CytometryA, 96(6):541-51.
#' @keywords methods
#' @examples
#' 
#' data(GvHD)
#' samp <- GvHD[[1]] 
#' ## User defined logicle function
#' lgcl <- logicleTransform( w = 0.5, t= 10000, m =4.5)
#' trans <- transformList(c("FL1-H", "FL2-H"), lgcl)
#' after <- transform(samp, trans)
#' invLgcl <- inverseLogicleTransform(trans = lgcl)
#' trans <- transformList(c("FL1-H", "FL2-H"), invLgcl)
#' before <- transform (after,  trans)
#' 
#' ## Automatically estimate the logicle transformation based on the data
#' lgcl <- estimateLogicle(samp, channels = c("FL1-H", "FL2-H", "FL3-H", "FL2-A", "FL4-H"))
#' ## transform  parameters using the estimated logicle transformation
#' after <- transform(samp, lgcl)
#' 
#' 
#' @export
logicleTransform <- function(transformationId="defaultLogicleTransform", 
        w = 0.5, t = 262144, m = 4.5, a = 0) {

    k <- new("transform", .Data=function(x) 
            x <- logicle_transform(as.double(x), as.double(t),as.double(w), as.double(m), as.double(a), FALSE)
            )            
    k@transformationId <- transformationId
    k
}

### Inverse logicle transformation constructor
#' Computes the inverse of the transform defined by the 'logicleTransform'
#' function or the transformList generated by 'estimateLogicle' function
#' 
#' inverseLogicleTransform can be use to compute the inverse of the Logicle
#' transformation. The parameters w, t, m, a for calculating the inverse are
#' obtained from the 'trans' input passed to the 'inverseLogicleTransform'
#' function. (The inverseLogicleTransform method makes use of the C++
#' implementation of the inverse logicle transform contributed by Wayne Moore
#' et al.)
#' 
#' @usage inverseLogicleTransform(trans,transformationId,...)
#' @param trans An object of class 'transform' created using the
#' 'logicleTransform' function or class 'transformList' created by
#' 'estimateLogicle'.  The parameters w, t, m, a for calculating the inverse
#' are obtained from the 'trans' input passed to the 'inverseLogicleTransform'
#' function.
#' @param transformationId A name to assigned to the inverse transformation.
#' Used by the transform routines.
#' @param ...  not used.
#' @author Wayne Moore, N. Gopalakrishnan
#' @family Transform functions
#' @seealso \code{\link[flowCore]{logicleTransform}}
#' @references Parks D.R., Roederer M., Moore W.A.(2006) A new "logicle"
#' display method avoids deceptive effects of logarithmic scaling for low
#' signals and compensated data. CytometryA, 96(6):541-51.
#' @keywords methods
#' @examples
#' 
#' data(GvHD)
#' samp <- GvHD[[1]] 
#' 
#' #########inverse the transform object###############
#' logicle  <- logicleTransform(t = 10000, w = 0.5, m = 4.5 , a =0 ,"logicle")
#' ## transform FL1-H parameter using logicle transformation
#' after <- transform(samp, transformList('FL1-H', logicle))
#' 
#' ## Inverse transform the logicle transformed data to retrieve the original data
#' invLogicle <- inverseLogicleTransform(trans = logicle)
#' before <- transform (after, transformList('FL1-H', invLogicle))
#' 
#' #########inverse the transformList object###############
#' translist <- estimateLogicle(samp, c("FL1-H", "FL2-H"))
#' after <- transform(samp, translist)
#' ## Inverse 
#' invLogicle <- inverseLogicleTransform(translist)
#' before <- transform (after, invLogicle)
#' 
#' @export
inverseLogicleTransform <- function(trans, transformationId, ...)UseMethod("inverseLogicleTransform")
#' @export
inverseLogicleTransform.default <- function(trans, transformationId, ...) {
  
    stop("trans has to be an object of class \"transform\"
            created using the \"logicleTransform\" function\n
         or a 'transformList' created by 'estimateLogicle'\n")
}
#' @export
inverseLogicleTransform.transform <- function(trans, transformationId, ...) {
    k <- .inverseLogicleTransform(trans@.Data)
   if(missing(transformationId))
    k@transformationId <- paste( "inverse", trans@transformationId, sep ="_")
    k
}
.inverseLogicleTransform <- function(func){
  pars <- c("w", "t", "m", "a")
  vals <- ls(environment(func))
  if(!all(pars %in% vals))
    stop("\"trans\" is not a valid object produced using the
           \"logicle\" function")
  
  w = environment(func)[["w"]] 
  t = environment(func)[["t"]] 
  m = environment(func)[["m"]]
  a = environment(func)[["a"]]
  k <- new("transform", .Data=function(x)
    x <- logicle_transform(as.double(x), as.double(t),as.double(w), as.double(m), as.double(a), TRUE)
  )
  
}
#' @export
inverseLogicleTransform.transformList <- function(trans, transformationId, ...) {
  invs <- sapply(trans@transforms, function(obj){
    .inverseLogicleTransform(obj@f)
  })
  channels <- names(invs)
  if(missing(transformationId))
    transformationId <- paste( "inverse", trans@transformationId, sep ="_")
  
  transformList(channels, invs, transformationId = transformationId)
}
#' It is mainly trying to estimate w (linearization width in asymptotic decades) value based on given m and data range
#' @param dat flowFrame
#' @param p channel name
#' @param m full length of transformed display in decodes
#' @param t top of the scale of data value
#' @param a additional negative range to be included in display in decades
#' @param q quantile of negative data value (used to adjust w calculation)
#' @param type character either "instrument" or "data". The data range.
#' @noRd
.lgclTrans  <- function(dat, p, t , m, a = 0, q = 0.05, type = "instrument") {
    type <- match.arg(type, c("instrument", "data"))
    transId <- paste(p,"logicleTransform", sep = "_")
    
    rng <- range(dat)
    dat <- exprs(dat)[,p]
    
    if(missing(t)){
      if(type == "instrument")
        t <- rng[,p][2]
      else
        t <- max(dat)
    }
    
    if(missing(m)){
      if(type == "instrument")
        m <- 4.5#hardcoded value to keep consistency with the legacy behavior
      else
        m <- log10(t) + 1 
    }
      
    dat <- dat[dat<0]
    w <- 0
    if(length(dat)) {
        r <- .Machine$double.eps + quantile(dat, q)
        w=(m-log10(t/abs(r))) / 2
        if(w<0)
          stop("w is negative!Try to increase 'm'")
    } 
    logicleTransform( transformationId = transId, w=w, t = t, m = m, a = a)
}

#' @export
estimateLogicle <- function(x, channels, ...)UseMethod("estimateLogicle")
#' @export
estimateLogicle.flowFrame <- function(x, channels, ...){
  trans <- .estimateLogicle(x, channels, ...)
  channels <- names(trans)
  transformList(channels, trans)
}
.estimateLogicle <- function(x, channels,...){
            if(!is(x,"flowFrame")&&!is(x,"cytoframe"))
                stop("x has to be an object of class \"flowFrame\"")
            if(missing(channels))
                stop("Please specify the channels to be logicle transformed");
#            indx <- channels %in% colnames(x)
#            if(!all(indx))
#                stop(paste("Channels", channels[!indx] , "were not found in x ",
#                            sep = " "))
            channels <- sapply(channels, function(channel)getChannelMarker(x, channel)[["name"]], USE.NAMES = FALSE)
            
            sapply(channels, function(p) {
                        .lgclTrans(x, p, ...)               
                    })
              
        }

## Truncation transformation constructor
#' Create the definition of a truncate transformation function to be applied on
#' a data set
#' 
#' Create the definition of the truncate Transformation that will be applied on
#' some parameter via the \code{transform} method.  The definition of this
#' function is currently x[x<a] <- a.  Hence, all values less than a are
#' replaced by a. The typical use would be to replace all values less than 1 by
#' 1.
#' 
#' @usage truncateTransform(transformationId="defaultTruncateTransform", a=1)
#' @param transformationId character string to identify the transformation
#' @param a double that corresponds to the value at which to truncate
#' @return Returns an object of class \code{transform}.
#' @author P. Haaland
#' @family Transform functions
#' @seealso \code{\link{transform-class}}, \code{\link{transform}}
#' @keywords methods
#' @examples
#' 
#' samp <- read.FCS(system.file("extdata",
#'    "0877408774.B08", package="flowCore"))
#'   truncateTrans <- truncateTransform(transformationId="Truncate-transformation", a=5)
#'   dataTransform <- transform(samp,transformList('FSC-H', truncateTrans))
#' 
#' 
#' @export
truncateTransform <- function(transformationId="defaultTruncateTransform",
                              a=1)
{
    t <- new("transform", .Data=function(x){
        x[x<=a] <- a
        x
    })
    t@transformationId <- transformationId
    t
}

## Scale transformation constructor
#' Create the definition of a scale transformation function to be applied on a
#' data set
#' 
#' Create the definition of the scale Transformation that will be applied on
#' some parameter via the \code{transform} method.  The definition of this
#' function is currently x = (x-a)/(b-a).  The transformation would normally be
#' used to convert to a 0-1 scale. In this case, b would be the maximum
#' possible value and a would be the minimum possible value.
#' 
#' @usage scaleTransform(transformationId="defaultScaleTransform", a, b)
#' @param transformationId character string to identify the transformation
#' @param a double that corresponds to the value that will be transformed to 0
#' @param b double that corresponds to the value that will be transformed to 1
#' @return Returns an object of class \code{transform}.
#' @author P. Haaland
#' @family Transform functions
#' @seealso \code{\link{transform-class}}, \code{\link{transform}}
#' @keywords methods
#' @examples
#' 
#' samp <- read.FCS(system.file("extdata",
#'    "0877408774.B08", package="flowCore"))
#'   scaleTrans <- scaleTransform(transformationId="Truncate-transformation", a=1, b=10^4)
#'   dataTransform <- transform(samp, transformList('FSC-H', scaleTrans))
#' 
#' @export
scaleTransform <- function(transformationId="defaultScaleTransform",
                           a=1, b=10^4)
{
    t <- new("transform", .Data=function(x) (x-a)/(b-a))
    t@transformationId <- transformationId
    t
}

## Split-scale transformation constructor
#' Compute the split-scale transformation describe by FL. Battye
#' 
#' The split scale transformation described by Francis L. Battye [B15] (Figure
#' 13) consists of a logarithmic scale at high values and a linear scale at low
#' values with a fixed transition point chosen so that the slope (first
#' derivative) of the transform is continuous at that point. The scale extends
#' to the negative of the transition value that is reached at the bottom of the
#' display.
#' 
#' @usage 
#' splitScaleTransform(transformationId="defaultSplitscaleTransform",
#'                     maxValue=1023, transitionChannel=64, r=192)
#' @param transformationId A name to assign to the transformation. Used by the
#' transform/filter integration routines.
#' @param maxValue Maximum value the transformation is applied to, e.g., 1023
#' @param transitionChannel Where to split the linear versus the logarithmic
#' transformation, e.g., 64
#' @param r Range of the logarithm part of the display, ie. it may be expressed
#' as the maxChannel - transitionChannel considering the maxChannel as the
#' maximum value to be obtained after the transformation.
#' @return Returns values giving the inverse of the biexponential within a
#' certain tolerance. This function should be used with care as numerical
#' inversion routines often have problems with the inversion process due to the
#' large range of values that are essentially 0. Do not be surprised if you end
#' up with population splitting about \code{w} and other odd artifacts.
#' @author N. LeMeur
#' @family Transform functions
#' @seealso \code{\link{transform}}
#' @references Battye F.L. A Mathematically Simple Alternative to the
#' Logarithmic Transform for Flow Cytometric Fluorescence Data Displays.
#' http://www.wehi.edu.au/cytometry/Abstracts/AFCG05B.html.
#' @keywords methods
#' @examples
#' 
#' data(GvHD)
#' ssTransform  <- splitScaleTransform("mySplitTransform")
#' after.1 <- transform(GvHD, transformList('FSC-H', ssTransform))
#' 
#' opar = par(mfcol=c(2, 1))
#' plot(density(exprs(GvHD[[1]])[, 1]), main="Original")
#' plot(density(exprs(after.1[[1]])[, 1]), main="Split-scale Transform")
#' 
#' @export
splitScaleTransform <- function(transformationId="defaultSplitscaleTransform",
                                maxValue=1023,
                                transitionChannel=64, r=192)
{
    maxChannel <- r + transitionChannel
    b <- transitionChannel/2
    d <- 2*log10(exp(1))*r/transitionChannel
    logt <- -2*log10(exp(1))*r/transitionChannel + log10(maxValue)
    t <- 10^logt
    a <- transitionChannel/(2*t)
    logCT <- (a*t+b)*d/r
    c <- 10^logCT/t
    tr <- new("transform", .Data= function(x){
        idx <- which(x <= t)
        idx2 <- which(x > t)
        if(length(idx2)>0)
            x[idx2] <- log10(c*x[idx2])*r/d
        if(length(idx)>0)
            x[idx] <- a*x[idx]+b
        x
    })
    tr@transformationId <- transformationId
    tr
}

## Hyperbolic Arcsin transformation constructor
#' Create the definition of an arcsinh transformation function (base specified
#' by user) to be applied on a data set
#' 
#' Create the definition of the arcsinh Transformation that will be applied on
#' some parameter via the \code{transform} method.  The definition of this
#' function is currently x<-asinh(a+b*x)+c).  The transformation would normally
#' be used to convert to a linear valued parameter to the natural logarithm
#' scale. By default a and b are both equal to 1 and c to 0.
#' 
#' @usage
#' arcsinhTransform(transformationId="defaultArcsinhTransform", a=1, b=1, c=0)
#' @param transformationId character string to identify the transformation
#' @param a positive double that corresponds to a shift about 0.
#' @param b positive double that corresponds to a scale factor.
#' @param c positive double
#' @return Returns an object of class \code{transform}.
#' @author B. Ellis
#' @family Transform functions
#' @seealso \code{\link{transform-class}}, \code{\link{transform}},
#' \code{asinh}
#' @keywords methods
#' @examples
#' 
#' samp <- read.FCS(system.file("extdata",
#'    "0877408774.B08", package="flowCore"))
#'   asinhTrans <- arcsinhTransform(transformationId="ln-transformation", a=1, b=1, c=1)
#'   translist <- transformList('FSC-H', asinhTrans) 
#'   dataTransform <- transform(samp, translist)
#' 
#' @export
arcsinhTransform <- function(transformationId="defaultArcsinhTransform",
                             a=1, b=1, c=0)
{
    t <- new("transform", .Data=function(x) asinh(a+b*x)+c)
    t@transformationId <- transformationId
    t
}



## ===========================================================================
## parameterTransform
## ---------------------------------------------------------------------------
## A class used to map parameters of a transform during %on% operations.
## ---------------------------------------------------------------------------
#' Class "parameterTransform"
#' 
#' Link a transformation to particular flow parameters
#' 
#' 
#' @name parameterTransform-class
#' @aliases parameterTransform-class parameterTransform
#' @docType class
#' 
#' @slot .Data Object of class \code{"function"}, the
#' transformation function.
#' @slot parameters Object of class \code{"character"} The
#' parameters the transformation is applied to.
#' @slot transformationId Object of class
#' \code{"character"}. The identifier for the object.
#' 
#' @section Objects from the Class:
#' 
#' Objects are created by using the \code{\%on\%} operator and are usually not
#' directly instantiated by the user.
#' @section Extends:
#' 
#' Class \code{"\linkS4class{transform}"}, directly.
#' Class \code{"\linkS4class{function}"}, by class "transform", distance 2.
#' 
#' @section Methods:
#' 
#' \describe{
#'   \item{\%on\%}{\code{signature(e1 = "filter", e2 =
#'                                   "parameterTransform")}: Apply the transformation. }
#'   \item{\%on\%}{\code{signature(e1 = "parameterTransform", e2 =
#'                                   "flowFrame")}: see above }
#'   \item{parameters}{\code{signature(object = "parameterTransform")}:
#'       Accessor to the parameters slot }
#' }
#' 
#' @author Byron Ellis
#' @keywords classes
#'
#' @export
setClass("parameterTransform",
         representation=representation(parameters="character"),
         contains="transform")

## constructor
parameterTransform <- function(FUN, params)
    new("parameterTransform", .Data=as.function(FUN),
        parameters=as.character(params))



## ===========================================================================
## transformMap
## ---------------------------------------------------------------------------
## We want to be able to include transforms within a filter. First we need to
## know which parameters should be input filters
## ---------------------------------------------------------------------------
#' A class for mapping transforms between parameters
#' 
#' 
#' This class provides a mapping between parameters and transformed parameters
#' via a function.
#' 
#' 
#' @name transformMap-class
#' @aliases transformMap-class transformMap show,transformMap-method
#' @docType class
#' 
#' @slot output Name of the transformed parameter.
#' @slot input Name of the parameter to transform.
#' @slot f Function used to accomplish the transform.
#' 
#' @section Objects from the Class:
#' 
#' Objects of this type are not usually created by the user, except perhaps in
#' special circumstances. They are generally automatically created by the
#' inline \code{\link[flowCore:transform-class]{transform}} process during the
#' creation of a \code{\link{transformFilter}}, or by a call to the
#' \code{\link{transformList}} constructor.
#' 
#' @section Methods:
#' \describe{
#'   \item{show}{\code{signature(object = "transformList")}: Print details
#'     about the object. }
#' }
#' 
#' @author B. Ellis, F. Hahne
#' @seealso
#' 
#' \code{\link{transform}}, \code{\link{transformList}}
#' @keywords classes
#' @examples
#' 
#' new("transformMap", input="FSC-H", output="FSC-H", f=log)
#' 
#' 
#' @export 
setClass("transformMap",
         representation=representation(output="character",
         input="character",
         f="function"))



## ===========================================================================
## transformList
## ---------------------------------------------------------------------------
## A list of transformMaps
## ---------------------------------------------------------------------------
#' Class "transformList"
#' 
#' A list of transformMaps to be applied to a list of parameters.
#' 
#' 
#' @name transformList-class
#' @aliases transformList-class transformList colnames,transformList-method
#' c,transformList-method identifier,transformList-method
#' identifier<-,transformList,character-method
#' @docType class
#' @usage transformList(from, tfun, to=from, transformationId =
#' "defaultTransformation")
#' 
#' @param from,to Characters giving the names of the measurement parameter on
#' which to transform on and into which the result is supposed to be stored. If
#' both are equal, the existing parameters will be overwritten.
#' @param tfun A list if functions or a character vector of the names of the
#' functions used to transform the data. R's recycling rules apply, so a single
#' function can be given to be used on all parameters.
#' @param transformationId The identifier for the object.
#' 
#' @slot transforms Object of class \code{"list"}, where each
#' list item is of class \code{\link{transformMap}}.
#' @slot transformationId Object of class \code{"character"},
#' the identifier for the object.
#' 
#' @section Objects from the Class:
#' 
#' Objects can be created by calls of the form \code{new("transformList",
#' ...)}, by calling the \code{\link{transform}} method with key-value pair
#' arguments of the form \code{key} equals character and \code{value} equals
#' function, or by using the constructor \code{transformList}. See below for
#' details
#' 
#' @section Methods:
#' 
#' \describe{
#'   \item{colnames}{\code{signature(x = "transformList")}: This returns
#'     the names of the parameters that are to be transformed. }
#'   
#'   \item{c}{\code{signature(x = "transformList")}: Concatenate
#'     \code{transformList}s or regular lists and \code{transformLists}. }
#'   
#'   \item{\%on\%}{\code{signature(e1 = "transformList", e2 =
#'                                   "flowFrame")}: Perform a transformation using the
#'     \code{transformList} on a \code{\link{flowFrame}} or
#'     \code{\link{flowSet}}. }
#' }
#' 
#' @author B. Ellis, F. Hahne
#' @seealso \code{\link{transform}}, \code{\link{transformMap}}
#' @keywords classes
#' @examples
#' 
#' tl <- transformList(c("FSC-H", "SSC-H"), list(log, asinh))
#' colnames(tl)
#' c(tl, transformList("FL1-H", "linearTransform"))
#' data(GvHD)
#' transform(GvHD[[1]], tl)
#' 
#' 
#' @export 
setClass("transformList",
         representation=representation(transforms="list",
                                       transformationId="character"),
         prototype=prototype(transformationId="defaultTransformation"),
         validity=function(object)
         if(all(sapply(object@transforms, is, "transformMap"))) TRUE else
         stop("All list items of a 'transformList' must be of class ",
              "'transformMap.'", call.=FALSE))

## constructor
#' @export
transformList <- function(from, tfun, to=from,
                          transformationId="defaultTransformation")
{
    from <- unique(from)
    to <- unique(to)
    if(!is.character(from) || !is.character(to) || length(from) != length(to))
        stop("'from' and 'to' must be character vectors of equal length.",
             call.=FALSE)
    if(is.character(tfun))
        tfun <- lapply(tfun, get)
    if(!is.list(tfun)) tfun <- list(tfun)
    if(!all(sapply(tfun, is, "function") | sapply(tfun, is, "transform")))
        stop("'tfun' must be a list of functions or a character vector ",
             "with the function names.", call.=FALSE)
    tfun <- rep(tfun, length(from))
    tlist <- mapply(function(x, y, z)
                    new("transformMap", input=x, output=y, 
                    f=if(is(z, "transform")) z@.Data else z),
                    from, to, tfun[1:length(from)])
    tlist <- as(tlist, "transformList")
    identifier(tlist) <- transformationId
    return(tlist)
}



## ===========================================================================
## transformFilter
## ---------------------------------------------------------------------------
## FIXME: I have no clue what that is supposed to be but my guess is that it
## can go away once we have the new transformations in place
## ---------------------------------------------------------------------------
#' 
#' A class for encapsulating a filter to be performed on transformed parameters
#' 
#' 
#' The \code{transformFilter} class is a mechanism for including one or more
#' variable transformations into the filtering process. Using a special case of
#' \code{\link[flowCore:transform-class]{transform}} we can introduce
#' transformations inline with the filtering process eliminating the need to
#' process \code{\link[flowCore:flowFrame-class]{flowFrame}} objects before
#' applying a filter.
#' 
#' 
#' @name transformFilter-class
#' @aliases transformFilter-class transformFilter show,transformFilter-method
#' @docType class
#' 
#' @slot transforms A list of transforms to perform on the
#' target \code{\link[flowCore:flowFrame-class]{flowFrame}}
#' @slot filter The filter to be applied to the transformed
#' frame
#' @slot filterId The name of the filter (chosen
#' automatically)
#' 
#' @section Objects from the Class:
#' 
#' Objects of this type are not generally created ``by hand''. They are a side
#' effect of the use of the \code{\link[flowCore:filter-on-methods]{\%on\%}}
#' method with a \code{\link[flowCore:filter-methods]{filter}} object on the
#' left hand side and a
#' \code{\link[flowCore:transformList-class]{transformList}} on the right hand
#' side.
#' 
#' @section Extends:
#' Class \code{"\linkS4class{filter}"}, directly.
#' 
#' @author B. Ellis
#' @seealso
#' 
#' \code{"\linkS4class{filter}"}, \code{"\linkS4class{transform}"},
#' \code{\link[flowCore:transform-class]{transform}}
#' @keywords classes
#' @examples
#' require(flowStats)
#' samp <- read.FCS(system.file("extdata", "0877408774.B08", package="flowCore"))
#' 
#' ## Gate this object after log transforming the forward and side
#' ## scatter variables
#' filter(samp, norm2Filter("FSC-H", "SSC-H", scale.factor=2)
#'        %on% transform("FSC-H"=log,"SSC-H"=log))
#' 
#' 
#' @export 
setClass("transformFilter",
         representation=representation(transforms="transformList",
         filter="filter"),
         contains="concreteFilter")



## ===========================================================================
## compensation
## ---------------------------------------------------------------------------
## A class to define a compensation operation.
## Slots are:
##   - compensationId: The identifier of the object
##   - spillover:      The spillover matrix
##   - parameters:     The parameters for which the data is to be compensated,
##                     an object of class parameters 
## ---------------------------------------------------------------------------
#' Class "compensation"
#' 
#' 
#' Class and methods to compensate for spillover between channels by applying a
#' spillover matrix to a \code{flowSet} or a \code{flowFrame} assuming a simple
#' linear combination of values.
#' 
#' 
#' The essential premise of compensation is that some fluorochromes may
#' register signals in detectors that do not correspond to their primary
#' detector (usually a photomultiplier tube). To compensate for this fact, some
#' sort of standard is used to obtain the background signal (no dye) and the
#' amount of signal on secondary channels for each fluorochrome relative to the
#' signal on their primary channel.
#' 
#' To calculate the spillover percentage we use either the mean or the median
#' (more often the latter) of the secondary signal minus the background signal
#' for each dye to obtain \code{n} by \code{n} matrix, \code{S}, of so-called
#' spillover values, expressed as a percentage of the primary channel. The
#' observed values are then considered to be a linear combination of the true
#' fluorescence and the spillover from each other channel so we can obtain the
#' true values by simply multiplying by the inverse of the spillover matrix.
#' 
#' The spillover matrix can be obtained through several means. Some flow
#' cytometers provide a spillover matrix calculated during acquisition,
#' possibly by the operator, that is made available in the metadata of the
#' flowFrame.  While there is a theoretical standard keyword \code{$SPILL} it
#' can also be found in the \code{SPILLOVER} or \code{SPILL} keyword depending
#' on the cytometry. More commonly the spillover matrix is calculated using a
#' series of compensation cells or beads collected before the experiment. If
#' you have set of FCS files with one file per fluorochrome as well as an
#' unstained FCS file you can use the
#' \code{\link[flowStats:spillover-flowSet]{spillover}} method for
#' \code{\link[flowCore:flowSet-class]{flowSets}} to automatically calculate a
#' spillover matrix.
#' 
#' The \code{compensation} class is essentially a wrapper around a
#' \code{matrix} that allows for transformed parameters and method dispatch.
#' 
#' @name compensation-class
#' @aliases compensation-class compensation identifier,compensation-method
#' parameters,compensation-method identifier<-,compensation,character-method
#' show,compensation-method compensate
#' @docType class
#' @usage
#' compensation(\dots, spillover, compensationId="defaultCompensation")
#' 
#' compensate(x, spillover, \dots)
#' @param spillover The spillover or compensation matrix.
#' @param compensationId The identifier for the compensation object.
#' @param x An object of class \code{\linkS4class{flowFrame}} or
#' \code{\linkS4class{flowSet}}.
#' @param \dots Further arguments.
#' 
#' The constructor is designed to be useful in both programmatic and
#' interactive settings, and \dots{} serves as a container for possible
#' arguments. The following combinations of values are allowed:
#' 
#' Elements in \dots{} are \code{character} scalars of parameter names or
#' \code{\linkS4class{transform}} objects and the colnames in \code{spillover}
#' match to these parameter names.
#' 
#' The first element in \dots{} is a \code{character} vector of parameter names
#' or a list of \code{character} scalars or \code{\linkS4class{transform}}
#' objects and the colnames in \code{spillover} match to these parameter names.
#' 
#' Argument \code{spillover} is missing and the first element in \dots{} is a
#' \code{matrix}, in which case it is assumed to be the spillover matrix.
#' 
#' \dots{} is missing, in which case all parameter names are taken from the
#' colnames of \code{spillover}.
#' 
#' @return
#' 
#' A \code{compensation} object for the constructor.
#' 
#' A \code{\linkS4class{flowFrame}} or \code{\linkS4class{flowSet}} for the
#' \code{compensate} methods.
#' @section Objects from the Class:
#' 
#' Objects should be created using the constructor \code{compensation()}. See
#' the \code{Usage} and \code{Arguments} sections for details.
#' 
#' @slot spillover Object of class \code{matrix}; the
#' spillover matrix.
#' @slot compensationId Object of class \code{character}. An
#' identifier for the object.
#' @slot parameters Object of class \code{parameters}. The
#' flow parameters for which the compensation is defined. This can
#' also be objects of class \code{\linkS4class{transform}}, in which
#' case the compensation is performed on the compensated parameters.
#' 
#' @section Methods:
#' \describe{
#'   
#'   \item{compensate}{\code{signature(x = "flowFrame", spillover =
#'                                       "compensation")}: Apply the compensation defined in a
#'     \code{compensation} object on a \code{\linkS4class{flowFrame}}.
#'     This returns a compensated \code{flowFrame}.
#'     
#'     \emph{Usage:}
#'     
#'     \code{   compensate(flowFrame, compensation)}
#'     
#'   }
#'   
#'   \item{compensate}{\code{signature(x = "flowFrame", spillover =
#'                                       "matrix")}: Apply a compensation matrix to a
#'     \code{\linkS4class{flowFrame}}.  This returns a compensated
#'     \code{flowFrame}.
#'     
#'     \emph{Usage:}
#'     
#'     \code{   compensate(flowFrame, matrix)}
#'     
#'   }
#'   
#'   \item{compensate}{\code{signature(x = "flowFrame", spillover =
#'                                       "data.frame")}:Try to coerce the \code{data.frame} to a
#'     \code{matrix} and apply that to a
#'     \code{\linkS4class{flowFrame}}.  This returns a compensated
#'     \code{flowFrame}.
#'     
#'     \emph{Usage:}
#'     
#'     \code{   compensate(flowFrame, data.frame)}
#'     
#'   }
#'   
#'   \item{identifier, identifier<-}{\code{signature(object =
#'                                                     "compensation")}: Accessor and replacement methods for the
#'     \code{compensationId} slot.
#'     
#'     \emph{Usage:}
#'     
#'     
#'     \code{   identifier(compensation)}
#'     
#'     \code{   identifier(compensation) <- value}
#'     
#'   }
#'   
#'   
#'   \item{parameters}{\code{signature(object =
#'                                       "compensation")}: Get the parameter names of the
#'     \code{compensation} object. This method also tries to resolve
#'     all \code{\link[flowCore:transform-class]{transforms}} and
#'     \code{\link[flowCore:transformReference-class]{transformReferences}}
#'     before returning the parameters as character vectors. Unresolvable
#'     references return \code{NA}.
#'     
#'     \emph{Usage:}
#'     
#'     
#'     \code{   parameters(compensation)}
#'     
#'     
#'   }
#'   
#'   
#'   \item{show}{\code{signature(object = "compensation")}: Print details
#'     about the object.
#'     
#'     \emph{Usage:}
#'     
#'     This method is automatically called when the object is printed on
#'     the screen.
#'     
#'   }  
#' }
#' 
#' @author F.Hahne, B. Ellis, N. Le Meur
#' @seealso
#' 
#' \code{\link[flowStats:spillover-flowSet]{spillover}}
#' @keywords methods classes
#' @examples
#' 
#' ## Read sample data and a sample spillover matrix
#' samp   <- read.flowSet(path=system.file("extdata", "compdata", "data",
#'           package="flowCore")) 
#' cfile <- system.file("extdata","compdata","compmatrix", package="flowCore")
#' comp.mat <- read.table(cfile, header=TRUE, skip=2, check.names = FALSE)
#' comp.mat
#' 
#' ## compensate using the spillover matrix directly
#' summary(samp)
#' samp <- compensate(samp, comp.mat)
#' summary(samp)
#' 
#' ## create a compensation object and compensate using that
#' comp <- compensation(comp.mat)
#' compensate(samp, comp)
#' 
#' ## demo the sample-specific compensation
#' ## create a list of comps (each element could be a 
#' ## different compensation tailored for the specific sample)
#' comps <- sapply(sampleNames(samp), function(sn)comp, simplify = FALSE)
#' # the names of comps must be matched to sample names of the flowset
#' compensate(samp, comps)
#' 
#' @export
setClass("compensation",
         representation(spillover="matrix",
                        compensationId="character",
                        parameters="parameters"),
         prototype=prototype(spillover=matrix(),
                             compensationId="default",
                             parameters=new("parameters",.Data="")))

## Constructor: We allow for the following inputs:
##  spillover is always a symmetric numerical matrix with colnames set
## invert is deprecated
##  invert is always a logical of length 1
##  ..1 is a character vector
##  ..1 is a list of character and/or transformations
##  ..1 is a matrix and spillover is missing
##  ... are characters and/or transformations
## If parameters are given explicitely they need to match the colnames
## of the spillover matrix.
#' @export
compensation <- function(..., spillover, compensationId="defaultCompensation")
{
    parms <- parseDots(list(...))
    if(missing(spillover))
        spillover <- as.matrix(parms$values)

#    J.Spidlen, Oct 23, 2013: Removed check for square matrices
#    We now support non-square matrices as well
#
#    if(!is.matrix(spillover) || !is.numeric(spillover) ||
#       ncol(spillover) != nrow(spillover))
#        stop("'spillover' must be numeric matrix with same number of ",
#             "rows and columns", call.=FALSE)

    if(!is.matrix(spillover) || !is.numeric(spillover))
        stop("'spillover' must be numeric matrix", call.=FALSE)
    if(is.null(colnames(spillover)))
        stop("Spillover matrix must have colnames", call.=FALSE)
    checkClass(compensationId, "character", 1)
#    checkClass(inv, "logical", 1)
    if(!length(parms$parameters))
        parms <- sapply(colnames(spillover), unitytransform)
    if(all(sapply(parms$parameters,function(x) is(x,"unitytransform"))) &&
       !all(sapply(parms$parameters, parameters) %in% colnames(spillover)))
        stop("Parameters and column names of the spillover matrix ",
             "don't match.", call.=FALSE)
#    if(inv)
      ## spillover <- solve(spillover/max(spillover))
#      spillover <- solve(spillover)
    new("compensation", spillover=spillover, 
        compensationId=compensationId,
        parameters=new("parameters", parms$parameters))
}



## ===========================================================================
## compensatedParameter
## ---------------------------------------------------------------------------
## FIXME NG: Please document
## ---------------------------------------------------------------------------
#' Class "compensatedParameter"
#' 
#' 
#' Emission spectral overlap can be corrected by subtracting the amount of
#' spectral overlap from the total detected signals. This compensation process
#' can be described by using spillover matrices.
#' 
#' The compensatedParameter class allows for compensation of specific parameters
#' the user is interested in by creating compensatedParameter objects and
#' evaluating them. This allows for use of compensatedParameter in gate
#' definitions.
#' 
#' 
#' @name compensatedParameter-class
#' @aliases compensatedParameter-class compensatedParameter
#' eval,compensatedParameter,missing-method
#' @docType class
#' @note The transformation object can be evaluated using the eval method by
#' passing the data frame as an argument. The transformed parameters are
#' returned as a matrix with a single column. (See example below)
#' @section Objects from the Class:
#' 
#' Objects can be created by calls to the constructor of the form
#' \code{compensatedParameter(parameters,spillRefId,transformationId,searchEnv)}.
#' 
#' @slot .Data Object of class \code{"function"}.
#' @slot parameters Object of class \code{"character"} -- the flow
#' parameters to be  compensated.
#' @slot spillRefId Object of class \code{"character"} -- the name of the
#' compensation object (The compensation object contains the spillover Matrix).
#' @slot searchEnv Object of class \code{"environment"} -environment in
#' which the compensation object is defined.
#' @slot transformationId Object of class \code{"character"} -- a unique Id to
#' reference the compensatedParameter object.
#' 
#' @section Extends:
#' Class \code{"\linkS4class{transform}"}, directly.
#' Class \code{"\linkS4class{transformation}"}, by class "transform", distance 2.
#' Class \code{"\linkS4class{characterOrTransformation}"}, by class "transform", distance 3.
#' 
#' @author Gopalakrishnan N,F.Hahne
#' @seealso compensation
#' @keywords classes
#' @examples
#' 
#' samp   <- read.flowSet(path=system.file("extdata", "compdata", "data", package="flowCore"))
#' cfile <- system.file("extdata","compdata","compmatrix", package="flowCore")
#' comp.mat <- read.table(cfile, header=TRUE, skip=2, check.names = FALSE)
#' comp.mat
#' 
#' ## create a compensation object 
#' comp <- compensation(comp.mat,compensationId="comp1")
#' ## create a compensated parameter object 
#' cPar1<-compensatedParameter(c("FL1-H","FL3-H"),"comp",searchEnv=.GlobalEnv)
#' compOut<-eval(cPar1)(exprs(samp[[1]]))
#' 
#' 
#' @export
setClass("compensatedParameter",
          contains=c("transform"),
          representation=representation(parameters="character",spillRefId="character",
                                        searchEnv="environment"
                                       )
        )

## Constructor
#' @export
compensatedParameter <- function(parameters,
                                 spillRefId="defaultCompensatedParameter",
                                 transformationId="defaultTransformationId",
                                 searchEnv)
{
    
    new("compensatedParameter", parameters=parameters, spillRefId=spillRefId,
        transformationId=transformationId,searchEnv=searchEnv)
}

## Create quasi-random guids. This is only based on the time stamp,
## not on MAC address or similar.
#guid <- function()
#    as.vector(format.hexmode(as.integer(Sys.time())/
#                             runif(1)*proc.time()["elapsed"]))

guid <- function(len=10){
       ltrs <- c(LETTERS,letters)
       paste(c(sample(ltrs,1),sample(c(ltrs,0:9),len-1,replace=TRUE)),collapse="")
}


## ===========================================================================
## normalization
## ---------------------------------------------------------------------------
## A class to describe normalization operations on a complete flowSet.
## Currently this is only the warping, but more methods may follow. The
## function 'normFunction' is supposed to take a flowSet, perform an
## operation on 'parameters' and return the altered flowSet. It has two
## mandatory arguments: 'x' and 'parameters'. All additional arguments
## have to be supplied via the list in the 'arguments' slot.
## ---------------------------------------------------------------------------
#' Class "normalization"
#' 
#' 
#' Class and methods to normalize a a \code{flowSet} using a potentially
#' complex normalization function.
#' 
#' Data normalization of a \code{flowSet} is a rather fuzzy concept. The idea is
#' to have a rather general function that takes a \code{flowSet} and a list of
#' parameter names as input and applies any kind of normalization to the
#' respective data columns. The output of the function has to be a
#' \code{flowSet} again. Although we don't formally check for it, the
#' dimensions of the input and of the output set should remain the same.
#' Additional arguments may be passed to the normalization function via the
#' \code{arguments} list. Internally we evaluate the function using
#' \code{\link{do.call}} and one should check its documentation for details.
#' 
#' Currently, the most prominent example for a normalization function is
#' warping, as provided by the \code{flowStats} package.
#' 
#' @name normalization-class
#' @aliases normalization-class normalization normalize
#' identifier<-,normalization,character-method identifier,normalization-method
#' normalize,flowSet,normalization-method parameters,normalization-method
#' @docType class
#' @usage
#' normalization(parameters, normalizationId="defaultNormalization",
#'               normFunction, arguments=list())
#'
#' normalize(data, x,...)
#' @param parameters Character vector of parameter names.
#' @param normalizationId The identifier for the normalization object.
#' @param x An object of class \code{\linkS4class{flowSet}}.
#' @param normFunction The normalization function
#' @param arguments The list of additional arguments to \code{normFunction}
#' @param data The \code{flowSet} to normalize.
#' @param \dots other arguments: see
#' \code{\link[flowStats:normalize-methods]{normalize-methods}}for details.
#' 
#' @return
#' 
#' A \code{normalization} object for the constructor.
#' 
#' A \code{\linkS4class{flowSet}} for the \code{normalize} methods.
#' @section Objects from the Class:
#' 
#' Objects should be created using the constructor \code{normalization()}. See
#' the \code{Usage} and \code{Arguments} sections for details.
#' 
#' @slot parameters Object of class \code{"character"}. The
#' flow parameters that are supposed to be normalized by the
#' normalization function.
#' @slot normalizationId Object of class \code{"character"}. An
#' identifier for the object.
#' @slot normFunction Object of class \code{"function"} The
#' normalization function. It has to take two mandatory arguments:
#' \code{x}, the \code{flowSet}, and \code{parameters}, a character
#' of parameter names that are to be normalized by the
#' function. Additional arguments have to be passed in via
#' \code{arguments}.
#' @slot arguments Object of class \code{"list"} A names list
#' of additional arguments. Can be \code{NULL}.
#' 
#' @section Methods:
#' \describe{
#'   
#'   \item{identifier<-}{\code{signature(object = "normalization", value
#'                                       = "character")}: Set method for the identifier slot. }
#'   
#'   \item{identifier}{\code{signature(object = "normalization")}: Get
#'     method for the identifier slot. }
#'   
#'   \item{normalize}{\code{signature(data = "flowSet", x =
#'                                      "normalization")}: Apply a normalization to a \code{\linkS4class{flowSet}}. }
#'   
#'   \item{parameters}{\code{signature(object = "normalization")}: The
#'     more generic constructor. }
#' }
#' @author F. Hahne
#' @keywords methods classes
#'
#' @export
setClass("normalization",
         representation(parameters="character",
                        normalizationId="character",
                        normFunction="function",
                        arguments="list"),
         prototype=prototype(normalizationId="defaultNormalization",
                             normFunction=function(x) x)
         )

## constructor
#' @export
normalization <- function(parameters, normalizationId="defaultNormalization",
                          normFunction, arguments=list())
{
    checkClass(normalizationId, "character", 1)
    checkClass(parameters, "character")
    checkClass(normFunction, "function")
    new("normalization", parameters=parameters,
        normalizationId=normalizationId, normFunction=normFunction,
        arguments=arguments)
}

## make deep copy of a flowSet
copyFlowSet <- function(x) x[1:length(x)]

## copy a flowFrame
copyFlowFrame <- function(x) x[1:nrow(x)]


#' Class "characterOrNumeric"
#' 
#' A simple union class of \code{character} and \code{numeric}.
#' Objects will be created internally whenever necessary and the user should
#' not need to explicitly interact with this class.
#' 
#' @name characterOrNumeric-class
#' @aliases characterOrNumeric-class characterOrNumeric
#' @docType class
#' @section Objects from the Class: A virtual Class: No objects may be created
#' from it.
#' @keywords classes
#' @examples
#' 
#' showClass("characterOrNumeric")
#' 
setClassUnion("characterOrNumeric", c("character","numeric"))


## ===========================================================================
## Unity transformation
## ---------------------------------------------------------------------------
## Transforms parameters names provided as characters into unity transform 
## objects which can be evaluated to retrieve the corresponding columns from the
## data frame
## ---------------------------------------------------------------------------
#' Class "unitytransform"
#' 
#' Unity transform class transforms parameters names provided as characters
#' into unity transform objects which can be evaluated to retrieve the
#' corresponding columns from the data frame
#' 
#' 
#' @name unitytransform-class
#' @aliases unitytransform-class unitytransform show,unitytransform-method
#' eval,unitytransform,missing-method
#' @docType class
#' @section Objects from the Class: Objects can be created by calls to the
#' constructor \code{unitytransform(parameters,transformationId)}.
#' 
#' @slot .Data Object of class \code{"function"}.
#' @slot parameters Object of class \code{"character"} -- the flow
#' parameters to be transformed.
#' @slot transformationId Object of class \code{"character"} -- a unique Id to
#' reference the transformation.
#' 
#' @section Extends:
#' Class \code{"\linkS4class{transform}"}, directly.
#' 
#' Class \code{"\linkS4class{transformation}"}, by class "transform", distance 2.
#' 
#' Class \code{"\linkS4class{characterOrTransformation}"}, by class "transform", distance 3.
#' 
#' @author Gopalakrishnan N, F.Hahne
#' @seealso dg1polynomial, ratio
#' @family mathematical transform classes
#' @keywords classes
#' @examples
#' 
#'   dat <- read.FCS(system.file("extdata","0877408774.B08",
#'   package="flowCore"))
#'   un1<-unitytransform(c("FSC-H","SSC-H"),transformationId="un1")
#'   transOut<-eval(un1)(exprs(dat))
#' 
#' @export 
setClass("unitytransform",
	 contains="transform",
	 representation=representation(parameters="character"))

#' @export
unitytransform <- function(parameters,
                           transformationId="defaultUnityTransform")
{
    checkClass(transformationId, "character", 1)
    if(missing(parameters))
        parameters <- character()
    new("unitytransform", parameters=parameters,
        transformationId=transformationId)
}

#' Multirange Gate class
#' @name multiRangeGate-class
#' @aliases multiRangeGate-class multiRangeGate summary,multiRangeGate-method
#' show,multiRangeGate-method
#' @docType class
#'
#'
#' @usage multiRangeGate(ranges, filterId="defaultMultiRangeGate")
#'
#' @param filterId An optional parameter that sets the \code{filterId} of this
#' gate. The object can later be identified by this name.
#' @param ranges A definition of the gate. This can be a list of min,max ranges
#' (see the prototype).
#' @return
#'
#' Returns a \code{\link{multiRangeGate}} object for use in filtering
#' \code{\link{flowFrame}}s or other flow cytometry objects.
#'@export
setClass("multiRangeGate", slots=c(filterId="character",ranges="list"),
         prototype=list(filterId="defaultMultiRangeGate", ranges=list(min=c(-Inf,1),max=c(1,Inf)),parameters=new("parameters",.Data=list(unitytransform("Time")))),
         contains="parameterFilter"
)
#'@export
multiRangeGate<-function(ranges,filterId="defaultMultiRangeGate") {
  checkClass(filterId, "character", 1)
  checkClass(ranges,"list")
  if(length(ranges)!=2){
    stop("ranges must be a list of length 2 with names 'min' 'max'")
  }
  if(length(ranges[[1]])!=length(ranges[[2]])){
    stop("lengths of min and max ranges must be equal")
  }
  if(!all(names(ranges)%in%c("min","max"))){
    stop("names of ranges must be 'min' and 'max'")
  }
  x=new("multiRangeGate", filterId = filterId, ranges=ranges)
  return(x)
}


## ===========================================================================
## Polynomial transformation of degree 1 
## ---------------------------------------------------------------------------
## Allows for scaling ,linear combination and translation within a single 
## transformation
## ---------------------------------------------------------------------------
#' Class "dg1polynomial"
#' 
#' dg1polynomial allows for scaling,linear combination and translation within a
#' single transformation defined by the function
#' \deqn{ f(parameter_1,...,parameter_n,a_1,...,a_n,b) = b + \Sigma_{i=1}^n
#' a_i*parameter_i }
#' 
#' 
#' @name dg1polynomial-class
#' @aliases dg1polynomial-class dg1polynomial eval,dg1polynomial,missing-method
#' initialize,dg1polynomial-method parameters<-,dg1polynomial,character-method
#' parameters<-,dg1polynomial,parameters-method
#' @docType class
#' @note The transformation object can be evaluated using the eval method by
#' passing the data frame as an argument.The transformed parameters are
#' returned as a matrix with a single column.(See example below)
#' @section Objects from the Class: Objects can be created by using the
#' constructor \code{dg1polynomial(parameter,a,b,transformationId)}.
#' 
#' @slot .Data Object of class \code{"function"}.
#' @slot parameters Object of class \code{"parameters"} --the flow parameters
#' that are to be transformed.
#' @slot a Object of class \code{"numeric"} -- coefficients of length equal
#' to the number of flow parameters.
#' @slot b Object of class \code{"numeric"} -- coefficient of length 1 that
#' performs the translation.
#' @slot transformationId Object of class \code{"character"} unique ID to
#' reference the transformation.
#' 
#' @section Extends:
#' Class \code{"\linkS4class{transform}"}, directly.
#' 
#' Class \code{"\linkS4class{transformation}"}, by class "transform", distance 2.
#' 
#' Class \code{"\linkS4class{characterOrTransformation}"}, by class "transform", distance 3.
#' 
#' @author Gopalakrishnan N, F.Hahne
#' @seealso ratio,quadratic,squareroot
#' @family mathematical transform classes
#' @references Gating-ML Candidate Recommendation for Gating Description in
#' Flow Cytometry V 1.5
#' @keywords classes
#' @examples
#' 
#'   dat <- read.FCS(system.file("extdata","0877408774.B08",
#'   package="flowCore"))
#'   dg1<-dg1polynomial(c("FSC-H","SSC-H"),a=c(1,2),b=1,transformationId="dg1")
#'   transOut<-eval(dg1)(exprs(dat))
#' 
#' @export
setClass("dg1polynomial", 		
         contains="transform",
         representation=representation(parameters="parameters",
                                       a="numeric",
                                       b="numeric"),
         prototype=prototype(parameters=new("parameters"),
                             a=1,
                             b=1))

#' @export
dg1polynomial <- function(parameters, a=1, b=1,
                          transformationId="defaultDg1polynomialTransform")
{
    checkClass(a, "numeric", length(parameters))
    checkClass(b, "numeric", 1)
    checkClass(transformationId, "character", 1)
    new("dg1polynomial", parameters=parameters, a=a, b=b,
        transformationId=transformationId)
}



## ===========================================================================
## Ratio transformation
## ---------------------------------------------------------------------------
## Ratio of two arguments defined in the transformation
## ---------------------------------------------------------------------------
#' Class "ratio"
#' 
#' ratio transform calculates the ratio of two parameters defined by the
#' function \deqn{f(parameter_1,parameter_2)=\frac{parameter_1}{parameter_2}}
#' 
#' 
#' @name ratio-class
#' @aliases ratio-class ratio eval,ratio,missing-method initialize,ratio-method
#' @docType class
#' @note The ratio transformation object can be evaluated using the eval method
#' by passing the data frame as an argument.The transformed parameters are
#' returned as matrix with one column. (See example below)
#' @section Objects from the Class: Objects can be created by calls to the
#' constructor \code{ratio(parameter1,parameter2,transformationId) }.
#' 
#' @slot .Data Object of class \code{"function"}.
#' @slot numerator Object of class \code{"transformation"} -- flow parameter
#' to be transformed
#' @slot denominator Object of class \code{"transformation"} -- flow parameter
#' to be transformed.
#' @slot transformationId Object of class \code{"character"} -- unique ID to
#' reference the transformation.
#' 
#' @section Extends:
#' Class \code{"\linkS4class{transform}"}, directly.
#' 
#' Class \code{"\linkS4class{transformation}"}, by class "transform", distance 2.
#' 
#' Class \code{"\linkS4class{characterOrTransformation}"}, by class "transform", distance 3.
#' 
#' @author Gopalakrishnan N, F.Hahne
#' @seealso  dg1polynomial,quadratic,squareroot
#' @family mathematical transform classes
#' @references Gating-ML Candidate Recommendation for Gating Description in
#' Flow Cytometry V 1.5
#' @keywords classes
#' @examples
#' 
#'   dat <- read.FCS(system.file("extdata","0877408774.B08",
#'   package="flowCore"))
#'   rat1<-ratio("FSC-H","SSC-H",transformationId="rat1")
#'   transOut<-eval(rat1)(exprs(dat))
#' 
#' @export
setClass("ratio",
         contains="transform",
         representation(numerator="transformation",
                        denominator="transformation"),
	 prototype=prototype(numerator=unitytransform(),
                             denominator=unitytransform()))

#' @export
ratio <- function(numerator=unitytransform(),
                  denominator=unitytransform(),
                  transformationId="defaultRatioTransform")
{
    if(!is(numerator, "transform")){
        checkClass(numerator, "character", 1)
        numerator <- unitytransform(numerator)
    }
    if(!is(denominator, "transform")){
        checkClass(denominator, "character", 1)
        denominator=unitytransform(denominator)
    }  
    new("ratio", numerator=numerator, denominator=denominator,
        transformationId=transformationId)
}



## ===========================================================================
## Quadratic transformation
## ---------------------------------------------------------------------------
#' Class "quadratic"
#' 
#' Quadratic transform class which represents a transformation defined by the 
#' function \deqn{f(parameter,a)=a*parameter^2}
#' 
#' 
#' @name quadratic-class
#' @aliases quadratic quadratic-class quadratic eval,quadratic,missing-method
#' @docType class
#' @note The quadratic transformation object can be evaluated using the eval
#' method by passing the data frame as an argument.The transformed parameters
#' are returned as a column vector. (See example below)
#' @section Objects from the Class: Objects can be created by calls to the
#' constructor \code{quadratic(parameters,a,transformationId)}
#' 
#' @slot .Data Object of class \code{"function"}.
#' @slot a Object of class \code{"numeric"} -- non-zero multiplicative 
#' constant.
#' @slot parameters Object of class \code{"transformation"} -- flow 
#' parameter to be transformed.
#' @slot transformationId Object of class \code{"character"} -- unique 
#' ID to reference the transformation.
#' 
#' @section Extends:
#' Class \code{"\linkS4class{singleParameterTransform}"}, directly.
#' 
#' Class \code{"\linkS4class{transform}"}, by class "singleParameterTransform", 
#' distance 2.
#' 
#' Class \code{"\linkS4class{transformation}"}, by class "singleParameterTransform",
#' distance 3.
#' 
#' Class \code{"\linkS4class{characterOrTransformation}"}, by class "singleParameterTransform",
#' distance 4.
#' 
#' @author Gopalakrishnan N, F.Hahne
#' @seealso dg1polynomial,ratio,squareroot
#' @family mathematical transform classes
#' @references Gating-ML Candidate Recommendation for Gating Description in
#' Flow Cytometry V 1.5
#' @keywords classes
#' @examples
#' 
#'   dat <- read.FCS(system.file("extdata","0877408774.B08",
#'   package="flowCore"))
#'   quad1<-quadratic(parameters="FSC-H",a=2,transformationId="quad1")
#'   transOut<-eval(quad1)(exprs(dat))
#' 
#' @export
setClass("quadratic", 		
         contains="singleParameterTransform",
         representation=representation(a="numeric"),
         prototype=prototype(parameters=unitytransform(),
                             a=1),
         validity=function(object) 
     {
         msg<-NULL
         if(length(object@parameters)!=1)
             msg <- c(msg, "Quadratic transform is defined for one parameter")
         if(length(object@a)!=1)
             msg <- c(msg, "Only one coefficient is defined for quadratic transform")
         if(object@a==0)
             msg <- c(msg, "'a' should be non-zero")
         msg
     })

#' @export
quadratic <- function(parameters="NULL", a=1,
                      transformationId="defaultQuadraticTransform")
    new("quadratic",parameters=parameters,a=a,
        transformationId=transformationId)

          

## ===========================================================================
## Squareroot transformation
## ---------------------------------------------------------------------------
#' Class "squareroot"
#' 
#' Square root transform class, which represents a transformation defined by the 
#' function \deqn{f(parameter,a)= \sqrt{ |{\frac{parameter}{a}|}}}
#' 
#' 
#' @name squareroot-class
#' @aliases squareroot-class squareroot squareroot eval,squareroot,missing-method
#' @docType class
#' @note The squareroot transformation object can be evaluated using the eval
#' method by passing the data frame as an argument.The transformed parameters
#' are returned as a column vector. (See example below)
#' @section Objects from the Class: Objects can be created by calls to the
#' constructor \code{squareroot(parameters,a,transformationId)}
#' @section Extends:
#' Class \code{"\linkS4class{singleParameterTransform}"}, directly.
#' 
#' Class \code{"\linkS4class{transform}"}, by class "singleParameterTransform", distance 2.
#' 
#' Class \code{"\linkS4class{transformation}"}, by class "singleParameterTransform", distance 3.
#' 
#' Class \code{"\linkS4class{characterOrTransformation}"}, by class "singleParameterTransform", distance 4.
#' 
#' @slot .Data Object of class \code{"function"}
#' @slot a Object of class \code{"numeric"} -- non-zero multiplicative 
#' constant
#' @slot parameters Object of class \code{"transformation"} -- flow 
#' parameter to be transformed.
#' @slot transformationId Object of class \code{"character"} -- unique 
#' ID to reference the transformation.
#' 
#' @author Gopalakrishnan N, F.Hahne
#' @seealso dg1polynomial, ratio, quadratic
#' @family mathematical transform classes
#' @references Gating-ML Candidate Recommendation for Gating Description in
#' Flow Cytometry
#' @keywords classes
#' @examples
#' 
#'   dat <- read.FCS(system.file("extdata","0877408774.B08",
#'   package="flowCore"))
#'   sqrt1<-squareroot(parameters="FSC-H",a=2,transformationId="sqrt1")
#'   transOut<-eval(sqrt1)(exprs(dat))
#' 
#' @export
setClass("squareroot", 		
         contains="singleParameterTransform",
         representation=representation(a="numeric"),
         prototype=prototype(parameters=unitytransform(), a=1),
         validity=function(object) 
     {
         msg <- NULL
         if(length(object@parameters)!=1)
             msg <- c(msg, "Square root transform is defined for one parameter")
         if(length(object@a)!=1)
             msg <- c(msg, "Only one coefficient is defined for quadratic transform")
         if(object@a==0)
             msg <- c(msg, "Coefficien> t should be non-zero")
         msg
     })

#' @export
squareroot <- function(parameters, a=1,
                       transformationId="defaultSquarerootTransform")
    new("squareroot", parameters=parameters, a=a,
        transformationId=transformationId)



## ===========================================================================
##  Logarithmic Transformation 
## ---------------------------------------------------------------------------
## inputs a,b of type numeric and parameter of type transformation or character
## ---------------------------------------------------------------------------
#' Class "logarithm"
#' 
#' Logartithmic transform class, which represents a transformation defined by
#' the function
#' 
#' \deqn{f(parameter,a,b)= ln(a*prarameter)*b ~~~~a*parameter>0} \deqn{0
#' ~~~~a*parameter<=0}
#' 
#' 
#' @name logarithm-class
#' @aliases logarithm-class logarithm eval,logarithm,missing-method
#' @docType class
#' @note The logarithm transformation object can be evaluated using the eval
#' method by passing the data frame as an argument.The transformed parameters
#' are returned as a matrix with a single column. (See example below)
#' @section Objects from the Class: Objects can be created by calls to the
#' constructor \code{logarithm(parameters,a,b,transformationId)}
#' 
#' @slot .Data Object of class \code{"function"}
#' @slot a Object of class \code{"numeric"} -- non-zero multiplicative constant.
#' @slot b Object of class \code{"numeric"} -- non-zero multiplicative constant.
#' @slot parameters Object of class \code{"transformation"} -- flow parameters to be transformed.
#' @slot transformationId Object of class \code{"character"} -- unique ID to reference the transformation.
#' 
#' @section Extends:
#' Class \code{"\linkS4class{singleParameterTransform}"}, directly.
#' 
#' Class \code{"\linkS4class{transform}"}, by class "singleParameterTransform", distance 2.
#' 
#' Class \code{"\linkS4class{transformation}"}, by class "singleParameterTransform", distance 3.
#' 
#' Class \code{"\linkS4class{characterOrTransformation}"}, by class "singleParameterTransform", distance 4.
#' 
#' @author Gopalakrishnan N, F.Hahne
#' @seealso exponential, quadratic
#' @family mathematical transform classes
#' @references Gating-ML Candidate Recommendation for Gating Description in
#' Flow Cytometry V 1.5
#' @keywords classes
#' @examples
#' 
#'  dat <- read.FCS(system.file("extdata","0877408774.B08",
#'   package="flowCore"))
#'   lg1<-logarithm(parameters="FSC-H",a=2,b=1,transformationId="lg1")
#'   transOut<-eval(lg1)(exprs(dat))
#' 
#' @export
setClass("logarithm",
         contains="singleParameterTransform",
         representation=representation(a="numeric", b="numeric"),
         prototype=prototype(parameters=unitytransform(), a=1, b=1),
         validity=function(object) 
     {
         msg <- NULL
         if(length(object@parameters)!=1)
             msg <- c(msg, "Logarithm transform is defined for one parameter")
         if(object@a==0)
             msg <- c(msg, "'a' should be a non-zero number")
         if(object@b==0)
             msg <- c(msg, "'b' should be a non-zero number")
         msg
     })

#' @export
logarithm <- function(parameters, a=1, b=1,
                      transformationId="defaultLogarithmTransform")
    new("logarithm", parameters=parameters, a=a, b=b,
        transformationId=transformationId)



## ===========================================================================
##  Exponential Transformation 
## ---------------------------------------------------------------------------
## inputs a,b of type numeric and parameter of type transformation or character
## ---------------------------------------------------------------------------
#' Class "exponential"
#' 
#' Exponential transform class, which represents a transformation given by the 
#' function \deqn{f(parameter,a,b)=e^{parameter/b}*\frac{1}{a}}
#' 
#' 
#' @name exponential-class
#' @aliases exponential-class exponential eval,exponential,missing-method
#' @docType class
#' @note The exponential transformation object can be evaluated using the eval
#' method by passing the data frame as an argument.The transformed parameters
#' are returned as a matrix with a single column
#' @section Objects from the Class: Objects can be created by calls to the
#' constructor\code{exponential(parameters,a,b)}.
#' 
#' @slot .Data Object of class \code{"function"}.
#' @slot a Object of class \code{"numeric"} -- non-zero constant.
#' @slot b Object of class \code{"numeric"}- non-zero constant.
#' @slot parameters Object of class \code{"transformation"} -- flow 
#' parameter to be transformed.
#' @slot transformationId Object of class \code{"character"} -- 
#' unique ID to reference the transformation
#' 
#' @section Extends:
#' Class \code{"\linkS4class{singleParameterTransform}"}, directly.
#' 
#' Class \code{"\linkS4class{transform}"}, by class "singleParameterTransform", distance 2.
#' 
#' Class \code{"\linkS4class{transformation}"}, by class "singleParameterTransform", distance 3.
#' 
#' Class \code{"\linkS4class{characterOrTransformation}"}, by class "singleParameterTransform", distance 4.
#'
#' @author Gopalakrishnan N, F.Hahne
#' @seealso logarithm
#' @family mathematical transform classes
#' @references Gating-ML Candidate Recommendation for Gating Description in
#' Flow Cytometry V 1.5
#' @keywords classes
#' @examples
#' 
#'  dat <- read.FCS(system.file("extdata","0877408774.B08",
#'   package="flowCore"))
#'   exp1<-exponential(parameters="FSC-H",a=1,b=37,transformationId="exp1")
#'   transOut<-eval(exp1)(exprs(dat))
#' 
#' @export
setClass("exponential", 		
         contains="singleParameterTransform",
         representation=representation(a="numeric",
                                       b="numeric"),
         prototype=prototype(parameters=unitytransform(),
                             a=1,
                             b=1),
         validity=function(object) 
     {
         msg <-NULL
         if(length(object@parameters)!=1)
             msg <- c(msg, "Exponential transform is defined for one parameter")
         if(object@a==0)
             msg<-c(msg,"'a' should be a non-zero number")
         if(object@b==0)
             msg <- c(msg,"'b' should be a non-zero number")
         msg  
     })

#' @export
exponential <- function(parameters, a=1, b=1,
                        transformationId="defaultExponentialTransformation")
    new("exponential", parameters=parameters, a=a, b=b,
        transformationId=transformationId)



## ===========================================================================
##  Inverse hyperbolic sin Transformation 
## ---------------------------------------------------------------------------
## inputs a,b of type numeric and parameter of type transformation or character
## ---------------------------------------------------------------------------
#' Class "asinht"
#' 
#' Inverse hyperbolic sine transform class, which represents a transformation 
#' defined by the function: 
#' \deqn{f(parameter,a,b)=sinh^{-1}(a*parameter)*b}
#' This definition is such that it can function as an inverse of 
#' \code{\linkS4class{sinht}} using the same definitions of the constants a
#' and b.
#' 
#' @name asinht-class
#' @aliases asinht-class asinht eval,asinht,missing-method
#' @docType class
#' @note The inverse hyperbolic sin transformation object can be evaluated
#' using the eval method by passing the data frame as an argument.The
#' transformed parameters are returned as a matrix with a single column. (See
#' example below)
#' @section Objects from the Class: Objects can be created by calls to the
#' constructor \code{asinht(parameter,a,b,transformationId)}
#' 
#' @slot .Data Object of class \code{"function"}.
#' @slot a Object of class \code{"numeric"} -- non-zero constant.
#' @slot b Object of class \code{"numeric"} -- non-zero constant.
#' @slot parameters Object of class \code{"transformation"} -- flow parameter
#' to be transformed
#' @slot transformationId Object of class \code{"character"} -- unique ID to 
#' reference the transformation.
#' 
#' @section Extends:
#' Class \code{"\linkS4class{singleParameterTransform}"}, directly.
#' 
#' Class \code{"\linkS4class{transform}"}, by class "singleParameterTransform", distance 2.
#' 
#' Class \code{"\linkS4class{transformation}"}, by class "singleParameterTransform", distance 3.
#' 
#' Class \code{"\linkS4class{characterOrTransformation}"}, by class "singleParameterTransform", distance 4.
#' 
#' @author Gopalakrishnan N, F.Hahne
#' @seealso sinht
#' @family mathematical transform classes
#' @references Gating-ML Candidate Recommendation for Gating Description in
#' Flow Cytometry V 1.5
#' @keywords classes
#' @examples
#' 
#'  dat <- read.FCS(system.file("extdata","0877408774.B08",  package="flowCore"))
#'   asinh1<-asinht(parameters="FSC-H",a=2,b=1,transformationId="asinH1")
#'   transOut<-eval(asinh1)(exprs(dat))
#' 
#' @export
setClass("asinht", 		
         contains="singleParameterTransform",
         representation=representation(a="numeric",
                                       b="numeric"),
         prototype=prototype(parameters=unitytransform(), a=1, b=1),
         validity=function(object) 
     {
         msg <- NULL
         if(length(object@parameters)!=1)
             msg <- c(msg, "Inverse hypberbolic transform is defined for one parameter")
         if(object@a==0)
             msg <- c(msg, "'a' should be a non-zero number")
         if(object@b==0)
             msg <- c(msg, "'b' should be a non-zero number")
         msg
     })

#' @export
asinht <- function(parameters="NULL", a=1, b=1,
                   transformationId="defaultAsinhTransform")
    new("asinht", parameters=parameters, a=a, b=b,
        transformationId=transformationId)



## ===========================================================================
##  Hyperbolic sin Transformation 
## ---------------------------------------------------------------------------
## inputs a,b of type numeric and parameter of type transformation or character
## ---------------------------------------------------------------------------
#' Class "sinht"
#' 
#' Hyperbolic sin transform class, which represents a transformation 
#' defined by the function: 
#' \deqn{f(parameter,a,b)=sinh(parameter/b)/a} 
#' This definition is such that it can function as an inverse of 
#' \code{\linkS4class{asinht}} using the same definitions of the constants a
#' and b.
#' 
#' @name sinht-class
#' @aliases sinht-class sinht eval,sinht,missing-method
#' @docType class
#' @note The transformation object can be evaluated using the eval method by
#' passing the data frame as an argument.The transformed parameters are
#' returned as a matrix with a single column.(See example below)
#' 
#' @section Objects from the Class: Objects can be created by calls to the
#' constructor \code{sinht(parameter,a,b,transformationId)}.
#' 
#' @slot .Data Object of class \code{"function"}.
#' @slot a Object of class \code{"numeric"} -- non-zero constant.
#' @slot b Object of class \code{"numeric"} -- non-zero constant.
#' @slot parameters Object of class \code{"transformation"} -- flow parameter
#' to be transformed
#' @slot transformationId Object of class \code{"character"} -- unique ID to 
#' reference the transformation.
#' 
#' @section Extends:
#' Class \code{"\linkS4class{singleParameterTransform}"}, directly.
#' 
#' Class \code{"\linkS4class{transform}"}, by class "singleParameterTransform", distance 2.
#' 
#' Class \code{"\linkS4class{transformation}"}, by class "singleParameterTransform", distance 3.
#' 
#' Class \code{"\linkS4class{characterOrTransformation}"}, by class "singleParameterTransform", distance 4.
#' 
#' @author Gopalakrishnan N, F.Hahne
#' @seealso asinht
#' @family mathematical transform classes
#' @references Gating-ML Candidate Recommendation for Gating Description in
#' Flow Cytometry V 1.5
#' @keywords classes
#' @examples
#' 
#'  dat <- read.FCS(system.file("extdata","0877408774.B08",  package="flowCore"))
#'  sinh1<-sinht(parameters="FSC-H",a=1,b=2000,transformationId="sinH1")
#'  transOut<-eval(sinh1)(exprs(dat))
#' 
#' @export
setClass("sinht", 		
         contains="singleParameterTransform",
         representation=representation(a="numeric",
                                       b="numeric"),
         prototype=prototype(parameters=unitytransform(),
                             a=1,
                             b=1),
         validity=function(object) 
     {
         msg <- NULL
         if(length(object@parameters)!=1)
             msg <- c(msg, "Hypberbolic transform is defined for one parameter")
         if(object@a==0)
             msg <- c(msg, "'a' should be a non-zero number")
         if(object@b==0)
             msg <- c(msg, "'b' should be a non-zero number")
         msg
     })

#' @export
sinht <- function(parameters, a=1, b=1,
                  transformationId="defaultSinhtTransform")
    new("sinht", parameters=parameters, a=a, b=b,
        transformationId=transformationId)




## ================================================================================
## Inverse hyperbolic sin transformation parametrized according to Gating-ML 2.0 
## --------------------------------------------------------------------------------
## Inputs T, M, A of type numeric and parameter of type transformation or character
##
## October 2014: additional boundMin and boundMax attributes to all Gating-ML 2.0
## transforms; if the result of the transform is outside of that range then set it
## to the appropriate boundMin/boundMax.
## --------------------------------------------------------------------------------
#' Class asinhtGml2
#' 
#' Inverse hyperbolic sin transformation as parameterized in Gating-ML 2.0. 
#' 
#' asinhtGml2 is defined by the following function: 
#' \deqn{bound(f, boundMin, boundMax) = max(min(f,boundMax),boundMin))} where 
#' \deqn{f(parameter, T, M, A) = (asinh(parameter * sinh(M * ln(10)) / T) +A * ln(10)) / ((M + A) * ln(10))}
#' 
#' This transformation is equivalent to Logicle(T, 0, M, A) (i.e., with W=0).
#' It provides an inverse hyperbolic sine transformation that maps a data value
#' onto the interval [0,1] such that: 
#' \itemize{ 
#' \item The top of scale value (i.e., T ) is mapped to 1.  
#' \item Large data values are mapped to locations similar to an 
#' (M + A)-decade logarithmic scale.  
#' \item A decades of negative data are brought on scale.
#' }
#' 
#' In addition, if a boundary is defined by the boundMin and/or boundMax
#' parameters, then the result of this transformation is restricted to the
#' [boundMin,boundMax] interval. Specifically, should the result of the f
#' function be less than boundMin, then let the result of this transformation
#' be boundMin. Analogically, should the result of the f function be more than
#' boundMax, then let the result of this transformation be boundMax. The
#' boundMin parameter shall not be greater than the boundMax parameter.
#' 
#' 
#' @name asinhtGml2-class
#' @aliases asinhtGml2-class asinhtGml2 eval,asinhtGml2,missing-method
#' @docType class
#' @note The inverse hyperbolic sin transformation object can be evaluated
#' using the eval method by passing the data frame as an argument. The
#' transformed parameters are returned as a matrix with a single column. (See
#' example below)
#' @section Objects from the Class: Objects can be created by calls to the
#' constructor
#' 
#' \code{asinhtGml2(parameter, T, M, A, transformationId, boundMin, boundMax)}
#' 
#' @slot .Data Object of class \code{function}.
#' @slot T Object of class \code{numeric} -- positive constant (top of scale value).
#' @slot M Object of class \code{numeric} -- positive constant (desired number of decades).
#' @slot A Object of class \code{numeric} -- non-negative constant that is less than or equal 
#' to M (desired number of additional negative decades).
#' @slot parameters Object of class \code{"transformation"} -- flow parameter to be transformed.
#' @slot transformationId Object of class \code{"character"} -- unique ID to reference the transformation.
#' @slot boundMin Object of class \code{numeric} -- lower bound of the transformation, default -Inf.
#' @slot boundMax Object of class \code{numeric} -- upper bound of the transformation, default Inf.
#' 
#' @section Extends:
#' Class \code{\linkS4class{singleParameterTransform}}, directly.
#' 
#' Class \code{\linkS4class{transform}}, by class singleParameterTransform, distance 2.
#' 
#' Class \code{\linkS4class{transformation}}, by class singleParameterTransform, distance 3.
#' 
#' Class \code{\linkS4class{characterOrTransformation}}, by class singleParameterTransform, distance 4.
#' 
#' @author Spidlen, J.
#' @seealso \code{\link{asinht}}, \code{\link{transform-class}},
#' \code{\link{transform}}
#' @family mathematical transform classes
#' @references Gating-ML 2.0: International Society for Advancement of
#' Cytometry (ISAC) standard for representing gating descriptions in flow
#' cytometry. \url{http://flowcyt.sourceforge.net/gating/20141009.pdf}
#' @keywords classes
#' @examples
#' 
#' myDataIn <- read.FCS(system.file("extdata", "0877408774.B08", 
#'     package="flowCore"))
#' myASinH1 <- asinhtGml2(parameters = "FSC-H", T = 1000, M = 4.5, 
#'     A = 0, transformationId="myASinH1")
#' transOut <- eval(myASinH1)(exprs(myDataIn))
#' 
#' @export
setClass(
    "asinhtGml2", 		
    contains = "singleParameterTransform",
    representation = representation(T = "numeric", M = "numeric", A = "numeric", boundMin = "numeric", boundMax = "numeric"),
    prototype = prototype(
        parameters = unitytransform(),
        T = 262144,
        M = 4.5,
        A = 0,
        boundMin = -Inf,
        boundMax = Inf),
    validity = function(object)
    {
        msg <- NULL
        if (length(object@parameters) != 1)
            msg <- c(msg, "Inverse hyperbolic sin transformation is defined for one parameter.")
        if (object@T <= 0)
            msg <- c(msg, "'T' should be greater than zero.")
        if (object@M <= 0)
            msg <- c(msg, "'M' should be greater than zero.")
        if (object@A < 0)
            msg <- c(msg, "'A' should be greater than or equal to zero.")
        if (object@A > object@M)
            msg <- c(msg, "'A' should be less than or equal to 'M'.")
        if (object@boundMin > object@boundMax)
          msg <- c(msg, "'boundMin' should be less than or equal to 'boundMax'")
        msg
    }
)

#' @export
asinhtGml2 <- function(
        parameters, 
        T = 262144, 
        M = 4.5, 
        A = 0, 
        transformationId = "defaultAsinhGml2Transform",
        boundMin = -Inf,
        boundMax = Inf)
    new("asinhtGml2", parameters = parameters, 
        T = T, M = M, A = A, transformationId = transformationId, boundMin = boundMin, boundMax = boundMax)


## ===================================================================================
## Logicle transformation parametrized according to Gating-ML 2.0
## -----------------------------------------------------------------------------------
## Inputs T, M, W, A of type numeric and parameter of type transformation or character
##
## October 2014: additional boundMin and boundMax attributes to all Gating-ML 2.0
## transforms; if the result of the transform is outside of that range then set it
## to the appropriate boundMin/boundMax.
## -----------------------------------------------------------------------------------
#' Class logicletGml2
#' 
#' Logicle transformation as published by Moore and Parks.
#' 
#' logicletGml2 is defined by the
#' following function: 
#' \deqn{bound(logicle, boundMin, boundMax) = max(min(logicle,boundMax),boundMin))} 
#' where \deqn{logicle(x, T, W, M, A) = root(B(y, T, W, M, A) - x)} and \eqn{B} 
#' is a modified biexponential function: 
#' \deqn{B(y, T, W, M, A) = ae^{by} - ce^{-dy} - f} where 
#' \itemize{
#' \item x is the value that is being transformed (an FCS dimension value).
#' Typically, x is less than or equal to T, although the transformation
#' function is also defined for x greater than T.
#' \item y is the result of the transformation.
#' \item T is greater than zero and represents the top of
#' scale value.
#' \item M is greater than zero and represents the number of
#' decades that the true logarithmic scale approached at the high end of the
#' Logicle scale would cover in the plot range.
#' \item W is non-negative and not greater than half of M and represents the 
#' number of such decades in the approximately linear region. The choice of 
#' \eqn{W = M/2} specifies a scale that is essentially linear over the whole 
#' range except for a small region of large data values. For situations in which 
#' values of W approaching \eqn{M/2} might be chosen, ordinary linear display scales 
#' will usually be more appropriate. The choice of \eqn{W = 0} gives essentially the 
#' hyperbolic sine function.
#' \item A is the number of additional decades of negative data
#' values to be included. A shall be greater than or equal to \eqn{-W}, and
#' less than or equal to \eqn{M - 2W}
#' \item root is a standard root finding
#' algorithm (e.g., Newton's method) that finds y such as \eqn{B(y, T, W, M, A)
#' = x}.
#' } 
#' and \eqn{a}, \eqn{b}, \eqn{c}, \eqn{d} and \eqn{f} are defined by
#' means of \eqn{T}, \eqn{W}, \eqn{M}, \eqn{A}, \eqn{w}, \eqn{x0}, \eqn{x1},
#' \eqn{x2}, \eqn{ca} and \eqn{fa} as: 
#' \deqn{w = W/(M+A)} \deqn{x2 = A/(M+A)}
#' \deqn{x1 = x2 + w} 
#' \deqn{x0 = x2 + 2*w} 
#' \deqn{b = (M + A)*ln(10)} and
#' \eqn{d} is a constant so that \deqn{2*(ln(d) - ln(b)) + w*(d + b) = 0} given
#' \eqn{b} and \eqn{w}, and 
#' \deqn{ca = e^{x0*(b+d)}} 
#' \deqn{fa = e^{b*x1} - (ca/(e^{d*x1}))} 
#' \deqn{a = T / (e^b - fa - (ca/e^d)) } \deqn{c = ca * a}
#' \deqn{f = fa * a}
#' 
#' The Logicle scale is the inverse of a modified biexponential function. It
#' provides a Logicle display that maps scale values onto the \eqn{[0,1]}
#' interval such that the data value \eqn{T} is mapped to 1, large data values
#' are mapped to locations similar to an (M + A)-decade logarithmic scale, and
#' A decades of negative data are brought on scale. For implementation
#' purposes, it is recommended to follow guidance in Moore and Parks
#' publication.
#' 
#' In addition, if a boundary is defined by the boundMin and/or boundMax
#' parameters, then the result of this transformation is restricted to the
#' [boundMin,boundMax] interval. Specifically, should the result of the logicle
#' function be less than boundMin, then let the result of this transformation
#' be boundMin. Analogically, should the result of the logicle function be more
#' than boundMax, then let the result of this transformation be boundMax. The
#' boundMin parameter shall not be greater than the boundMax parameter.
#' 
#' 
#' @name logicletGml2-class
#' @aliases logicletGml2-class logicletGml2 eval,logicletGml2,missing-method
#' @docType class
#' @note Please note that \code{logicletGml2} and
#' \code{\link{logicleTransform}} are similar transformations; however, the
#' Gating-ML 2.0 compliant \code{logicletGml2} brings "reasonable" data values
#' to the scale of \eqn{[0,1]} while the \code{\link{logicleTransform}} scales
#' these values to \eqn{[0,M]}.
#' 
#' The logicle transformation object can be evaluated using the eval method by
#' passing the data frame as an argument. The transformed parameters are
#' returned as a matrix with a single column. (See example below)
#' @section Objects from the Class: Objects can be created by calls to the
#' constructor
#' 
#' \code{logicletGml2(parameter, T, M, W, A, transformationId, boundMin,
#' boundMax)}
#' 
#' @slot .Data Object of class \code{function}.
#' @slot T Object of class \code{numeric} -- positive constant (top of scale value).
#' @slot M Object of class \code{numeric} -- positive constant (desired number of decades).
#' @slot W Object of class \code{numeric} -- non-negative constant that is not greater than half of M
#' (the number of such decades in the approximately linear region).
#' @slot A Object of class \code{numeric} -- a constant that is greater than or equal to -W, and also
#' less than or equal to M-2W. (A represents the number of additional decades of negative data values to 
#' be included.)
#' @slot parameters Object of class \code{"transformation"} -- flow parameter to be transformed.
#' @slot transformationId Object of class \code{"character"} -- unique ID to reference the transformation.
#' @slot boundMin Object of class \code{numeric} -- lower bound of the transformation, default -Inf.
#' @slot boundMax Object of class \code{numeric} -- upper bound of the transformation, default Inf.
#' 
#' @section Extends:
#' Class \code{\linkS4class{singleParameterTransform}}, directly.
#' 
#' Class \code{\linkS4class{transform}}, by class singleParameterTransform, distance 2.
#' 
#' Class \code{\linkS4class{transformation}}, by class singleParameterTransform, distance 3.
#' 
#' Class \code{\linkS4class{characterOrTransformation}}, by class singleParameterTransform, distance 4.
#' 
#' @author Spidlen, J., Moore, W.
#' @seealso \code{\link{logicleTransform}}, \code{\link{transform-class}},
#' \code{\link{transform}}
#' @family mathematical transform classes
#' @references Gating-ML 2.0: International Society for Advancement of
#' Cytometry (ISAC) standard for representing gating descriptions in flow
#' cytometry. \url{http://flowcyt.sourceforge.net/gating/20141009.pdf}
#' 
#' Moore, WA and Parks, DR. Update for the logicle data scale including
#' operational code implementations. Cytometry A., 2012:81A(4):273-277.
#' 
#' Parks, DR and Roederer, M and Moore, WA. A new "Logicle" display method
#' avoids deceptive effects of logarithmic scaling for low signals and
#' compensated data. Cytometry A., 2006:69(6):541-551.
#' @keywords classes
#' @examples
#' 
#' myDataIn  <- read.FCS(system.file("extdata", "0877408774.B08", 
#'     package="flowCore"))
#' myLogicle <- logicletGml2(parameters = "FSC-H", T = 1023, M = 4.5, 
#'     W = 0.5, A = 0, transformationId="myLogicle")
#' transOut  <- eval(myLogicle)(exprs(myDataIn))
#' 
#' @export
setClass(
    "logicletGml2", 		
    contains = "singleParameterTransform",
    representation = representation(T = "numeric", M = "numeric", W = "numeric", A = "numeric", boundMin = "numeric", boundMax = "numeric"),
    prototype = prototype(
        parameters = unitytransform(),
            T = 262144,
            M = 4.5,
            W = 0.5,
            A = 0,
            boundMin = -Inf,
            boundMax = Inf),
    validity = function(object)
    {
        msg <- NULL
        if (length(object@parameters) != 1)
            msg <- c(msg, "Logicle transformation is defined for one parameter.")
        if (object@T <= 0)
            msg <- c(msg, "'T' should be greater than zero.")
        if (object@M <= 0)
            msg <- c(msg, "'M' should be greater than zero.")
        if (object@W < 0)
            msg <- c(msg, "'W' should be greater than or equal to zero.")
        if (object@W > object@M/2)
            msg <- c(msg, "'W' should be less than or equal to half of 'M'.")
        if (object@A < -object@W)
            msg <- c(msg, "'A' should be greater than or equal to 'minus W'.")
        if (object@A > object@M - 2*object@W)
            msg <- c(msg, "'A' should be less than or equal to 'M minus two W'")
        if (object@boundMin > object@boundMax)
          msg <- c(msg, "'boundMin' should be less than or equal to 'boundMax'")
        msg
    }
)

#' @export
logicletGml2 <- function(
    parameters,
    T = 262144,
    M = 4.5,
    W = 0.5,
    A = 0,
    transformationId = "defaultLogicletGml2Transform",
    boundMin = -Inf,
    boundMax = Inf)
    new("logicletGml2", parameters = parameters,
        T = T, M = M, W = W, A = A, transformationId = transformationId, boundMin = boundMin, boundMax = boundMax)


## ===================================================================================
## Hyperlog transformation parametrized according to Gating-ML 2.0
## -----------------------------------------------------------------------------------
## Inputs T, M, W, A of type numeric and parameter of type transformation or character
##
## October 2014: additional boundMin and boundMax attributes to all Gating-ML 2.0
## transforms; if the result of the transform is outside of that range then set it
## to the appropriate boundMin/boundMax.
## -----------------------------------------------------------------------------------
#' Class hyperlogtGml2
#' 
#' Hyperlog transformation parameterized according to Gating-ML 2.0.
#' 
#' hyperlogtGml2 is defined by the following function: 
#' \deqn{bound(hyperlog, boundMin, boundMax) = max(min(hyperlog,boundMax),boundMin))} 
#' where \deqn{hyperlog(x, T, W, M, A) = root(EH(y, T, W, M, A) - x)} and 
#' \eqn{EH} is defined as: 
#' \deqn{EH(y, T, W, M, A) = ae^{by} + cy - f} where 
#' \itemize{ 
#' \item x is the value that is being
#' transformed (an FCS dimension value). Typically, x is less than or equal to
#' T, although the transformation function is also defined for x greater than
#' T.
#' \item y is the result of the transformation.
#' \item T is greater than zero and represents the top of scale value.
#' \item M is greater than zero and represents the number of decades that the 
#' true logarithmic scale approached at the high end of the Hyperlog scale would 
#' cover in the plot range.
#' \item W is positive and not greater than half of M and represents the number of 
#' such decades in the approximately linear region.
#' \item A is the number of additional decades of negative data values to be included. A
#' shall be greater than or equal to \eqn{-W}, and less than or equal to \eqn{M
#' - 2W}
#' \item root is a standard root finding algorithm (e.g., Newton's
#' method) that finds y such as \eqn{B(y, T, W, M, A) = x}. } and \eqn{a},
#' \eqn{b}, \eqn{c} and \eqn{f} are defined by means of \eqn{T}, \eqn{W},
#' \eqn{M}, \eqn{A}, \eqn{w}, \eqn{x0}, \eqn{x1}, \eqn{x2}, \eqn{e0}, \eqn{ca}
#' and \eqn{fa} as: 
#' \deqn{w = W/(M+A)} 
#' \deqn{x2 = A/(M+A)} 
#' \deqn{x1 = x2 + w}
#' \deqn{x0 = x2 + 2*w} 
#' \deqn{b = (M + A)*ln(10)} 
#' \deqn{e0 = e^{b*x0}} 
#' \deqn{ca= e0/w} 
#' \deqn{fa = e^{b*x1} + ca*x1} 
#' \deqn{a = T / (e^b + ca - fa)} 
#' \deqn{c = ca * a} 
#' \deqn{f = fa * a}
#' 
#' In addition, if a boundary is defined by the boundMin and/or boundMax
#' parameters, then the result of this transformation is restricted to the
#' [boundMin,boundMax] interval. Specifically, should the result of the
#' hyperlog function be less than boundMin, then let the result of this
#' transformation be boundMin. Analogically, should the result of the hyperlog
#' function be more than boundMax, then let the result of this transformation
#' be boundMax. The boundMin parameter shall not be greater than the boundMax
#' parameter.
#' 
#' 
#' @name hyperlogtGml2-class
#' @aliases hyperlogtGml2-class hyperlogtGml2 eval,hyperlogtGml2,missing-method
#' @docType class
#' @note That \code{hyperlogtGml2} transformation brings "reasonable" data
#' values to the scale of \eqn{[0,1]}.  The transformation is somewhat similar
#' to \code{\link{logicletGml2}}. (See Gating-ML 2.0 for detailed comparison)
#' 
#' The hyperlog transformation object can be evaluated using the eval method by
#' passing the data frame as an argument. The transformed parameters are
#' returned as a matrix with a single column. (See example below)
#' @section Objects from the Class: Objects can be created by calls to the
#' constructor
#' 
#' \code{hyperlogtGml2(parameter, T, M, W, A, transformationId, boundMin,
#' boundMax)}
#' 
#' @slot .Data Object of class \code{function}.
#' @slot T Object of class \code{numeric} -- positive constant (top of scale value).
#' @slot M Object of class \code{numeric} -- positive constant (desired number of decades).
#' @slot W Object of class \code{numeric} -- positive constant that is not greater than half of M
#' (the number of such decades in the approximately linear region)
#' @slot A Object of class \code{numeric} -- a constant that is greater than or equal to -W, and also
#' less than or equal to M-2W. (A represents the number of additional decades of negative data values to 
#' be included.)
#' @slot parameters Object of class \code{"transformation"} -- flow parameter to be transformed.
#' @slot transformationId Object of class \code{"character"} -- unique ID to reference the transformation.
#' @slot boundMin Object of class \code{numeric} -- lower bound of the transformation, default -Inf.
#' @slot boundMax Object of class \code{numeric} -- upper bound of the transformation, default Inf.
#' 
#' @section Extends:
#' Class \code{\linkS4class{singleParameterTransform}}, directly.
#' 
#' Class \code{\linkS4class{transform}}, by class singleParameterTransform, distance 2.
#' 
#' Class \code{\linkS4class{transformation}}, by class singleParameterTransform, distance 3.
#' 
#' Class \code{\linkS4class{characterOrTransformation}}, by class singleParameterTransform, distance 4.
#' 
#' @author Spidlen, J., Moore, W.
#' @seealso \code{\link{hyperlog}}, \code{\link{logicleTransform}},
#' \code{\link{transform-class}}, \code{\link{transform}}
#' @family mathematical transform classes
#' @references Gating-ML 2.0: International Society for Advancement of
#' Cytometry (ISAC) standard for representing gating descriptions in flow
#' cytometry. \url{http://flowcyt.sourceforge.net/gating/20141009.pdf}
#' @keywords classes
#' @examples
#' 
#' myDataIn  <- read.FCS(system.file("extdata", "0877408774.B08", 
#'     package="flowCore"))
#' myHyperLg <- hyperlogtGml2(parameters = "FSC-H", T = 1023, M = 4.5, 
#'     W = 0.5, A = 0, transformationId="myHyperLg")
#' transOut  <- eval(myHyperLg)(exprs(myDataIn))
#' 
#' @export
setClass(
    "hyperlogtGml2",
    contains = "singleParameterTransform",
    representation = representation(T = "numeric", M = "numeric", W = "numeric", A = "numeric", boundMin = "numeric", boundMax = "numeric"),
    prototype = prototype(
        parameters = unitytransform(),
        T = 262144,
        M = 4.5,
        W = 0.5,
        A = 0,
        boundMin = -Inf,
        boundMax = Inf),
    validity = function(object)
    {
        msg <- NULL
        if (length(object@parameters) != 1)
            msg <- c(msg, "Logicle transformation is defined for one parameter.")
        if (object@T <= 0)
            msg <- c(msg, "'T' should be greater than zero.")
        if (object@M <= 0)
            msg <- c(msg, "'M' should be greater than zero.")
        if (object@W <= 0)
            msg <- c(msg, "'W' should be greater than zero.")
        if (object@W > object@M/2)
            msg <- c(msg, "'W' should be less than or equal to half of 'M'.")
        if (object@A < -object@W)
            msg <- c(msg, "'A' should be greater than or equal to 'minus W'.")
        if (object@A > object@M - 2*object@W)
            msg <- c(msg, "'A' should be less than or equal to 'M minus two W'")
        if (object@boundMin > object@boundMax)
          msg <- c(msg, "'boundMin' should be less than or equal to 'boundMax'")
        msg
    }
)

#' @export
hyperlogtGml2 <- function(
    parameters,
    T = 262144,
    M = 4.5,
    W = 0.5,
    A = 0,
    transformationId = "defaultHyperlogtGml2Transform",
    boundMin = -Inf,
    boundMax = Inf)
    new("hyperlogtGml2", parameters = parameters,
        T = T, M = M, W = W, A = A, transformationId = transformationId, boundMin = boundMin, boundMax = boundMax)

## ================================================================================
## Linear transformation parametrized according to Gating-ML 2.0
## --------------------------------------------------------------------------------
## Inputs T, A of type numeric and parameter of type transformation or character
##
## October 2014: additional boundMin and boundMax attributes to all Gating-ML 2.0
## transforms; if the result of the transform is outside of that range then set it
## to the appropriate boundMin/boundMax.
## --------------------------------------------------------------------------------
#' Class lintGml2
#' 
#' Linear transformation as parameterized in Gating-ML 2.0.
#' 
#' lintGml2 is defined by the following function: 
#' \deqn{bound(f, boundMin, boundMax) = max(min(f,boundMax),boundMin))} where 
#' \deqn{f(parameter, T, A) = (parameter + A) / (T + A)}
#' 
#' This transformation provides a linear display that maps scale values from
#' the \eqn{[-A, T]} interval to the \eqn{[0, 1]} interval.  However, it is
#' defined for all \eqn{x in R} including outside of the \eqn{[-A, T]}
#' interval.
#' 
#' In addition, if a boundary is defined by the boundMin and/or boundMax
#' parameters, then the result of this transformation is restricted to the
#' [boundMin,boundMax] interval. Specifically, should the result of the f
#' function be less than boundMin, then let the result of this transformation
#' be boundMin. Analogically, should the result of the f function be more than
#' boundMax, then let the result of this transformation be boundMax. The
#' boundMin parameter shall not be greater than the boundMax parameter.
#' 
#' 
#' @name lintGml2-class
#' @aliases lintGml2-class lintGml2 eval,lintGml2,missing-method
#' @docType class
#' @note The linear transformation object can be evaluated using the eval
#' method by passing the data frame as an argument. The transformed parameters
#' are returned as a matrix with a single column. (See example below)
#' @section Objects from the Class: Objects can be created by calls to the
#' constructor
#' 
#' \code{lintGml2(parameter, T, A, transformationId, boundMin, boundMax)}
#' 
#' @slot .Data Object of class \code{function}.
#' @slot T Object of class \code{numeric} -- positive constant (top of scale value).
#' @slot A Object of class \code{numeric} -- non-negative constant that is less than or equal
#' to T; it is determining the bottom end of the transformation.
#' @slot parameters Object of class \code{"transformation"} -- flow parameter to be transformed.
#' @slot transformationId Object of class \code{"character"} -- unique ID to reference the transformation.
#' @slot boundMin Object of class \code{numeric} -- lower bound of the transformation, default -Inf.
#' @slot boundMax Object of class \code{numeric} -- upper bound of the transformation, default Inf.
#' 
#' @section Extends:
#' Class \code{\linkS4class{singleParameterTransform}}, directly.
#' 
#' Class \code{\linkS4class{transform}}, by class singleParameterTransform, distance 2.
#' 
#' Class \code{\linkS4class{transformation}}, by class singleParameterTransform, distance 3.
#' 
#' Class \code{\linkS4class{characterOrTransformation}}, by class singleParameterTransform, distance 4.
#' 
#' @author Spidlen, J.
#' @seealso \code{\link{linearTransform}}, \code{\link{transform-class}},
#' \code{\link{transform}}
#' @family mathematical transform classes
#' @references Gating-ML 2.0: International Society for Advancement of
#' Cytometry (ISAC) standard for representing gating descriptions in flow
#' cytometry. \url{http://flowcyt.sourceforge.net/gating/20141009.pdf}
#' @keywords classes
#' @examples
#' 
#' myDataIn <- read.FCS(system.file("extdata", "0877408774.B08", 
#'     package="flowCore"))
#' myLinTr1 <- lintGml2(parameters = "FSC-H", T = 1000, A = 0, 
#'     transformationId="myLinTr1")
#' transOut <- eval(myLinTr1)(exprs(myDataIn))
#' 
#' @export
setClass(
    "lintGml2",
    contains = "singleParameterTransform",
    representation = representation(T = "numeric", A = "numeric", boundMin = "numeric", boundMax = "numeric"),
    prototype = prototype(
        parameters = unitytransform(),
        T = 262144,
        A = 0,
        boundMin = -Inf,
        boundMax = Inf),
    validity = function(object)
    {
        msg <- NULL
        if (length(object@parameters) != 1)
            msg <- c(msg, "Linear transformation is defined for one parameter.")
        if (object@T <= 0)
            msg <- c(msg, "'T' should be greater than zero.")
        if (object@A < 0)
            msg <- c(msg, "'A' should be greater than or equal to zero.")
        if (object@A > object@T)
            msg <- c(msg, "'A' should be less than or equal to 'T'.")
        if (object@boundMin > object@boundMax)
          msg <- c(msg, "'boundMin' should be less than or equal to 'boundMax'")
        msg
    }
)

#' @export
lintGml2 <- function(
    parameters,
    T = 262144,
    A = 0,
    transformationId = "defaultLintGml2Transform",
    boundMin = -Inf,
    boundMax = Inf)
    new("lintGml2", parameters = parameters,
        T = T, A = A, transformationId = transformationId, boundMin = boundMin, boundMax = boundMax)


## ================================================================================
## Log transformation parametrized according to Gating-ML 2.0
## --------------------------------------------------------------------------------
## Inputs T, M of type numeric and parameter of type transformation or character
##
## October 2014: additional boundMin and boundMax attributes to all Gating-ML 2.0
## transforms; if the result of the transform is outside of that range then set it
## to the appropriate boundMin/boundMax.
## --------------------------------------------------------------------------------
#' Class logtGml2
#' 
#' Log transformation as parameterized in Gating-ML 2.0.
#' 
#' logtGml2 is defined by the following function: 
#' \deqn{bound(f, boundMin, boundMax) = max(min(f,boundMax),boundMin))} where 
#' \deqn{f(parameter, T, M) = (1/M) * log10(x/T) + 1}
#' 
#' This transformation provides a logarithmic display that maps scale values
#' from the \eqn{(0, T]} interval to the \eqn{(-Inf, 1]} interval such that the
#' data value T is mapped to 1 and M decades of data are mapped into the
#' interval.  Also, the limit for x going to 0 is -Inf.
#' 
#' In addition, if a boundary is defined by the boundMin and/or boundMax
#' parameters, then the result of this transformation is restricted to the
#' [boundMin,boundMax] interval. Specifically, should the result of the f
#' function be less than boundMin, then let the result of this transformation
#' be boundMin. Analogically, should the result of the f function be more than
#' boundMax, then let the result of this transformation be boundMax. The
#' boundMin parameter shall not be greater than the boundMax parameter.
#' 
#' 
#' @name logtGml2-class
#' @aliases logtGml2-class logtGml2 eval,logtGml2,missing-method
#' @docType class
#' @note The log transformation object can be evaluated using the eval method
#' by passing the data frame as an argument. The transformed parameters are
#' returned as a matrix with a single column. (See example below)
#' @section Objects from the Class: Objects can be created by calls to the
#' constructor
#' 
#' \code{logtGml2(parameter, T, M, transformationId, boundMin, boundMax)}
#' 
#' @slot .Data Object of class \code{function}.
#' @slot T Object of class \code{numeric} -- positive constant (top of scale value).
#' @slot M Object of class \code{numeric} -- positive constant (number of decades).
#' @slot parameters Object of class \code{"transformation"} -- flow parameter to be transformed.
#' @slot transformationId Object of class \code{"character"} -- unique ID to reference the transformation.
#' @slot boundMin Object of class \code{numeric} -- lower bound of the transformation, default -Inf.
#' @slot boundMax Object of class \code{numeric} -- upper bound of the transformation, default Inf.
#' 
#' @section Extends:
#' Class \code{\linkS4class{singleParameterTransform}}, directly.
#' 
#' Class \code{\linkS4class{transform}}, by class singleParameterTransform, distance 2.
#' 
#' Class \code{\linkS4class{transformation}}, by class singleParameterTransform, distance 3.
#' 
#' Class \code{\linkS4class{characterOrTransformation}}, by class singleParameterTransform, distance 4.
#' 
#' @author Spidlen, J.
#' @seealso \code{\link{logTransform}}, \code{\link{transform-class}},
#' \code{\link{transform}}
#' @family mathematical transform classes
#' @references Gating-ML 2.0: International Society for Advancement of
#' Cytometry (ISAC) standard for representing gating descriptions in flow
#' cytometry. \url{http://flowcyt.sourceforge.net/gating/20141009.pdf}
#' @keywords classes
#' @examples
#' 
#' myDataIn <- read.FCS(system.file("extdata", "0877408774.B08", 
#'     package="flowCore"))
#' myLogTr1 <- logtGml2(parameters = "FSC-H", T = 1023, M = 4.5, 
#'     transformationId="myLogTr1")
#' transOut <- eval(myLogTr1)(exprs(myDataIn))
#' 
#' @export
setClass(
    "logtGml2",
    contains = "singleParameterTransform",
    representation = representation(T = "numeric", M = "numeric", boundMin = "numeric", boundMax = "numeric"),
    prototype = prototype(
        parameters = unitytransform(),
        T = 262144,
        M = 4.5,
        boundMin = -Inf,
        boundMax = Inf),
    validity = function(object)
    {
        msg <- NULL
        if (length(object@parameters) != 1)
            msg <- c(msg, "Log transformation is defined for one parameter.")
        if (object@T <= 0)
            msg <- c(msg, "'T' should be greater than zero.")
        if (object@M <= 0)
            msg <- c(msg, "'M' should be greater than zero.")
        if (object@boundMin > object@boundMax)
          msg <- c(msg, "'boundMin' should be less than or equal to 'boundMax'")
        msg
    }
)

#' @export
logtGml2 <- function(
    parameters,
    T = 262144,
    M = 4.5,
    transformationId = "defaultLogGml2Transform",
    boundMin = -Inf,
    boundMax = Inf)
    new("logtGml2", parameters = parameters,
        T = T, M = M, transformationId = transformationId, boundMin = boundMin, boundMax = boundMax)



## ========================================================================================
## Ratio transformation parametrized according to Gating-ML 2.0
## ----------------------------------------------------------------------------------------
## Inputs A, B and C of type numeric and two parameters of type character or transformation
##
## October 2014: additional boundMin and boundMax attributes to all Gating-ML 2.0
## transforms; if the result of the transform is outside of that range then set it
## to the appropriate boundMin/boundMax.
## ----------------------------------------------------------------------------------------
#' Class "ratiotGml2"
#' 
#' Ratio transformation as parameterized in Gating-ML 2.0.
#' 
#' ratiotGml2 is defined by the following function: 
#' \deqn{bound(f, boundMin, boundMax) =
#' max(min(f,boundMax),boundMin))} where 
#' \deqn{f(p1, p2, A, B, C) = A * (p1 - B) / (p2 - C)}
#' 
#' If a boundary is defined by the boundMin and/or boundMax parameters, then
#' the result of this transformation is restricted to the [boundMin,boundMax]
#' interval. Specifically, should the result of the f function be less than
#' boundMin, then let the result of this transformation be boundMin.
#' Analogically, should the result of the f function be more than boundMax,
#' then let the result of this transformation be boundMax. The boundMin
#' parameter shall not be greater than the boundMax parameter.
#' 
#' 
#' @name ratiotGml2-class
#' @aliases ratiotGml2-class ratiotGml2 eval,ratiotGml2,missing-method
#' initialize,ratiotGml2-method parameters,ratiotGml2-method
#' @docType class
#' @note The ratiotGml2 transformation object can be evaluated using the eval
#' method by passing the data frame as an argument. The transformed parameters
#' are returned as matrix with one column. (See example below)
#' @section Objects from the Class: Objects can be created by calls to the
#' constructor
#' 
#' \code{ratiotGml2(p1, p2, A, B, C, transformationId, boundMin, boundMax)}
#' 
#' @slot .Data Object of class \code{function}.
#' @slot numerator Object of class \code{"transformation"} -- flow parameter to be 
#' used as numerator in the transformation function.
#' @slot denominator Object of class \code{"transformation"} -- flow parameter to be 
#' used as denominator in the transformation function.
#' @slot pA Object of class \code{numeric} constant A.
#' @slot pB Object of class \code{numeric} constant B.
#' @slot pC Object of class \code{numeric} constant C.
#' @slot transformationId Object of class \code{"character"} -- unique ID to reference 
#' the transformation.
#' @slot boundMin Object of class \code{numeric} -- lower bound of the transformation, default -Inf.
#' @slot boundMax Object of class \code{numeric} -- upper bound of the transformation, default Inf.
#' 
#' @section Extends:
#' Class \code{"\linkS4class{transform}"}, directly.
#' 
#' Class \code{"\linkS4class{transformation}"}, by class "transform", distance 2.
#' 
#' Class \code{"\linkS4class{characterOrTransformation}"}, by class "transform", distance 3.
#' 
#' @author Spidlen, J.
#' @seealso \code{\link{ratio}}, \code{\link{transform-class}},
#' \code{\link{transform}}
#' @family mathematical transform classes
#' @references Gating-ML 2.0: International Society for Advancement of
#' Cytometry (ISAC) standard for representing gating descriptions in flow
#' cytometry. \url{http://flowcyt.sourceforge.net/gating/20141009.pdf}
#' @keywords classes
#' @examples
#' 
#' myDataIn <- read.FCS(system.file("extdata", "0877408774.B08", 
#'     package="flowCore"))
#' myRatioT <- ratiotGml2("FSC-H", "SSC-H", pA = 2, pB = 3, 
#'     pC = -10, transformationId = "myRatioT")
#' transOut <- eval(myRatioT)(exprs(myDataIn))
#' 
#' @export
setClass("ratiotGml2",
    contains="transform",
    representation(
        numerator = "transformation", denominator = "transformation",
        pA = "numeric", pB = "numeric", pC = "numeric", boundMin = "numeric", boundMax = "numeric"),
    prototype = prototype(
        numerator=unitytransform(),
        denominator=unitytransform(),
        pA = 1,
        pB = 0,
        pC = 0,
        boundMin = -Inf,
        boundMax = Inf),
    validity = function(object)
    {
      msg <- NULL
      if (object@boundMin > object@boundMax)
        msg <- c(msg, "'boundMin' should be less than or equal to 'boundMax'")
      msg
    }
)

#' @export
ratiotGml2 <- function(
    numerator = unitytransform(),
    denominator = unitytransform(),
	pA = 1,
	pB = 0,
	pC = 0,
	transformationId = "defaultRatioTransform",
	boundMin = -Inf,
	boundMax = Inf)
{
    if(!is(numerator, "transform")){
        checkClass(numerator, "character", 1)
        numerator <- unitytransform(numerator)
    }
    if(!is(denominator, "transform")){
        checkClass(denominator, "character", 1)
        denominator <- unitytransform(denominator)
    }
    new("ratiotGml2", numerator = numerator, denominator = denominator,
        pA = pA, pB = pB, pC = pC, transformationId = transformationId, 
        boundMin = boundMin, boundMax = boundMax)
}


## ===========================================================================
##  Hyperlog Transformation 
## ---------------------------------------------------------------------------
## inputs a,b of type numeric and parameter of type transformation or character
## ---------------------------------------------------------------------------
#' Class "hyperlog"
#' 
#' Hyperlog transformation of a parameter is defined by the function
#' \deqn{f(parameter,a,b)=root{EH(y,a,b)-parameter}}
#' where EH is a function defined by \deqn{EH(y,a,b) = 10^{(\frac{y}{a})} +
#' \frac{b*y}{a}-1, y>=0}
#' \deqn{EH(y,a,b)= -10^{(\frac{-y}{a})} + \frac{b*y}{a}+1, y<0}
#' 
#' 
#' @name hyperlog-class
#' @aliases hyperlog-class hyperlog eval,hyperlog,missing-method
#' @docType class
#' @note The transformation object can be evaluated using the eval method by
#' passing the data frame as an argument.The transformed parameters are
#' returned as a matrix with a single column. (See example below)
#' @section Objects from the Class: Objects can be created by calls to the
#' constructor \code{hyperlog(parameter,a,b,transformationId)}
#' 
#' @slot .Data Object of class \code{"function"}.
#' @slot a Object of class \code{"numeric"} -- numeric constant
#' treater than zero.
#' @slot b Object of class \code{"numeric"} numeric constant greater than zero.
#' @slot parameters Object of class \code{"transformation"} -- flow parameter to be 
#' transformed.
#' @slot transformationId Object of class \code{"character"} -- unique ID to 
#' reference the transformation.
#' 
#' @section Extends:
#' Class \code{"\linkS4class{singleParameterTransform}"}, directly.
#' 
#' Class \code{"\linkS4class{transform}"}, by class "singleParameterTransform", distance 2.
#' 
#' Class \code{"\linkS4class{transformation}"}, by class "singleParameterTransform", distance 3.
#' 
#' Class \code{"\linkS4class{characterOrTransformation}"}, by class "singleParameterTransform", distance 4.
#' 
#' @author Gopalakrishnan N, F.Hahne
#' @seealso EHtrans
#' @family mathematical transform classes
#' @references Gating-ML Candidate Recommendation for Gating Description in
#' Flow Cytometry V 1.5
#' @keywords classes
#' @examples
#' 
#'   dat <- read.FCS(system.file("extdata","0877408774.B08",
#'   package="flowCore"))
#'   hlog1<-hyperlog("FSC-H",a=1,b=1,transformationId="hlog1")
#'   transOut<-eval(hlog1)(exprs(dat))
#' 
#' @export
setClass("hyperlog", 		
         contains="singleParameterTransform",
         representation=representation(a="numeric",
                                       b="numeric"),
         prototype=prototype(parameters=unitytransform(), a=1, b=1),
         validity=function(object) 
     {
         msg <- NULL
         if(length(object@parameters)!=1)
             msg <- c(msg, "Hyperlog transform is defined for one parameter")
         if(object@a<=0)
             msg <- c(msg, "'a' should be greater than zero")
         if(object@b<=0)
             msg <- c(msg, "'b' should be greater than zero")
         msg
     })

#' @export
hyperlog <- function(parameters="NULL", a=1, b=1,
                     transformationId="defaultHyperlogTransform")
    new("hyperlog", parameters=parameters, a=a, b=b,
        transformationId=transformationId)



## ===========================================================================
##  EH Transformation 
## ---------------------------------------------------------------------------
## inputs a,b of type numeric and parameter of type transformation or character
## ---------------------------------------------------------------------------
#' Class "EHtrans"
#' 
#' EH transformation of a parameter is defined by the function
#' \deqn{EH(parameter,a,b)= 10^{(\frac{parameter}{a})} +
#' \frac{b*parameter}{a}-1, parameter>=0}
#' \deqn{-10^{(\frac{-parameter}{a})} + \frac{b*parameter}{a}+1, parameter<0}
#' 
#' 
#' @name EHtrans-class
#' @aliases EHtrans-class EHtrans eval,EHtrans,missing-method
#' @docType class
#' @note The transformation object can be evaluated using the eval method by
#' passing the data frame as an argument.The transformed parameters are
#' returned as a matrix with a single column. (See example below)
#' @section Objects from the Class: Objects can be created by calls to the
#' constructor \code{EHtrans(parameters,a,b,transformationId)}
#' 
#' @slot .Data Object of class \code{"function"}.
#' @slot a Object of class \code{"numeric"} -- numeric constant greater than zero.
#' @slot b Object of class \code{"numeric"} -- numeric constant greater than zero.
#' @slot parameters Object of class \code{"transformation"} -- flow parameter to be 
#' transformed.
#' @slot transformationId Object of class \code{"character"} -- unique ID to reference the transformation.
#' 
#' @section Extends:
#' Class \code{"\linkS4class{singleParameterTransform}"}, directly.
#' 
#' Class \code{"\linkS4class{transform}"}, by class "singleParameterTransform", distance 2.
#' 
#' Class \code{"\linkS4class{transformation}"}, by class "singleParameterTransform", distance 3.
#' 
#' Class \code{"\linkS4class{characterOrTransformation}"}, by class "singleParameterTransform", distance 4.
#' 
#' @author Gopalakrishnan N, F.Hahne
#' @seealso hyperlog
#' @family mathematical transform classes
#' @references Gating-ML Candidate Recommendation for Gating Description in
#' Flow Cytometry V 1.5
#' @keywords classes
#' @examples
#' 
#'   dat <- read.FCS(system.file("extdata","0877408774.B08",
#'                   package="flowCore"))
#'   eh1<-EHtrans("FSC-H",a=1250,b=4,transformationId="eh1")
#'   transOut<-eval(eh1)(exprs(dat))
#' 
#' @export
setClass("EHtrans", 		
         contains="singleParameterTransform",
         representation=representation(a="numeric",
                                       b="numeric"),
         prototype=prototype(parameters=unitytransform(), a=1, b=1),
         validity=function(object) 
     {
         msg <-NULL
         if(length(object@parameters)!=1)
             msg <- c(msg, "EH transform is defined for one parameter")
         if(object@a<=0)
             msg<-c(msg, "'a' should be greater than zero")
         if(object@b<=0)
             msg<-c( msg, "'b' should be greater than zero")
         msg
     })

#' @export
EHtrans <- function(parameters, a=1, b=1,
                    transformationId="defaultEHtransTransform")
    new("EHtrans", parameters=parameters, a=a, b=b,
        transformationId=transformationId)
      
          

## ===========================================================================
##  Splitscale Transformation 
## ---------------------------------------------------------------------------
#' Class "splitscale"
#' 
#' The split scale transformation class defines a transformation that has a
#' logarithmic scale at high values and a linear scale at low values. The
#' transition points are chosen so that the slope of the transformation is
#' continuous at the transition points.
#' 
#' The split scale transformation is defined by the function
#' 
#' \deqn{f(parameter,r,maxValue,transitionChannel) = a*parameter+ b, parameter<=t}
#' \deqn{(parameter,r,maxValue,transitionChannel) = log_{10}(c*parameter)*\frac{r}{d}, parameter > t } where,
#' \deqn{b=\frac{transitionChannel}{2}}
#' \deqn{d=\frac{2*log_{10}(e)*r}{transitionChannel} + log_{10}(maxValue) }
#' \deqn{t=10^{log_{10}t}} \deqn{a= \frac{transitionChannel}{2*t}}
#' \deqn{log_{10}ct=\frac{(a*t+b)*d}{r}} \deqn{c=10^{log_{10}ct}}
#' 
#' 
#' @name splitscale-class
#' @aliases splitscale-class splitscale eval,splitscale,missing-method
#' @docType class
#' @note The transformation object can be evaluated using the eval method by
#' passing the data frame as an argument.The transformed parameters are
#' returned as a matrix with a single column. (See example below)
#' @section Objects from the Class: Objects can be created by calls to the
#' constructor
#' \code{splitscale(parameters,r,maxValue,transitionChannel,transformationId)}
#' 
#' @slot .Data Object of class \code{"function"}.
#' @slot r Object of class \code{"numeric"} -- a positive value indicating the range of the logarithmic 
#' part of the display.
#' @slot maxValue Object of class \code{"numeric"} -- a positive value indicating the maximum value the transformation
#' is applied to.
#' @slot transitionChannel Object of class \code{"numeric"} -- non negative value that indicates where to 
#' split the linear vs. logarithmic transformation.
#' @slot parameters Object of class \code{"transformation"} -- flow parameter to be transformed.
#' @slot transformationId Object of class \code{"character"} -- unique ID to reference the transformation.
#' 
#' @section Extends:
#' Class \code{"\linkS4class{singleParameterTransform}"}, directly.
#' Class \code{"\linkS4class{transform}"}, by class "singleParameterTransform", distance 2.
#' Class \code{"\linkS4class{transformation}"}, by class "singleParameterTransform", distance 3.
#' Class \code{"\linkS4class{characterOrTransformation}"}, by class "singleParameterTransform", distance 4.
#' 
#' @author Gopalakrishnan N, F.Hahne
#' @seealso invsplitscale
#' @family mathematical transform classes
#' @references Gating-ML Candidate Recommendation for Gating Description in
#' Flow Cytometry
#' @keywords classes
#' @examples
#' 
#'   dat <- read.FCS(system.file("extdata","0877408774.B08",package="flowCore"))
#'   sp1<-splitscale("FSC-H",r=768,maxValue=10000,transitionChannel=256)
#'   transOut<-eval(sp1)(exprs(dat))
#' 
#' @export
setClass("splitscale", 		
         contains="singleParameterTransform",
         representation=representation(r="numeric",
                                       maxValue="numeric",
                                       transitionChannel="numeric"),
         prototype=prototype(parameters=unitytransform(),
                             r=1,
                             maxValue=1,
                             transitionChannel=4),
         validity=function(object) 
     {
         msg <-NULL
         if(length(object@parameters)!=1)
             msg<-c(msg, "Split scale transform is defined for one parameter")
         if(object@r<=0)
             msg <- c(msg, "'r' should be a greater than zero")
         if(object@maxValue<=0)
             msg <- c(msg, "maxValue should be a greater than zero")
         if(object@transitionChannel<0)
             msg <- c(msg, "transitionChannel should be a non negative")
         msg
     })

#' @export
splitscale <- function(parameters="NULL", r=1, maxValue=1, transitionChannel=4,
                       transformationId="defaultSplitscaleTransform")
    new("splitscale",
        parameters=parameters, r=r, maxValue=maxValue,
        transitionChannel=transitionChannel,
        transformationId=transformationId)



## ===========================================================================
##  Inverse Splitscale Transformation 
## ---------------------------------------------------------------------------
#' Class "invsplitscale"
#' 
#' As its name suggests, the inverse split scale transformation class represents
#' the inverse transformation of a split scale transformation that has a logarithmic scale at 
#' high values and a linear scale at low values.
#' 
#' The inverse split scale transformation is defined by the function
#' \deqn{f(parameter,r,maxValue,transitionChannel)  \frac{(parameter-b)}{a}, parameter<=t*a + b}
#' \deqn{f(parameter,r,maxValue,transitionChannel) = \frac{10^{parameter*\frac{d}{r}}}{c}, parameter > t*a+b }
#' where 
#' \deqn{b=\frac{transitionChannel}{2}}
#' \deqn{d=\frac{2*log_{10}(e)*r}{transitionChannel} + log_{10}(maxValue) }
#' \deqn{t=10^{log_{10}t}} \deqn{a= \frac{transitionChannel}{2*t}}
#' \deqn{log_{10}ct=\frac{(a*t+b)*d}{r}} \deqn{c=10^{log_{10}ct}}
#' 
#' 
#' @name invsplitscale-class
#' @aliases invsplitscale-class invsplitscale eval,invsplitscale,missing-method
#' @docType class
#' @note The transformation object can be evaluated using the eval method by
#' passing the data frame as an argument.The transformed parameters are
#' returned as a matrix with a single column. (See example below)
#' @section Objects from the Class: Objects can be created by calls to the
#' constructor
#' \code{invsplitscale(parameters,r,maxValue,transitionChannel,transformationId)}
#' 
#' @slot .Data Object of class \code{"function"}.
#' @slot r Object of class \code{"numeric"} -- a positive value indicating
#' the range of the logarithmic part of the dispmlay.
#' @slot maxValue Object of class \code{"numeric"} -- a positive value 
#' indicating the maximum value the transformation is applied to.
#' @slot transitionChannel Object of class \code{"numeric"} -- non negative 
#' value that indicates where to split the linear vs. logarithmic transformation.
#' @slot parameters Object of class \code{"transformation"} -- flow parameter
#' to be transformed.
#' @slot transformationId Object of class \code{"character"} -- unique ID to
#' reference the transformation.
#' 
#' @section Extends:
#' Class \code{"\linkS4class{singleParameterTransform}"}, directly.
#' 
#' Class \code{"\linkS4class{transform}"}, by class "singleParameterTransform", distance 2.
#' 
#' Class \code{"\linkS4class{transformation}"}, by class "singleParameterTransform", distance 3.
#' 
#' Class \code{"\linkS4class{characterOrTransformation}"}, by class "singleParameterTransform", distance 4.
#' 
#' @author Gopalakrishnan N,F.Hahne
#' @seealso splitscale
#' @family mathematical transform classes
#' @references Gating-ML Candidate Recommendation for Gating Description in
#' Flow Cytometry
#' @keywords classes
#' @examples
#' 
#'   dat <- read.FCS(system.file("extdata","0877408774.B08",package="flowCore"))
#'   sp1<-invsplitscale("FSC-H",r=512,maxValue=2000,transitionChannel=512)
#'   transOut<-eval(sp1)(exprs(dat))
#' 
#' @export
setClass("invsplitscale", 		
         contains="singleParameterTransform",
         representation=representation(r="numeric",
                                       maxValue="numeric",
                                       transitionChannel="numeric"),
         prototype=prototype(parameters=unitytransform(),
                             r=1,
                             maxValue=1,
                             transitionChannel=4),
         validity=function(object) 
     {
         msg <- NULL
         if(length(object@parameters)!=1)
             msg <- c(msg, "Split scale transform is defined for one parameter")
         if(object@r<=0)
             msg <- c(msg, "'r' should be a greater than zero")
         if(object@maxValue<=0)
             msg <- c(msg, "'maxValue' should be a greater than zero")
         if(object@transitionChannel<0)
             msg <- c(msg, "'transitionChannel' should be a non negative")
         msg
     })
       
#' @export
invsplitscale <- function(parameters, r=1, maxValue=1,
                          transitionChannel=4,
                          transformationId="defaultInvsplitscaleTransforms")
    new("invsplitscale",
        parameters=parameters, r=r, maxValue=maxValue,
        transitionChannel=transitionChannel,
        transformationId=transformationId)
      


## ===========================================================================
## Transformation reference
## ---------------------------------------------------------------------------
## Reference to a transformation defined previously
## ---------------------------------------------------------------------------
#' Class "transformReference"
#' 
#' Class allowing for reference of transforms, for instance as parameters.
#' 
#' 
#' @name transformReference-class
#' @aliases transformReference-class transformReference
#' parameters,transformReference-method eval,transformReference,missing-method
#' @docType class
#' @section Objects from the Class: Objects will be created internally whenever
#' necessary and this should not be of any concern to the user.
#' 
#' @slot .Data The list of references.
#' @slot searchEnv The environment into which the reference points.
#' @slot transformationId The name of the transformation.
#' 
#' @section Extends:
#' Class \code{"\linkS4class{transform}"}, directly.
#' Class \code{"\linkS4class{transformation}"}, by class "transform", distance 2.
#' Class \code{"\linkS4class{characterOrTransformation}"}, by class "transform", distance 3.
#' 
#' @author N. Gopalakrishnan
#' @keywords classes
#'
#' @export 
setClass("transformReference",
         contains="transform",
         representation(searchEnv="environment"))

#' @export
transformReference <- function(referenceId="defaultTransformReference",
                               searchEnv)
    new("transformReference",
        transformationId=referenceId, searchEnv=searchEnv)
RGLab/flowCore documentation built on March 19, 2024, 9:45 p.m.
rdrr.io home R language documentation Run R code online
CRAN packages Bioconductor packages R-Forge packages GitHub packages
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
RGLab/flowCore
flowCore: Basic structures for flow cytometry data

R/AllClasses.R
In RGLab/flowCore: flowCore: Basic structures for flow cytometry data

R Package Documentation

Browse R Packages

We want your feedback!

RGLab/flowCore flowCore: Basic structures for flow cytometry data

R/AllClasses.R In RGLab/flowCore: flowCore: Basic structures for flow cytometry data

R Package Documentation

Browse R Packages

We want your feedback!

RGLab/flowCore
flowCore: Basic structures for flow cytometry data

R/AllClasses.R
In RGLab/flowCore: flowCore: Basic structures for flow cytometry data
