diff --git a/DESCRIPTION b/DESCRIPTION index c5e0d16..11dfa8b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -44,6 +44,7 @@ Collate: AllClasses.R flowFrame-accessors.R flowSet-accessors.R + gate-accessors.R transform_gate-methods.R coerce.R logicalFilterResult-accessors.R diff --git a/R/AllClasses.R b/R/AllClasses.R index 6243671..a341984 100644 --- a/R/AllClasses.R +++ b/R/AllClasses.R @@ -2495,7 +2495,7 @@ ellipsoidGate <- function(..., .gate, mean, distance=1, checkClass(distance, "numeric", 1) parms <- prepareInputs(parseDots(list(...)), .gate) names(mean) <- sapply(parms$parameters, parameters) - new("ellipsoidGate", filterId=filterId, parameters=parms$parameters, + new("ellipsoidGate", filterId=filterId, parameters=unname(parms$parameters), cov=parms$values, mean=mean, distance=distance) } @@ -5224,9 +5224,21 @@ setClass("transformList", ## constructor #' @export -transformList <- function(from, tfun, to=from, +transformList <- function(from, tfun, to, transformationId="defaultTransformation") { + if(missing(from)) { + from <- names(tfun) + if(is.null(from)) { + stop( + "channel names must be supplied to 'from' or included ", + "as names in 'tfun'!" + ) + } + } + if(missing(to)) { + to <- from + } from <- unique(from) to <- unique(to) if(!is.character(from) || !is.character(to) || length(from) != length(to)) diff --git a/R/flowFrame-accessors.R b/R/flowFrame-accessors.R index 54f8d5c..4d72802 100644 --- a/R/flowFrame-accessors.R +++ b/R/flowFrame-accessors.R @@ -826,24 +826,28 @@ setMethod("compensate", -#' Transform a flowFrame or flowSet +#' Transform a flowFrame, flowSet or gate object #' #' Similar to the base transform method, this will transform the values of -#' a flowFrame or flowSet object according to the transformations specified +#' a flowFrame, flowSet or gate object according to the transformations specified #' in one of two ways: -#' 1. a [transformList][flowCore::transformList-class] or list of [transform][flowCore::transform-class] objects +#' 1. a \code{transformList} or list of \code{transform} objects #' 2. named arguments specifying transformations to be applied to channels (see details) #' #' @name transform #' @aliases transform,flowFrame-method transform,flowSet-method -#' @param _data a flowFrame or flowSet object +#' transform,rectangleGate-method transform,polygonGate-method +#' transform,ellipsoidGate-method transform,quadGate-method +#' transform,filters-method +#' @param _data a flowFrame, flowSet or gate object #' @param translist a transformList object #' @param ... other arguments. e.g. `FL1-H` = myFunc(`FL1-H`) #' +#' @return A transformed flowFrame, flowSet or gate object. #' #' @details To specify the transformations in the second way, the names of these arguments #' should correspond to the new channel names and the values should be functions applied to -#' channels currently present in the flowFrame or flowSet. There are a few examples below. +#' channels currently present in the flowFrame, flowSet or gate. There are a few examples below. #' #' @examples #' data(GvHD) diff --git a/R/gate-accessors.R b/R/gate-accessors.R new file mode 100644 index 0000000..cf6d715 --- /dev/null +++ b/R/gate-accessors.R @@ -0,0 +1,199 @@ +## ============================================================================= +## Gate objects define boundaries for populations +## ============================================================================= + +#' @export +setMethod( + "transform", + signature = signature(`_data` = "rectangleGate"), + definition = function(`_data`, + translist, + ...) { + + gate <- `_data` + if(!(missing(translist))){ + #check if it is a transformList + res <- try(class(translist), silent = TRUE) + if(res != "transformList") { + err_msg <- attr(res, "condition")[["message"]] + err_msg <- paste( + err_msg, + "!Please make sure the unnamed argument is a valid 'transformList' object!" + ) + stop(err_msg) + } else { + params <- unname(parameters(gate)) + trans_params <- colnames(translist) + # transformation required + for(param in params) { + if(param %in% trans_params) { + tfun <- translist@transforms[[param]]@f + if(!is.infinite(gate@min[param])) { + gate@min[param] <- tfun(gate@min[param]) + } + if(!is.infinite(gate@max[param])) { + gate@max[param] <- tfun(gate@max[param]) + } + } + } + return(gate) + } + # apply named transformations of form `FSC-H`=asinhTrans(`FSC-H`) + } else { + coords <- as.matrix( + transform( + as.data.frame( + rbind( + min = gate@min, + max = gate@max + ) + ), + ... + ) + ) + gate@min <- unlist(coords[1, , drop = TRUE]) + gate@max <- unlist(coords[2, , drop = TRUE]) + return(gate) + } + } +) + +#' @export +setMethod( + "transform", + signature = signature(`_data` = "polygonGate"), + definition = function(`_data`, + translist, + ...) { + + gate <- `_data` + if(!(missing(translist))){ + #check if it is a transformList + res <- try(class(translist), silent = TRUE) + if(res != "transformList") { + err_msg <- attr(res, "condition")[["message"]] + err_msg <- paste( + err_msg, + "!Please make sure the unnamed argument is a valid 'transformList' object!" + ) + stop(err_msg) + } else { + params <- unname(parameters(gate)) + trans_params <- colnames(translist) + # transformation required + for(param in params) { + if(param %in% trans_params) { + tfun <- translist@transforms[[param]]@f + coords <- gate@boundaries[, param] + coords[!is.infinite(coords)] <- tfun(coords[!is.infinite(coords)]) + gate@boundaries[, param] <- coords + } + } + return(gate) + } + # apply named transformations of form `FSC-H`=asinhTrans(`FSC-H`) + } else { + gate@boundaries <- as.matrix( + transform( + as.data.frame( + gate@boundaries + ), + ... + ) + ) + return(gate) + } + } +) + +#' @export +setMethod( + "transform", + signature = signature(`_data` = "ellipsoidGate"), + definition = function(`_data`, + translist, + ...) { + + # cannot preserve ellipse geometry after transform -> polygonGate + gate <- as(`_data`, "polygonGate") + gate <- transform(gate, translist = translist, ...) + return(gate) + + } +) + +#' @export +setMethod( + "transform", + signature = signature(`_data` = "quadGate"), + definition = function(`_data`, + translist, + ...) { + + gate <- `_data` + if(!(missing(translist))){ + #check if it is a transformList + res <- try(class(translist), silent = TRUE) + if(res != "transformList") { + err_msg <- attr(res, "condition")[["message"]] + err_msg <- paste( + err_msg, + "!Please make sure the unnamed argument is a valid 'transformList' object!" + ) + stop(err_msg) + } else { + params <- unname(parameters(gate)) + trans_params <- colnames(translist) + # transformation required + for(param in params) { + if(param %in% trans_params) { + tfun <- translist@transforms[[param]]@f + if(!is.infinite(gate@boundary[param])) { + gate@boundary[param] <- tfun(gate@boundary[param]) + } + } + } + return(gate) + } + # apply named transformations of form `FSC-H`=asinhTrans(`FSC-H`) + } else { + coords <- as.matrix( + transform( + as.data.frame( + rbind( + gate@boundary + ) + ), + ... + ) + ) + gate@boundary <- unlist(coords[1, , drop = TRUE]) + return(gate) + } + } +) + +#' @export +setMethod( + "transform", + signature = signature(`_data` = "filters"), + definition = function(`_data`, + translist, + ...) { + + # transform each gate in filters list + gate <- filters( + lapply( + unlist(`_data`), + function(z) { + transform( + z, + translist = translist, + ... + ) + } + ) + ) + return(gate) + } +) diff --git a/man/multiRangeGate-class.Rd b/man/multiRangeGate-class.Rd new file mode 100644 index 0000000..d1efb17 --- /dev/null +++ b/man/multiRangeGate-class.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllClasses.R +\docType{class} +\name{multiRangeGate-class} +\alias{multiRangeGate-class} +\alias{multiRangeGate} +\alias{summary,multiRangeGate-method} +\alias{show,multiRangeGate-method} +\title{Multirange Gate class} +\usage{ +multiRangeGate(ranges, filterId="defaultMultiRangeGate") +} +\arguments{ +\item{filterId}{An optional parameter that sets the \code{filterId} of this +gate. The object can later be identified by this name.} + +\item{ranges}{A definition of the gate. This can be a list of min,max ranges +(see the prototype).} +} +\value{ +Returns a \code{\link{multiRangeGate}} object for use in filtering +\code{\link{flowFrame}}s or other flow cytometry objects. +} +\description{ +Multirange Gate class +} diff --git a/man/transform.Rd b/man/transform.Rd index 083006b..82b9d2c 100644 --- a/man/transform.Rd +++ b/man/transform.Rd @@ -4,28 +4,36 @@ \alias{transform} \alias{transform,flowFrame-method} \alias{transform,flowSet-method} -\title{Transform a flowFrame or flowSet} +\alias{transform,rectangleGate-method} +\alias{transform,polygonGate-method} +\alias{transform,ellipsoidGate-method} +\alias{transform,quadGate-method} +\alias{transform,filters-method} +\title{Transform a flowFrame, flowSet or gate object} \usage{ \S4method{transform}{flowFrame}(`_data`, translist, ...) } \arguments{ -\item{_data}{a flowFrame or flowSet object} +\item{_data}{a flowFrame, flowSet or gate object} \item{translist}{a transformList object} \item{...}{other arguments. e.g. `FL1-H` = myFunc(`FL1-H`)} } +\value{ +A transformed flowFrame, flowSet or gate object. +} \description{ Similar to the base transform method, this will transform the values of -a flowFrame or flowSet object according to the transformations specified +a flowFrame, flowSet or gate object according to the transformations specified in one of two ways: -1. a [transformList][flowCore::transformList-class] or list of [transform][flowCore::transform-class] objects +1. a \code{transformList} or list of \code{transform} objects 2. named arguments specifying transformations to be applied to channels (see details) } \details{ To specify the transformations in the second way, the names of these arguments should correspond to the new channel names and the values should be functions applied to -channels currently present in the flowFrame or flowSet. There are a few examples below. +channels currently present in the flowFrame, flowSet or gate. There are a few examples below. } \examples{ data(GvHD) diff --git a/tests/testthat/test-gate-transform.R b/tests/testthat/test-gate-transform.R new file mode 100644 index 0000000..6e29c96 --- /dev/null +++ b/tests/testthat/test-gate-transform.R @@ -0,0 +1,144 @@ +context("transformation of gate co-ordinates") + +# PE inverse transformer with cofactor = 50 +pe_sinh_trans <- function(x, cofactor = 50) { + sinh(x) * cofactor +} + +# APC inverse transformer with cofactor = 100 +apc_sinh_trans <- function(x, cofactor = 100) { + sinh(x) * cofactor +} + +# extract inverse transformers to transformList +inv_trans <- transformList( + c("PE-A", "APC-A"), + list( + "PE-A" = pe_sinh_trans, + "APC-A" = apc_sinh_trans + ) +) + +# NOTE: here we create gates on the transformed scale +# PE-A range = c(0, 9.26) - asinh(x/50) +# APC-A range = c(0, 8.56) - asinh(x/100) + +# rectangleGate +rg <- rectangleGate( + "PE-A" = c(4, 6), + "APC-A" = c(3.5, 7), + filterId = "rect" +) + +# polygonGate +pg <- as(rg, "polygonGate") + +# ellipsoidGate +eg <- ellipsoidGate( + .gate = matrix( + c( + 6879, + 3612, + 3612, + 5215 + ), + ncol=2, + dimnames = list( + c("PE-A", "APC-A"), + c("PE-A", "APC-A") + ) + ), + mean = c( + "PE-A" = 4.5, + "APC-A" = 4 + ), + filterId = "ellipse" +) + +# quadGate +qg <- quadGate( + "PE-A" = 4.5, + "APC-A" = 4, + filterId = "quad" +) + +# filters - all supported gate types +gates <- filters( + list( + "rect" = rg, + "poly" = pg, + "ellipse" = eg, + "quad" = qg + ) +) + +# test filters method to cover all gate type tests +test_that( + "transform gate co-ordinates", { + # transform to get linear gates + gates_inv <- transform( + gates, + inv_trans + ) + # rectangleGate + expect_equal( + rbind( + gates_inv[["rect"]]@min, + gates_inv[["rect"]]@max + ), + matrix( + c( + 1364.5, + 1654.3, + 10085.7, + 54831.6 + ), + nrow = 2, + ncol = 2, + byrow = TRUE, + dimnames = list( + NULL, + c("PE-A", "APC-A") + ) + ), + tolerance = 0.1 + ) + + # polygonGate + expect_equal( + gates_inv[["poly"]]@boundaries, + matrix( + c( + 1364.5, 1654.3, + 10085.7, 1654.3, + 10085.7, 54831.6, + 1364.5, 54831.6 + ), + ncol = 2, + nrow = 4, + byrow = TRUE, + dimnames = list( + NULL, + c("PE-A", "APC-A") + ) + ), + tolerance = 0.1 + ) + + # ellipsoidGate -> calls polygonGate method -> no need to check coords here + expect_is( + gates_inv[["ellipse"]], + "polygonGate" + ) + + # quadGate + expect_equal( + gates_inv[["quad"]]@boundary, + c( + "PE-A" = 2250.2, + "APC-A" = 2729 + ), + tolerance = 0.1 + ) + } +) \ No newline at end of file