R/addNames-methods.R

In flowViz: Visualization for flow cytometry

## Add gate names to a flowViz plot.
## These methods add gate names to a \code{flowViz} plot, either derived from
## the population identifiers or as provided by the user. These methods are
## ment for internal use and are usually not called directly by the user.
## 
#' Add gate names to a flowViz plot.
#' 
#' 
#' These methods add gate names to a \code{flowViz} plot, either derived from
#' the population identifiers or as provided by the user. These methods are
#' ment for internal use and are usually not called directly by the user.
#' 
#' 
#' @name addName-methods
#' @aliases addName addName-methods addName,curv1Filter,character-method
#' addName,curv1Filter,logical-method addName,curv2Filter,character-method
#' addName,curv2Filter,logical-method addName,ellipsoidGate,character-method
#' addName,ellipsoidGate,logical-method addName,kmeansFilter,character-method
#' addName,kmeansFilter,logical-method addName,polygonGate,character-method
#' addName,polygonGate,logical-method addName,quadGate,character-method
#' addName,quadGate,logical-method addName,quadGate,matrix-method
#' addName,rectangleGate,character-method addName,rectangleGate,logical-method
#' @docType methods
#' @return The methods are called for their side effects. No value is returned.
#' @section Methods: \describe{
#' 
#' \item{x = "curv1Filter", name = "character"}{ User-provided names. }
#' 
#' \item{x = "curv1Filter", name = "logical"}{ Get names from the
#' \code{\link[flowCore:filter-class]{filter}} or
#' \code{\link[flowCore:filterResult-class]{filterResult}} object}
#' 
#' \item{x = "curv2Filter", name = "character"}{ see above }
#' 
#' \item{x = "curv2Filter", name = "logical"}{ see above }
#' 
#' \item{x = "ellipsoidGate", name = "character"}{ see above }
#' 
#' \item{x = "ellipsoidGate", name = "logical"}{ see above }
#' 
#' \item{x = "kmeansFilter", name = "character"}{ see above }
#' 
#' \item{x = "kmeansFilter", name = "logical"}{ see above }
#' 
#' \item{x = "polygonGate", name = "character"}{ see above }
#' 
#' \item{x = "polygonGate", name = "logical"}{ see above }
#' 
#' \item{x = "quadGate", name = "character"}{ see above }
#' 
#' \item{x = "quadGate", name = "logical"}{ see above }
#' 
#' \item{x = "quadGate", name = "matrix"}{ see above }
#' 
#' \item{x = "rectangleGate", name = "character"}{ see above }
#' 
#' \item{x = "rectangleGate", name = "logical"}{ see above }
#' 
#' }
#' @author F. Hahne
#' @keywords methods
#' @export 
#' @param x rectangleGate, ellipsoidGate, quadGate, polygonGate or kmeansFilter
#' @param name character or logical or matrix
#' @param data flowFrame
#' @param gp a list of graphical parameters
#' @param pos,abs specifying location of the name. see 'help(xyplot)' for more details
#' @param xlim,ylim limits of axis
#' @param ... other arguments
setMethod("addName",
          signature(x="rectangleGate", name="character"), 
          function(x, name, data, gp,pos=0.5,abs=FALSE,xlim,ylim,...)
      {
#		  browser()
          parms <- parameters(x)
          
		  

		  
          ## 1D rectangular gate (region gate).
          if(length(parms)==1){
              mt <- match(parms, data)
              if(mt==1){
				  xx<-c(x@min,x@max)
				  yy <- ylim
              }else if(mt==2){
				  yy<-c(x@min,x@max)
				  xx <- xlim
              }else stop("How did you end up here????")
          }else{## 2D rectangular gate   
              bl <- x@min[data]
              tr <- x@max[data]
			  xx<-c(bl[1], tr[1])
			  yy<-c(bl[2], tr[2])
#              gltext(mean(xx), mean(yy), labels=name, adj=0.5, gp=gp)
          }
		  
		  if(abs)#plot label whithin the boundary by default 
		  {
			  xx<-xlim
			  yy<-ylim
		  }else #specify location by absolute position of the current window
		  {
			  
			  xx<-fixBound_addName(xx,xlim)
			  yy<-fixBound_addName(yy,ylim)
		  }
		  pos <- rep(pos, length=2)[1:2]
		  xx<-xx[1]+diff(xx)*pos[1]
		  yy<-yy[1]+diff(yy)*pos[2]
          		  
		  gltext(xx, yy, labels=name, adj=0.5, gp=gp)
          return(invisible())
      })


setMethod("addName",
          signature(x="rectangleGate", name="logical"), 
          function(x, name, ...)
      {
          if(name)
              addName(x, paste(identifier(x), "+", sep=""), ...)
          else
              return(invisible())
      })



