R/getResidRet.R

In TIMP: Fitting Separable Nonlinear Models in Spectroscopy and Microscopy

"getResidRet" <-
  function(X, psi, rlist, returnX, finished, nnls, algorithm = "nls",
           nnlscrit = list(), group = 0) {
    if (returnX) {
      return(as.vector(X))
    }
    if (finished) {
      rlist$QR <- qr(X)
      rlist$psi <- psi
      return(rlist)
    }
    if (!nnls) { ## just varpro
      qty.temp <- qr.qty(qr(X), psi)
      residQspace <- qty.temp[-(1:ncol(X))]
      retval <- residQspace
    } else {
      if (length(nnlscrit$negpos) > 0) {
        con <- nnlscrit$spec[[as.character(group[[1]][1])]]
        cp <- coef(nnnpls(A = X, b = psi, con = con))
      } else {
        sol <- try(nnls(A = X, b = psi))
        if (is(sol, "try-error")) {
          cp <- rep(0, ncol(X))
        } else {
          cp <- coef(sol)
        }
      }
      if (algorithm != "optim") {
        retval <- psi - X %*% cp
      } else {
        retval <- sum((psi - X %*% cp)^2)
      }
    }
    retval
  }