# R/lpolygon-methods.R In flowViz: Visualization for flow cytometry

## ==========================================================================
## Draw gate regions as polygons on an existing lattice plot. All graphical
## parameters will be passed on to grid.polygon in the end, so
## these are basically extended grid.polygon methods for gates and filters.
## Filters are only evaluated if that is needed for plotting of the
## regions. The methods always dispatch on filters (or filteResults since
## they inherits from filter) and on an optional additional argument
## data, which can be either a character vector, a filterResult or a
## flowFrame. The optional channels argument can be used to pass along
## the plotting parameters, and it takes precendence over everything else.
##
## Most of the methods will just call the next applicable method, the real
## workhorses are signature(x="rectangleGate", data="character") and
## signature(x="polygonGate", data="character") since in the end everything
## boils down to rectangles or polygons.
##
## Population names can be added to the plot if argument 'names' is true.
## Eventually we may want to fix the size and location of the names tags,
## but for now it is always using the gate centroids.

## ==========================================================================
## for all filters
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## We only know how to add the gate boundaries if the definiton of that gate
## contains exactly two dimensions, and even then we need to guess that
## they match the plotted data, hence we warn unless the plotted parameters
## are explicitely provided by the channels argument.
#' Drawing filter regions
#'
#' These methods extend the lattice \code{\link[lattice:llines]{lpolygon}}
#' methods for drawing of \code{\link[flowCore:filter-class]{filter}} regions.
#' They allow for multiple dispatch, since not all
#' \code{\link[flowCore:filter-class]{filter}} types need to be evaluated for
#' plotting, but this decision should be made internally.
#'
#' When plotting \code{\link[flowCore:flowFrame-class]{flowFrames}} using the
#' any of the lattice-type \code{plot} method provided by \code{flowViz}, the
#' plotted parameters are recorded, which makes it possible to correctly
#' overlay the outlines of \code{\link[flowCore:filter-class]{filter}} assuming
#' that they are defined for the respective parameters. Warnings and error will
#' be cast for the cases where the parameters are non-distinct or ambigious.
#' These methods are meant to be used within lattice panel functions and are
#' probably not of much use outside of those.
#'
#' @name glpolygon-methods
#' @aliases glpolygon glpolygon-methods glpolygon,curv1Filter,ANY-method
#' glpolygon,complementFilter,ANY-method glpolygon,curv1Filter,flowFrame-method
#' glpolygon,curv1Filter,missing-method
#' glpolygon,curv1Filter,multipleFilterResult-method
#' glpolygon,curv2Filter,ANY-method glpolygon,curv2Filter,flowFrame-method
#' glpolygon,curv2Filter,multipleFilterResult-method
#' glpolygon,filter,missing-method glpolygon,filterResult,flowFrame-method
#' glpolygon,filterResult,missing-method glpolygon,filterResult,ANY-method
#' glpolygon,kmeansFilter,ANY-method glpolygon,norm2Filter,ANY-method
#' glpolygon,norm2Filter,flowFrame-method
#' glpolygon,norm2Filter,logicalFilterResult-method
#' glpolygon,polygonGate,character-method
#' glpolygon,polygonGate,filterResult-method
#' glpolygon,rectangleGate,character-method
#' glpolygon,rectangleGate,filterResult-method
#' glpolygon,rectangleGate,flowFrame-method
#' glpolygon,ellipsoidGate,character-method
#' glpolygon,ellipsoidGate,filterResult-method
#' glpolygon,ellipsoidGate,flowFrame-method glpolygon,subsetFilter,ANY-method
#' @docType methods
#' @return The methods will return the outlines of the gate region as polygon
#' vertices.
#' @section Methods:
#'
#' \describe{
#'
#' \item{x = "filter", data = "missing"}{ General method for all objects
#' inheriting from \code{\link[flowCore:filter-class]{filter}}. This is used as
#' the default when no more explicit method is found. It tries to find the
#' plotted parameters from the internal \code{flowViz.state} environment. This
#' only works if the flow data has been plotted using the \code{plot} methods
#' provided by this \code{flowViz} package. }
#'
#' \item{x = "filterResult", data = "missing"}{ General method for all
#' basically extracts the \code{\link[flowCore:filter-class]{filter}} from the
#' that. }
#'
#' \item{x = "filterResult", data = "flowFrame"}{ For some
#' \code{\link[flowCore:filter-class]{filter}} types we need the raw data to
#' re-evaluate the filter. }
#'
#' \item{x = "curv1Filter", data = "ANY"}{ We either need a
#' \code{\link[flowCore:filterResult-class]{filterResult}} or the raw data as a
#'
#' \item{x = "curv1Filter", data = "flowFrame"}{ see above }
#'
#' \item{x = "curv1Filter", data = "missing"}{ see above }
#'
#' \item{x = "curv1Filter", data = "multipleFilterResult"}{ see above }
#'
#' \item{x = "curv2Filter", data = "ANY"}{ We either need a
#' \code{\link[flowCore:filterResult-class]{filterResult}} or the raw data as a
#'
#' \item{x = "curv2Filter", data = "flowFrame"}{ see above }
#'
#' \item{x = "curv2Filter", data = "multipleFilterResult"}{ see above }
#'
#' \item{x = "kmeansFilter", data = "ANY"}{ We don't know how to plot regions
#' of a \code{\link[flowCore:kmeansFilter]{kmeansFilter}}, hence we warn. }
#'
#' \item{x = "norm2Filter", data = "ANY"}{ We either need a
#' \code{\link[flowCore:filterResult-class]{filterResult}} or the raw data as a
#'
#' \item{x = "norm2Filter", data = "flowFrame"}{ see above }
#'
#' \item{x = "norm2Filter", data = "logicalFilterResult"}{ see above }
#'
#' \item{x = "polygonGate", data = "character"}{ We can plot a
#' \code{\link[flowCore]{polygonGate}} directly from the gate definition. }
#'
#' \item{x = "polygonGate", data = "filterResult"}{ see above }
#'
#' \item{x = "polygonGate", data = "flowFrame"}{ see above }
#'
#' \item{x = "quadGate", data = "character"}{ We can plot a
#'
#' \item{x = "quadGate", data = "filterResult"}{ see above }
#'
#' \item{x = "quadGate", data = "flowFrame"}{ see above }
#'
#' \item{x = "rectangleGate", data = "character"}{ We can plot a
#' \code{\link[flowCore]{rectangleGate}} directly from the gate definition. }
#'
#' \item{x = "rectangleGate", data = "filterResult"}{ see above }
#'
#' \item{x = "rectangleGate", data = "flowFrame"}{ see above }
#'
#' \item{x = "ellipsoidGate", data = "character"}{ We can plot a
#' \code{\link[flowCore]{rectangleGate}} directly from the gate definition. }
#'
#' \item{x = "ellipsoidGate", data = "filterResult"}{ see above }
#'
#' \item{x = "ellipsoidGate", data = "flowFrame"}{ see above }
#'
#' }
#' @author F. Hahne
#' @seealso
#'
#' @keywords methods
#' @export
#' @param x filter or filterResult or any derived filter class
#' @param data flowFrame or filterResult or character or missing or ANY
#' @param verbose logical
#' @param gpar a list of graphical parameters. see 'help(flowViz.par.get)' for details.
#' @param strict logical
#' @param ... other arguments
setMethod("glpolygon",
signature(x="filter", data="missing"),
function(x, data, verbose=TRUE, gpar=flowViz.par.get(),
strict=TRUE, ...)
{
parms <- checkParameterMatch(parameters(x), verbose=verbose,
strict=strict,...)
if(!all(is.na(parms)))
glpolygon(x=x, data=parms, gpar=gpar, verbose=FALSE,strict=strict, ...)
})

