internal use: save nm source in the model object

.Rbuildignore

@@ -49,8 +49,10 @@ docs
 ^\.drone\.jsonnet$
 ^doc$
 ^Meta$
+vignettes/
 vignettes/extra
 vignettes/build
 vignettes/mrgsolve-builds
 vignettes/extra/mrgsolve-builds/
 
+

DESCRIPTION

@@ -61,7 +61,6 @@ RdMacros:
 Encoding: UTF-8
 Language: en-US
 LazyLoad: yes
-VignetteBuilder: knitr
 NeedsCompilation: yes
 RoxygenNote: 7.1.1
 SystemRequirements: C++11

Makefile

@@ -31,7 +31,7 @@ check:
 	make house
 	make doc
 	make build
-	R CMD check --ignore-vignettes ${TARBALL} --no-manual
+	R CMD check ${TARBALL} --no-manual
 	make unit
 
 check-only:

R/class_mrgmod.R

@@ -525,6 +525,7 @@ setMethod("as.list", "mrgmod", function(x, deep = FALSE, ...) {
     delta <- x@delta
     end <- x@end
     start <- x@start
+    nm_import <- shlib(x)[["nm_import"]]
     shlib <- shlib(x)
     cfile <- cfile(x)
     sodll <- sodll(x)

R/handle_spec_block.R

@@ -518,6 +518,7 @@ handle_spec_block.specNMXML <- function(x, env, ...) {
   env[["param"]][[pos]] <- xml$theta
   env[["omega"]][[pos]] <- xml$omega
   env[["sigma"]][[pos]] <- xml$sigma
+  env[["nm_import"]] <- c(env[["nm_import"]], xml[["file"]])
   return(NULL)
 }
 
@@ -532,6 +533,7 @@ handle_spec_block.specNMEXT <- function(x, env, ...) {
   env[["param"]][[pos]] <- ext$theta
   env[["omega"]][[pos]] <- ext$omega
   env[["sigma"]][[pos]] <- ext$sigma
+  env[["nm_import"]] <- c(env[["nm_import"]], ext[["file"]])
   return(NULL)
 }
 

R/modspec.R

@@ -589,17 +589,18 @@ parse_env <- function(spec, incoming_names = names(spec),project,ENV=new.env())
   n <- length(spec)
   mread.env <- new.env()
   mread.env$project <- project
-  mread.env$param <- vector("list",n)
-  mread.env$fixed <- vector("list",n)
-  mread.env$init  <- vector("list",n)
-  mread.env$omega <- vector("list",n)
-  mread.env$sigma <- vector("list",n)
-  mread.env$annot <- vector("list",n)
+  mread.env$param <- vector("list", n)
+  mread.env$fixed <- vector("list", n)
+  mread.env$init  <- vector("list", n)
+  mread.env$omega <- vector("list", n)
+  mread.env$sigma <- vector("list", n)
+  mread.env$annot <- vector("list", n)
   mread.env$ode   <- vector("list", n)
   mread.env$namespace <- vector("list", n)
-  mread.env$capture <- vector("list",n)
+  mread.env$capture <- vector("list", n)
   mread.env$error <- character(0)
   mread.env$covariates <- character(0)
+  mread.env$nm_import <- character(0)
   mread.env$ENV <- ENV 
   mread.env$blocks <- names(spec)
   mread.env$incoming_names <- incoming_names

R/mread.R

@@ -411,6 +411,7 @@ mread <- function(model, project = getOption("mrgsolve.project", getwd()),
   inc <- spec[["INCLUDE"]]
   if(is.null(inc)) inc <- character(0)
   x@shlib[["include"]] <- inc
+  x@shlib[["nm_import"]] <- mread.env[["nm_import"]]
   x@shlib[["source"]] <- file.path(build$soloc,build$compfile)
   x@shlib[["md5"]] <- build[["md5"]]
 

R/nmxml.R

@@ -207,9 +207,9 @@ nmxml <- function(run = numeric(0), project = character(0),
     class="sigmalist"
   )
 
-  ans <- list(theta=th, omega=om, sigma=sg)
+  ans <- list(theta = th, omega = om, sigma = sg, file = target)
 
-  return(structure(ans,class="NMXMLDATA"))
+  return(structure(ans, class = "NMXMLDATA"))
 
 }
 
@@ -294,18 +294,19 @@ nmext <- function(run = NA_real_, project = getwd(),
   }
 
   om <- create_matlist(
-    setNames(list(om),oname), 
-    labels=olabels, 
-    class="omegalist"
+    setNames(list(om), oname), 
+    labels = olabels, 
+    class = "omegalist"
   )
 
   sg <- create_matlist(
-    setNames(list(sg),sname), 
-    labels=slabels, 
-    class="sigmalist"
+    setNames(list(sg), sname), 
+    labels = slabels, 
+    class = "sigmalist"
   )
 
-  ans <- list(theta = th, omega = om, sigma = sg)
+  file <- attributes(ans)[["file"]]
+  ans <- list(theta = th, omega = om, sigma = sg, file = file)
 
   return(structure(ans,class="NMXMLDATA"))
 }
@@ -428,12 +429,12 @@ read_nmext <- function(run = NA_real_,
   ans <- as.list(ans)
   names(ans) <- gsub("[[:punct:]]", "", names(ans))
   ans <- list(
+    raw = ans,
     param = ans[grepl("THETA", names(ans))],
     omega = as_bmat(ans, "OMEGA"), 
-    sigma = as_bmat(ans, "SIGMA"),
-    raw = ans
+    sigma = as_bmat(ans, "SIGMA")
   )
-  return(structure(ans, table = m$table, index = index))
+  return(structure(ans, table = m$table, index = index, file = extfile))
 }
 
 map_ext_file <- function(file, all_rows = FALSE) {

tests/testthat/test-nmxml.R

@@ -258,7 +258,7 @@ test_that("Mixed labels / no labels and prefix", {
 test_that("read_nmext returns estimates", {
   project <- system.file("nonmem", package="mrgsolve")
   x <- read_nmext(1005, project)   
-  expect_equal(names(x), c("param", "omega", "sigma", "raw"))
+  expect_equal(names(x), c("raw", "param", "omega", "sigma"))
   expect_is(x$param, "list")
   expect_is(x$omega, "matrix")
   expect_is(x$sigma, "matrix")
@@ -336,3 +336,16 @@ test_that("read nm estimates relative to cpp file", {
   mod <- mread("1005-xml", project = "nm", compile = FALSE)
   expect_is(mod, "mrgmod") 
 })
+
+test_that("nm source file is available via as.list", {
+  skip_if_not(
+    all(
+      file.exists("nm/1005-ext.cpp"), 
+      file.exists("nm/1005-xml.cpp")
+    )
+  )
+  list1 <- as.list(mread("1005-ext", project = "nm", compile = FALSE))
+  list2 <- as.list(mread("1005-xml", project = "nm", compile = FALSE))
+  expect_equal(basename(list1[["nm_import"]]), "1005.ext")
+  expect_equal(basename(list2[["nm_import"]]), "1005.xml")
+})

vignettes/extra/dollar-pred.Rmd

@@ -1,5 +1,5 @@
 ---
-title: Models without compartments (dollar-PRED)
+title: Models without compartments
 author: ""
 date: "`r Sys.Date()`"
 output: 
@@ -11,7 +11,7 @@ output:
     fig_width: 5
     fig_height: 4
 vignette: >
-  %\VignetteIndexEntry{Models without compartments (dollar-PRED)}
+  %\VignetteIndexEntry{Models without compartments}
   %\VignetteEngine{knitr::rmarkdown}
   %\VignetteEncoding{UTF-8}
 ---
@@ -23,6 +23,9 @@ set.seed(10202)
 
 ```{r pred_setup}
 library(mrgsolve)
+library(ggplot2)
+library(dplyr)
+library(purrr)
 ```
 
 This vignette introduces a new formal code block for writing models
@@ -39,8 +42,7 @@ models are invoked.
 As a most-basic model, we look at the `pred1` model in `modlib()`
 
 ```{r}
-library(mrgsolve)
-mod <- mread_cache("pred1", modlib())
+mod <- modlib("pred1")
 ```
 
 
@@ -61,15 +63,14 @@ When mrgsolve finds `$PRED`, it will generate an error if it also finds
 In the example model, the response is a function of the parameter `B`, 
 so we'll generate an input data set with some values of `B`
 
-```{r,message = FALSE}
-library(dplyr)
+```{r, message = FALSE}
 data <- tibble(ID = 1, B = exp(rnorm(100, 0,2)))
 
 head(data)
 ```
 
 ```{r}
-out <- mrgsim_d(mod,data,carry.out="B")
+out <- mrgsim_d(mod, data, carry_out = "B")
 
 plot(out, Y~B)
 ```
@@ -78,15 +79,13 @@ plot(out, Y~B)
 Like other models, we can simulate from a population
 
 ```{r}
-library(purrr)
-set.seed(223)
 df <- map_df(1:30, ~ tibble(ID = .x, B = seq(0,30,1)))
 
 head(df)
 
 mod %>% 
   data_set(df) %>% 
-  mrgsim(carry.out="B") %>%
+  mrgsim(carry_out = "B") %>%
   plot(Y ~ B)
 ```
 
@@ -124,28 +123,28 @@ mod <- mcode_cache("pkpd", code)
 
 To simulate, look at 50 subjects at each of 5 doses
 ```{r}
+set.seed(8765)
+
 data <- 
-  expand.idata(DOSE = c(30,50,80,110,200),ID = 1:50) %>% 
+  expand.idata(DOSE = c(30,50,80,110,200), ID = 1:50) %>% 
   mutate(WT = exp(rnorm(n(),log(80),1)))
 
 head(data)
 ```
 
 ```{r}
-out <- mrgsim_d(mod,data,carry.out="WT,DOSE") %>% as.data.frame()
+out <- mrgsim_df(mod, data, carry_out="WT,DOSE") 
 
 head(out)
 ```
 
 
 Plot the response (`Y`) versus `AUC`, colored by dose
 ```{r}
-library(ggplot2)
-
-ggplot(out, aes(AUC,Y,col =factor(DOSE))) + 
+ggplot(out, aes(AUC, Y, col =factor(DOSE))) + 
   geom_point() + 
-  scale_x_continuous(trans = "log", breaks = 10^seq(-4,4)) + 
-  geom_smooth(aes(AUC,Y),se = FALSE,col="darkgrey") + theme_bw() + 
+  scale_x_log10(breaks = 10^seq(-4, 4)) + 
+  geom_smooth(aes(AUC,Y), se = FALSE, col="darkgrey") + theme_bw() + 
   scale_color_brewer(palette = "Set2", name = "") + 
   theme(legend.position = "top")
 ```