R/curvFilter-methods.R

In flowStats: Statistical methods for the analysis of flow cytometry data

## ==========================================================================
## for curv1Filter
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## 'names' either uses population names generated by the filter
## or can be a character provided by the user.

#' These methods are copied from flowViz to eliminate its dependency on curv1Filter and curv2Filter
#' @description These methods are copied from flowViz to eliminate its dependency on curv1Filter and curv2Filter
#' @param x curv1Filter, curv2Filter
#' @param name character or logical. Names can be generated by the filter or by the user.
#' @param data flowFrame
#' @param ... other arguments
#' @return The methods are called for their side effects. No value is returned.
#' @rdname addName-methods
setMethod("addName",
    signature(x = "curv1Filter", name = "character"), 
    function(x, name, data, ...)
    {
      fd <- filterDetails(data, identifier(x))
      bounds <- fd$boundaries
      if(all(is.na(bounds[[1]])))
        return(invisible())
      data <- flowViz:::checkParameterMatch(parameters(x), verbose=FALSE,...)
      lb <- length(bounds)
      name <- rep(name, lb)
      for(i in 1:lb){
        tmp <- matrix(bounds[[i]], nrow=2)
        colnames(tmp) <- parameters(x)
        addName(x=rectangleGate(.gate=tmp, filterId=name[i]),
            name=name[i], data=data, ...)
      }
      return(invisible())
    })

#'@rdname addName-methods
setMethod("addName",
    signature(x="curv1Filter", name="logical"), 
    function(x, name, data, ...)
    {
      if(name)
        addName(x, names(data)[-1], data=data, ...)
      else
        return(invisible())
    })



## ==========================================================================
## for curv2Filter
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## 'names' either uses population names generated by the filter
## or can be a character provided by the user.
#'@rdname addName-methods
setMethod("addName",
    signature(x="curv2Filter", name="character"), 
    function(x, name, data, ...)
    {
      fd <- filterDetails(data, identifier(x))
      bounds <- fd$polygon
      data <- flowViz:::checkParameterMatch(parameters(x), verbose=FALSE,...)
      lb <- length(bounds)
      name <- rep(name, lb)
      for(i in 1:lb){
        tmp <- cbind(bounds[[i]]$x, bounds[[i]]$y)
        colnames(tmp) <- parameters(x)
        addName(x=polygonGate(.gate=tmp, filterId=name[i]),
            name=name[i], data=data, ...)
      }
      return(invisible())
    })

#'@rdname addName-methods
setMethod("addName",
    signature(x="curv2Filter", name="logical"), 
    function(x, name, data, ...)
    {
      if(name)
        addName(x, names(data)[-1], data=data, ...)
      else
        return(invisible())
    })


## ==========================================================================
## for curv1Filters
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## This filter produces a multipleFilterResult, so we can't subset directly.
## Instead, we split the original frame and plot each component separately
setMethod("glpoints",
    signature(x="curv1Filter", data="flowFrame", channels="character"), 
    function(x, data, channels, verbose=TRUE,
        filterResult=NULL, gpar=flowViz.par.get(), names=FALSE,
        ...)  
    {
      if(is.null(filterResult))
        filterResult <- filter(data, x)
      flowViz:::multFiltPoints(x=x, data=data, channels=channels, verbose=verbose,
          filterResult=filterResult, gpar=gpar$gate, ...)
      addName(x, name=names, data=filterResult, gp=gpar$gate.text,...)
    })




## ==========================================================================
## for curv2Filters
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## This filter produces a multipleFilterResult, so we can't subset directly.
## Instead, we split the original frame and plot each component separately.
setMethod("glpoints",
    signature(x="curv2Filter", data="flowFrame", channels="character"), 
    function(x, data, channels, verbose=TRUE,
        filterResult=NULL, gpar=flowViz.par.get(), names=FALSE,
        ...)
    {
      if(is.null(filterResult))
        filterResult <- filter(data, x)
      flowViz:::multFiltPoints(x=x, data=data, channels=channels, verbose=verbose,
          filterResult=filterResult, gpar=gpar$gate, ...)
      addName(x, name=names, data=filterResult, gp=gpar$gate.text,...)
    })


## ==========================================================================
## for curv1Filters
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## An error if we can't evaluate the filter.
setMethod("glpolygon",
    signature(x="curv1Filter", data="ANY"), 
    function(x, data, ...) flowViz:::evalError("curv1Filters"))

