test-update.R
In mrgsolve: Simulate from ODE-Based Models

# Copyright (C) 2013 - 2020  Metrum Research Group
#
# This file is part of mrgsolve.
#
# mrgsolve is free software: you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# mrgsolve is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with mrgsolve.  If not, see <http://www.gnu.org/licenses/>.

library(testthat)
library(mrgsolve)
library(dplyr)
Sys.setenv(R_TESTS="")
options("mrgsolve_mread_quiet"=TRUE)

mod <- mrgsolve::house() %>% update(atol = 1E-20, rtol = 1E-12, digits = 8)
mod1 <- update(mod %>% param(CL=12, VC=220), delta=33, end=222)
mod2 <- update(mod, param=list(CL=12, VC=220), delta=33, end=222)
x <- sort(runif(100, 0,300))
mod3 <- update(mod, add=x, end=1000, delta=20)
mod4 <- update(mod, init=list(CENT=111))
mod5 <- mod %>% param(VC=999)
mod6 <- mod %>% init(GUT=5566)
mod7 <- update(mod, hmin=111, hmax=222, maxsteps=333, 
               ixpr=444, mxhnil=555, atol=1E-99, rtol=1E-88)
mod8 <- mrgsolve:::mod(mrgsim(mod, delta=33, end=222))
mod9 <- update(mod, delta=33, end=222)
mod10 <- mrgsolve:::mod(mrgsim(mod, param=list(CL=12, VC=220)))
mod11 <- mrgsolve:::mod(mrgsim(mod  %>% param(CL=12, VC=220)))

context("test-update")

test_that("model object updates through update and %>% operator", {
  expect_true(identical(mod1, mod2))
  expect_true(!identical(mod1, mod))
})

test_that("Simulation times update properly via update",{
  expect_equal(stime(mod1), seq(0,mod1@end, mod2@delta))
  expect_equal(stime(mod3), sort(unique(c(x,seq(0,mod3@end, mod3@delta)))))
})

test_that("Simulation times update when passed into mrgsim",{
  expect_identical(mod8,mod9)
})

test_that("Parameter updates when passed to mrgsim",{
  expect_equal(param(mod10)$CL, param(mod2)$CL)
  expect_equal(param(mod10)$VC, param(mod2)$VC)
})

test_that("Parameter updates when added inside mrgsim call",{
  expect_equal(param(mod11)$CL, param(mod1)$CL)
  expect_equal(param(mod11)$VC, param(mod1)$VC)
})

rm(mod8,mod9,mod10,mod11)

test_that("Initials update via init and list",{
  mod1 <- mod %>% init(list(CENT=123,GUT=456))
  expect_equal(init(mod1)$CENT, 123)
  expect_equal(init(mod1)$GUT, 456)
})

test_that("Initials update via init ",{
  mod1 <- mod %>% init(CENT=1123, GUT=1456)
  expect_equal(init(mod1)$CENT, 1123)
  expect_equal(init(mod1)$GUT, 1456)
})

test_that("Initials update via init and data.frame ",{
  mod1 <- mod %>% init(data.frame(CENT=987,GUT=654))
  expect_equal(init(mod1)$CENT, 987)
  expect_equal(init(mod1)$GUT, 654)
})

test_that("Initial conditions update via update()",{
  expect_equal(init(mod6)$GUT,5566)
})

test_that("Solver setting hmin updates", {
  expect_equal(mod7@hmin,111)
})

test_that("Solver setting hmax updates", {
  expect_equal(mod7@hmax,222)
})

test_that("Solver setting maxsteps updates", {
  expect_equal(mod7@maxsteps,333)
})

test_that("Solver setting ixpr updates", {
  expect_equal(mod7@ixpr,444)
})

test_that("Solver setting mxhnil updates", {
  expect_equal(mod7@mxhnil,555)
})

test_that("Solver setting atol updates", {
  expect_equal(mod7@atol,1E-99)
})

test_that("Solver setting rtol updates", {
  expect_equal(mod7@rtol,1E-88)
})

