Nothing
#' Separate the additive and the regenerative curves
#'
#' Internal function called by \link{analyse_TL.MAAD}. \cr
#' This function separates the additive curves from the regenerative curves using a vector containing the data type associate with each curve.
#' Additive curves have "Natural" or "N+dose" as datatype.
#' Regenerative curves have "Bleach" or "Bleach+dose" as datatype.
#' Other datatypes are not supported.
#'
#'
#' @param doses
#' \link{numeric} (\bold{required}): doses vector
#' @param Lx
#' \link{numeric} (\bold{required}): Lx matrix
#' @param Lx.error
#' \link{numeric} (\bold{required}): Error for the Lx matrix.
#' @param dTypes
#' \link{character} (\bold{required}): data type vector.
#'
#' @details
#' \bold{Warning}: This function is an internal function and should not be used except for development purposes.
#' Internal functions can be heavily modified and even renamed or removed in new version of the package.
#'
#' @author David Strebler, University of Cologne (Germany).
#'
#' @export calc_TL.MAAD.separate
calc_TL.MAAD.separate <- function(
Lx,
Lx.error,
doses,
dTypes
){
# ------------------------------------------------------------------------------
# Integrity Check
# ------------------------------------------------------------------------------
if(!is.character(dTypes)){
stop("[calc_TL.MAAD.separate] Error: names is not of type 'character'.")
}
if(!is.numeric(doses)){
stop("[calc_TL.MAAD.separate] Error: Lx is not of type 'numeric'.")
}
if(!is.numeric(Lx)){
stop("[calc_TL.MAAD.separate] Error: Lx is not of type 'numeric'.")
}
if(!is.numeric(Lx.error)){
stop("[calc_TL.MAAD.separate] Error: Lx.error is not of type 'numeric'.")
}
# ------------------------------------------------------------------------------
V_ADDITIVE <- c("Natural", "N+dose")
C_ADDITIVE <- "A"
V_REGENERATIVE <- c("Bleach", "Bleach+dose")
C_REGENERATIVE <- "R"
# ------------------------------------------------------------------------------
#Values Check
if(length(dTypes) != length(doses)){
stop("[calc_TL.MAAD.separate] Error: dTypes and doses do not have the same size.")
}
if(length(Lx) != length(Lx.error)){
stop("[calc_TL.MAAD.separate] Error: Lx and Lx.error do not have the same size.")
}
if(length(doses) != ncol(Lx)){
stop("[calc_TL.MAAD.separate] Error: Lx and doses do not have the same size.")
}
if(FALSE %in% (dTypes %in% c(V_ADDITIVE,V_REGENERATIVE))){
stop("[calc_TL.MAAD.separate] Error: Data type not supported.")
}
# ------------------------------------------------------------------------------
uDoses <- unique(doses[order(doses)])
temp.n <- 0
aDoses <- vector()
aNames <- vector()
aLx <- vector()
aLx.error <- vector()
rDoses <- vector()
rNames <- vector()
rLx <- vector()
rLx.error <- vector()
for(temp.dose in uDoses){
if(temp.dose > 0){
temp.n <- temp.n+1
}
#Signal selection based on the dose step
for(i in 1: length(doses)){
if(doses[i] == temp.dose){
if(dTypes[i] %in% V_ADDITIVE){
temp.Lx <- Lx[,i]
temp.Lx.error <- Lx.error[,i]
temp.name <- paste(C_ADDITIVE,temp.n, sep="")
if(temp.name == "A0"){
temp.name <- "N"
}
aNames <- c(aNames, temp.name)
aDoses <- c(aDoses, temp.dose)
aLx <- cbind(aLx, temp.Lx)
aLx.error <- cbind(aLx.error, temp.Lx.error)
}else if(dTypes[i] %in% V_REGENERATIVE){
temp.Lx <- Lx[,i]
temp.Lx.error <- Lx.error[,i]
temp.name <- paste(C_REGENERATIVE,temp.n, sep="")
rNames <- c(rNames, temp.name)
rDoses <- c(rDoses, temp.dose)
rLx <- cbind(rLx, temp.Lx)
rLx.error <- cbind(rLx.error, temp.Lx.error)
}else{
stop("[calc_TL.MAAD.separate] Error: Data type not supported.")
}
}
}
}
# Column naming
if(length(aLx)>0){
colnames(aLx) <- aNames
colnames(aLx.error) <- aNames
}
if(length(rLx)>0){
colnames(rLx) <- rNames
colnames(rLx.error) <- rNames
}
#Values Check
aLx[!is.finite(aLx)] <- NA
aLx.error[!is.finite(aLx.error)] <- NA
rLx[!is.finite(rLx)] <- NA
rLx.error[!is.finite(rLx.error)] <- NA
# ---------------------------------------------------------------------
result <- list(aDoses=aDoses,
aNames=aNames,
aLx=aLx,
aLx.error=aLx.error,
rDoses=rDoses,
rNames=rNames,
rLx=rLx,
rLx.error=rLx.error)
new.originator <- as.character(match.call()[[1]])
new.plotData <- list()
new.TLum.Results.calc_TL.MAAD.separate <- set_TLum.Results(originator= new.originator,
data = result,
plotData = new.plotData)
return(new.TLum.Results.calc_TL.MAAD.separate)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.