## ==========================================================================
## for ellipsoidGates
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## 'names' either uses population names generated by the filter
## or can be a character provided by the user.
setMethod("addName",
          signature(x="ellipsoidGate", name="character"), 
          function(x, name, data, gp,...)
      {
          gltext(x@mean[data[1]], x@mean[data[2]], labels=name, adj=0.5, gp=gp)
          return(invisible())
      })

setMethod("addName",
          signature(x="ellipsoidGate", name="logical"), 
          function(x, name, ...)
      {
          if(name)
              addName(x, paste(identifier(x), "+", sep=""), ...)
          else
              return(invisible())
      })



## ==========================================================================
## for quadGates
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## 'names' either uses population names generated by the filter
## or can be a character provided by the user.
setMethod("addName",
          signature(x="quadGate", name="matrix"), 
          function(x, name, data, gp,xlim,ylim,...)
      {
          v <- x@boundary[data[1]]
          h <- x@boundary[data[2]]
          
          yoff <- diff(ylim)/50
          trans <- match(colnames(name)[1], data)-1
          if(trans)
              name <- matrix(c(name[2,2], name[2,1], name[1,2],
                                name[1,1]), ncol=2)
          gltext(c(mean(c(xlim[1], v)), mean(c(v, xlim[2]))),
                 rep(ylim[2], 2)-yoff, labels=name[1,],
                 adj=c(0.5, 1), gp=gp)
          gltext(c(mean(c(xlim[1], v)), mean(c(v, xlim[2]))),
                 rep(ylim[1], 2)+yoff, labels=name[2,],
                 adj=c(0.5, 0), gp=gp)
          return(invisible())
      }) 

setMethod("addName",
          signature(x="quadGate", name="logical"), 
          function(x, name, data, ...)
      {
          if(name){
              desc <- flowCore:::popNames(data, x)
              names <- matrix(c(sprintf("%s-%s+", desc[1], desc[2]),
                                sprintf("%s-%s-", desc[1], desc[2]),
                                sprintf("%s+%s+", desc[1], desc[2]),
                                sprintf("%s+%s-", desc[1], desc[2])),
                              ncol=2)
              colnames(names) <- names(desc)
              data <- checkParameterMatch(parameters(x), verbose=FALSE,...)
              addName(x, names, data, ...)
          }else
          return(invisible())
      })
    
setMethod("addName",
          signature(x="quadGate", name="character"), 
          function(x, name, data, ...)
      {
          desc <- flowCore:::popNames(data, x)
          data <- checkParameterMatch(parameters(x), verbose=FALSE,...)
          names <- matrix(rep(name, 4)[4:1], ncol=2, dimnames=list(NULL, data))
          colnames(names) <- names(desc)
          addName(x, names, data, ...)
          return(invisible())
      })



## ==========================================================================
## for polygonGates
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## 'names' either uses population names generated by the filter
## or can be a character provided by the user.
setMethod("addName",
          signature(x="polygonGate", name="character"), 
          function(x, name, data, gp,pos=0.5,abs=FALSE,xlim,ylim,...)
      {
		  
		  
		  if(abs)#plot label whithin the boundary by default 
		  {
			  xp<-xlim
			  yp<-ylim
		  }else #specify location by absolute position of the current window
		  {
			  xp <- range(x@boundaries[,data[1]])
			  yp <- range(x@boundaries[,data[2]])
			  xp<-fixBound_addName(xp,xlim)
			  yp<-fixBound_addName(yp,ylim)
		  }
		  pos <- rep(pos, length=2)[1:2]
		  
  		  xp<-xp[1]+diff(xp)*pos[1]
		  yp<-yp[1]+diff(yp)*pos[2]
	  		 
          
          gltext(xp, yp, labels=name, adj=0.5, gp=gp)
          return(invisible())
      })

setMethod("addName",
          signature(x="polygonGate", name="logical"), 
          function(x, name, ...)
      {
          if(name)
              addName(x, paste(identifier(x), "+", sep=""), ...)
          else
              return(invisible())
      })



## ==========================================================================
## for kmeansFilter
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## 'names' either uses population names generated by the filter
## or can be a character provided by the user.
setMethod("addName",
          signature(x="kmeansFilter", name="character"), 
          function(x, name, data, gp, ...)
      {
          chan <- checkParameterMatch(parameters(x), verbose=FALSE,...)
          loc <- sapply(data, function(x) colMeans(exprs(x)[,chan]))
          gltext(loc[1,], loc[,2], labels=name, adj=0.5, gp=gp)
          return(invisible())
      })

setMethod("addName",
          signature(x="kmeansFilter", name="logical"), 
          function(x, name, data, ...)
      {
          if(name)
              addName(x, names(data), data=data, ...)
          else
              return(invisible())
      })