R/getPar.R

In TIMP: Fitting Separable Nonlinear Models in Spectroscopy and Microscopy

"getPar" <-
  function(model, po, th, theta = theta(), addM = FALSE) {
    removepar <- po$rm
    if (length(unlist(slot(model, po$name))) - length(removepar) != 0) {
      parvec <- th[po$ind]
    } else {
      parvec <- vector()
    }
    if (po$name %in% model@positivepar && length(parvec) != 0) {
      parvec <- exp(parvec)
    }
    for (fx in removepar) {
      if (fx %in% model@fvecind[[po$name]]) {
        parvec <- append(parvec, unlist(slot(model, po$name))[fx],
          after = (fx - 1)
        )
      } else if (fx %in% model@pvecind[[po$name]] || (
        fx %in% model@mvecind[[po$name]] && !addM)) {
        parvec <- append(parvec, 0, after = (fx - 1))
      }
    }
    if (length(model@clinde[[po$name]] > 0)) {
      for (i in 1:length(model@clinde[[po$name]])) {
        ind <- model@clinde[[po$name]][i]
        if (!po$name %in% model@positivepar) {
          parvec[ind] <- exp(parvec[ind])
        }
        parvec[ind] <- model@lowcon[[po$name]][i] - parvec[ind]
      }
    }
    if (length(model@chinde[[po$name]]) > 0) {
      for (i in 1:length(model@chinde[[po$name]])) {
        ind <- model@chinde[[po$name]][i]
        if (!po$name %in% model@positivepar) {
          parvec[ind] <- exp(parvec[ind])
        }
        parvec[ind] <- model@highcon[[po$name]][i] + parvec[ind]
      }
    }
    parvec
  }