## Extract the filter definiton from a filterResult and pass that on
## along with it. We decide later if we really need it or not.
setMethod("glpolygon",
signature(x="filterResult", data="ANY"),
definition=function(x, data, verbose=TRUE,
gpar=flowViz.par.get(), ...)
{
fd <- filterDetails(x)
filt <- fd[[length(fd)]]$filter if(!missing(data) && is.character(data) && ! ("channels" %in% names(list(...)))) glpolygon(filt, x, verbose=FALSE, channels=data, gpar=gpar, ...) else glpolygon(filt, x, verbose=FALSE, gpar=gpar, ...) }) ## We don't need the flowFrame if the filter is already evaluated, but we ## can check that the IDs are matching before dropping it. setMethod("glpolygon", signature(x="filterResult", data="flowFrame"), definition=function(x, data, verbose=TRUE, gpar=flowViz.par.get(), ...){ checkIdMatch(x=x, f=data) dropWarn("flowFrame", "filterResults", verbose=verbose) glpolygon(x=x, verbose=verbose, gpar=gpar, ...) }) ## ========================================================================== ## for rectangleGates ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Plotting parameters are specified as a character vector. If channels is ## provided this takes precedence. setMethod("glpolygon", signature(x="rectangleGate", data="character"), function(x, data, channels, verbose=TRUE, gpar=flowViz.par.get(), plot=TRUE, names=FALSE,xlim,ylim, ...) { if(!missing(channels)) data <- channels parms <- parameters(x) # browser() if(plot){ ## 1D rectangular gate (region gate). We cheat those by drawing a ## rectangle that is slightly bigger than the drawing limits in the ## missing channel and let clipping work for us. if(length(parms)==1){ mt <- match(parms, data) if(mt==1){ glrect(fixInf(x@min, xlim), ylim[1]-diff(ylim)*10, fixInf(x@max, xlim), ylim[2]+diff(ylim)*10, gp=gpar$gate, ...)
}
else if(mt==2){
glrect(xlim[1]-diff(xlim)*10, fixInf(x@min, ylim),
xlim[2]+diff(xlim)*10, fixInf(x@max, ylim),
gp=gpar$gate, ...) }else stop("How did you end up here????") }else{## 2D rectangular gate bl <- x@min[data] tr <- x@max[data] glrect(fixInf(bl[1], xlim), fixInf(bl[2], ylim), fixInf(tr[1], xlim), fixInf(tr[2], ylim), gp=gpar$gate, ...)
}

}
addName(x, names, data, gp = gpar$gate.text,xlim=xlim,ylim=ylim,...) res <- rbind(x@min[data], x@max[data]) res <- res[,!apply(res, 2, function(z) all(is.na(z))), drop=FALSE] return(invisible(list(res))) }) ## We can ignore the filterResult, don't need it to plot the gate. setMethod("glpolygon", signature(x="rectangleGate", data="filterResult"), function(x, data, verbose=TRUE, gpar=flowViz.par.get(), ...) { dropWarn("filterResult", "rectangleGates", verbose=verbose) glpolygon(x=x, verbose=verbose, gpar=gpar, ...) }) ## We can drop the flowFrame, don't need it for rectangleGates. setMethod("glpolygon", signature(x="rectangleGate", data="flowFrame"), function(x, data, verbose=TRUE, gpar=flowViz.par.get(), ...) { dropWarn("flowFrame", "rectangleGates", verbose=verbose) glpolygon(x=x, verbose=verbose, gpar=gpar, ...) }) ## ========================================================================== ## for ellipsoidGates ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Plotting parameters are specified as a character vector setMethod("glpolygon", signature(x="ellipsoidGate", data="character"), function(x, data, channels, verbose=TRUE, gpar=flowViz.par.get(), plot=TRUE, names=FALSE, ...) { if(!missing(channels)) data <- channels parms <- parameters(x) ## We coerce to a polygon gate and plot that res <- as(x, "polygonGate") glpolygon(res, verbose=verbose, gpar=gpar, plot=plot, ...) addName(x, names, data, gp = gpar$gate.text,...)
return(invisible(res@boundaries))
})

