# R/setGate_Methods.R In RGLab/flowWorkspace: Infrastructure for representing and interacting with gated and ungated cytometry data sets.

#### Documented in gh_pop_set_gategs_pop_set_gaterotate_gate.GatingHierarchyscale_gate.GatingHierarchyshift_gate.GatingHierarchytransform_gate.GatingHierarchy

#' @include filterObject_Methods.R
NULL

#' @templateVar old setGate
#' @templateVar new gs(/gh)_pop_set_gate
#' @template template-depr_pkg
NULL
#' @export
setGeneric("setGate",function(obj,y,value,...)standardGeneric("setGate"))

#' @export
setMethod("setGate"
,signature(obj="GatingHierarchy",y="character",value="filter")
,function(obj,y,value,...){
.Deprecated("gh_pop_set_gate")
gh_pop_set_gate(obj,y,value,...)

})

#' update the gate
#'
#' update the population node with a flowCore-compatible gate object
#'
#' Usually \link{recompute} is followed by this call since updating a gate
#' doesn't re-calculating the cell events within the gate automatically.
#' see \link{filterObject} for the gate types that are currently supported.
#'
#' @name gs_pop_set_gate
#' @aliases gh_pop_set_gate setGate setGate,GatingHierarchy,character,filter-method
#' setGate,GatingSet,character,ANY-method
#' @param obj \code{GatingHierarchy} or \code{GatingSet}
#' @param y \code{character} node name or path
#' @param value \code{filter} or \code{filterList} or \code{list} of \code{filter} objects
#' @param ... other aguments
#' @examples
#' \dontrun{
#' rg1 <- rectangleGate("FSC-H"=c(200,400), "SSC-H"=c(250, 400), filterId="rectangle")
#' rg2 <- rectangleGate("FSC-H"=c(200,400), "SSC-H"=c(250, 400), filterId="rectangle")
#' flist <- list(rg1,rg2)
#' names(flist) <- sampleNames(gs[1:2])
#' gs_pop_set_gate(gs[1:2], "lymph", flist)
#' recompute(gs[1:2], "lymph")
#' }
#' @export
gh_pop_set_gate <- function(obj,y,value, negated = FALSE,...){
{
if(negated)
stop("'negated' flag can't be TRUE for quadGate")
g <- gh_pop_get_gate(obj, y)
stop(y, " is not a quadGate and can't be updated by a new quadGate!")
newintersection <- value@boundary
stop("The channel names of the new quadGate do not match to the original quadGate")
}else
{
this_fobj <- filter_to_list(value)
this_fobj\$negated<-negated
.cpp_setGate(obj@pointer,sampleNames(obj), y, this_fobj)

}

}

#' @export
setMethod("setGate",
signature=c(obj="GatingSet",y="character", value = "ANY"),
definition=function(obj, y, value,...)
{
.Deprecated("gs_pop_set_gate")
gs_pop_set_gate(obj, y, value)

})

#' @rdname gs_pop_set_gate
#' @export
gs_pop_set_gate <- function(obj, y, value,...)
{
if(is(value, "filterList"))
{
samples<-sampleNames(obj)

if(!setequal(names(value),samples))
stop("names of filterList do not match with the sample names in the gating set!")

lapply(samples,function(sample){
curFilter<-value[[sample]]
gh<-obj[[sample]]
gh_pop_set_gate(obj=gh,y,value=curFilter,...)
})
}else if(is(value, "list")){
flist<-filterList(value)
gs_pop_set_gate(obj,y,flist,...)

}else
stop(class(value), " not supported!")

}

