From aba81f3074ac5d4a401a7ae6b8b13ff23b13f24b Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Mon, 6 Jul 2020 16:58:54 -0500 Subject: [PATCH 01/23] working with user interrupt --- src/devtran.cpp | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/devtran.cpp b/src/devtran.cpp index 5499604d6..9d64ae59a 100644 --- a/src/devtran.cpp +++ b/src/devtran.cpp @@ -354,9 +354,12 @@ Rcpp::List DEVTRAN(const Rcpp::List parin, int this_idata_row = 0; if(verbose) say("starting the simulation ..."); + // i is indexing the subject, j is the record for(size_t i=0; i < a.size(); ++i) { + //if((i % 128)==0) Rcpp::checkUserInterrupt(); + double id = dat.get_uid(i); double Fn = 1.0; int this_cmtn = 0; From 39359114c0c7e4bacfadff010e3837db8e97c977 Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Sun, 7 Mar 2021 23:13:13 -0600 Subject: [PATCH 02/23] slot in code for evid2 handling --- src/devtran.cpp | 10 ++++++++++ src/odeproblem.cpp | 3 --- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/src/devtran.cpp b/src/devtran.cpp index 420ad2e8f..cdeda377c 100644 --- a/src/devtran.cpp +++ b/src/devtran.cpp @@ -611,6 +611,16 @@ Rcpp::List DEVTRAN(const Rcpp::List parin, } if(this_rec->evid()==2) { this_rec->implement(&prob); + if(this_rec->cmt() < 0 && prob.infusion_count[this_cmtn] > 0) { + int n_inf = prob.infusion_count[this_cmtn]; + for(int ii = j; ii < a[i].size() && n_inf > 0; ++ii) { + if(a[i].at(ii)->evid()==9) { + prob.rate_rm(this_cmtn, a[i].at(ii)->rate()); + a[i].erase(a[i].begin() + ii); + --n_inf; + } + } + } } tfrom = tto; } diff --git a/src/odeproblem.cpp b/src/odeproblem.cpp index abcdcd3c9..eb0756136 100644 --- a/src/odeproblem.cpp +++ b/src/odeproblem.cpp @@ -329,9 +329,6 @@ void odeproblem::on(const unsigned short int eq_n) { } void odeproblem::off(const unsigned short int eq_n) { - if(infusion_count[eq_n]>0) { - Rcpp::stop("attempting to turn compartment off when infusion is on."); - } On[eq_n] = 0; this->y(eq_n,0.0); } From 4c4fc72f45b68444a30ae3333beb2387f93455b5 Mon Sep 17 00:00:00 2001 From: Romain Francois Date: Thu, 22 Apr 2021 17:24:36 +0200 Subject: [PATCH 03/23] use expand.grid(KEEP.OUT.ATTRS = FALSE) --- R/utils.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/utils.R b/R/utils.R index b5e95ca01..80bdacb82 100644 --- a/R/utils.R +++ b/R/utils.R @@ -222,7 +222,7 @@ my_str_split <- function(string,pattern,n=3,fixed=FALSE,collapse=pattern) { ##' @md ##' @export expand.idata <- function(...) { - ans <- expand.grid(...,stringsAsFactors=FALSE) + ans <- expand.grid(...,stringsAsFactors=FALSE, KEEP.OUT.ATTRS = FALSE) ans$ID <- seq_len(nrow(ans)) dplyr::select(ans, "ID", everything()) } From d927312657844ffe399e7dae3347a55b1e311ee8 Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Sat, 1 May 2021 09:53:55 -0500 Subject: [PATCH 04/23] develop version --- DESCRIPTION | 2 +- NEWS.md | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 96e45f8c4..0066a87c2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: mrgsolve Title: Simulate from ODE-Based Models -Version: 0.11.0 +Version: 0.11.0.9000 Authors@R: c(person(given = "Kyle T", family = "Baron", role = c("aut", "cre"), diff --git a/NEWS.md b/NEWS.md index ef178ed90..c80740443 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,5 @@ +# mrgsolve (development version) + # mrgsolve 0.11.0 - The absolute paths to nonmem output files (`root.xml` or `root.ext`) are now From 65299e4d67cffd7e8cea40d2de28b1fb8411278e Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Sat, 1 May 2021 13:06:59 -0500 Subject: [PATCH 05/23] revise code to remove infusions when compartment is turned off --- src/devtran.cpp | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/devtran.cpp b/src/devtran.cpp index 104960bcb..072f58a2d 100644 --- a/src/devtran.cpp +++ b/src/devtran.cpp @@ -610,11 +610,14 @@ Rcpp::List DEVTRAN(const Rcpp::List parin, this_rec->implement(&prob); if(this_rec->cmt() < 0 && prob.infusion_count[this_cmtn] > 0) { int n_inf = prob.infusion_count[this_cmtn]; - for(int ii = j; ii < a[i].size() && n_inf > 0; ++ii) { + int n_end = a[i].size(); + for(int ii = j; (n_inf > 0 && ii < n_end); ++ii) { if(a[i].at(ii)->evid()==9) { prob.rate_rm(this_cmtn, a[i].at(ii)->rate()); a[i].erase(a[i].begin() + ii); --n_inf; + --n_end; + --ii; } } } From 083c606f5e5ec1f021fd99370417c3ea83c6e800 Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Mon, 3 May 2021 11:57:45 -0500 Subject: [PATCH 06/23] check user for user interrupt --- R/class_mrgmod.R | 2 +- R/mrgsolve.R | 6 ++++++ inst/include/odeproblem.h | 1 + man/mrgsim.Rd | 6 ++++++ src/devtran.cpp | 11 ++++++++--- src/odeproblem.cpp | 2 ++ 6 files changed, 24 insertions(+), 4 deletions(-) diff --git a/R/class_mrgmod.R b/R/class_mrgmod.R index 03fe6268d..2a8c25d3a 100644 --- a/R/class_mrgmod.R +++ b/R/class_mrgmod.R @@ -734,7 +734,7 @@ parin <- function(x) { digits=x@digits, tscale=x@tscale, mindt=x@mindt, advan=x@advan, ss_n = 500, ss_fixed = FALSE, - ss_cmt = x@ss_cmt + ss_cmt = x@ss_cmt, interrupt = -1 ) } diff --git a/R/mrgsolve.R b/R/mrgsolve.R index 02fefbf43..7b3712f26 100644 --- a/R/mrgsolve.R +++ b/R/mrgsolve.R @@ -461,6 +461,10 @@ mrgsim_nid <- function(x, nid, events = ev(), ...) { #' To silence warnings related to steady state, set `ss_fixed` to `TRUE` and #' set `ss_n` as the maximum number of iterations to try when advancing the #' system for steady state determination. +#' @param interrupt integer check user interrupt interval; when `interrupt` is a +#' positive integer, the simulation will check for the user interrupt signal +#' every `interrupt` simulation records; pass a negative number to never check +#' for the user interrupt interval. #' #' @md #' @rdname mrgsim @@ -487,6 +491,7 @@ do_mrgsim <- function(x, skip_init_calc = FALSE, ss_n = 500, ss_fixed = FALSE, + interrupt = 256, ...) { x <- update(x,...,strict=TRUE) @@ -591,6 +596,7 @@ do_mrgsim <- function(x, parin$ss_fixed <- ss_fixed parin$ss_n <- ss_n parin$request <- Cmti(x)-1L + parin$interrupt <- interrupt if(tad && any(x@capture =="tad")) { wstop("tad argument is true and 'tad' found in $CAPTURE") diff --git a/inst/include/odeproblem.h b/inst/include/odeproblem.h index cf3f6f859..97dddcf7e 100644 --- a/inst/include/odeproblem.h +++ b/inst/include/odeproblem.h @@ -250,6 +250,7 @@ class odeproblem { config_func Config; ///< $PREAMBLE function bool Do_Init_Calc; ///< Flag regulating whether or not initials are taken from $MAIN + int interrupt; }; diff --git a/man/mrgsim.Rd b/man/mrgsim.Rd index 6c65e7df0..19c292c09 100644 --- a/man/mrgsim.Rd +++ b/man/mrgsim.Rd @@ -33,6 +33,7 @@ do_mrgsim( skip_init_calc = FALSE, ss_n = 500, ss_fixed = FALSE, + interrupt = 256, ... ) } @@ -130,6 +131,11 @@ has not been reached within \code{ss_n} dosing iterations. To silence warnings related to steady state, set \code{ss_fixed} to \code{TRUE} and set \code{ss_n} as the maximum number of iterations to try when advancing the system for steady state determination.} + +\item{interrupt}{integer check user interrupt interval; when \code{interrupt} is a +positive integer, the simulation will check for the user interrupt signal +every \code{interrupt} simulation records; pass a negative number to never check +for the user interrupt interval.} } \value{ An object of class \link{mrgsims} diff --git a/src/devtran.cpp b/src/devtran.cpp index 77431ed20..c9d9c49aa 100644 --- a/src/devtran.cpp +++ b/src/devtran.cpp @@ -337,7 +337,8 @@ Rcpp::List DEVTRAN(const Rcpp::List parin, idata_carry_start,nocb); } - crow = 0; + crow = 0; // current output row + int crec = 0; // current record number prob.nid(dat.nid()); prob.nrow(NN); @@ -349,14 +350,13 @@ Rcpp::List DEVTRAN(const Rcpp::List parin, bool has_idata = idat.nrow() > 0; int this_idata_row = 0; + const bool do_interrupt = prob.interrupt > 0; if(verbose) say("starting the simulation ..."); // i is indexing the subject, j is the record for(size_t i=0; i < a.size(); ++i) { - //if((i % 128)==0) Rcpp::checkUserInterrupt(); - double id = dat.get_uid(i); dat.next_id(i); prob.idn(i); @@ -400,6 +400,11 @@ Rcpp::List DEVTRAN(const Rcpp::List parin, for(size_t j=0; j < a[i].size(); ++j) { + if(do_interrupt && ((crec % prob.interrupt)==0)) { + Rcpp::checkUserInterrupt(); + ++crec; + } + if(crow == NN) continue; prob.rown(crow); diff --git a/src/odeproblem.cpp b/src/odeproblem.cpp index eb0756136..8968ec5ac 100644 --- a/src/odeproblem.cpp +++ b/src/odeproblem.cpp @@ -103,6 +103,7 @@ odeproblem::odeproblem(Rcpp::NumericVector param, ss_flag = false; ssRtol = 0; ssAtol = 0; + interrupt = -4321; pred.assign(5,0.0); @@ -669,6 +670,7 @@ void odeproblem::copy_parin(const Rcpp::List& parin) { } Do_Init_Calc = Rcpp::as(parin["do_init_calc"]); Ss_cmt = Rcpp::as>(parin["ss_cmt"]); + interrupt = Rcpp::as(parin["interrupt"]); } void odeproblem::copy_funs(const Rcpp::List& funs) { From 8939c4026c0f5f1b869841091e9505d4caccf458 Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Mon, 3 May 2021 12:03:47 -0500 Subject: [PATCH 07/23] document in C++ code --- inst/include/odeproblem.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/inst/include/odeproblem.h b/inst/include/odeproblem.h index 97dddcf7e..5c2747071 100644 --- a/inst/include/odeproblem.h +++ b/inst/include/odeproblem.h @@ -250,7 +250,7 @@ class odeproblem { config_func Config; ///< $PREAMBLE function bool Do_Init_Calc; ///< Flag regulating whether or not initials are taken from $MAIN - int interrupt; + int interrupt; ///< Check User Interrupt interval (number of simulation records) }; From 0397b82d6d496d82819855e594b04de20d210357 Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Tue, 4 May 2021 08:27:36 -0500 Subject: [PATCH 08/23] change where crec is incremented --- src/devtran.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/devtran.cpp b/src/devtran.cpp index c9d9c49aa..8c8dfb58c 100644 --- a/src/devtran.cpp +++ b/src/devtran.cpp @@ -400,9 +400,9 @@ Rcpp::List DEVTRAN(const Rcpp::List parin, for(size_t j=0; j < a[i].size(); ++j) { + ++crec; if(do_interrupt && ((crec % prob.interrupt)==0)) { Rcpp::checkUserInterrupt(); - ++crec; } if(crow == NN) continue; From c6da8125cb82f049a7c6047dd0cd901452806612 Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Thu, 6 May 2021 06:54:30 -0500 Subject: [PATCH 09/23] default to -1 --- src/odeproblem.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/odeproblem.cpp b/src/odeproblem.cpp index 8968ec5ac..4a72e4132 100644 --- a/src/odeproblem.cpp +++ b/src/odeproblem.cpp @@ -103,7 +103,7 @@ odeproblem::odeproblem(Rcpp::NumericVector param, ss_flag = false; ssRtol = 0; ssAtol = 0; - interrupt = -4321; + interrupt = -1; pred.assign(5,0.0); From 4f6950b7cea90626480b8a4071ad443bec239001 Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Fri, 7 May 2021 00:38:37 -0500 Subject: [PATCH 10/23] test for removing infusions --- inst/maintenance/unit/test-on-off.R | 36 +++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/inst/maintenance/unit/test-on-off.R b/inst/maintenance/unit/test-on-off.R index 6fdb49007..a2fd2d04c 100644 --- a/inst/maintenance/unit/test-on-off.R +++ b/inst/maintenance/unit/test-on-off.R @@ -52,3 +52,39 @@ test_that("compartment is turned on when F is zero", { expect_equal(ans[7:9], c(0,0,0)) expect_equal(ans[10:27], seq(1,24-t2)) }) + +test_that("compartment with active infusion can be turned off", { + mod <- house(end = 96) + data1 <- c( + # start a bunch of infusions into 2nd cmt + # then off at time 20 + # then dose again + ev(amt = 100, rate = 1, cmt = 2), + ev(amt = 500, rate = 1, cmt = 2, time = 2), + ev(amt = 50, rate = 1, cmt = 2, time = 5), + ev(amt = 5, rate = 1, cmt = 2, time = 10), + ev(amt = 0, evid = 2, cmt = -2, time = 20), + ev(amt = 10, time = 40, cmt = 2, rate = 10) + ) %>% mutate(ID = 1) %>% as.data.frame() + data2 <- c( + # same thing, just one infusion + ev(amt = 100, rate = 1, cmt = 2), + ev(amt = 0, evid = 2, cmt = -2, time = 20), + ev(amt = 10, time = 40, cmt = 2, rate = 10) + ) %>% mutate(ID = 2) %>% as.data.frame() + data3 <- c( + # same thing, just do the test dose + ev(amt = 10, time = 40, cmt = 2, rate = 10) + ) %>% mutate(ID = 3) %>% as.data.frame() + data <- bind_rows(data1,data2,data3) + out <- mrgsim_df(mod, data, end = 60) + ans <- filter(out, time >= 40) + id <- ans$ID + ans$ID <- NULL + comp <- split(ans, id) + for(i in 1:3) { + rownames(comp[[i]]) <- NULL + } + expect_equal(comp[[1]], comp[[2]]) + expect_equal(comp[[1]], comp[[3]]) +}) From f6b60f8e153ed78ea1dc9796deaf82e319cff7c6 Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Fri, 7 May 2021 18:13:31 -0500 Subject: [PATCH 11/23] zero_re docs; remove drop_re and zero.re --- NAMESPACE | 6 +--- R/matlist.R | 83 +++++++++++++++++++------------------------------- man/drop_re.Rd | 26 ---------------- man/matlist.Rd | 21 +++---------- 4 files changed, 36 insertions(+), 100 deletions(-) delete mode 100644 man/drop_re.Rd diff --git a/NAMESPACE b/NAMESPACE index 0ed0a6c39..53cbda205 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -87,8 +87,6 @@ export(data_set) export(design) export(dmat) export(do_mrgsim) -export(drop.re) -export(drop_re) export(env_eval) export(env_get) export(env_get_env) @@ -164,8 +162,6 @@ export(valid_data_set) export(valid_data_set.matrix) export(valid_idata_set) export(wf_sweep) -export(zero.re) -export(zero_re) exportClasses(ev) exportClasses(mrgmod) exportClasses(numericlist) @@ -210,7 +206,7 @@ exportMethods(smat) exportMethods(stime) exportMethods(tail) exportMethods(update) -exportMethods(zero.re) +exportMethods(zero_re) import(methods) importFrom(Rcpp,evalCpp) importFrom(dplyr,arrange) diff --git a/R/matlist.R b/R/matlist.R index 0134c8ff7..390f82a56 100644 --- a/R/matlist.R +++ b/R/matlist.R @@ -200,24 +200,29 @@ setMethod("smat", "mrgsims", function(.x,make=FALSE,...) { as.matrix(mod(.x)@sigma) }) -##' Methods for working with matrix-list objects -##' -##' @param .x a matlist object -##' @param x a matlist object -##' @param .drop if \code{TRUE}, \code{zero_re} will drop \code{omega} -##' or \code{sigma} or both entirely -##' @param ... passed along -##' -##' @export -##' @aliases zero.re -##' @name matlist -##' @rdname matlist -setGeneric("zero.re", function(.x,...) standardGeneric("zero.re")) -##' @export -##' @rdname matlist -setMethod("zero.re", "mrgmod", function(.x,...,.drop=FALSE) { - if(.drop) return(drop_re(.x,...)) +#' Zero out random effects in a model object +#' +#' Sets all elements of the OMEGA or SIGMA matrix to zero +#' +#' @param .x a model object +#' @param ... which matrix to zero out; pass `omega` to just zero out `omega`, +#' `sigma` to just zero out `sigma`; passing nothing will zero out both +#' +#' @return +#' An updated object. +#' +#' @examples +#' +#' mod <- house() +#' revar(mod) +#' mod <- zero_re(mod) +#' revar(mod) +#' +setGeneric("zero_re", function(.x, ...) standardGeneric("zero_re")) + +#' @export +setMethod("zero_re", "mrgmod", function(.x, ...) { what <- as.character(eval(substitute(alist(...)))) if(length(what)==0) what <- c("omega", "sigma") if(is.element("omega", what) & !is.null(nrow(omat(.x)))) { @@ -229,47 +234,21 @@ setMethod("zero.re", "mrgmod", function(.x,...,.drop=FALSE) { return(.x) }) -##' @rdname matlist -##' @export -zero_re <- function(...) zero.re(...) - -#' Deprecated: drop random effect matrices from model object -#' -#' -#' @param .x not used -#' @param ... not used -#' -#' @details -#' Users are no longer allowed to remove random effect matrices from the model -#' object. Use [zero_re] instead to convert the matrix to all zeros. -#' -#' -#' @seealso [zero_re] -#' @md -#' @export -drop_re <- function(.x,...) { - lifecycle::deprecate_stop("0.10.1", "drop_re()", "zero_re()") - # .Deprecated(msg="drop.re and drop_re are deprecated. Use zero_re instead.") - # what <- as.character(eval(substitute(alist(...)))) - # if(length(what)==0) what <- c("omega", "sigma") - # if(is.element("omega", what)) .x@omega <- new("omegalist") - # if(is.element("sigma", what)) .x@sigma <- new("sigmalist") - # return(.x) -} -#' @rdname drop_re +#' Methods for working with matrix-list objects +#' +#' @param .x a matlist object +#' @param x a matlist object +#' @param ... passed through to other methods +#' +#' @name matlist #' @export -drop.re <- function(...) { - lifecycle::deprecate_stop("0.10.1", "drop.re()", "zero_re()") -} - -##' @export -##' @rdname matlist +#' @rdname matlist setMethod("as.list", "matlist", function(x, ...) x@data) ##' @export ##' @rdname matlist -setMethod("as.matrix", "matlist", function(x,...) { +setMethod("as.matrix", "matlist", function(x, ...) { if(length(x@data)==0) return(matrix(nrow=0,ncol=0)) SUPERMATRIX(x@data,...) }) diff --git a/man/drop_re.Rd b/man/drop_re.Rd deleted file mode 100644 index 2873831ad..000000000 --- a/man/drop_re.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/matlist.R -\name{drop_re} -\alias{drop_re} -\alias{drop.re} -\title{Deprecated: drop random effect matrices from model object} -\usage{ -drop_re(.x, ...) - -drop.re(...) -} -\arguments{ -\item{.x}{not used} - -\item{...}{not used} -} -\description{ -Deprecated: drop random effect matrices from model object -} -\details{ -Users are no longer allowed to remove random effect matrices from the model -object. Use \link{zero_re} instead to convert the matrix to all zeros. -} -\seealso{ -\link{zero_re} -} diff --git a/man/matlist.Rd b/man/matlist.Rd index c27adf7c0..02ebffc9c 100644 --- a/man/matlist.Rd +++ b/man/matlist.Rd @@ -2,10 +2,6 @@ % Please edit documentation in R/matlist.R \name{matlist} \alias{matlist} -\alias{zero.re} -\alias{zero.re,mrgmod-method} -\alias{zero_re} -\alias{as.list,matlist-method} \alias{as.matrix,matlist-method} \alias{names.matlist} \alias{length.matlist} @@ -15,12 +11,6 @@ \alias{show,matlist-method} \title{Methods for working with matrix-list objects} \usage{ -zero.re(.x, ...) - -\S4method{zero.re}{mrgmod}(.x, ..., .drop = FALSE) - -zero_re(...) - \S4method{as.list}{matlist}(x, ...) \S4method{as.matrix}{matlist}(x, ...) @@ -38,16 +28,13 @@ zero_re(...) \S4method{show}{matlist}(object) } \arguments{ -\item{.x}{a matlist object} - -\item{...}{passed along} - -\item{.drop}{if \code{TRUE}, \code{zero_re} will drop \code{omega} -or \code{sigma} or both entirely} - \item{x}{a matlist object} +\item{...}{passed through to other methods} + \item{object}{passed to showmatlist} + +\item{.x}{a matlist object} } \description{ Methods for working with matrix-list objects From a10f42287a16b1af088d7e0adae09c5b6dd80aed Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Fri, 7 May 2021 20:19:51 -0500 Subject: [PATCH 12/23] fix documentation for zero re --- NAMESPACE | 1 + R/matlist.R | 44 ++++++++++++++++++++++++++------------------ man/matlist.Rd | 1 + man/zero_re.Rd | 32 ++++++++++++++++++++++++++++++++ 4 files changed, 60 insertions(+), 18 deletions(-) create mode 100644 man/zero_re.Rd diff --git a/NAMESPACE b/NAMESPACE index 53cbda205..1932fbe0b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -162,6 +162,7 @@ export(valid_data_set) export(valid_data_set.matrix) export(valid_idata_set) export(wf_sweep) +export(zero_re) exportClasses(ev) exportClasses(mrgmod) exportClasses(numericlist) diff --git a/R/matlist.R b/R/matlist.R index 390f82a56..ea54e8829 100644 --- a/R/matlist.R +++ b/R/matlist.R @@ -218,9 +218,13 @@ setMethod("smat", "mrgsims", function(.x,make=FALSE,...) { #' revar(mod) #' mod <- zero_re(mod) #' revar(mod) +#' revar(zero_re(omega)) #' +#' @md +#' @export setGeneric("zero_re", function(.x, ...) standardGeneric("zero_re")) +#' @rdname zero_re #' @export setMethod("zero_re", "mrgmod", function(.x, ...) { what <- as.character(eval(substitute(alist(...)))) @@ -242,47 +246,51 @@ setMethod("zero_re", "mrgmod", function(.x, ...) { #' @param ... passed through to other methods #' #' @name matlist -#' @export #' @rdname matlist +NULL + +#' @rdname matlist +#' @export setMethod("as.list", "matlist", function(x, ...) x@data) -##' @export -##' @rdname matlist +#' @rdname matlist +#' @export setMethod("as.matrix", "matlist", function(x, ...) { if(length(x@data)==0) return(matrix(nrow=0,ncol=0)) - SUPERMATRIX(x@data,...) + SUPERMATRIX(x@data, ...) }) -##' @export -##' @rdname matlist +#' @rdname matlist +#' @export names.matlist <- function(x) { names(x@data) } -##' @export -##' @rdname matlist +#' @rdname matlist +#' @export length.matlist <- function(x) { length(x@data) } -##' @export -##' @rdname matlist +#' @rdname matlist +#' @export setMethod("labels", "matlist", function(object,...) { object@labels }) -##' @export -##' @rdname matlist +#' @rdname matlist +#' @export setMethod("dim", "matlist", function(x) lapply(x@data, dim)) -##' @export -##' @rdname matlist +#' @rdname matlist +#' @export setMethod("nrow", "matlist", function(x) unlist(lapply(x@data, nrow))) -##' @rdname matlist -##' @param object passed to showmatlist -##' @export -##' @keywords internal + +#' @param object passed to showmatlist +#' @rdname matlist +#' @keywords internal +#' @export setMethod("show", "matlist", function(object) showmatlist(object)) showmatlist <- function(x,...) { diff --git a/man/matlist.Rd b/man/matlist.Rd index 02ebffc9c..b3bd2ef25 100644 --- a/man/matlist.Rd +++ b/man/matlist.Rd @@ -2,6 +2,7 @@ % Please edit documentation in R/matlist.R \name{matlist} \alias{matlist} +\alias{as.list,matlist-method} \alias{as.matrix,matlist-method} \alias{names.matlist} \alias{length.matlist} diff --git a/man/zero_re.Rd b/man/zero_re.Rd new file mode 100644 index 000000000..acb34bf05 --- /dev/null +++ b/man/zero_re.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/matlist.R +\name{zero_re} +\alias{zero_re} +\alias{zero_re,mrgmod-method} +\title{Zero out random effects in a model object} +\usage{ +zero_re(.x, ...) + +\S4method{zero_re}{mrgmod}(.x, ...) +} +\arguments{ +\item{.x}{a model object} + +\item{...}{which matrix to zero out; pass \code{omega} to just zero out \code{omega}, +\code{sigma} to just zero out \code{sigma}; passing nothing will zero out both} +} +\value{ +An updated object. +} +\description{ +Sets all elements of the OMEGA or SIGMA matrix to zero +} +\examples{ + +mod <- house() +revar(mod) +mod <- zero_re(mod) +revar(mod) +revar(zero_re(omega)) + +} From 1eecb8972e30112652735806f2ba80ca99c19d71 Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Sat, 8 May 2021 00:50:37 -0500 Subject: [PATCH 13/23] new version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0066a87c2..e64e5544e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: mrgsolve Title: Simulate from ODE-Based Models -Version: 0.11.0.9000 +Version: 0.11.0.9001 Authors@R: c(person(given = "Kyle T", family = "Baron", role = c("aut", "cre"), From 471fa3370668a744971bfa9f36df9942841ab8ca Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Sat, 8 May 2021 07:57:51 -0500 Subject: [PATCH 14/23] fix example --- R/matlist.R | 2 +- man/zero_re.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/matlist.R b/R/matlist.R index ea54e8829..7af75121a 100644 --- a/R/matlist.R +++ b/R/matlist.R @@ -218,7 +218,7 @@ setMethod("smat", "mrgsims", function(.x,make=FALSE,...) { #' revar(mod) #' mod <- zero_re(mod) #' revar(mod) -#' revar(zero_re(omega)) +#' revar(zero_re(mod, omega)) #' #' @md #' @export diff --git a/man/zero_re.Rd b/man/zero_re.Rd index acb34bf05..321d67a77 100644 --- a/man/zero_re.Rd +++ b/man/zero_re.Rd @@ -27,6 +27,6 @@ mod <- house() revar(mod) mod <- zero_re(mod) revar(mod) -revar(zero_re(omega)) +revar(zero_re(mod, omega)) } From 328e59b6e2487fa647bc414652a9f0da483aa3cf Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Sat, 8 May 2021 13:59:38 -0500 Subject: [PATCH 15/23] rename duplicates and warn --- R/matlist.R | 8 ++++++-- R/mrgsolve.R | 19 ++++++++++++++++++- man/zero_re.Rd | 6 +++++- 3 files changed, 29 insertions(+), 4 deletions(-) diff --git a/R/matlist.R b/R/matlist.R index 7af75121a..52ea03b67 100644 --- a/R/matlist.R +++ b/R/matlist.R @@ -218,8 +218,12 @@ setMethod("smat", "mrgsims", function(.x,make=FALSE,...) { #' revar(mod) #' mod <- zero_re(mod) #' revar(mod) -#' revar(zero_re(mod, omega)) -#' +#' +#' \dontrun{ +#' mod <- modlib("popex", compile = FALSE) +#' mod <- zero_re(mod, omega) +#' revar(mod) +#' } #' @md #' @export setGeneric("zero_re", function(.x, ...) standardGeneric("zero_re")) diff --git a/R/mrgsolve.R b/R/mrgsolve.R index 7b3712f26..3afe22455 100644 --- a/R/mrgsolve.R +++ b/R/mrgsolve.R @@ -672,9 +672,26 @@ do_mrgsim <- function(x, x@capL # already re-named ) + if(anyDuplicated.default(cnames)) { + dups <- duplicated(cnames) + new_names <- make.names(cnames, unique = TRUE) + for(dup in which(dups)) { + prev <- cnames[dup] + updated <- new_names[dup] + warning( + glue("duplicate output name: `{prev}`-->`{updated}`"), + call. = FALSE + ) + } + cnames <- new_names + } + dimnames(out[["data"]]) <- list(NULL, cnames) - ans <- as.data.frame(out[["data"]]) + ans <- as.data.frame.matrix( + out[["data"]], + stringsAsFactors = FALSE + ) if(do_recover_data || do_recover_idata) { if(do_recover_data) { diff --git a/man/zero_re.Rd b/man/zero_re.Rd index 321d67a77..0bf6eb292 100644 --- a/man/zero_re.Rd +++ b/man/zero_re.Rd @@ -27,6 +27,10 @@ mod <- house() revar(mod) mod <- zero_re(mod) revar(mod) -revar(zero_re(mod, omega)) +\dontrun{ +mod <- modlib("popex", compile = FALSE) +mod <- zero_re(mod, omega) +revar(mod) +} } From 23829009eb0cd8901f8f15da9bf4688221d9ed76 Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Sat, 8 May 2021 14:09:06 -0500 Subject: [PATCH 16/23] refactor warning for duplicates --- R/mrgsolve.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/mrgsolve.R b/R/mrgsolve.R index 3afe22455..813286766 100644 --- a/R/mrgsolve.R +++ b/R/mrgsolve.R @@ -675,11 +675,12 @@ do_mrgsim <- function(x, if(anyDuplicated.default(cnames)) { dups <- duplicated(cnames) new_names <- make.names(cnames, unique = TRUE) + warning("duplicate output columns found; these will be renamed", call.=FALSE) for(dup in which(dups)) { prev <- cnames[dup] updated <- new_names[dup] warning( - glue("duplicate output name: `{prev}`-->`{updated}`"), + glue("duplicate renamed: {prev} -> {updated}"), call. = FALSE ) } From 38fcea7464457e30ac010e9899d870b4b3b0ec2e Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Sat, 8 May 2021 16:17:39 -0500 Subject: [PATCH 17/23] adds test for duplicate columns --- tests/testthat/test-mrgsim.R | 10 ++++++++++ tests/testthat/test-rename.R | 3 +-- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-mrgsim.R b/tests/testthat/test-mrgsim.R index dd01749a7..532debc13 100644 --- a/tests/testthat/test-mrgsim.R +++ b/tests/testthat/test-mrgsim.R @@ -218,3 +218,13 @@ test_that("simulate non-pred with negative times is allowed", { data$time[1] <- -8 expect_error(mrgsim(mod, data), "the data set is not sorted by time") }) + +test_that("warning for duplicate output names and rename", { + mod <- house(end = -1) + dose <- ev(amt = 100, CP = 999) + expect_warning( + out <- mrgsim(mod, events = dose, carry_out = "CP"), + regexp = "duplicate output columns found; these will be renamed" + ) + expect_true(all(c("CP", "CP.1") %in% names(out))) +}) diff --git a/tests/testthat/test-rename.R b/tests/testthat/test-rename.R index f8be0eea1..2c47c3693 100644 --- a/tests/testthat/test-rename.R +++ b/tests/testthat/test-rename.R @@ -1,4 +1,4 @@ -# Copyright (C) 2013 - 2020 Metrum Research Group +# Copyright (C) 2013 - 2021 Metrum Research Group # # This file is part of mrgsolve. # @@ -41,7 +41,6 @@ test_that("tran item is renamed", { expect_false(all(is.element("evid", names(out)))) }) - test_that("Item carried from data set is renamed", { out <- mod %>% carry_out(Dose,WEIGHT = WT) %>% mrgsim expect_true(all(is.element(s_(RESP,CENT,WEIGHT), names(out)))) From 66de1515c2d86c57374d611e56453ea0e90da652 Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Sat, 8 May 2021 16:29:04 -0500 Subject: [PATCH 18/23] dump dev version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index e64e5544e..794adf974 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: mrgsolve Title: Simulate from ODE-Based Models -Version: 0.11.0.9001 +Version: 0.11.0.9002 Authors@R: c(person(given = "Kyle T", family = "Baron", role = c("aut", "cre"), From 7fdae6a1d61601cedf621f9020be1dfa1e18c78e Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Mon, 10 May 2021 08:21:51 -0500 Subject: [PATCH 19/23] bump dev version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 794adf974..4a3432144 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: mrgsolve Title: Simulate from ODE-Based Models -Version: 0.11.0.9002 +Version: 0.11.0.9003 Authors@R: c(person(given = "Kyle T", family = "Baron", role = c("aut", "cre"), From df280603acb3318b497608166174864d5b427ab3 Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Mon, 10 May 2021 08:32:22 -0500 Subject: [PATCH 20/23] NEWS --- NEWS.md | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/NEWS.md b/NEWS.md index c80740443..77093b1ac 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,16 @@ # mrgsolve (development version) +- `mrgsim()` will now periodically check for user interrupt signal so that + long-running simulations can be stopped using `Esc` and / or `Control-C`; + the check interval can be modified through the `interrupt` argument to + `mrgsim()`, but for most applications, this shouldn't need to be changed + (#823) +- `mrgsim()` will issue a warning if duplicate columns are found in simulated + output and rename duplicates using `make.names()`; thanks @FelicienLL + for the report (#827, #828) +- Users can now turn compartments to `OFF` when they have active infusions + running; this was previously an error (#822) + # mrgsolve 0.11.0 - The absolute paths to nonmem output files (`root.xml` or `root.ext`) are now From ecadab539ded8710151c13619a67a2a77f11c03d Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Mon, 10 May 2021 08:48:48 -0500 Subject: [PATCH 21/23] change test from identical to equal --- tests/testthat/test-mrgsim.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-mrgsim.R b/tests/testthat/test-mrgsim.R index 532debc13..b2efa1d52 100644 --- a/tests/testthat/test-mrgsim.R +++ b/tests/testthat/test-mrgsim.R @@ -115,7 +115,7 @@ test_that("mrgsim with data and idata", { expect_false(any(x[2:length(x)] == first(x))) out_pars <- distinct(out, ID,CL,V) %>% as.data.frame idata_cut <- filter(idata, ID <= 7) - expect_identical(round(out_pars,6), round(idata_cut,6)) + expect_equal(round(out_pars,6), round(idata_cut,6)) }) test_that("mrgsim with ev and ID", { From 3376920a752fc6e5af53acca2d149e695eda583e Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Mon, 10 May 2021 08:52:33 -0500 Subject: [PATCH 22/23] revert to identical but coerce to data.frame --- tests/testthat/test-mrgsim.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-mrgsim.R b/tests/testthat/test-mrgsim.R index b2efa1d52..2fa2739db 100644 --- a/tests/testthat/test-mrgsim.R +++ b/tests/testthat/test-mrgsim.R @@ -113,9 +113,9 @@ test_that("mrgsim with data and idata", { sims <- mutate(sims, CENT_amt = CENT/amt) x <- round(sims$CENT_amt,6) expect_false(any(x[2:length(x)] == first(x))) - out_pars <- distinct(out, ID,CL,V) %>% as.data.frame - idata_cut <- filter(idata, ID <= 7) - expect_equal(round(out_pars,6), round(idata_cut,6)) + out_pars <- as.data.frame(distinct(out, ID,CL,V)) + idata_cut <- as.data.frame(filter(idata, ID <= 7)) + expect_identical(round(out_pars,6), round(idata_cut,6)) }) test_that("mrgsim with ev and ID", { From b289f85336390e861b3476929fedfc59e575d2bd Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Mon, 10 May 2021 11:48:17 -0500 Subject: [PATCH 23/23] bump version for cran update --- DESCRIPTION | 2 +- NEWS.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4a3432144..a40a74ed2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: mrgsolve Title: Simulate from ODE-Based Models -Version: 0.11.0.9003 +Version: 0.11.1 Authors@R: c(person(given = "Kyle T", family = "Baron", role = c("aut", "cre"), diff --git a/NEWS.md b/NEWS.md index 77093b1ac..2546d1dfd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# mrgsolve (development version) +# mrgsolve 0.11.1 - `mrgsim()` will now periodically check for user interrupt signal so that long-running simulations can be stopped using `Esc` and / or `Control-C`;