R/transforms.R

In RGLab/CytoML: A GatingML Interface for Cross Platform Cytometry Data Sharing

# This file was copied from the flowUtils package on 5/6/2019.
# This represents the work of Josef Spidlen and the other flowUtils 
# authors who are also accordingly credited in the authors list for CytoML.
# 
# Details:
# https://github.com/jspidlen/flowUtils/
# GitHub version: 1.35.8
# Bioconductor version: 1.49.0

#' @include gate-methods.R
NULL

setMethod("identifyNode", "http...www.isac.net.org.std.Gating.ML.v2.0.transformations_transformation",
    function(object,flowEnv,...)
    {
        if (flowEnv[['.flowUtilsRead.GatingML.PassNo']] == 1)
		{
            transName=sapply(xmlChildren(object), xmlName)
            dispatchGatingML2Transform(transName, object, flowEnv)
		}
    }
)

dispatchGatingML2Transform <- function(transName, node, flowEnv)
{
    if (length(transName) > 1) transName = transName[[length(transName)]]
    temp = switch(transName,
                "fasinh" = fasinhTr(node, flowEnv),
                "flin" = flinTr(node, flowEnv),
                "flog" = flogTr(node, flowEnv),
                "logicle" = logicleTr(node, flowEnv),
				"hyperlog" = hyperlogTr(node, flowEnv),
                "fratio" = fratioTr(node, flowEnv)
                )
    name=as.character(slot(temp,"transformationId"))
    flowEnv[[name]]=temp
    temp
}



setMethod("identifyNode","http...www.isac.net.org.std.Gating.ML.v1.5.transformations_transformation",
          function(object,flowEnv,...)
	  {  
	      transName=sapply(xmlChildren(object),xmlName)
              dispatchTransform(transName,object,flowEnv)
	  } 
       	 )
         
dispatchTransform<-function(transName,node,flowEnv)
{      
    temp=switch(transName,
                "split-scale"=transSplitScale(node,flowEnv),
                "ratio"=transRatio(node,flowEnv),
                "dg1polynomial"=transDg1polynomial(node,flowEnv),
                "quadratic"=transQuadratic(node,flowEnv),
                "sqrt"=transSquareroot(node,flowEnv),
                "ln"=transLogarithm(node,flowEnv),
                "exponential"=transExponential(node,flowEnv),
                "asinh"=transInverseHyperbolicSin(node,flowEnv),
                "sinh"=transHyperbolicSin(node,flowEnv),
                "inverse-split-scale"=transInvSplitScale(node,flowEnv),
                "compensation"=transCompensation(node,flowEnv),
                "hyperlog"=transHyperLog(node,flowEnv),
                "EH"=transEH(node,flowEnv)
                )

    name=as.character(slot(temp,"transformationId"))
    flowEnv[[name]]=temp
    temp
}

####################################################
####--------- Gating-ML 2.0 transforms -------------
####################################################

# NOTE TO ALL Gating-ML 2.0 scale transforms:
# *******************************************
# Gating-ML 2.0 transforms are defined as applicable to any FCS parameters, so we will create one
# "placeholder" transformation with parameters = "any" and later on, when a transformation is 
# actually needed (i.e., paired with FCS parameters), then we will "copy" this transformation and
# fill out the parameters accodingly.

####----------- fasinh transformation --------------
fasinhTr <- function(node, flowEnv)
{       
    transformationId = (xmlGetAttr(node, "id", genid(flowEnv)))
    coefficientList = xmlElementsByTagName(node, "fasinh", recursive=FALSE)
    pT = sapply(coefficientList, xmlGetAttr, "T", default=262144) # It's questionable whether to use
    pM = sapply(coefficientList, xmlGetAttr, "M", default=4.5)    # defaults here or just let the
    pA = sapply(coefficientList, xmlGetAttr, "A", default=0)      # method fail...
    boundMin = (xmlGetAttr(node, "boundMin", -Inf))
    boundMax = (xmlGetAttr(node, "boundMax", Inf))
    return(asinhtGml2(parameters = "any", T = as.numeric(pT), M = as.numeric(pM), 
      A = as.numeric(pA), transformationId = transformationId,
      boundMin = as.numeric(boundMin), boundMax = as.numeric(boundMax)))
}

