R/weightPsi.R

In TIMP: Fitting Separable Nonlinear Models in Spectroscopy and Microscopy

"weightPsi" <-
  function (model) 
  {
    psisim <- model@psi.df
    if(is.na(model@weightM[1,1])) # weight not used from previous analysis 
      weight <- matrix(1, nrow=model@nt, ncol=model@nl)
    else weight <- model@weightM
    wt <- model@weightpar
    typ <- model@weightsmooth$funct
    if(length(wt)  !=  0 && length(wt$poisson) == 0) {
      for (i in 1:length(wt)) {
        if (is.na(wt[[i]][1])) 
          wt[[i]][1] <- model@x[1]
        if (is.na(wt[[i]][2])) 
          wt[[i]][2] <- model@x[model@nt]
        if (is.na(wt[[i]][3])) 
          wt[[i]][3] <- model@x2[1]
        if (is.na(wt[[i]][4])) 
          wt[[i]][4] <- model@x2[model@nl]
        for (j in 1:model@nl) {
          for (k in 1:model@nt) {
            
            if (((model@x2[j] >= wt[[i]][3]) && (model@x2[j] <= 
                                                   wt[[i]][4])) && ((model@x[k] >= wt[[i]][1]) && 
                                                                      (model@x[k] <= wt[[i]][2]))) {
              weight[k, j] <- wt[[i]][5] * weight[k, j]                    
            }
          }
        }
      }
    }
    else {
      if(wt$poisson){
        for (j in 1:model@nl) {
          for (k in 1:model@nt) { 
            if(psisim[k, j]>0){
              weight[k, j] <- 1 / (sqrt(psisim[k,j])) 
              
            }	}	 
        }
      }
    }
    psisim <- psisim * weight
    list(psi.weight = psisim, weight = weight)
  }