## Filter has been evaluated and the filterResult is provided. We plot this
## as a series of rectangleGates.
setMethod("glpolygon",
    signature(x="curv1Filter", data="multipleFilterResult"), 
    function(x, data, verbose=TRUE, gpar=flowViz.par.get(),
        names=FALSE, ...)
    {
      flowViz:::checkFres(filter=x, fres=data, verbose=verbose)
      fd <- filterDetails(data, identifier(x))
      bounds <- fd$boundaries
      if(all(is.na(bounds[[1]])))
        return(NA)
      lb <- length(bounds)
      ## we want to be able to use different colors for each population
      fill <- rep(gpar$gate$fill, lb)
      col <- rep(gpar$gate$col, lb)
      res <- vector(lb, mode="list")
      n <- if(is.logical(names) && names) names(data)[-1]
          else if(is.character(names)) rep(names, lb)
          else if(is.list(names)) unlist(names)[-1]
          else rep(FALSE, lb)
      for(i in 1:lb){
        tmp <- matrix(bounds[[i]], nrow=2)
        colnames(tmp) <- parameters(x)
        gpar$gate$col <- col[i]
        gpar$gate$fill <- fill[i]
        res[[i]] <- glpolygon(x=rectangleGate(.gate=tmp,
                filterId=as.character(n[i])),
            verbose=FALSE, gpar=gpar,
            names=n[i],
            ...)[[1]]
      }
      return(invisible(res))
    })

## Evaluate the filter and pass on to the filterResult method.
setMethod("glpolygon",
    signature(x="curv1Filter", data="flowFrame"), 
    function(x, data, verbose=TRUE, gpar=flowViz.par.get(), ...)
    {
      fres <- filter(data, x)
      glpolygon(x=x, data=fres, verbose=verbose, gpar=gpar, ...)
    })




## ==========================================================================
## for curv2Filters
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## An error if we can't evaluate the filter.
setMethod("glpolygon",
    signature(x="curv2Filter", data="ANY"), 
    function(x, data, ...)  flowViz:::evalError("curv2Filters")) 

## Filter has been evaluated and the filterResult is provided. We plot this
## as a series of polygonGates.
setMethod("glpolygon",
    signature(x="curv2Filter", data="multipleFilterResult"), 
    function(x, data, verbose=TRUE, gpar=flowViz.par.get(),
        names=FALSE, ...)
    {
      flowViz:::checkFres(filter=x, fres=data, verbose=verbose)
      fd <- filterDetails(data, identifier(x))
      polygons <- fd$polygons
      lf <- length(polygons)
      ## we want to be able to use different colors for each population
      fill <- rep(gpar$gate$fill, lf)
      col <- rep(gpar$gate$col, lf)
      res <- vector(lf, mode="list")
      n <- if(is.logical(names) && names) names(data)[-1]
          else if(is.character(names)) rep(names, lf)
          else if(is.list(names)) unlist(names)[-1]
          else rep(FALSE, lf)
      for(i in 1:lf){
        tmp <- cbind(polygons[[i]]$x, polygons[[i]]$y)
        colnames(tmp) <- parameters(x)
        gpar$gate$col <- col[i]
        gpar$gate$fill <- fill[i]
        res[[i]] <- glpolygon(x=polygonGate(.gate=tmp,
                filterId=as.character(n[i])),
            verbose=FALSE, gpar=gpar,
            names=n[i], ...)[[1]]
      }
      return(invisible(res))
    })

## Evaluate the filter and pass on to the filterResult method.
setMethod("glpolygon",
    signature(x="curv2Filter", data="flowFrame"), 
    function(x, data, verbose=TRUE, gpar=flowViz.par.get(), ...)
    {
      fres <- filter(data, x)
      glpolygon(x=x, data=fres, verbose=verbose, gpar=gpar, ...)
    })


## ==========================================================================
## for curv2Filters
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## An error if we can't evaluate the filter
setMethod("glines",
    signature(x="curv2Filter", data="ANY"), 
    function(x, data, verbose=TRUE, ...) flowViz:::evalError("curv2Filters"))

