From ca68100398b6f9a83fafcf141c2865c5eac97dac Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Fri, 21 Jun 2024 22:57:31 -0500 Subject: [PATCH 1/3] add replace function to evtools --- inst/base/mrgsolv.h | 4 +-- inst/base/mrgsolve-evtools.h | 15 ++++++++++ inst/maintenance/unit-cpp/test-evtools.R | 37 +++++++++++++++++++++++- 3 files changed, 53 insertions(+), 3 deletions(-) diff --git a/inst/base/mrgsolv.h b/inst/base/mrgsolv.h index 36ad527b..72cba564 100644 --- a/inst/base/mrgsolv.h +++ b/inst/base/mrgsolv.h @@ -1,4 +1,4 @@ -// Copyright (C) 2013 - 2023 Metrum Research Group +// Copyright (C) 2013 - 2024 Metrum Research Group // // This file is part of mrgsolve. // @@ -49,7 +49,7 @@ struct resim { }; struct evdata { - evdata(double a_, int b_) : time(a_), evid(b_) { + evdata(double a_, int b_) : time(a_), evid(b_) { cmt = 1; amt = 0.0; rate = 0.0; diff --git a/inst/base/mrgsolve-evtools.h b/inst/base/mrgsolve-evtools.h index d3a3f998..2acae78c 100644 --- a/inst/base/mrgsolve-evtools.h +++ b/inst/base/mrgsolve-evtools.h @@ -34,6 +34,21 @@ void infuse(databox& self, const double amt, const int cmt, const double rate) { return; } +mrgsolve::evdata replace(const double amt, const int cmt) { + mrgsolve::evdata ev(0, 8); + ev.amt = amt; + ev.cmt = cmt; + ev.now = true; + ev.check_unique = false; + return ev; +} + +void replace(databox& self, const double amt, const int cmt) { + mrgsolve::evdata ev = replace(amt, cmt); + self.mevector.push_back(ev); + return; +} + void retime(mrgsolve::evdata& ev, const double time) { ev.time = time; ev.now = false; diff --git a/inst/maintenance/unit-cpp/test-evtools.R b/inst/maintenance/unit-cpp/test-evtools.R index edb8310d..0ceca50d 100644 --- a/inst/maintenance/unit-cpp/test-evtools.R +++ b/inst/maintenance/unit-cpp/test-evtools.R @@ -13,12 +13,14 @@ $SET end = 12, rtol = 1e-4, atol = 1e-4, delta = 0.25 $PLUGIN evtools $PARAM mode = 0, f1 = 1, dose = 100, irate = 50, newtime = 2 -$CMT A B +reptime = 5 +$CMT A B C $PK F_A = f1; $DES dxdt_A = -1 * A; dxdt_B = 1 * A - 0.1 * B; +dxdt_C = 0; $TABLE bool givedose = TIME==0; if(mode==1 && givedose) { @@ -48,6 +50,14 @@ if(mode==6 && givedose) { evt::now(ev); evt::push(self, ev); } +if(mode==7 && TIME==reptime) { + evt::replace(self, C/2.0, 3); +} +if(mode==8 && givedose) { + evt::ev rep = evt::replace(10, 3); + evt::retime(rep, reptime); + self.push(rep); +} ' mod <- mcode("test-evtools-model-1", code) @@ -103,3 +113,28 @@ test_that("evtools - give timed dose now", { b <- mrgsim(mod, param = list(mode = 1)) expect_identical(as.data.frame(a), as.data.frame(b)) }) + +test_that("evtools - replace", { + mod <- init(mod, C = 100) + mod <- update(mod, delta = 0.1) + a <- mrgsim(mod, param = list(mode = 7)) + before <- filter(a, time < 5) + expect_true(all(before$C==100)) + after <- filter(a, time >= 5) + expect_true(all(after$C==50)) + + #' When the replacement is timed into the future, we see the + #' replacement right at the indicated time + b <- mrgsim(mod, param = list(mode = 8, reptime = 8)) + before <- filter(b, time <= 8) # note: <= 8 + expect_true(all(before$C==100)) + after <- filter(b, time > 8) # note: > 8 + expect_true(all(after$C==10)) + + #' We can control this with `recsort` + c <- mrgsim(mod, param = list(mode = 8, reptime = 8), recsort = 3) + before <- filter(c, time < 8) # note: < 8 + expect_true(all(before$C==100)) + after <- filter(c, time >= 8) # note: >= 8 + expect_true(all(after$C==10)) +}) From 5e42f1835af1ee8e2a7b71a027d896c6676648bb Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Mon, 24 Jun 2024 08:08:16 -0500 Subject: [PATCH 2/3] tweak test --- inst/maintenance/unit-cpp/test-evtools.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/inst/maintenance/unit-cpp/test-evtools.R b/inst/maintenance/unit-cpp/test-evtools.R index 0ceca50d..ffd00775 100644 --- a/inst/maintenance/unit-cpp/test-evtools.R +++ b/inst/maintenance/unit-cpp/test-evtools.R @@ -54,7 +54,7 @@ if(mode==7 && TIME==reptime) { evt::replace(self, C/2.0, 3); } if(mode==8 && givedose) { - evt::ev rep = evt::replace(10, 3); + evt::ev rep = evt::replace(C/10.0, 3); evt::retime(rep, reptime); self.push(rep); } From 9dacd398e7c533cd2fb861d111dfab4de3dfce62 Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Wed, 3 Jul 2024 09:45:18 -0500 Subject: [PATCH 3/3] change roxygen comments to plain R comments per @kyleam code review --- inst/maintenance/unit-cpp/test-evtools.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/inst/maintenance/unit-cpp/test-evtools.R b/inst/maintenance/unit-cpp/test-evtools.R index ffd00775..6eb9813c 100644 --- a/inst/maintenance/unit-cpp/test-evtools.R +++ b/inst/maintenance/unit-cpp/test-evtools.R @@ -123,15 +123,15 @@ test_that("evtools - replace", { after <- filter(a, time >= 5) expect_true(all(after$C==50)) - #' When the replacement is timed into the future, we see the - #' replacement right at the indicated time + # When the replacement is timed into the future, we see the + # replacement right at the indicated time b <- mrgsim(mod, param = list(mode = 8, reptime = 8)) before <- filter(b, time <= 8) # note: <= 8 expect_true(all(before$C==100)) after <- filter(b, time > 8) # note: > 8 expect_true(all(after$C==10)) - #' We can control this with `recsort` + # We can control this with `recsort` c <- mrgsim(mod, param = list(mode = 8, reptime = 8), recsort = 3) before <- filter(c, time < 8) # note: < 8 expect_true(all(before$C==100))