#' Simplified geometric transformations of gates associated with nodes
#'
#' Perform geometric transformations of a gate associated with a node of a \code{\linkS4class{GatingHierarchy}} or
#' updating of the gate associated with a node of a \code{GatingHierarchy} or \code{GatingSet}.
#'
#' \code{transform_gate} calls \code{\link{gs_pop_set_gate}} to modify the provided \code{GatingHierarchy} or \code{GatingSet}
#' directly so there is no need to re-assign its output. The arguments will be essentially identical to the
#' \code{flowCore} method, except for the specification of the target gate. Rather than being called on an
#' object of type \code{flowCore::filter}, here it is called on a \code{GatingHierarchy} or \code{GatingSet}
#' object with an additional character argument for specifying the node whose gate should be transformed.
#' The rest of the details below are taken from the \code{flowCore} documentation.
#'
#' This method allows changes to the four filter types defined by simple geometric gates (\code{\linkS4class{quadGate}},
#' equally simple geometric transformations (shifting/translation, scaling/dilation, and rotation). The method also
#' allows for directly re-setting the slots of each Gate-type object. Note that these methods are for manually altering
#' the geometric definition of a gate. To easily transform the definition of a gate with an accompanyging scale
#' transformation applied to its underlying data, see ?ggcyto::rescale_gate.
#'
#' First, \code{transform_gate} will apply any direct alterations to the slots of the supplied Gate-type filter object.
#' For example, if "\code{mean = c(1,3)}" is present in the argument list when \code{transform_gate} is called on a
#' \code{ellipsoidGate} object, the first change applied will be to shift the \code{mean} slot to \code{(1,3)}. The method
#' will carry over the dimension names from the gate, so there is no need to provide column or row names with arguments
#' such as \code{mean} or \code{cov} for \code{ellipsoidGate} or \code{boundaries} for \code{polygonGate}.
#'
#' \code{transform_gate} then passes the geometric arguments (\code{dx}, \code{dy}, \code{deg}, \code{rot_center}, \code{scale},
#' and \code{center}) to the methods which perform each respective type of transformation:
#' The order of operations is to first scale, then rotate, then shift. The default behavior of each operation follows
#' that of its corresponding method but for the most part these are what the user would expect. A few quick notes:
#' \itemize{
#' \item \code{rotate_gate} is not defined for \code{rectangleGate} or \code{quadGate} objects, due to their definition as
#' having 1-dimensional boundaries.
#' \item The default center for both rotation and scaling of a \code{polygonGate} is the centroid of the polygon. This
#' results in the sort of scaling most users expect, with a uniform scale factor not distorting the shape of the original polygon.
#' }
#'
#' @name transform_gate
#' @aliases transform_gate,GatingHierarchy-method transform_gate,GatingSet-method
#' @param obj A \code{GatingHierarchy} or \code{GatingSet} object
#' @param y A character specifying the node whose gate should be modified
#' @param scale Either a numeric scalar (for uniform scaling in all dimensions) or numeric vector specifying the factor by
#' which each dimension of the gate should be expanded (absolute value > 1) or contracted (absolute value < 1). Negative values
#' will result in a reflection in that dimension.
#'
#' For \code{rectangleGate} and \code{quadGate} objects, this amounts to simply
#' scaling the values of the 1-dimensional boundaries. For \code{polygonGate} objects, the values of \code{scale} will be used
#' to determine scale factors in the direction of each of the 2 dimensions of the gate (\code{scale_gate} is not yet defined
#' for higher-dimensional \code{polytopeGate} objects). \strong{Important: } For \code{ellipsoidGate} objects, \code{scale}
#' determines scale factors for the major and minor axes of the ellipse, in that order.
#'
#' @param deg An angle in degrees by which the gate should be rotated in the counter-clockwise direction.
#' @param rot_center A separate 2-dimensional center of rotation for the gate, if desired. By default, this will
#' be the center for \code{ellipsoidGate} objects or the centroid for \code{polygonGate} objects. The \code{rot_center} argument
#' is currently only supported for \code{polygonGate} objects. It is also usually simpler to perform a rotation and a translation
#' individually than to manually specify the composition as a rotation around a shifted center.
#'
#' @param dx Either a numeric scalar or numeric vector. If it is scalar, this is just the desired shift of the gate in
#' its first dimension. If it is a vector, it specifies both \code{dx} and \code{dy} as \code{(dx,dy)}.
#' This provides an alternate syntax for shifting gates, as well as allowing shifts of \code{ellipsoidGate} objects
#' in more than 2 dimensions.
#' @param dy A numeric scalar specifying the desired shift of the gate in its second dimension.
#' @param center A numeric vector specifying where the center or centroid should be moved (rather than specifiying \code{dx}
#' and/or \code{dy})
#'
#' @param \dots Assignments made to the slots of the particular Gate-type filter object in the form "<slot_name> = <value>"
#'
#' @examples
#' \dontrun{
#' # Scale the original gate non-uniformly, rotate it 15 degrees, and shift it
#' transform_gate(gs, node, scale = c(2,3), deg = 15, dx = 500, dy = -700)
#'
#' # Scale the original gate (in this case an ellipsoidGate) after moving its center to (1500, 2000)
#' transform_gate(gs, node, scale = c(2,3), mean = c(1500, 2000))
#' }
#'
#'
#' @export
transform_gate.GatingHierarchy <- function(obj, y, scale = NULL, deg = NULL, rot_center = NULL, dx = NULL, dy = NULL, center = NULL, ...){
gate <- gh_pop_get_gate(obj, y)
gate <- transform_gate(gate, scale = scale, deg = deg,
rot_center = rot_center, dx = dx,
dy = dy, center = center, ...)
gh_pop_set_gate(obj, y, gate)
}

