R/compModelMass.R

In TIMP: Fitting Separable Nonlinear Models in Spectroscopy and Microscopy

"compModelMass" <-
function (theta, model)
{
  peakpar <- theta@peakpar
  amp <- theta@amplitudes
  if(model@extracomp) {
    if(length(amp)==0)
      eamp <- 1
    else {
      eamp <- amp[length(amp)]
      amp <- amp[- length(amp)]
    }
  }
  shift <- theta@shift
  if(model@peakfunct == "expmodgaus") {
    fn1 <- function(x,ind) x[[ind]]
    lpp <- length(peakpar)
    locations <- unlist(lapply(peakpar, fn1, ind=1))
    if(length(shift)!=0)
      locations <- locations + shift 
    widths <- unlist(lapply(peakpar, fn1, ind=2))
    rates <- unlist(lapply(peakpar, fn1, ind=3))
    massm <- rep(0, model@nt * lpp) 
    massm <- as.matrix(.C("r_calcCirf_multi", 
                          cmat = as.double(massm), 
                          as.double(rates), as.double(model@x), 
                          as.double(widths), 
                          as.double(locations), 
                          as.integer(lpp), 
                          as.integer(model@nt), PACKAGE="TIMP")$cmat)
    dim(massm) <- c(model@nt, lpp)
    if(length(amp) > 0)
      massm <- massm %*% diag(amp)
  }
  if(model@extracomp)
    massm <- cbind(massm, rep(eamp, model@nt))
  massm
}