get.eigen.mod(), get.shrinkage.mod(): suggested code

Per Marita, in support of NONMEM 7.4 :
get.eigen.mod = function (run, path = getOption("nmDir"), file.ext = ".lst") 
{
  out = read.out(path = path, run = run, file.ext = file.ext)
  if (length(grep("EIGENVALUES", out)) == 0) {
    message("no eigen values. To obtain eigen values add PRINT=E to $COV in NONMEM")
    return(NULL)
  }
  txtStart = grep("EIGENVALUES", out) - 1
  txtStop = which(out == " ")
  txtParse = as.list(seq(length(txtStart)))
  for (i in 1:length(txtStart)) {
    tmp = txtStop - txtStart[i]
    tmp = tmp[tmp > 0][2:3]
    txtParse[[i]] = (txtStart[i] + tmp[1] + 1):(txtStart[i] + 
                                                  tmp[2] - 1)
  }
  eigen = lapply(txtParse, function(x, out) paste(out[x], collapse = ""), 
                 out = out)
  nameParse = as.list(seq(length(txtStart)))
  for (i in 1:length(txtStart)) {
    tmp = txtStop - txtStart[i]
    tmp = tmp[tmp > 0][1]
    nameParse[[i]] = (txtStart[i])
  }
  parName = lapply(nameParse, function(x, out) sub("[*]+", 
                                                   "", out[x]), out = out)
  parName = unlist(lapply(parName, function(x) trimSpace(sub("[*]+", 
                                                             "", x))))
  eigen = lapply(eigen, function(x) unlist(strsplit(trimSpace(x), 
                                                    " ")))
  eigen = lapply(eigen, function(x) asNumeric(x[x != ""]))
  names(eigen) = parName
  return(eigen)
}

get.shrinkage.mod = function (run, path = getOption(nmDir), file.ext = ".lst") 
{       
  out = read.out(path = path, run = run, file.ext = file.ext)
  version = get.nm.version(path = path, run = run, file.ext = file.ext)
  txtETAStart = grep("ETASHRINKSD", out)
  txtEBVStart = grep("EBVSHRINKSD", out)
  txtEPSStart = grep("EPSSHRINKSD", out)
  txtETAParse = as.list(seq(length(txtETAStart)))
  txtEPSParse = txtEBVParse = txtETAParse
  for (i in 1:length(txtETAStart)) {
    txtETAParse[[i]] = txtETAStart[i]:(txtEBVStart[i] - 2)
    txtEBVParse[[i]] = txtEBVStart[i]:(txtEPSStart[i] - 2)
    txtEPSParse[[i]] = txtEPSStart[i]
  }
  etaShrink = lapply(txtETAParse, function(x, out) trimSpace(substring(paste(out[x], 
                                                                             collapse = ""), 16)), out = out)
  ebvShrink = lapply(txtEBVParse, function(x, out) trimSpace(substring(paste(out[x], 
                                                                             collapse = ""), 16)), out = out)
  epsShrink = lapply(txtEPSParse, function(x, out) trimSpace(substring(paste(out[x], 
                                                                             collapse = ""), 16)), out = out)
  nameParse = as.list(seq(length(etaShrink)))
  txtOBJParse = grep("FINAL PARAMETER ESTIMATE", out)
  for (i in 1:length(nameParse)) {
    nameParse[[i]] = trimSpace(sub("[*]+", "", sub("[*]+", 
                                                   "", out[txtOBJParse[i] - 1])))
  }
  names(etaShrink) = nameParse
  names(ebvShrink) = nameParse
  names(epsShrink) = nameParse
  return(list(version = version, eta = etaShrink, ebv = ebvShrink, 
              eps = epsShrink))
  }
qPharmetra / qpToolkit

get.eigen.mod(), get.shrinkage.mod(): suggested code #43