test_that("bad update gives warning", {
  expect_warning(
    update(mod, kyle = 1), 
    "The following argument was passed"
  )
  expect_warning(
    update(mod, kyle = 1, baron = 2), 
    "The following arguments were passed"
  )
})

test_that("the mrgsolve.update.strict option is deprecated", {
  options(mrgsolve.update.strict = TRUE)
  expect_warning(
    update(house(), foo = 2), 
    regexp="mrgsolve\\.update\\.strict", 
  )
  options(mrgsolve.update.strict = NULL)
})

test_that("update outvars issue-483", {
  x <- update(mod, outvars = "RESP,CP,CENT")
  expect_equal(x@cmtL, c("CENT", "RESP"))
  expect_equal(x@capL, "CP")
  expect_equal(x@Icmt, c(2,3))
  expect_equal(x@Icap, 2)
  mod <- update(mod, add = c(0,1), end = -1)
  out <- mrgsim_df(mod, outvars="CP,RESP,CENT")
  expect_equal(names(out[,3:5]), c("CENT", "RESP", "CP"))
  expect_error(update(mod, outvars = "KYLE"))
  x <- update(x, outvars="(all)")
  ref <- c(names(init(x)),x@capture)
  tst <- c(x@cmtL,x@capL)
  expect_equivalent(ref,tst)
})

test_that("update req issue-483", {
  x <- update(mod, req = "RESP,CENT")
  expect_equal(x@cmtL, c("CENT", "RESP"))
  expect_equal(x@capL, c("DV","CP"))
  expect_equal(x@Icmt, c(2,3))
  expect_equal(x@Icap, c(1,2))
  x <- update(mod, request = "RESP,CENT")
  expect_equal(x@cmtL, c("CENT", "RESP"))
  expect_equal(x@capL, c("DV","CP"))
  x <- update(x, outvars="CP")
  x <- update(x, request = "(all)")
  ref <- c(names(init(x)),"CP")
  tst <- c(x@cmtL,x@capL)
  expect_equivalent(ref,tst)
})

CL <- exp(rnorm(100, log(3),  sqrt(0.5)))
VC <- exp(rnorm(100, log(30), sqrt(0.5))) 
pars <- signif(data.frame(CL=CL,VC=VC),6)
pars$ID <- seq(nrow(pars))

out <- mrgsim(mod, idata=pars, end=8, carry_out="CL,VC")
out <- distinct(out, ID, .keep_all=TRUE)
out <- signif(as.data.frame(out[,c("CL", "VC", "ID")]),6)

test_that("Recover items from simulated data when passed in as idata",{
  expect_equivalent(out,pars)
})

data <- expand.grid(time=seq(0,12,1), ID=1:100, cmt=1)
data <- merge(data, pars, sort=FALSE)

out <- mrgsim(mod, data=data, carry_out="CL,VC")
out <- out %>% as_tibble %>% distinct(ID, .keep_all=TRUE)
out <- signif(as.data.frame(out)[,c("CL", "VC", "ID")], 6)

test_that("Recover items from simulated data when passed in as data", {
  expect_equivalent(out,pars)
})

events <- ev(time=c(0,24,48), amt=1000, rate=50, 
             addl=c(0,0,10), ii=12,cmt=1)

out1 <- mrgsim(mod %>% ev(events), idata=data.frame(ID=1:20), end=200,
               carry_out="evid,amt,rate,addl,ii,cmt", req="")
data1 <- as.data.frame(out1)

out2 <- mrgsim(mod, data=data1, 
               carry_out="evid,amt,rate,addl,ii,cmt", req="")
data2 <- as.data.frame(out2)

test_that("CP is equal when simulating from events or data", {
  expect_identical(data1$CP, data2$CP)
})

set.seed(11111)
data1$ROW <- sample(1:nrow(data1))

out <- mrgsim(mod, data=data1, carry_out="ROW")

test_that("Time-varying data items in data are properly carried into output", {
  expect_true(all(data1$ROW == out$ROW))
})