####----------- flin transformation --------------
flinTr <- function(node, flowEnv)
{       
    transformationId = (xmlGetAttr(node, "id", genid(flowEnv)))
    coefficientList = xmlElementsByTagName(node, "flin", recursive=FALSE)
    pT = sapply(coefficientList, xmlGetAttr, "T", default=262144) # It's questionable whether to use defaults
    pA = sapply(coefficientList, xmlGetAttr, "A", default=0)      # here or just let the method fail...
    boundMin = (xmlGetAttr(node, "boundMin", -Inf))
    boundMax = (xmlGetAttr(node, "boundMax", Inf))
    return(lintGml2(parameters = "any", T = as.numeric(pT), A = as.numeric(pA), 
      transformationId = transformationId,
      boundMin = as.numeric(boundMin), boundMax = as.numeric(boundMax)))
}

####----------- flog transformation --------------
flogTr <- function(node, flowEnv)
{       
	transformationId = (xmlGetAttr(node, "id", genid(flowEnv)))
	coefficientList = xmlElementsByTagName(node, "flog", recursive=FALSE)
	pT = sapply(coefficientList, xmlGetAttr, "T", default=262144) # It's questionable whether to use defaults
	pM = sapply(coefficientList, xmlGetAttr, "M", default=4.5)    # here or just let the method fail...
	boundMin = (xmlGetAttr(node, "boundMin", -Inf))
	boundMax = (xmlGetAttr(node, "boundMax", Inf))
  return(logtGml2(parameters = "any", T = as.numeric(pT), M = as.numeric(pM), 
		transformationId = transformationId,
		boundMin = as.numeric(boundMin), boundMax = as.numeric(boundMax)))
}

####----------- Logicle transformation --------------
logicleTr <- function(node, flowEnv)
{       
    transformationId = (xmlGetAttr(node, "id", genid(flowEnv)))
    coefficientList = xmlElementsByTagName(node, "logicle", recursive=FALSE)
    pT = sapply(coefficientList, xmlGetAttr, "T", default=262144) # It's questionable whether to use
    pM = sapply(coefficientList, xmlGetAttr, "M", default=4.5)    # defaults here or just let the
    pW = sapply(coefficientList, xmlGetAttr, "W", default=0.5)    # method fail...
    pA = sapply(coefficientList, xmlGetAttr, "A", default=0)
    boundMin = (xmlGetAttr(node, "boundMin", -Inf))
    boundMax = (xmlGetAttr(node, "boundMax", Inf))
    return(logicletGml2(parameters = "any", T = as.numeric(pT), M = as.numeric(pM), 
      W = as.numeric(pW), A = as.numeric(pA), transformationId = transformationId,
      boundMin = as.numeric(boundMin), boundMax = as.numeric(boundMax)))
}

####----------- Hyperlog transformation --------------
hyperlogTr <- function(node, flowEnv)
{   
    transformationId = (xmlGetAttr(node, "id", genid(flowEnv)))
    coefficientList = xmlElementsByTagName(node, "hyperlog", recursive=FALSE)
    pT = sapply(coefficientList, xmlGetAttr, "T", default=262144) # It's questionable whether to use
    pM = sapply(coefficientList, xmlGetAttr, "M", default=4.5)    # defaults here or just let the
    pW = sapply(coefficientList, xmlGetAttr, "W", default=0.5)    # method fail...
    pA = sapply(coefficientList, xmlGetAttr, "A", default=0)
    boundMin = (xmlGetAttr(node, "boundMin", -Inf))
    boundMax = (xmlGetAttr(node, "boundMax", Inf))
    return(hyperlogtGml2(parameters = "any", T = as.numeric(pT), M = as.numeric(pM), 
      W = as.numeric(pW), A = as.numeric(pA), transformationId = transformationId,
      boundMin = as.numeric(boundMin), boundMax = as.numeric(boundMax)))
}

