Nothing
# 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)
context("test-mrgsim")
mod <- mrgsolve::house()
mod <- update(mod, end = 84, atol = 1E-30)
## one individual
e <- ev(amt = 100, ii = 24, addl = 2)
## three individuals
e_id <- ev(amt = 100, ii = 24, addl = 2, ID = 1:3)
## seven individuals
data <- as_data_set(ev(amt = 100, ii = 24, addl = 2, ID = 1:3),
ev(amt = 200, ii = 24, addl = 2, ID = 1:2),
ev(amt = 300, ii = 24, addl = 2, ID = 1:2))
dose <- distinct(data, ID,amt)
## ten individuals
idata <- expand.idata(CL = runif(10, 0.2,2)) %>%
mutate(V = runif(10, 5, 50))
test_that("error to not pass model object issue-547", {
expect_error(mrgsim(dose), "the first argument to mrgsim")
expect_error(mrgsim_d(dose), "the first argument to mrgsim_d ")
expect_error(mrgsim_ei(dose), "the first argument to mrgsim_ei ")
expect_error(mrgsim_e(dose), "the first argument to mrgsim_e ")
expect_error(mrgsim_di(dose), "the first argument to mrgsim_di ")
expect_error(mrgsim_q(dose), "the first argument to mrgsim_q ")
expect_error(qsim(dose), "the first argument to qsim ")
})
test_that("mrgsim_df", {
out <- mrgsim_df(mod, events = ev(amt=100))
out2 <- mrgsim_e(mod,ev(amt = 100))
expect_is(out, "data.frame")
expect_identical(out, as.data.frame(out2))
})
test_that("mrgsim with ev", {
out_pipe <- mod %>% ev(e) %>% mrgsim()
out <- mrgsim(mod, events = e)
out_quick <- mrgsim_e(mod,e)
out_pipe@mod <- simargs(out_pipe@mod,clear = TRUE)
expect_identical(out,out_pipe)
expect_identical(out,out_quick)
expect_is(out, "mrgsims")
expect_equal(length(unique(out$ID)),1)
})
test_that("mrgsim with ev and idata", {
out_pipe <- mod %>% ev(e) %>% idata_set(idata) %>% mrgsim()
out <- mrgsim(mod, idata=idata, events = e)
out_quick <- mrgsim_ei(mod, e, idata)
out_pipe@mod <- simargs(out_pipe@mod,clear = TRUE)
expect_identical(out,out_pipe)
expect_identical(out,out_quick)
expect_equal(length(unique(out$ID)),10)
})
test_that("mrgsim with ev and ID and idata", {
out_pipe <- mod %>% ev(e_id) %>% idata_set(idata) %>% mrgsim()
out <- mrgsim(mod, idata=idata, events = e_id)
out_pipe@mod <- simargs(out_pipe@mod,clear = TRUE)
expect_identical(out,out_pipe)
expect_equal(length(unique(out$ID)),3)
})
test_that("mrgsim with data and idata", {
out <- mrgsim(mod, data = data, idata = idata, carry_out = "CL,V")
out_pipe <- mod %>% data_set(data) %>% idata_set(idata) %>%
carry_out(CL,V) %>%
mrgsim()
out_quick <- mrgsim_di(mod,data,idata, carry_out="CL,V")
out_pipe@mod <- simargs(out_pipe@mod,clear = TRUE)
expect_identical(out,out_pipe)
expect_identical(out,out_quick)
out12 <- filter(out, time==12)
expect_equal(length(unique(out$ID)), 7)
expect_equal(length(unique(out12$CENT)), 7)
sims <- left_join(out12,dose,by="ID")
sims <- mutate(sims, CENT_amt = CENT/amt)
x <- round(sims$CENT_amt,6)
expect_false(any(x[2:length(x)] == first(x)))
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", {
out <- mrgsim(mod, events = e_id)
out_pipe <- mod %>% ev(e_id) %>% mrgsim
out_quick <- mrgsim_e(mod, e_id)
out_pipe@mod <- simargs(out_pipe@mod,clear = TRUE)
expect_identical(out,out_pipe)
expect_identical(out,out_quick)
expect_is(out, "mrgsims")
expect_equal(length(unique(out$ID)),3)
})
test_that("mrgsim with data", {
out <- mod %>% mrgsim(data = data)
out_pipe <- mod %>% data_set(data) %>% mrgsim
out_quick <- mrgsim_d(mod,data)
out_pipe@mod <- simargs(out_pipe@mod,clear = TRUE)
expect_identical(out,out_pipe)
expect_identical(out,out_quick)
expect_is(out, "mrgsims")
expect_equal(length(unique(out$ID)),7)
out12 <- filter(out, time ==12)
sims <- left_join(out12,dose,by="ID")
sims <- mutate(sims, CENT_amt = CENT/amt)
x <- round(sims$CENT_amt,6)
expect_true(all(x == first(x)))
})
test_that("mrgsim with data and ev", {
out <- mod %>% mrgsim(data = data, events = e)
out_pipe <- mod %>% data_set(data) %>% ev(e) %>% mrgsim()
out_pipe@mod <- simargs(out_pipe@mod,clear = TRUE)
expect_identical(out,out_pipe)
expect_is(out, "mrgsims")
expect_equal(length(unique(out$ID)),7)
})
test_that("mrgsim with nid", {
out <- mod %>% mrgsim(nid = 5, end = 2)
expect_is(out, "mrgsims")
expect_equal(length(unique(out$ID)),5)
})
test_that("update arguments are passed", {
out <- mrgsim(mod, atol = 1E-4, rtol = 1E-3,
add = c(12,13,14),
end = 11, delta = 2, maxsteps = 5000)
mod <- out@mod
expect_equal(mod@atol, 1E-4)
expect_equal(mod@rtol, 1E-3)
expect_equal(mod@end, 11)
expect_equal(mod@add ,c(12,13,14))
expect_equal(mod@delta, 2)
expect_equal(mod@maxsteps, 5000)
})
test_that("no data generates error", {
e <- ev()
data <- as.data.frame(e)
expect_error(mrgsim(mod, events = e))
expect_error(mrgsim(mod, data = data))
})
test_that("no idata no problem generates error", {
e <- ev(amt = 100)
idata <- as.data.frame(e)[0,]
expect_is(mrgsim(mod, events = e, idata = idata, end = -1), "mrgsims")
expect_is(mrgsim(mod, data = data, idata = idata, end = -1), "mrgsims")
})
test_that("negative istate is reported issue-457", {
mod <- update(mod, maxsteps = 1)
x <- utils::capture.output(try(mrgsim(mod),silent=TRUE), type = "message")
expect_true(grepl("consider increasing maxsteps", x[1]))
expect_true(grepl("lsoda returned with negative istate: -1", x[3]))
})
test_that("simulate non-pred with negative times is allowed", {
mod <- house(delta=1)
dose <- ev(amt = 100, time = 4)
times <- seq(-10,10)
data <- expand_observations(dose, times)
out1 <- mrgsim(mod, data)
expect_is(out1, "mrgsims")
expect_equal(data[["time"]],out1$time)
out2 <- mrgsim(mod, events = dose, start = -10, end = 10, obsonly=TRUE)
expect_is(out2, "mrgsims")
expect_equal(times,out2$time)
out3 <- filter_sims(out2, time >= 0)
out4 <- mrgsim(mod, events = dose, end = 10, obsonly=TRUE)
expect_is(out4, "mrgsims")
expect_equal(out3$DV,out4$DV)
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)))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.