Merge pull request #866 from metrumresearchgroup/release/0.11.2

Release/0.11.2

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: mrgsolve
 Title: Simulate from ODE-Based Models
-Version: 0.11.1
+Version: 0.11.2
 Authors@R: 
     c(person(given = "Kyle T", family = "Baron",
              role = c("aut", "cre"),

NEWS.md

@@ -1,3 +1,23 @@
+# mrgsolve 0.11.2
+
+- In `pk2iv`, change scaling volume for `CENT` from `V2` (incorrect) to 
+  `V1` (#831, #832, #833)
+
+- Fix bug collating multiple `$OMEGA` or `$SIGMA` matrices when parsing a 
+  model (#863)
+
+- Refactor how debugging information is processed when using the `recover` 
+  argument to `mread()` (#853)
+
+- Fix typo in documentation for `as_cmat()`; the off-diagonals are assumed
+  to contain correlations (#856)
+
+- Wrote a `as.data.frame.matrix()` function in Rcpp; all simulation results
+  return from the C++ simulation code as a data frame (#857)
+
+- Fix bug where dynamic capture (via `mread()`) was not allowed for variables
+  declared in `$GLOBAL` (#868)
+
 # mrgsolve 0.11.1
 
 - `mrgsim()` will now periodically check for user interrupt signal so that 

R/class_build.R

@@ -209,20 +209,26 @@ build_output_cleanup <- function(x,build) {
   patt <- "^ *In function .*void _model.*:$"
   errr <- msub(pattern = patt, replacement = "", x = errr)
   x[["stderr"]] <- errr
-  x <- structure(x, class = "mrgsolve-build-error")
+  x <- structure(x, class = c("mrgsolve-build-error", "list"))
   x
 }
 
-
-build_failed <- function(out,build,mod,ignore.stdout) {
-  outt <- list(out)
-  names(outt) <- paste0("mrgsolve.build.", build[["model"]])
-  options(outt)
+build_failed <- function(out,build,mod,spec,ignore.stdout) {
   out <- build_output_cleanup(out,build)
-  if(build[["recover"]]) {
+  if(isTRUE(build[["recover"]])) {
     warning("returning object for debugging purposes only.")
-    ans <- list(build = build, mod = as.list(mod), shlib=list(compiled=FALSE), out=out)
-    return(structure(ans,class = "mrgsolve-build-recover"))
+    build <- as.list(build)
+    mod <- as.list(mod)
+    mod[["envir"]] <- as.list(mod[["envir"]])
+    mod[["shlib"]][["version"]] <- unlist(mod[["shlib"]][["version"]])
+    mod[["shlib"]][["compiled"]] <- FALSE
+    ans <- list(
+      out = out,
+      build = build, 
+      mod = mod, 
+      spec = spec
+    )
+    return(structure(ans, class = c("mrgsolve-build-recover", "list")))
   }
   if(!ignore.stdout) {
     msg <- divider_msg("stdout")
@@ -241,22 +247,16 @@ build_failed <- function(out,build,mod,ignore.stdout) {
   stop("the model build step failed.",call.=FALSE)
 }
 
-
-build_save_output <- function(out) {
-  out[["date"]] <- date()
-  path <- file.path(tempdir(), "mrgsolve-build-result.RDS")
-  saveRDS(out, file=path)
-  return(invisible(path))
-}
-
-build_get_output <- function() {
-  file <- file.path(tempdir(),"mrgsolve-build-result.RDS")
-  file <- normalizePath(file,mustWork=FALSE)
-  if(!file.exists(file)) {
-    message("No build output was found.")
-    return(invisible(list()))
+build_format_recover <- function(data, path = NULL) {
+  if(!requireNamespace("yaml")) {
+    stop("please install the yaml package to format recovery data", call.=FALSE)  
+  }
+  ans <- yaml::as.yaml(data)
+  if(is.character(path)) {
+    writeLines(text = ans, con = path)
+    return(invisible(ans))
   }
-  return(readRDS(file))
+  ans
 }
 
 build_handle_127 <- function(out) {

R/class_matlist.R

@@ -47,7 +47,7 @@ valid.matlist <- function(object) {
   }
 
   if(!x4) {
-    y <- which(sapply(object@data, det) < 0)
+    y <- which(!sapply(object@data, det) > 0)
     message("Problem with this matrix:")
     print(object@data[y])
     out <- c(out, "Invalid matrix: determinant is less than 0.")

R/funset.R

@@ -19,10 +19,10 @@
 FUNSET_ERROR__ <- 
   '
 There was a problem accessing the model shared object.
-  Either the model object is corrupted or the model was 
+  Either the model object was corrupted or the model was 
   not properly compiled and/or loaded. If the model is 
-  not loaded, use loadso(mod) to do so. This is usually 
-  required for parallel simuilation on a worker node that
+  not loaded, use `loadso(mod)` to do so. This is usually 
+  required for parallel simulation on a worker node that
   was not forked (e.g. when using future::multisession).
   Also check mrgsolve:::funset(mod) for more information.
 '

R/matlist.R

@@ -200,7 +200,6 @@ setMethod("smat", "mrgsims", function(.x,make=FALSE,...) {
   as.matrix(mod(.x)@sigma)
 })
 
-
 #' Zero out random effects in a model object
 #' 
 #' Sets all elements of the OMEGA or SIGMA matrix to zero
@@ -260,7 +259,9 @@ setMethod("as.list", "matlist", function(x, ...) x@data)
 #' @rdname matlist
 #' @export
 setMethod("as.matrix", "matlist", function(x, ...) {
-  if(length(x@data)==0) return(matrix(nrow=0,ncol=0))
+  if(length(x@data)==0) {
+    return(matrix(nrow = 0, ncol = 0))
+  }
   SUPERMATRIX(x@data, ...)
 })
 
@@ -335,13 +336,14 @@ cumoffset <- function(x) {
 ##' @rdname matlist_ops
 ##' @export
 setMethod("c", "matlist", function(x,...,recursive=FALSE) {
-  what <- c(list(x),list(...))
-  stopifnot(all(sapply(what,is.matlist)))
+  what <- c(list(x), list(...))
+  stopifnot(all(sapply(what, is.matlist)))
+  what <- what[sapply(what, slot, name = "n") > 0]
   if(length(what)==1) return(x)
-  d <- lapply(what,as.matrix)
-  d <- setNames(d,sapply(what,names))
+  d <- lapply(what, as.matrix)
+  d <- setNames(d, sapply(what, names))
   l <- sapply(unname(what), labels)
-  create_matlist(d,labels=l, class=class(x)[1])
+  create_matlist(d, labels = l, class = class(x)[1])
 })
 
 collapse_matrix <- function(x,class) {

R/matrix.R

@@ -1,5 +1,4 @@
-# Copyright (C) 2013 - 2019  Metrum Research Group, LLC
-#
+# Copyright (C) 2013 - 2021  Metrum Research Group
 # This file is part of mrgsolve.
 #
 # mrgsolve is free software: you can redistribute it and/or modify it
@@ -15,9 +14,10 @@
 # You should have received a copy of the GNU General Public License
 # along with mrgsolve.  If not, see <http://www.gnu.org/licenses/>.
 
-
-SUPERMATRIX <- function(x,keep_names=FALSE) {
-  x <- .Call(`_mrgsolve_SUPERMATRIX`,x,keep_names,PACKAGE="mrgsolve")
+SUPERMATRIX <- function(x, keep_names = FALSE) {
+  stopifnot(is.list(x))
+  stopifnot(all(sapply(x, is.matrix)))
+  x <- .Call(`_mrgsolve_SUPERMATRIX`, x, keep_names, PACKAGE = "mrgsolve")
   if(nrow(x) > 0 & !keep_names) {
     dimnames(x) <- list(paste0(seq_len(nrow(x)), ": "), NULL)
   }
@@ -132,7 +132,7 @@ Diag <- function(x) {
 ##' Create matrices from vector input
 ##'
 ##' @param ... matrix data
-##' @param correlation logical; if TRUE, off diagonal elements are assumed 
+##' @param correlation logical; if TRUE, off-diagonal elements are assumed 
 ##' to be correlations and converted to covariances
 ##' @param digits if greater than zero, matrix is passed to signif (along 
 ##' with digits) prior to returning
@@ -192,7 +192,7 @@ dmat <- function(...) {
 ##' @details
 ##' Use \code{as_dmat} to create a diagonal matrix, \code{as_bmat}
 ##' to create a block matrix, and \code{as_cmat} to create a block 
-##' matrix where diagonal elements are understood to be correlations
+##' matrix where off-diagonal elements are understood to be correlations
 ##' rather than covariances. \code{as_cmat} uses \code{as_bmat} to 
 ##' form the matrix and then converts off-diagonal elements to 
 ##' covariances before returning.

R/modspec.R

@@ -328,7 +328,7 @@ get_c_vars2 <- function(y,context) {
   if(length(regm)==0) return(data.frame())
   vars <- gsub(pattern="\\s*=$", replacement = "", x = regm, perl=TRUE)
   vars <- token_space(vars)
-  ans <- as.data.frame(do.call(rbind,vars),stringsAsFactors = FALSE)
+  ans <- as.data.frame(do.call(rbind,vars), stringsAsFactors = FALSE)
   names(ans) <- c("type", "var")
   if(nrow(ans) > 0) ans$context <- context
   ans
@@ -354,7 +354,12 @@ pp_defs <- function(x,context) {
   code <- s_pick(x, 3)
   list(
     vars = vars, code = code, n = length(x), 
-    tab = data.frame(type = "define", var = vars, context = "global")
+    tab = data.frame(
+      type = "define", 
+      var = vars, 
+      context = "global", 
+      stringsAsFactors = FALSE
+    )
   )
 }
 

R/mread.R

@@ -48,8 +48,9 @@ NULL
 #' @param quiet don't print messages when compiling
 #' @param preclean logical; if \code{TRUE}, compilation artifacts are 
 #' cleaned up first
-#' @param recover if \code{TRUE}, an object will be returned in case
-#' the model shared object fails to build
+#' @param recover if \code{TRUE}, a list of build will be returned in case
+#' the model shared object fails to compile; use this option to and 
+#' the returned object to collect information assist in debugging
 #' @param capture a character vector or comma-separated string of additional 
 #' model variables to capture; these variables will be added to the capture 
 #' list for the current call to \code{\link{mread}} only
@@ -282,8 +283,7 @@ mread <- function(model, project = getOption("mrgsolve.project", getwd()),
       unlist(labels(sigma)),
       .eta,
       .eps,
-      mread.env[["move_global"]], 
-      mread.env[["defines"]]
+      build[["cpp_variables"]][["var"]]
     )
     unique(ans)
   }
@@ -539,7 +539,7 @@ mread <- function(model, project = getOption("mrgsolve.project", getwd()),
 
   if(!comp_success) {
     if(ignore.stdout) message("error.\n", appendLF=FALSE)
-    return(build_failed(out,build,x,ignore.stdout))
+    return(build_failed(out,build,x,spec,ignore.stdout))
   } 
 
   if(ignore.stdout) {

R/mrgsim_q.R

@@ -157,20 +157,21 @@ mrgsim_q <- function(x,
     PACKAGE = "mrgsolve"
   )[["data"]]
 
-  dimnames(out) <- list(NULL, c("ID", tcol,x@cmtL,x@capL))
+  names(out) <- c("ID", tcol, x@cmtL, x@capL)
 
   if(output=="df") {
-    return(as.data.frame(out))  
+    return(out)  
   }
+
   if(output=="matrix") {
-    return(out)  
+    return(as.matrix(out))  
   }
 
   new(
     "mrgsims",
-    request=x@cmtL,
-    data=as.data.frame(out),
-    outnames=x@capL,
-    mod=x
+    request = x@cmtL,
+    data = out,
+    outnames = x@capL,
+    mod = x
   )
 }