#' @export
transform_gate.GatingSet <- function(obj, y, scale = NULL, deg = NULL, rot_center = NULL, dx = NULL, dy = NULL, center = NULL, ...){
gates <- gs_pop_get_gate(obj, y)
gates <- lapply(gates, function(gate) transform_gate(gate, scale = scale, deg = deg,
rot_center = rot_center, dx = dx,
dy = dy, center = center, ...))
gs_pop_set_gate(obj, y, gates)
}

#' Simplified geometric scaling of gates associated with nodes
#'
#' Scale a gate associated with a node of a \code{GatingHierarchy} or
#' updating of the gate associated with a node of a \code{GatingHierarchy} or \code{GatingSet}.
#'
#' \code{scale_gate} calls \code{\link{gs_pop_set_gate}} to modify the provided \code{GatingHierarchy} or \code{GatingSet}
#' directly so there is no need to re-assign its output. The arguments will be essentially identical to the
#' \code{flowCore} method, except for the specification of the target gate. Rather than being called on an
#' object of type \code{\link[flowCore]{filter}}, here it is called on a \code{GatingHierarchy} or \code{GatingSet}
#' object with an additional character argument for specifying the node whose gate should be transformed.
#' The rest of the details below are taken from the \code{flowCore} documentation.
#'
#' This method allows uniform or non-uniform geometric scaling of filter types defined by simple geometric gates
#' \code{\linkS4class{polygonGate}}) Note that these methods are for manually altering
#' the geometric definition of a gate. To easily transform the definition of a gate with an accompanyging scale
#' transformation applied to its underlying data, see ?ggcyto::rescale_gate.
#'
#' The \code{scale} argument passed to \code{scale_gate} should be either a scalar or a vector of the same length
#' as the number of dimensions of the gate. If it is scalar, all dimensions will be multiplicatively scaled uniformly
#' by the scalar factor provided. If it is a vector, each dimension will be scaled by its corresponding entry in the vector.
#'
#' The scaling behavior of \code{scale_gate} depends on the type of gate passed to it. For \code{rectangleGate}
#' and \code{quadGate} objects, this amounts to simply scaling the values of the 1-dimensional boundaries.
#' For \code{polygonGate} objects, the values of \code{scale} will be used to determine scale factors
#' in the direction of each of the 2 dimensions of the gate (\code{scale_gate} is not yet defined
#' for higher-dimensional \code{polytopeGate} objects). \strong{Important: } For \code{ellipsoidGate} objects, \code{scale}
#' determines scale factors for the major and minor axes of the ellipse, \emph{in that order}. Scaling by a negative factor
#' will result in a reflection in the corresponding dimension.
#'
#' @name scale_gate
#' @aliases scale_gate,GatingHierarchy-method scale_gate,GatingSet-method
#' @param obj A \code{GatingHierarchy} or \code{GatingSet} object
#' @param y A character specifying the node whose gate should be modified
#'
#' @param scale Either a numeric scalar (for uniform scaling in all dimensions) or numeric vector specifying the factor by
#' which each dimension of the gate should be expanded (absolute value > 1) or contracted (absolute value < 1). Negative values
#' will result in a reflection in that dimension.
#' @param ... not used
#' @examples
#' \dontrun{
#' # Scales both dimensions by a factor of 5
#' scale_gate(gs, node, 5)
#'
#' # Shrinks the gate in the first dimension by factor of 1/2
#' # and expands it in the other dimension by factor of 3
#' scale_gate(gs, node, c(0.5,3))
#' }
#'
#' @export
scale_gate.GatingHierarchy <- function(obj, y, scale = NULL, ...){
gate <- gh_pop_get_gate(obj, y)
gate <- scale_gate(gate, scale = scale)
gh_pop_set_gate(obj, y, gate)
}

