metrumresearchgroup · kylebaron · Sep 25, 2024 · Sep 8, 2024 · Sep 8, 2024 · Sep 8, 2024
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: mrgsolve
 Title: Simulate from ODE-Based Models
-Version: 1.5.1.9001
+Version: 1.5.1.9002
 Authors@R: 
     c(person(given = "Kyle T", family = "Baron",
              role = c("aut", "cre"),

diff --git a/Makefile b/Makefile
@@ -78,6 +78,7 @@ readme:
 doc:
 	Rscript -e "roxygen2::roxygenize()"
 
+.PHONY: build
 build:
 	R CMD build --md5 $(PKGDIR) --no-manual
 

diff --git a/NAMESPACE b/NAMESPACE
@@ -22,6 +22,7 @@ S3method(handle_spec_block,specBLOCK)
 S3method(handle_spec_block,specCAPTURE)
 S3method(handle_spec_block,specCMT)
 S3method(handle_spec_block,specCMTN)
+S3method(handle_spec_block,specEVENT)
 S3method(handle_spec_block,specFIXED)
 S3method(handle_spec_block,specINCLUDE)
 S3method(handle_spec_block,specINIT)

diff --git a/R/Aaaa.R b/R/Aaaa.R
@@ -80,7 +80,7 @@ block_list <- c("ENV", "PROB", "PARAM", "INIT",
                 "PKMODEL", "PLUGIN", "INCLUDE", "NAMESPACE",
                 "OMEGA", "SIGMA", "SET","GLOBAL", "CAPTURE", 
                 "PREAMBLE", "PRED", "BLOCK", "TRANSIT", "YAML", "NMEXT", 
-                "INPUT")
+                "INPUT", "EVENT")
 
 Reserved_cvar <- c("SOLVERTIME","table","ETA","EPS", "AMT", "CMT",
                    "ID", "TIME", "EVID","simeps", "self", "simeta",

diff --git a/R/class_mrgmod.R b/R/class_mrgmod.R
@@ -16,8 +16,8 @@
 # along with mrgsolve.  If not, see <http://www.gnu.org/licenses/>.
 
 valid_funs <- function(x) {
-  x1 <- length(x)==4
-  x2 <- identical(names(x), c("main", "ode", "table", "config"))
+  x1 <- length(x)==5
+  x2 <- identical(names(x), c("main", "ode", "table", "event", "config"))
   if(x1 & x2) return(list(TRUE,NULL))
   msg <- c(
     "Invalid functions specification.",
@@ -794,7 +794,8 @@ parin <- function(x) {
     ss_n = 500, 
     ss_fixed = FALSE, 
     interrupt = -1, 
-    etasrc = "omega"
+    etasrc = "omega", 
+    call_event = x@shlib$call_event
   )
 }
 

diff --git a/R/compile.R b/R/compile.R
@@ -1,4 +1,4 @@
-# Copyright (C) 2013 - 2023  Metrum Research Group
+# Copyright (C) 2013 - 2024  Metrum Research Group
 #
 # This file is part of mrgsolve.
 #
@@ -17,12 +17,15 @@
 
 generate_rdefs <- function(pars,
                            cmt,
-                           func,
-                           init_fun="",
-                           table_fun="",
-                           config_fun="",
-                           model="",omats,smats,
-                           set=list(), 
+                           func = "",
+                           init_fun = "",
+                           table_fun = "",
+                           event_fun = "",
+                           config_fun = "",
+                           model = "",
+                           omats,
+                           smats,
+                           set = list(), 
                            plugin = NULL,
                            dbsyms = FALSE, ...) {
 
@@ -91,6 +94,7 @@ generate_rdefs <- function(pars,
         c(paste0("#define __INITFUN___ ",init_fun),
           paste0("#define __ODEFUN___ ",func),
           paste0("#define __TABLECODE___ ", table_fun),
+          paste0("#define __EVENTFUN___ ", event_fun), 
           paste0("#define __CONFIGFUN___ ", config_fun),
           paste0("#define __REGISTERFUN___ ", register_fun(model)),
           paste0("#define _nEQ ", ncmt),

diff --git a/R/funset.R b/R/funset.R
@@ -1,4 +1,4 @@
-# Copyright (C) 2013 - 2019  Metrum Research Group, LLC
+# Copyright (C) 2013 - 2024  Metrum Research Group
 #
 # This file is part of mrgsolve.
 #
@@ -30,6 +30,7 @@ There was a problem accessing the model shared object.
 main_func   <- function(x) x@funs["main"]
 ode_func    <- function(x) x@funs["ode"]
 table_func  <- function(x) x@funs["table"] 
+event_func  <- function(x) x@funs["event"]
 config_func <- function(x) x@funs["config"]
 info_func   <- function(x) x@funs["info"]
 #nocov end
@@ -42,7 +43,7 @@ clean_symbol <- function(x) {
   gsub("[[:punct:]]", "__", x)
 }
 
-funs_create <- function(model, what = c("main", "ode", "table", "config")) {
+funs_create <- function(model, what = c("main", "ode", "table", "event", "config")) {
   setNames(paste0("_model_", clean_symbol(model), "_", what ,"__"),what)
 }
 
@@ -55,7 +56,7 @@ package_loaded <- function(x) {
 }
 
 funs <- function(x) {
-  x@funs[c("main", "ode", "table", "config")]
+  x@funs[c("main", "ode", "table", "event", "config")]
 }
 
 model_loaded <- function(x) {

diff --git a/R/handle_spec_block.R b/R/handle_spec_block.R
@@ -566,6 +566,17 @@ handle_spec_block.specTABLE <- function(x, env, ...) {
   return(x)
 }
 
+#' @export 
+handle_spec_block.specEVENT <- function(x, env, ...) {
+
+  x <- dump_opts(x)
+
+  pos <- attr(x,"pos")
+
+  check_block_data(x, env, pos)
+
+  return(x)
+}
 
 # NMXML --------------------------------
 #' @export

diff --git a/R/modlib.R b/R/modlib.R
@@ -1,4 +1,4 @@
-# Copyright (C) 2013 - 2021  Metrum Research Group
+# Copyright (C) 2013 - 2024  Metrum Research Group
 #
 # This file is part of mrgsolve.
 #
@@ -55,8 +55,9 @@
 ##' mod <- mread("viral2", modlib())
 ##' mod <- mread("pred1",  modlib())
 ##' mod <- mread("pbpk",   modlib())
-##' mod <- mread("1005",   modlib())      # embedded NONMEM result
+##' mod <- mread("1005",   modlib())  # embedded NONMEM result
 ##' mod <- mread("nm-like", modlib()) # model with nonmem-like syntax
+##' mod <- mread("evtools", modlib())
 ##' 
 ##' mrgsolve:::code(mod)
 ##' }
@@ -75,7 +76,7 @@ modlib <- function(model = NULL,...,list=FALSE)  {
 modlib_models <- c(
   "pk1cmt", "pk2cmt", "pk3cmt", "pk", "pk1", "pk2", "popex",
   "irm1", "irm2", "irm3", "pred1", "emax", "tmdd", "viral1", 
-  "viral2", "effect", "1005", "nm-like"
+  "viral2", "effect", "1005", "nm-like", "evtools"
 )
 #nocov end
 

diff --git a/R/modspec.R b/R/modspec.R
@@ -368,7 +368,7 @@ param_re_find <- "\\bparam\\s+\\w+\\s*="
 # please-deprecate
 move_global <- function(x,env) {
 
-  what <- intersect(c("PREAMBLE","MAIN", "ODE", "TABLE", "PRED"),names(x))
+  what <- intersect(c("PREAMBLE","MAIN", "ODE", "TABLE", "EVENT", "PRED"),names(x))
 
   if(length(what)==0) return(x)
 
@@ -495,12 +495,17 @@ move_global2 <- function(spec, env, build) {
   if(!is.null(table$code)) {
     spec$TABLE <- table$code
   }
+  event <- c_vars(spec[["EVENT"]], context = "event")  
+  if(!is.null(event$code)) {
+    spec$EVENT <- event$code
+  }
   to_ns <- bind_rows(
     pream$vars,
     pred$vars,
     main$vars,
     ode$vars,
-    table$vars
+    table$vars, 
+    event$vars
   )
   vars <- bind_rows(glob$vars, to_ns)
   if(any(cap <- to_ns$type=="capture")) {
@@ -536,7 +541,7 @@ move_global2 <- function(spec, env, build) {
 }
 
 find_cpp_dot <- function(spec, env) {
-  to_check <- c("PREAMBLE", "MAIN", "PRED", "ODE", "TABLE", "GLOBAL")
+  to_check <- c("PREAMBLE", "MAIN", "PRED", "ODE", "EVENT", "TABLE", "GLOBAL")
   x <- spec[names(spec) %in% to_check]
   x <- unlist(x, use.names = FALSE)
   # Narrow the search first; 10x speed up when searching for `pattern`

diff --git a/R/mread.R b/R/mread.R
@@ -336,10 +336,11 @@ mread <- function(model, project = getOption("mrgsolve.project", getwd()),
   rd <- generate_rdefs(
     pars = Pars(x),
     cmt = Cmt(x),
-    ode_func(x),
-    main_func(x),
-    table_func(x),
-    config_func(x),
+    func = ode_func(x),
+    init_fun = main_func(x),
+    table_fun = table_func(x),
+    event_fun = event_func(x),
+    config_fun = config_func(x),
     model = model(x),
     omats = omat(x),
     smats = smat(x),
@@ -375,7 +376,7 @@ mread <- function(model, project = getOption("mrgsolve.project", getwd()),
   }
   # autodec
   if("autodec" %in% names(plugin)) {
-    auto_blocks <- c("PREAMBLE", "MAIN", "PRED", "ODE", "TABLE")
+    auto_blocks <- c("PREAMBLE", "MAIN", "PRED", "ODE", "TABLE", "EVENT")
     auto_skip <- cvec_cs(ENV[["MRGSOLVE_AUTODEC_SKIP"]])
     autov <- autodec_vars(spec, blocks = auto_blocks)
     autov <- autodec_clean(
@@ -461,6 +462,7 @@ mread <- function(model, project = getOption("mrgsolve.project", getwd()),
   x@shlib[["nm_import"]] <- mread.env[["nm_import"]]
   x@shlib[["source"]] <- file.path(build[["soloc"]],build[["compfile"]])
   x@shlib[["md5"]] <- build[["md5"]]
+  x@shlib[["call_event"]] <- "EVENT" %in% names(spec)
 
   # build----
   # In soloc directory
@@ -536,6 +538,10 @@ mread <- function(model, project = getOption("mrgsolve.project", getwd()),
     dbs[["ode"]],
     spec[["ODE"]], 
     "__END_ode__",
+    "\n// MODELED EVENTS:", 
+    "__BEGIN_event__", 
+    spec[["EVENT"]],
+    "__END_event__",
     "\n// TABLE CODE BLOCK:",
     "__BEGIN_table__",
     dbs[["cmt"]],

diff --git a/R/nm-mode.R b/R/nm-mode.R
@@ -22,7 +22,7 @@ find_nm_vars <- function(spec) {
   ans[["has_ode"]] <- "ODE" %in% names(spec)
   FRDA <- c("F", "R", "D", "ALAG")
   # CHeck non-ODE
-  blocks_to_check <- c("PREAMBLE", "MAIN", "TABLE")
+  blocks_to_check <- c("PREAMBLE", "MAIN", "TABLE", "EVENT")
   pmt <- unlist(spec[blocks_to_check], use.names = FALSE)
   m1 <- find_nm_vars_impl(pmt)
   # Check ODE

diff --git a/inst/base/modelheader.h b/inst/base/modelheader.h
@@ -65,6 +65,8 @@ typedef double capture;
 #define __END_main__ __DONE__
 #define __BEGIN_table__ extern "C" { void __TABLECODE___(MRGSOLVE_TABLE_SIGNATURE) {
 #define __END_table__ __DONE__
+#define __BEGIN_event__ extern "C" {void __EVENTFUN___(MRGSOLVE_EVENT_SIGNATURE) {
+#define __END_event__ __DONE__
 #define __DONE__ }}
 
 

diff --git a/inst/base/mrgsolv.h b/inst/base/mrgsolv.h
@@ -132,6 +132,10 @@ typedef std::vector<double> dvec;
 #define MRGSOLVE_TABLE_SIGNATURE const dvec& _A_, const dvec& _A_0_,  dvec& _THETA_,  const dvec& _F_, const dvec& _R_,  databox& self, const dvec& _pred_, dvec& _capture_, mrgsolve::resim& simeps
 #define MRGSOLVE_TABLE_SIGNATURE_N 9
 
+//! signature for <code>$EVENT</code> same as what we use for <code>$TABLE</code>
+#define MRGSOLVE_EVENT_SIGNATURE MRGSOLVE_TABLE_SIGNATURE
+#define MRGSOLVE_EVENT_SIGNATURE_N MRGSOLVE_TABLE_SIGNATURE_N
+
 //! signature for <code>$ODE</code>
 #define MRGSOLVE_ODE_SIGNATURE const double* _ODETIME_, const double* _A_, double* _DADT_,  const dvec& _A_0_, const dvec& _THETA_, const bool _ss_flag_
 #define MRGSOLVE_ODE_SIGNATURE_N 6

diff --git a/inst/include/odeproblem.h b/inst/include/odeproblem.h
@@ -48,6 +48,9 @@ typedef void (*init_func)(MRGSOLVE_INIT_SIGNATURE);
 //! <code>$TABLE</code> function
 typedef void (*table_func)(MRGSOLVE_TABLE_SIGNATURE);
 
+//! <code>$EVENT</code> function
+typedef void (*event_func)(MRGSOLVE_EVENT_SIGNATURE);
+
 //! <code>$ODE</code> function
 typedef void (*deriv_func)(MRGSOLVE_ODE_SIGNATURE);
 
@@ -115,6 +118,7 @@ class odeproblem {
 
   void table_call();
   void table_init_call();
+  void event_call();
   void config_call();
 
   void set_d(rec_ptr this_rec);
@@ -249,6 +253,7 @@ class odeproblem {
   deriv_func Derivs; ///< <code>$ODE</code> function
   init_func Inits; ///< <code>$MAIN</code> function
   table_func Table; ///< <code>$TABLE</code> function
+  event_func Event; ///< <code>$EVENT</code> function
   config_func Config; ///< <code>$PREAMBLE</code> function
 
   bool Do_Init_Calc; ///< Flag regulating whether or not initials are taken from <code>$MAIN</code>