####----------- Ratio transformation --------------
# Note that unlike the scale transformations above, the Gating-ML 2.0
# ratio (fratio) transformation is not applicable on arbitrary parameters.
# Instead, the parameters are specified when the transformation is defined.
# Therefore, we don't need to do create the generic version with "any" parameters.
fratioTr <- function(node, flowEnv)
{
    transformationId = (xmlGetAttr(node, "id", genid(flowEnv)))
    coefficientList = xmlElementsByTagName(node, "fratio", recursive=FALSE)
    pA = sapply(coefficientList, xmlGetAttr, "A", default=1) # It's questionable whether to use
    pB = sapply(coefficientList, xmlGetAttr, "B", default=0) # defaults here or just let the
    pC = sapply(coefficientList, xmlGetAttr, "C", default=0) # method fail...
    boundMin = (xmlGetAttr(node, "boundMin", -Inf))
    boundMax = (xmlGetAttr(node, "boundMax", Inf))
    parameters <- getGatingML2RatioParameterList(node, flowEnv)
    return(ratiotGml2(numerator = parameters[[1]], denominator = parameters[[2]], pA = as.numeric(pA),
      pB = as.numeric(pB), pC = as.numeric(pC), transformationId = transformationId,
      boundMin = as.numeric(boundMin), boundMax = as.numeric(boundMax)))
}

####################################################
####--------- Gating-ML 1.5 transforms -------------
####################################################

####----------Degree n polynomial ------------------

transDg1polynomial<-function(node,flowEnv)
{        
    transformationId=(xmlGetAttr(node,"id",genid(flowEnv)))
    coefficientList=xmlElementsByTagName(node,"coefficient",recursive=TRUE)
    len=length(coefficientList)-1
    values=sapply(coefficientList,xmlGetAttr,"value")		
    a=as.numeric(values[1:len])
    b=as.numeric(values[len+1])
    parameters<-getParameterList(node,0,flowEnv)
    parm=new("parameters",.Data=parameters)
    return(dg1polynomial(parameters=parm,a=a,b=b,transformationId=transformationId))				
}
####-----------Ratio transformation ------------------
transRatio<-function(node,flowEnv)
{      
    transformationId=(xmlGetAttr(node,"id",genid(flowEnv)))
    parameters<-getParameterList(node,1,flowEnv)
    return(ratio(numerator=parameters[[1]],denominator=parameters[[2]],transformationId=transformationId))			
}

####-----------Quadratic transformation ------------------

transQuadratic<-function(node,flowEnv)
{       
    transformationId=(xmlGetAttr(node,"id",genid(flowEnv)))
    coefficientList=xmlElementsByTagName(node,"quadratic",recursive=FALSE)
    coefficients=sapply(coefficientList,xmlGetAttr,"a")		
    parameters<-getParameterList(node,1,flowEnv)
    return(quadratic(parameters=parameters[[1]],a=as.numeric(coefficients),transformationId=transformationId))	

}
	
####-----------Square root transformation ------------------
transSquareroot<-function(node,flowEnv)
{      
    transformationId=(xmlGetAttr(node,"id",genid(flowEnv)))
    coefficientList=xmlElementsByTagName(node,"sqrt",recursive=FALSE)
    coefficients=sapply(coefficientList,xmlGetAttr,"a")		
    parameters<-getParameterList(node,1,flowEnv)
    return(squareroot(parameters=parameters[[1]],a=as.numeric(coefficients),transformationId=transformationId))
}
####-----------Logarithmic transformation ------------------	
transLogarithm<-function(node,flowEnv)
{      
        
    transformationId=(xmlGetAttr(node,"id",genid(flowEnv)))
    coefficientList=xmlElementsByTagName(node,"ln",recursive=FALSE)
    a=sapply(coefficientList,xmlGetAttr,"a")		
    b=sapply(coefficientList,xmlGetAttr,"b")		
    parameters<-getParameterList(node,0,flowEnv)   
    return(logarithm(parameters=parameters[[1]],a=as.numeric(a),b=as.numeric(b),transformationId=transformationId))
}
####-----------Exponential transformation ------------------	
transExponential<-function(node,flowEnv)
{       
    transformationId=(xmlGetAttr(node,"id",genid(flowEnv)))
    coefficientList=xmlElementsByTagName(node,"exponential",recursive=FALSE)
    a=sapply(coefficientList,xmlGetAttr,"a")		
    b=sapply(coefficientList,xmlGetAttr,"b")		
    parameters<-getParameterList(node,1,flowEnv)   
    return(exponential(parameters=parameters[[1]],a=as.numeric(a),b=as.numeric(b),transformationId=transformationId))
}
####-----------Inverse Hyperbolic sin transformation ------------------	
transInverseHyperbolicSin<-function(node,flowEnv)
{       
    transformationId=(xmlGetAttr(node,"id",genid(flowEnv)))
    coefficientList=xmlElementsByTagName(node,"asinh",recursive=FALSE)
    a=sapply(coefficientList,xmlGetAttr,"a")		
    b=sapply(coefficientList,xmlGetAttr,"b")		
    parameters<-getParameterList(node,0,flowEnv)   
    return(asinht(parameters=parameters[[1]],a=as.numeric(a),b=as.numeric(b),transformationId=transformationId))
}