#' @export
scale_gate.GatingSet <- function(obj, y, scale = NULL, ...){
gates <- gs_pop_get_gate(obj, y)
gates <- lapply(gates, function(gate) scale_gate(gate, scale = scale))
gs_pop_set_gate(obj, y, gates)
}

#' Simplified geometric rotation of gates associated with nodes
#'
#' Rotate a gate associated with a node of a \code{GatingHierarchy} or
#' \code{GatingSet}. This method is a wrapper for \code{\link[flowCore]{rotate_gate}} that enables
#' updating of the gate associated with a node of a \code{GatingHierarchy} or \code{GatingSet}.
#'
#' \code{rotate_gate} calls \code{\link{gs_pop_set_gate}} to modify the provided \code{GatingHierarchy} or \code{GatingSet}
#' directly so there is no need to re-assign its output. The arguments will be essentially identical to the
#' \code{flowCore} method, except for the specification of the target gate. Rather than being called on an
#' object of type \code{flowCore:filter}, here it is called on a \code{GatingHierarchy} or \code{GatingSet}
#' object with an additional character argument for specifying the node whose gate should be transformed.
#' The rest of the details below are taken from the \code{flowCore} documentation.
#'
#' This method allows for geometric rotation of filter types defined by simple geometric gates
#' for \code{rectangleGate} or \code{quadGate} objects, due to their definition as having 1-dimensional boundaries.
#'
#' The angle provided in the \code{deg} argument should be in degrees rather than radians. By default, the rotation
#' will be performed around the center of an \code{ellipsoidGate} or the centroid of the area encompassed by
#' a \code{polygonGate}. The \code{rot_center} argument allows for specification of a different center of rotation
#' for \code{polygonGate} objects (it is not yet implemented for \code{ellipsoidGate} objects) but
#' it is usually simpler to perform a rotation and a translation individually than to manually specify
#' the composition as a rotation around a shifted center.
#'
#' @name rotate_gate
#' @aliases rotate_gate,GatingHierarchy-method rotate_gate,GatingSet-method
#' @param obj A \code{GatingHierarchy} or \code{GatingSet} object
#' @param y A character specifying the node whose gate should be modified
#'
#' @param deg An angle in degrees by which the gate should be rotated in the counter-clockwise direction
#' @param rot_center A separate 2-dimensional center of rotation for the gate, if desired. By default, this will
#' be the center for \code{ellipsoidGate} objects or the centroid for \code{polygonGate} objects. The \code{rot_center} argument
#' is currently only supported for \code{polygonGate} objects.
#' @param ... not used
#' @examples
#' \dontrun{
#' #' # Rotates the original gate 15 degrees counter-clockwise
#' rotate_gate(gs, node, deg = 15)
#' # Rotates the original gate 270 degrees counter-clockwise
#' rotate_gate(gs, node, 270)
#' }
#'
#' @export
rotate_gate.GatingHierarchy <- function(obj, y, deg = NULL, rot_center = NULL, ...){
gate <- gh_pop_get_gate(obj, y)
gate <- rotate_gate(gate, deg = deg, rot_center = rot_center)
gh_pop_set_gate(obj, y, gate)
}

#' @export
rotate_gate.GatingSet <- function(obj, y, deg = NULL, rot_center = NULL, ...){
gates <- gs_pop_get_gate(obj, y)
gates <- lapply(gates, function(gate) rotate_gate(gate, deg = deg, rot_center = rot_center))
gs_pop_set_gate(obj, y, gates)
}