## Filter has been evaluated and the filterResult is provided
setMethod("glines",
    signature(x="curv2Filter", data="multipleFilterResult"), 
    function(x, data, verbose=TRUE, col, ...)
    {
      flowViz:::checkFres(filter=x, fres=data, verbose=verbose)
      fd <- filterDetails(data, identifier(x))
      parms <- parameters(x)
      polygons <- fd$polygons
      lf <- length(polygons)
      ## we want to use different colors for each population
      if(missing(col))
        col <-  colorRampPalette(brewer.pal(9, "Set1"))(lf)
      else
        col <- rep(col, lf)[1:lf]
      mapply(function(x, co, ...){
            tmp <- cbind(x$x, x$y)
            colnames(tmp) <- parms
            glines(polygonGate(boundaries=tmp), col=co, ...)
          }, x=polygons, co=col, MoreArgs=list(verbose=FALSE, ...))
    })

## Evaluate the filter and plot the filterResult
setMethod("glines",
    signature(x="curv2Filter", data="flowFrame"), 
    function(x, data, verbose=TRUE, ...)
    {
      fres <- filter(data, x)
      glines(x, fres, verbose=verbose, ...)
    })




## ==========================================================================
## for curv1Filters
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## An error if we can't evaluate the filter
setMethod("glines",
    signature(x="curv1Filter", data="ANY"), 
    function(x, data, verbose=TRUE, ...) flowViz:::evalError("curv1Filters"))
setMethod("glines",
    signature(x="curv1Filter", data="missing"), 
    function(x, data, verbose=TRUE, ...) flowViz:::evalError("curv1Filters"))

## Filter has been evaluated and the filterResult is provided
setMethod("glines",
    signature(x="curv1Filter", data="multipleFilterResult"), 
    function(x, data, verbose=TRUE, col, ...)
    {
      flowViz:::checkFres(filter=x, fres=data, verbose=verbose)
      fd <- filterDetails(data, identifier(x))
      parms <- parameters(x)
      bounds <- fd$boundaries
      lb <- length(bounds)
      ## we want to use different colors for each population
      if(missing(col))
        col <-  colorRampPalette(brewer.pal(9, "Set1"))(lb)
      else
        col <- rep(col, lb)[1:lb]
      mapply(function(x, co, ...){
            tmp <- matrix(x, nrow=2)
            colnames(tmp) <- parms
            glines(rectangleGate(.gate=tmp), col=co, ...)
          }, x=bounds, co=col, MoreArgs=list(verbose=FALSE, ...))
      return(invisible(NULL))
    })

## Evaluate the filter and plot the filterResult
setMethod("glines",
    signature(x="curv1Filter", data="flowFrame"), 
    function(x, data, verbose=TRUE, ...){
      fres <- filter(data, x)
      glines(x, fres, verbose=verbose, ...)
    })




## ==========================================================================
## for curv2Filters
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## This filter produces a multipleFilterResult, so we can't subset directly.
## Instead, we split the original frame and plot each component separately
setMethod("gpoints",
    signature(x="curv2Filter", data="flowFrame", channels="character"), 
    function(x, data, channels, verbose=TRUE,
        filterResult=NULL, col, ...)
    {
      ## We check that the filterResult matches the filter and split by that
      channels <- flowViz:::checkParameterMatch(channels, verbose=verbose)
      if(!is.null(filterResult)){
        if(!identical(identifier(x), identifier(filterResult)) ||
            class(x) != class(filterDetails(filterResult,
                    identifier(x))$filter))
          stop("The 'filterResult' and the filter object ",
              "don't match.", call.=FALSE)
        x <- filterResult
      }
      datsplit <- split(data, x)[-1]
      ld <- length(datsplit)
      if(missing(col))
        col <-  colorRampPalette(brewer.pal(9, "Set1"))(ld)
      else
        col <- rep(col, ld)[1:ld]
      mapply(function(z, co, ...) points(exprs(z)[,channels], col=co, ...),
          z=datsplit, co=col, MoreArgs=list(...))
      return(invisible(NULL))
    })




