R/preProcess.R

In TIMP: Fitting Separable Nonlinear Models in Spectroscopy and Microscopy

"preProcess" <-
function (data, sample = 1, sample_time = 1, sample_lambda = 1, 
    sel_time = vector(), sel_lambda = vector(), baselinetime = vector(), 
    baselinelambda = vector(), scalx = NULL, scalx2 = NULL, 
    sel_lambda_ab = vector(), sel_time_ab = vector(), rm_x2 = vector(), 
    rm_x = vector(), svdResid = list(), numV = 0, sel_special = list(),
    doubleDiff = FALSE, doubleDiffFile = "doubleDiff.txt") 
{
    ## Note that the options are _not_ compatible with each other
    ## call preProcess repeatedly for consistency
  
  dataN <- sample_sel(data = data, sample = sample, sample_time = 
                      sample_time, sample_lambda = sample_lambda, 
                      sel_time = sel_time, sel_lambda = sel_lambda, 
                      sel_lambda_ab = sel_lambda_ab,
                      sel_time_ab = sel_time_ab, sel_special = sel_special)
  if (length(baselinelambda) != 0) 
    dataN <- baseCorlambda(dataN, baselinelambda)
  if (length(baselinetime) != 0) 
    dataN <- baseCortime(dataN, baselinetime)
  if (length(rm_x2) != 0) { 
    dataN@psi.df <- dataN@psi.df[,-rm_x2] 
    dataN@x2 <-  dataN@x2[-rm_x2]
    dataN@nl <- dataN@nl - length(rm_x2)
  }
  if (length(rm_x) != 0) { 
    dataN@psi.df <- dataN@psi.df[-rm_x,] 
    dataN@x <-  dataN@x[-rm_x]
    dataN@nt <- dataN@nt - length(rm_x)
  }
  if (!is.null(scalx)) 
        dataN@x <- dataN@x * scalx
  if (!is.null(scalx2)) 
        dataN@x2 <- dataN@x2 * scalx2[1] + scalx2[2]
  if (numV > 0) {
    if(numV == 1)
      subtr <- as.matrix( as.matrix(svdResid$left[,1:numV]) * svdResid$value[1:numV]) %*% t(as.matrix(svdResid$right[1:numV,])) 
    else {
      leftscaled <- svdResid$left[,1:numV]
	    for(i in 1:numV) 
              leftscaled[,i] <- leftscaled[,i] * svdResid$value[i]
      subtr <- leftscaled %*% svdResid$right[1:numV,]
    }
    if(svdResid$weight) 
		subtr <- subtr / svdResid$weightM
    dataN@psi.df <- dataN@psi.df - subtr
  }
  if(doubleDiff) 
    dataN <- doubleDiff(dataN, file=doubleDiffFile)
  dataN@datCall <- append(data@datCall, match.call())
  dataN
}