Merge pull request #370 from nlmixr2/368-bring-back-$parhistdata

Only keep $parHistData and calc $parHist and $parHistStacked

NAMESPACE

@@ -100,6 +100,7 @@ S3method(nmObjGet,methodOde)
 S3method(nmObjGet,modelName)
 S3method(nmObjGet,notes)
 S3method(nmObjGet,omegaR)
+S3method(nmObjGet,parHist)
 S3method(nmObjGet,parHistStacked)
 S3method(nmObjGet,phiR)
 S3method(nmObjGet,phiRSE)

NEWS.md

@@ -12,6 +12,8 @@
 - Values in `$parFixed` for BSV without exponential transformation are now
   correctly shown (#366)
 
+- Add back values for $parHistData (#368)
+
 # nlmixr2est 2.1.6
 
 ## Breaking changes

R/complete.R

@@ -9,9 +9,10 @@
   objDf="Objective Function DF",
   omega="Omega Matrix",
   origData="Original Data",
+  phiC="covariance matrix of each individual's eta (if present)",
   parFixed="Formatted Parameter Values for Fixed effects",
   parFixedDf="Parameter Values for Fixed Effects (data frame)",
-  parHist="Parameter History",
+  parHistData="Parameter History (including gradients)",
   scaleInfo="Scaling Information",
   shrink="Shrinkage data frame",
   table="Table Control Value",

R/focei.R

@@ -1547,6 +1547,19 @@ attr(rxUiGet.foceiOptEnv, "desc") <- "Get focei optimization environment"
          deparse1(ui$dvidLine)),
         collapse="\n")
 }
+#' Calculate the parameter history
+#'
+#' @param .ret return data
+#' @return parameter history data frame
+#' @noRd
+#' @author Matthew L. Fidler
+.parHistCalc <- function(.ret) {
+  .tmp <- .ret$parHistData
+  .tmp <- .tmp[.tmp$type == "Unscaled", names(.tmp) != "type"]
+  .iter <- .tmp$iter
+  .tmp <- .tmp[, names(.tmp) != "iter"]
+  data.frame(iter = .iter, .tmp, check.names=FALSE)
+}
 
 #' Setup the par history information
 #'
@@ -1556,13 +1569,7 @@ attr(rxUiGet.foceiOptEnv, "desc") <- "Get focei optimization environment"
 #' @noRd
 .foceiSetupParHistData <- function(.ret) {
   if (exists("parHistData", envir=.ret)) {
-    .tmp <- .ret$parHistData
-    .tmp <- .tmp[.tmp$type == "Unscaled", names(.tmp) != "type"]
-    .iter <- .tmp$iter
-    .tmp <- .tmp[, names(.tmp) != "iter"]
-    ## .ret$parHistStacked <- data.frame(stack(.tmp), iter = .iter)
-    ## names(.ret$parHistStacked) <- c("val", "par", "iter")
-    .ret$parHist <- data.frame(iter = .iter, .tmp)
+    .ret$parHist <- .parHistCalc(.ret)
   }
 }
 
@@ -1637,7 +1644,7 @@ attr(rxUiGet.foceiOptEnv, "desc") <- "Get focei optimization environment"
       .env$saem0 <- .saem
     }
     if (.control$compress) {
-      for (.item in c("origData", "phiM", "parHist", "saem0")) {
+      for (.item in c("origData", "phiM", "parHistData", "saem0")) {
         if (exists(.item, .env)) {
           .obj <- get(.item, envir=.env)
           .size <- utils::object.size(.obj)
@@ -1659,7 +1666,7 @@ attr(rxUiGet.foceiOptEnv, "desc") <- "Get focei optimization environment"
                     "xType", "IDlabel", "ODEmodel",
                     # times
                     "optimTime", "setupTime", "covTime",
-                    "parHistData", "dataSav", "idLvl", "theta",
+                    "parHist", "dataSav", "idLvl", "theta",
                     "missingTable", "missingControl", "missingEst")) {
       if (exists(.item, .env)) {
         rm(list=.item, envir=.env)
@@ -1913,4 +1920,3 @@ nlmixr2CreateOutputFromUi <- function(ui, data=NULL, control=NULL, table=NULL, e
   class(.env) <- c("output", "nlmixr2Est")
   nlmixr2Est(.env)
 }
-

R/nmObjGet.R

@@ -488,22 +488,32 @@ nmObjGet.saemTransformedData <- function(x, ...) {
 }
 #attr(nmObjGet.saemTransformedData, "desc") <- "data that saem sees for optimization"
 
+#' @rdname nmObjGet
+#' @export
+nmObjGet.parHist <- function(x, ...) {
+  .obj <- x[[1]]
+  .env <- .obj$env
+  if (exists("parHistData", envir=.env)) {
+    return(.parHistCalc(.env))
+  }
+  NULL
+}
+attr(nmObjGet.parHist, "desc") <- "Parameter History"
 
 #' @rdname nmObjGet
 #' @export
 nmObjGet.parHistStacked <- function(x, ...) {
   .obj <- x[[1]]
   .env <- .obj$env
-  if (exists("parHist", envir=.env)) {
-    .parHist <- .env$parHist
+  if (exists("parHistData", envir=.env)) {
+    .parHist <- .parHistCalc(.env)
     .iter <- .parHist$iter
     .ret <- data.frame(iter=.iter, stack(.parHist[, -1]))
     names(.ret) <- sub("values", "val",
                        sub("ind", "par", names(.ret)))
-    .ret
-  } else {
-    NULL
+    return(.ret)
   }
+  NULL
 }
 attr(nmObjGet.parHistStacked, "desc") <- "stacked parameter history"
 

R/saem.R

@@ -396,12 +396,13 @@
   if (ncol(.m) > length(.allThetaNames)) {
     .m <- .m[, seq_along(.allThetaNames)]
   }
-  .ph <- data.frame(iter = rep(1:nrow(.m)), as.data.frame(.m))
-  names(.ph) <- c("iter", .allThetaNames)
+  .ph <- data.frame(iter = rep(seq_len(nrow(.m))), as.data.frame(.m),
+                    type="Unscaled", check.names=FALSE)
+  names(.ph) <- c("iter", .allThetaNames, "type")
   .cls <- class(.ph)
   attr(.cls, "niter") <- env$saemControl$mcmc$niter[1]
   class(.ph) <- .cls
-  assign("parHist", .ph, envir=env)
+  assign("parHistData", .ph, envir=env)
 }
 #' Calculate the covariance term
 #'

tests/testthat/test-addCwres.R

@@ -1,6 +1,7 @@
 nmTest({
 
   test_that("addCwres", {
+
     one.compartment <- function() {
       ini({
         tka <- log(1.57)
@@ -22,6 +23,7 @@ nmTest({
     suppressMessages(
       fitNoEta <- nlmixr2(one.compartment, theo_sd,  est="focei", control = list(print=0))
     )
+    expect_true(inherits(fitNoEta$parHistData, "data.frame"))
     expect_error(
       addCwres(fitNoEta),
       regexp = "cannot add CWRES to a model without etas"