## We can ignore the filterResult, don't need it to plot the gate.
setMethod("glpolygon",
signature(x="ellipsoidGate", data="filterResult"),
function(x, data, verbose=TRUE, gpar=flowViz.par.get(), ...)
{
dropWarn("filterResult", "ellipsoidGates", verbose=verbose)
glpolygon(x=x, verbose=verbose, gpar=gpar, ...)
})

## We can drop the flowFrame, don't need it for rectangleGates.
setMethod("glpolygon",
signature(x="ellipsoidGate", data="flowFrame"),
function(x, data, verbose=TRUE, gpar=flowViz.par.get(), ...)
{
dropWarn("flowFrame", "ellipsoidGates", verbose=verbose)
glpolygon(x=x, verbose=verbose, gpar=gpar, ...)
})

## ==========================================================================
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## We plot this as four individual rectangle gates. If channels is
## provided this takes precedence.
setMethod("glpolygon",
function(x, data, channels, verbose=TRUE,
gpar=flowViz.par.get(), names=NULL,abs=FALSE,pos=NULL,...)
{
#		  browser()
if(!missing(channels))
data <- channels
v <- x@boundary[data[1]]
h <- x@boundary[data[2]]
mat <- matrix(c(-Inf, v, h, Inf, v, Inf, h, Inf, -Inf, v, -Inf,
h, v, Inf, -Inf, h), byrow=TRUE, ncol=4)
## we want to be able to use different colors for each population
fill <- rep(gpar$gate$fill, 4)
col <- rep(gpar$gate$col, 4)
col <- col[c(2,1,3,4)]
fill <- fill[c(2,1,3,4)]
res <- vector(4, mode="list")
#quadrant iteration in this loop goes by :x-y+,x+y+,x-y-,x+y-
#	yet populations generated from quadGate is:++,-+,+-,--
#so we need to re-order the names character
if(length(names)==1)
names<-rep(names,4)
names<-names[c(2,1,4,3)]
# fix the location of gate labels at four corners for quadGate

poslist<-vector(mode="list",4)
poslist[[1]]<-c(0.15,0.9)
poslist[[2]]<-c(0.9,0.9)
poslist[[3]]<-c(0.15,0.1)
poslist[[4]]<-c(0.9,0.1)
for(i in 1:4){
gpar$gate$col <- col[i]
gpar$gate$fill <- fill[i]
rg <- rectangleGate(.gate=matrix(mat[i,], ncol=2,
dimnames=list(c("min", "max"),
data)))

res[[i]] <- glpolygon(x=rg, data=data, verbose=FALSE,
gpar=gpar, channels=data,names=names[i],abs=abs,pos=poslist[[i]],...)[[1]]

}
return(invisible(res))
})

