R/set_residPart_spec.R

In TIMP: Fitting Separable Nonlinear Models in Spectroscopy and Microscopy

setMethod("residPart", signature(model="spec"), 
          function (model, group, multimodel, thetalist, clpindepX, finished, 
                    returnX, rawtheta) 
          {
            psi <- vector()
            spectra <- matrix()
            if(returnX) 
              thetalist <-  getThetaCl(rawtheta, multimodel)
            if(finished) 
              rlist <- list(irfvec=list())
            for(i in 1:length(group)) {
	      m <-  multimodel@modellist[[group[[i]][2]]]  
	      t <-  thetalist[[group[[i]][2]]] 
	      psi <- append(psi, m@psi.weight[group[[i]][1], ]) 
	      if(m@timedep){
                if(m@specdisp)
                  specpar <- specparF(specpar = t@specpar, 
                                      xi = m@x[group[[i]][1]], 
                                      i = group[[i]][1], specref = m@specref, 
                                      specdispindex = m@specdispindex, 
                                      specdisppar = t@specdisppar,
                                      parmufunc = m@parmufunc)
		else 
                  specpar <- t@specpar 
		spectra_i <- specModel(specpar, m)
		if(m@weight)
                  spectra_i <- weightNL(spectra_i,m,group[[i]][1])	
		if(ncol(spectra_i) != 0) {
                  spectra <- if(!identical(spectra, matrix()))
                    rbind(spectra, spectra_i) 
                  else 
                    spectra_i
	        }
              }
              else {
                if(identical(spectra, matrix()))
                  spectra <- clpindepX[[group[[i]][2]]]
                else 
                  spectra <- rbind(spectra, clpindepX[[group[[i]][2]]])
                
	      }
              
	      if(finished) {
		rlist$irfvec[[group[[i]][1]]] <- 
                  if(m@timedep) 
                    specpar
                  else c(0,0)
	      }
            }
            ## apply constraints to clp, using spec. from 1st dataset in group
            m <- multimodel@modellist[[group[[1]][2]]]
            if(m@timedep) 
              spectra <- doClpConstr(spectra, clp_ind = group[[1]][1], 
                                     clpCon = m@clpCon, clpequ = t@clpequ, 
                                     num_clpequ = length(m@clpequspec), 
                                     usecompnames0 = m@usecompnames0, 
                                     usecompnamesequ = m@usecompnamesequ)

            
            retval <- getResidRet(spectra, psi, rlist, returnX, finished,
                                  multimodel@nnls, multimodel@algorithm) 
            retval
            
          })