####-----------Hyperbolic sin transformation ------------------	
transHyperbolicSin<-function(node,flowEnv)
{      
    transformationId=(xmlGetAttr(node,"id",genid(flowEnv)))
    coefficientList=xmlElementsByTagName(node,"sinh",recursive=FALSE)
    a=sapply(coefficientList,xmlGetAttr,"a")		
    b=sapply(coefficientList,xmlGetAttr,"b")		
    parameters<-getParameterList(node,0,flowEnv)  
    return(sinht(parameters=parameters[[1]],a=as.numeric(a),b=as.numeric(b),transformationId=transformationId))
}

####-----------Split scale transformation ------------------	
transSplitScale<-function(node,flowEnv)
{      
    transformationId=(xmlGetAttr(node,"id",genid(flowEnv)))
    coefficientList=xmlElementsByTagName(node,"split-scale",recursive=FALSE)
    r=sapply(coefficientList,xmlGetAttr,"r")		
    maxValue=sapply(coefficientList,xmlGetAttr,"maxValue")	
    transitionChannel=sapply(coefficientList,xmlGetAttr,"transitionChannel")		
    parameters<-getParameterList(node,0,flowEnv)  
    return(splitscale(parameters=parameters[[1]],r=as.numeric(r),maxValue=as.numeric(maxValue),transitionChannel=as.numeric(transitionChannel),transformationId=transformationId))
}


####-----------Inverse Split scale transformation ------------------	
transInvSplitScale<-function(node,flowEnv)
{      
    transformationId=(xmlGetAttr(node,"id",genid(flowEnv)))
    coefficientList=xmlElementsByTagName(node,"inverse-split-scale",recursive=FALSE)
    r=sapply(coefficientList,xmlGetAttr,"r")		
    maxValue=sapply(coefficientList,xmlGetAttr,"maxValue")	
    transitionChannel=sapply(coefficientList,xmlGetAttr,"transitionChannel")		
    parameters<-getParameterList(node,0,flowEnv)  
    return(invsplitscale(parameters=parameters[[1]],r=as.numeric(r),maxValue=as.numeric(maxValue),transitionChannel=as.numeric(transitionChannel),transformationId=transformationId))
}

transHyperLog<-function(node,flowEnv)
{     
    transformationId=(xmlGetAttr(node,"id",genid(flowEnv)))
    coefficientList=xmlElementsByTagName(node,"hyperlog",recursive=FALSE)
    a=sapply(coefficientList,xmlGetAttr,"a")		
    b=sapply(coefficientList,xmlGetAttr,"b")		
    parameters<-getParameterList(node,0,flowEnv)  
    return(hyperlog(parameters=parameters[[1]],a=as.numeric(a),b=as.numeric(b),transformationId=transformationId))
}

transEH<-function(node,flowEnv)
{     
    transformationId=(xmlGetAttr(node,"id",genid(flowEnv)))
    coefficientList=xmlElementsByTagName(node,"EH",recursive=FALSE)
    a=sapply(coefficientList,xmlGetAttr,"a")		
    b=sapply(coefficientList,xmlGetAttr,"b")		
    parameters<-getParameterList(node,0,flowEnv)  
    return(EHtrans(parameters=parameters[[1]],a=as.numeric(a),b=as.numeric(b),transformationId=transformationId))
}