## We can ignore the filterResult, don't need it to plot the gate.
setMethod("glpolygon",
function(x, data, verbose=TRUE, gpar=flowViz.par.get(),
names=FALSE, ...)
{
#		  browser()
#          glpolygon(x=x, verbose=verbose, gpar=gpar,
#                    names=ifelse(names, names(x), FALSE), ...)

glpolygon(x=x, verbose=verbose, gpar=gpar,
names=names, ...)
})

## We can drop the dataFrame, don't need it for rectangleGates.
setMethod("glpolygon",
function(x, data, verbose=TRUE, gpar=flowViz.par.get(),
names=FALSE, ...)
{
res <- glpolygon(x=x, verbose=verbose, gpar=gpar,
names=FALSE, ...)
addName(x, names, data=data, gp = gpar$gate.text,...) return(invisible(res)) }) ## ========================================================================== ## for polygonGates ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Plotting parameters are specified as a character vector. If channels is ## provided this takes precedence. setMethod("glpolygon", signature(x="polygonGate", data="character"), function(x, data, channels, verbose=TRUE, gpar=flowViz.par.get(), plot=TRUE, names=FALSE, inverse=FALSE,xlim,ylim, ...) { if(!missing(channels)) data <- channels xp <- x@boundaries[,data[1]] yp <- x@boundaries[,data[2]] # class(gpar) <- "gpar" if(plot){ if(inverse){ mx <- which.min(yp) xpi <- rep(xp, 2) ypi <- rep(yp, 2) nextDiff <- min(which(xpi[-(1:mx)] != xpi[mx]))+mx if(xpi[nextDiff] < xp[mx]){ xp <- rev(xp) yp <- rev(yp) mx <- which.min(yp) } xoff <- diff(xlim) yoff <- diff(ylim) boundingBox <- cbind(c(rep(xlim-xoff, 2), rep(xlim+xoff, 2)), c(ylim-yoff, ylim+yoff, ylim+yoff, ylim-yoff)) xpi <- c(rep(boundingBox[1,1], 2), xp, xp[1], boundingBox[,1], boundingBox[1,1]) ypi <- c(boundingBox[1,2], yp[mx], yp, yp[1], yp[mx], boundingBox[-1,2], boundingBox[1,2]) gpari <- gpar$gate
gpari$col <- "transparent" glpoly(xpi, ypi, gp=gpari) gpari$col <- gpar$gate$col
gpari$fill <- "transparent" glpoly(xp, yp, gp=gpari) }else{ glpoly(xp, yp, gp=gpar$gate)
}
}
addName(x, names, data, gp = gpar\$gate.text,xlim=xlim,ylim=ylim,...)
res <- cbind(xp,yp)
res <- res[,!apply(res, 2, function(z) all(is.na(z))), drop=FALSE]
return(invisible(list(res)))
})

