R/getTheta.R

In TIMP: Fitting Separable Nonlinear Models in Spectroscopy and Microscopy

"getTheta" <- function (mod) 
{
  modelspec <- mod@modelspec
  modellist <- mod@modellist
  datasetind <- mod@datasetind 
  th <- vector()
  parorder <- list()
  for(i in 1:length(modelspec)) {
    ds <- which(datasetind == i)
    model <- modellist[[ds[1]]]
    fixed <- model@fvecind
    prel <- model@pvecind
    mrel <- model@mvecind 
    ppars <- append(model@parnames, "prel")
    for (p in ppars) {
      if(length(slot(modelspec[[datasetind[i]]], p)) != 0) {  
        removepar <- sort(unique(c(fixed[[p]], prel[[p]])))
        rmpar <- sort(unique(c(fixed[[p]], prel[[p]], mrel[[p]])))
        parapp <- unlist(slot(model, p))
        if(length(model@clinde[[p]]) > 0) {
          for(j in 1:length(model@clinde[[p]]))  {
            ind <- model@clinde[[p]][j]
            parapp[ind] <- model@lowcon[[p]][j] - parapp[ind]
            if(! p %in% model@positivepar)
              parapp[ind] <- log(parapp[ind])
          }
        }
        if(length(model@chinde[[p]]) > 0) { 
          for(j in 1:length(model@chinde[[p]]))  {
            ind <- model@chinde[[p]][j]
            parapp[ind] <- parapp[ind] + model@highcon[[p]][j]
            if(! p %in% model@positivepar)
              parapp[ind] <- log(parapp[ind])
          }
        }
        if (length(rmpar) != 0)
          parapp <- parapp[-rmpar]
        if(length(parapp) != 0) 
          ind <- (length(th) + 1):(length(th) + length(parapp))
        else 
          ind <- vector()
        parorder[[length(parorder)+1]] <- list(name=p, ind=ind, 
                                               dataset = ds, rm=rmpar)
        if(p %in% model@positivepar && length(parapp) != 0) 
          parapp <- log(parapp)
        th <- append(th, parapp)
      }
    }  
  }
  mod@parorder <- processOrder(parorder, mod) 
  df <- getDiffTheta(th, mod)

  if(mod@modellist[[1]]@lscalpar) {
    thetascal <- abs(df$theta)
    df$mod@modellist[[1]]@thetascal <- thetascal
    df$theta <- df$theta/thetascal
  }
  list(theta = df$theta, mod = df$mod)
}