R/triResolve.R

In TIMP: Fitting Separable Nonlinear Models in Spectroscopy and Microscopy

"triResolve" <- function(currModel, currTheta) {
  ## plot the alpha results
  opt <- currModel@optlist[[1]]
  if (opt@plot) {
    plotter(currModel@modellist[[1]], currModel, currTheta, opt)
  }
  m <- currModel@modellist
  specList <- getSpecList(currModel, currTheta)
  aList <- lapply(specList, t)
  newdata <- aList[[1]]
  for (i in 2:length(aList)) {
    newdata <- rbind(newdata, aList[[i]])
  }

  plotTri(newdata)

  startres <- getStartTri(newdata, ncomp = nrow(aList[[1]]), nexp = length(aList))

  ampList <- startres$ampList
  fixedamps <- startres$fixedamps

  aDatList <- list(dat(
    psi.df = newdata,
    x = 1:nrow(newdata), nt = nrow(newdata),
    x2 = 1:ncol(newdata), nl = ncol(newdata)
  ))

  amp_model <- initModel(
    mod_type = "amp", amps = ampList,
    fixed = list(amps = fixedamps)
  )

  fit <- fitModel(
    data = aDatList, modspec = list(amp_model),
    opt = opt(iter = 3, nnls = 2, plot = FALSE)
  )

  newcp <- fit$currModel@fit@resultlist[[1]]@cp
  ## add the new amplitude estimates
  for (i in 1:length(currModel@data)) {
    currTheta[[i]]@amplitudes <- fit$currTheta[[1]]@amps[[i]]
    currModel@fit@resultlist[[1]]@cp[[i]] <- newcp[[i]]
  }
  ## now the residuals have changed, and so has the fit
  ## need to calculate the new model
  ## but will just plug in the new estimates into a call to
  ## fitModel (0 iter.) separately

  list(currModel = fit$currModel, currTheta = fit$currTheta)
}