R/diffRel.R

In TIMP: Fitting Separable Nonlinear Models in Spectroscopy and Microscopy

"diffRel" <-
  function(modellist, diffsrel) {
    ## diffsrel has structure
    ## list(list(what1, ind1, dataset1,
    ##           what2, ind2, dataset2,
    ##           rel, start, fixed), ...)
    ## dataset1 can be a vector of indices into dataset list
    ## dataset2 can be a vector of indices into dataset list
    ## length(dataset1) == length(dataset2)

    for (diffs in diffsrel) {
      for (i in 1:length(diffs$dataset1)) {
        if (length(diffs$rel) == 0 || diffs$rel == "lin") {
          if (length(diffs$ind1) == 1 && length(diffs$ind2) == 1) {
            slot(
              modellist[[diffs$dataset1[i]]],
              diffs$what1
            )[diffs$ind1] <-
              slot(
                modellist[[diffs$dataset2[i]]],
                diffs$what2
              )[diffs$ind2] * diffs$start[1] + diffs$start[2]
          }
          if (length(diffs$ind1) == 1 && length(diffs$ind2) == 2) {
            slot(
              modellist[[diffs$dataset1[i]]],
              diffs$what1
            )[diffs$ind1] <-
              slot(
                modellist[[diffs$dataset2[i]]],
                diffs$what2
              )[[diffs$ind2[1]]][diffs$ind2[2]] *
              diffs$start[1] + diffs$start[2]
          }
          if (length(diffs$ind1) == 2 && length(diffs$ind2) == 1) {
            slot(
              modellist[[diffs$dataset1[i]]],
              diffs$what1
            )[[diffs$ind1[1]]][diffs$ind1[2]] <-
              slot(
                modellist[[diffs$dataset2[i]]],
                diffs$what2
              )[diffs$ind2] * diffs$start[1] + diffs$start[2]
          }
          if (length(diffs$ind1) == 2 && length(diffs$ind2) == 2) {
            slot(
              modellist[[diffs$dataset1[i]]],
              diffs$what1
            )[[diffs$ind1[1]]][diffs$ind1[2]] <-
              slot(
                modellist[[diffs$dataset2[i]]],
                diffs$what2
              )[[diffs$ind2[1]]][diffs$ind2[2]] *
              diffs$start[1] + diffs$start[2]
          }
        }
      }
    }
    modellist
  }