## We can ignore the filterResult, don't need it to plot the gate.
setMethod("glpolygon",
signature(x="polygonGate", data="filterResult"),
function(x, data, verbose=TRUE, gpar=flowViz.par.get(), ...)
{
dropWarn("filterResult", "polygonGates", verbose=verbose)
glpolygon(x=x, verbose=verbose, gpar=gpar, ...)
})

## we can drop the flowFrame, don't need it for polygonGates.
setMethod("glpolygon",
signature(x="polygonGate", data="flowFrame"),
function(x, data, verbose=TRUE, gpar=flowViz.par.get(), ...)
{
dropWarn("flowFrame", "polygonGates", verbose=verbose)
glpolygon(x=x, verbose=verbose, gpar=gpar, ...)
})

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

## Filter has been evaluated and the filterResult is provided. We convert
## this into a polygon gate and plot that.
setMethod("glpolygon",
signature(x="norm2Filter", data="logicalFilterResult"),
function(x, data, verbose=TRUE, gpar=flowViz.par.get(),
names=FALSE, ...){
checkFres(filter=x, fres=data, verbose=verbose)
fd <- filterDetails(data, identifier(x))
np <- norm2Polygon(fd, parameters(x))
identifier(np) <- identifier(x)
glpolygon(x=np, verbose=FALSE, gpar=gpar, names=names, ...)
})

## Evaluate the filter and pass on to the filterResult method.
setMethod("glpolygon",
signature(x="norm2Filter", 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 kmeansFilters
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## We don't know how to plot these, hence we warn
setMethod("glpolygon",
signature(x="kmeansFilter", data="ANY"),
function(x, data, verbose=TRUE, ...)
nnWarn("kmeansFilter", verbose))

## ==========================================================================
## for complementFilter
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## We have to do this on the level of polygons or rectangles, so here we
## only set a flag and pass on the basic filter.
## FIXME: This doesn't work for multi-polygon filters so far.
setMethod("glpolygon",
signature(x="complementFilter", data="ANY"),
function(x, data, verbose=TRUE, inverse=FALSE, ...)
{
glpolygon(x@filters[[1]], data, verbose=verbose,
inverse=!inverse, ...)
})

# ==========================================================================
## for subsetFilter
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## For now we just plot the top-level filter.
## FIXME: We may want to be able to plot all filters
setMethod("glpolygon",
signature(x="subsetFilter", data="ANY"),
function(x, data, verbose=TRUE, inverse=FALSE, ...)
{
glpolygon(x@filters[[1]], data, verbose=verbose, ...)
})


## Try the flowViz package in your browser

Any scripts or data that you put into this service are public.

flowViz documentation built on Nov. 17, 2017, 8:42 a.m.