#' Simplified geometric translation of gates associated with nodes
#'
#' Shift the location of a gate associated with a node of a \code{GatingHierarchy} or
#' \code{GatingSet}. This method is a wrapper for \code{\link[flowCore]{shift_gate}} that enables
#' updating of the gate associated with a node of a \code{GatingHierarchy} or \code{GatingSet}.
#'
#' \code{shift_gate} calls \code{\link{gs_pop_set_gate}} to modify the provided \code{GatingHierarchy} or \code{GatingSet}
#' directly so there is no need to re-assign its output. The arguments will be essentially identical to the
#' \code{flowCore} method, except for the specification of the target gate. Rather than being called on an
#' object of type \code{flowCore::filter}, here it is called on a \code{GatingHierarchy} or \code{GatingSet}
#' object with an additional character argument for specifying the node whose gate should be transformed.
#' The rest of the details below are taken from the \code{flowCore} documentation.
#'
#' This method allows for geometric translation of filter types defined by simple geometric gates
#' The method provides two approaches to specify a translation. For \code{rectangleGate} objects, this will
#' shift the \code{min} and \code{max} bounds by the same amount in each specified dimension. For \code{quadGate}
#' objects, this will simply shift the divinding boundary in each dimension. For \code{ellipsoidGate} objects, this
#' will shift the center (and therefore all points of the ellipse). For \code{polgonGate} objects, this will simply
#' shift all of the points defining the polygon.
#'
#' The method allows two different approaches to shifting a gate. Through the \code{dx} and/or \code{dy} arguments,
#' a direct shift in each dimension can be provided. Alternatively, through the \code{center} argument, the gate
#' can be directly moved to a new location in relation to the old center of the gate. For \code{quadGate} objects,
#' this center is the intersection of the two dividing boundaries (so the value of the \code{boundary} slot). For
#' \code{rectangleGate} objects, this is the center of the rectangle defined by the intersections of the centers
#' of each interval. For \code{ellipsoidGate} objects, it is the center of the ellipsoid, given by the \code{mean}
#' slot. For \code{polygonGate} objects, the centroid of the old polygon will be calculated and shifted to the new
#' location provided by \code{center} and all other points on the polygon will be shifted by relation to the centroid.
#'
#' @name shift_gate
#' @aliases shift_gate,GatingHierarchy-method shift_gate,GatingSet-method
#' @param obj A \code{GatingHierarchy} or \code{GatingSet} object
#' @param y A character specifying the node whose gate should be modified
#'
#' @param dx Either a numeric scalar or numeric vector. If it is scalar, this is just the desired shift of the gate in
#' its first dimension. If it is a vector, it specifies both \code{dx} and \code{dy} as \code{(dx,dy)}.
#' This provides an alternate syntax for shifting gates, as well as allowing shifts of \code{ellipsoidGate} objects
#' in more than 2 dimensions.
#' @param dy A numeric scalar specifying the desired shift of the gate in its second dimension.
#' @param center A numeric vector specifying where the center or centroid should be moved (rather than specifiying \code{dx}
#' and/or \code{dy})
#' @param ... not used
#' @examples
#' \dontrun{
#' # Moves the entire gate +500 in its first dimension and 0 in its second dimension
#' shift_gate(gs, node, dx = 500)
#'
#' #Moves the entire gate +250 in its first dimension and +700 in its second dimension
#' shift_gate(gs, node, dx = 500, dy = 700)
#'
#' # Same as previous
#' shift_gate(gs, node, c(500,700))
#'
#' # Move the gate based on shifting its center to (700, 1000)
#' shift_gate(gs, node, center = c(700, 1000))
#' }
#'
#' @export
shift_gate.GatingHierarchy <- function(obj, y, dx=NULL, dy=NULL, center=NULL, ...){
gate <- gh_pop_get_gate(obj, y)
gate <- shift_gate(gate, dx = dx, dy = dy, center = center)
gh_pop_set_gate(obj, y, gate)
}

#' @export
shift_gate.GatingSet <- function(obj, y, dx=NULL, dy=NULL, center=NULL, ...){
gates <- gs_pop_get_gate(obj, y)
gates <- lapply(gates, function(gate) shift_gate(gate, dx = dx, dy = dy, center = center))
gs_pop_set_gate(obj, y, gates)
}


RGLab/flowWorkspace documentation built on July 18, 2021, 9:05 p.m.