## ==========================================================================
## for curv1Filters
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## This filter produces a multipleFilterResult, so we can't subset directly.
## Instead, we split the original frame and plot each component separately
setMethod("gpoints",
    signature(x="curv1Filter", data="flowFrame", channels="character"), 
    function(x, data, channels, verbose=TRUE,
        filterResult=NULL, col, ...)
    {
      ## We check that the filterResult matches the filter and split by that
      channels <- flowViz:::checkParameterMatch(channels, verbose=verbose,...)
      if(!is.null(filterResult)){
        if(!identical(identifier(x), identifier(filterResult)) ||
            class(x) != class(filterDetails(filterResult,
                    identifier(x))$filter))
          stop("The 'filterResult' and the filter object ",
              "don't match.", call.=FALSE)
        x <- filterResult
      }
      datsplit <- split(data, x)[-1]
      ld <- length(datsplit)
      if(missing(col))
        col <-  colorRampPalette(brewer.pal(9, "Set1"))(ld)
      else
        col <- rep(col, ld)[1:ld]
      mapply(function(z, co, ...) points(exprs(z)[,channels], col=co, ...),
          z=datsplit, co=col, MoreArgs=list(...))
      return(invisible(NULL))
    })






## ==========================================================================
## for curv2Filters
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## An error if we can't evaluate the filter
setMethod("gpolygon",
    signature(x="curv2Filter", data="ANY"), 
    function(x, data, verbose=TRUE, ...) flowViz:::evalError("curv2Filters"))

## Filter has been evaluated and the filterResult is provided
setMethod("gpolygon",
    signature(x="curv2Filter", data="multipleFilterResult"), 
    function(x, data, verbose=TRUE, col, ...)
    {
      flowViz:::checkFres(filter=x, fres=data, verbose=verbose)
      fd <- filterDetails(data, identifier(x))
      parms <- parameters(x)
      polygons <- fd$polygons
      lf <- length(polygons)
      ## we want to use different colors for each population
      if(missing(col)){
        col <-  col2rgb(colorRampPalette(brewer.pal(9, "Set1"))(lf),
            alpha=TRUE)
        col <- rgb(col[1,], col[2,], col[3,], 75, maxColorValue=255)
      }
      else
        col <- rep(col, lf)[1:lf]
      mapply(function(x, co, ...){
            tmp <- cbind(x$x, x$y)
            colnames(tmp) <- parms
            gpolygon(polygonGate(boundaries=tmp), col=co, ...)
          }, x=polygons, co=col, MoreArgs=list(verbose=FALSE, ...))
      return(invisible(NULL))
    })

## Evaluate the filter and plot the filterResult
setMethod("gpolygon",
    signature(x="curv2Filter", data="flowFrame"), 
    function(x, data, verbose=TRUE, ...)
    {
      fres <- filter(data, x)
      gpolygon(x, fres, verbose=verbose, ...)
    })




## ==========================================================================
## for curv1Filters
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## An error if we can't evaluate the filter
setMethod("gpolygon",
    signature(x="curv1Filter", data="ANY"), 
    function(x, data, verbose=TRUE, ...) flowViz:::evalError("curv1Filters"))
setMethod("gpolygon",
    signature(x="curv1Filter", data="missing"), 
    function(x, data, verbose=TRUE, ...) flowViz:::evalError("curv1Filters"))      

## Filter has been evaluated and the filterResult is provided
setMethod("gpolygon",
    signature(x="curv1Filter", data="multipleFilterResult"), 
    function(x, data, verbose=TRUE, col, ...)
    {
      flowViz:::checkFres(filter=x, fres=data, verbose=verbose)
      fd <- filterDetails(data, identifier(x))
      parms <- parameters(x)
      bounds <- fd$boundaries
      lb <- length(bounds)
      ## we want to use different colors for each population
      if(missing(col)){
        col <-  col2rgb(colorRampPalette(brewer.pal(9, "Set1"))(lb),
            alpha=TRUE)
        col <- rgb(col[1,], col[2,], col[3,], 75, maxColorValue=255)
      }
      else
        col <- rep(col, lb)[1:lb]
      mapply(function(x, co, ...){
            tmp <- matrix(x, nrow=2)
            colnames(tmp) <- parms
            gpolygon(rectangleGate(.gate=tmp), col=co, ...)
          }, x=bounds, co=col, MoreArgs=list(verbose=FALSE, ...))
      return(invisible(NULL))
    })

## Evaluate the filter and plot the filterResult
setMethod("gpolygon",
    signature(x="curv1Filter", data="flowFrame"), 
    function(x, data, verbose=TRUE, ...)
    {
      fres <- filter(data, x)
      gpolygon(x, fres, verbose=verbose, ...)
    })