R/getXList.R

In TIMP: Fitting Separable Nonlinear Models in Spectroscopy and Microscopy

getXList <- function(result, group = vector(), file = "") {
  modtype <- result$currModel@modellist[[1]]@mod_type
  resultlist <- result$currModel@fit@resultlist
  m <- result$currModel@modellist
  t <- result$currTheta
  XList <- vector("list", length = length(m))
  tauList <- muList <- list()

  if (modtype == "kin") {
    groups <- result$currModel@groups
    multimodel <- result$currModel
    f1 <- function(x) {
      x[[1]]
    }
    f2 <- function(x) {
      x[[2]]
    }
    ## will plot the first concentration from each dataset
    grtoplot <- vector("list", length(m))

    for (i in 1:length(m)) {
      if (length(group) == 0) {
        cnt <- 1
        notfound <- TRUE
        while (notfound) {
          for (j in 1:length(groups[[cnt]])) {
            if (groups[[cnt]][[j]][2] == i) {
              grtoplot[[i]] <- list(groups[[cnt]], j)
              notfound <- FALSE
            }
          }
          cnt <- cnt + 1
        }
      } else {
        grtoplot[[i]] <- list(groups[[group]], 1)
      }
    }
    for (i in 1:length(m)) {
      group <- grtoplot[[i]][[1]]
      place <- grtoplot[[i]][[2]]
      dset <- group[[place]][2]
      irfmu <- unlist(lapply(resultlist[[i]]@irfvec, f1))
      irftau <- unlist(lapply(resultlist[[i]]@irfvec, f2))
      muList[[i]] <- irfmu
      tauList[[i]] <- irftau
      XList[[i]] <- getConToPlot(getKinConcen(
        group, multimodel, t,
        oneDS = place
      ), m[[i]]@cohspec, m[[i]]@cohcol)
    }
  }
  if (modtype == "spec") {
    for (i in 1:length(m)) {
      if (m[[i]]@timedep) {
        specpar <- specparF(t[[i]]@specpar, m[[i]]@x[group],
          group, m[[i]]@specref, m[[i]]@specdispindex,
          t[[i]]@specdisppar,
          parmufunc = m[[i]]@parmufunc
        )
      } else {
        specpar <- t[[i]]@specpar
      }

      XList[[i]] <- doClpConstr(specModel(specpar, m[[i]]),
        clp_ind = group,
        clpCon = m[[i]]@clpCon, clpequ = t[[i]]@clpequ,
        num_clpequ = length(m[[i]]@clpequspec),
        usecompnames0 = m[[i]]@usecompnames0,
        usecompnamesequ = m[[i]]@usecompnamesequ
      )
    }
  }
  if (modtype == "mass") {
    for (i in 1:length(m)) {
      XList[[i]] <- compModelMass(theta = t[[i]], model = m[[i]])
    }
  }
  for (i in 1:length(XList)) {
    xdim <- dim(XList[[i]])
    attributes(XList[[i]]) <- NULL
    dim(XList[[i]]) <- xdim
    if (file != "") {
      for (i in 1:length(XList)) {
        write.table(XList[[i]],
          file = paste(file,
            "_concen_dataset_", i, ".txt",
            sep = ""
          ), quote = FALSE,
          row.names = m[[i]]@x
        )
      }
    }
  }

  XList
}

getX <- function(result, group = vector(), dataset = 1, file = "", lreturnA = FALSE, lreturnC = FALSE) {
  # minimal model of getXList for one dataset case
  modtype <- result$currModel@modellist[[1]]@mod_type
  resultlist <- result$currModel@fit@resultlist
  m <- result$currModel@modellist
  t <- result$currTheta
  tauList <- muList <- list()
  if (modtype == "kin") {
    groups <- result$currModel@groups
    multimodel <- result$currModel
    f1 <- function(x) {
      x[[1]]
    }
    f2 <- function(x) {
      x[[2]]
    }
    ## will plot the first concentration from each dataset
    grtoplot <- list()
    if (length(group) == 0) {
      cnt <- 1
      notfound <- TRUE
      while (notfound) {
        for (j in 1:length(groups[[cnt]])) {
          if (groups[[cnt]][[j]][2] == dataset) {
            grtoplot[[dataset]] <- list(groups[[cnt]], j)
            notfound <- FALSE
          }
        }
        cnt <- cnt + 1
      }
    } else {
      grtoplot[[dataset]] <- list(groups[[group]], 1)
    }
    group <- grtoplot[[dataset]][[1]]
    place <- grtoplot[[dataset]][[2]]
    dset <- group[[place]][2]
    irfmu <- unlist(lapply(resultlist[[dataset]]@irfvec, f1))
    irftau <- unlist(lapply(resultlist[[dataset]]@irfvec, f2))
    muList[[dataset]] <- irfmu
    tauList[[dataset]] <- irftau
    if (lreturnA || lreturnC) {
      group <- list(c(1, dataset))
      XList <- getKinConcen(group, multimodel, t, oneDS = 1, lreturnA = lreturnA, lreturnC = lreturnC)
      #        XList <- getKinConcen(group, multimodel, t, oneDS = place,lreturnA=lreturnA,lreturnC=lreturnC)
    } else {
      XList <- getConToPlot(
        getKinConcen(group, multimodel, t, oneDS = place),
        m[[dataset]]@cohspec, m[[dataset]]@cohcol
      )
    }
  }
  if (modtype == "spec") {
    if (m[[dataset]]@timedep) {
      specpar <- specparF(t[[dataset]]@specpar, m[[dataset]]@x[group],
        group, m[[dataset]]@specref, m[[dataset]]@specdispindex,
        t[[dataset]]@specdisppar,
        parmufunc = m[[dataset]]@parmufunc
      )
    } else {
      specpar <- t[[dataset]]@specpar
    }

    XList <- doClpConstr(specModel(specpar, m[[dataset]]),
      clp_ind = group,
      clpCon = m[[dataset]]@clpCon,
      clpequ = t[[dataset]]@clpequ,
      num_clpequ = length(m[[dataset]]@clpequspec),
      usecompnames0 = m[[dataset]]@usecompnames0,
      usecompnamesequ = m[[dataset]]@usecompnamesequ
    )
  }
  if (modtype == "mass") {
    XList <- compModelMass(theta = t[[dataset]], model = m[[dataset]])
  }
  xdim <- dim(XList)
  attributes(XList) <- NULL
  dim(XList) <- xdim
  if (file != "") {
    write.table(XList,
      file = paste(file,
        "_concen_dataset_", dataset, ".txt",
        sep = ""
      ), quote = FALSE,
      row.names = m[[dataset]]@x
    )
  }
  XList
}