R/getPrelTheta.R

In TIMP: Fitting Separable Nonlinear Models in Spectroscopy and Microscopy

"getPrelTheta" <-
function (th, modellist, diffs, d, parorder) 
{
  model <- modellist[[d]]
  fixed <- model@fvecind
  removepar <- fixed[["prel"]]
  if(length(unlist(slot(model, "prel"))) - length(removepar) != 0) {
    if(diffs$what %in%  modellist[[d]]@positivepar)
      parapp <- log(unlist(slot(model, "prel"))[-removepar])
    else {
      if(length(modellist[[d]]@clinde[[diffs$what]]) > 0) 
        for(i in 1:length(modellist[[d]]@clinde[[diffs$what]]))  
          parapp <- log(parapp[i])
      if(length(modellist[[d]]@chinde[[diffs$what]]) > 0) 
        for(i in 1:length(modellist[[d]]@chinde[[diffs$what]]))  
          parapp <- log(parapp[i])
      
    }
    parapp <- parapp[-removepar] 
  }
  else 
    parapp <- vector() 
  if(length(parapp) != 0) 
    ind <- (length(th) + 1):(length(th) + length(parapp))
  else ind <- vector()
  parorder[[length(parorder)+1]] <- list(name="prel",
                                         ind=ind, dataset = d, rm=removepar)
  th <- append(th, parapp)
  list(th=th, parorder=parorder)
}