tests/testthat/test-simulation.R

skip_on_cran()
skip_if_not_installed("lixoftConnectors")


initRsSimulx()
demo_path <- gsub("simulx", "monolix", .lixoftCall("getDemoPath"), fixed = TRUE)
skip_if(!dir.exists(demo_path), message = NULL)

project <- file.path(demo_path, "1.creating_and_using_models",
                     "1.1.libraries_of_models", "theophylline_project.mlxtran")
project <- get_project(project, runStdErrorsIfNeed = TRUE)
initRsSimulx(force = TRUE)

# test_that("simulxR runs on simulx demo with no fail", {
#   files <- list.files(path = demo_path , pattern = '[.]mlxtran$', full.names = T, include.dirs = F, recursive = T)
# 
#   for (f in files[81:91]) {
#     print(f)
#     project <- get_project(f)
# 
#     initRsSimulx(force = TRUE)
#     expect_error(simulx(project = project), NA)
#   }
# })

test_that("Case studies and demos run with no fail", {
  expect_error(simulx(project = project), NA)
  expect_error(simulx(project = project,
                      output = list(name = 'Cc', time = seq(from = 0, to = 24, by = 1))),
               NA)
  expect_error(simulx(project = project,
                      parameter = "mlx_PopUncertainSA",
                      output = list(name = 'Cc', time = seq(from = 0, to = 24, by = 1))),
               "^Invalid parameter.")
  expect_error(simulx(project = project,
                      parameter = "mlx_Pop",
                      output = list(name = 'Cc', time = seq(from = 0, to = 24, by = 1))),
               NA)
  expect_error(simulx(project = project,
                      parameter = "mlx_PopIndiv",
                      output = list(name = 'Cc', time = seq(from = 0, to = 24, by = 1))),
               NA)
  
  expect_error(simulx(project = project,
                      output = list(name = 'Cc', time = seq(from = 0, to = 24, by = 1)),
                      group = list(size = 5)),
               NA)
  expect_error(simulx(project = project,
                      output = list(name = 'Cc', time = seq(from = 0, to = 24, by = 1)),
                      treatment =  list(amount = 10, time = seq(from = 0, to = 5, by = 1)),
                      group = list(size = 5)),
               NA)
  expect_error(simulx(project = project,
                      output = list(name = 'Cc', time = seq(from = 0, to = 24, by = 1)),
                      treatment =  "mlx_Adm1",
                      group = list(size = 5)),
               NA)
  expect_error(simulx(project = project,
                      output = list(name = 'Cc', time = seq(from = 0, to = 24, by = 1)),
                      treatment =  "mlx_Adm2",
                      group = list(size = 5)),
               "^Invalid treatment.")
  
  g1 = list(size = 5, treatment = list(amount = 10, time = 0), parameter = c(omega_V = 0, omega_ka = 0, omega_Cl = 0))
  g2 = list(size = 4, treatment = list(amount = 20, time = 2))
  
  g3 = list(size = 5, treatment = "mlx_Adm1", parameter = "mlx_Pop")

  expect_error(suppressWarnings(simulx(project = project,
                      output = list(name = 'Cc', time = seq(from = 1, to = 25, by = 12)),
                      group = list(g1,g2)),
               NA))
  expect_error(simulx(project = project,
                      output = list(name = 'Cc', time = seq(from = 1, to = 25, by = 12)),
                      group = list(g3,g2)),
               NA)
  
})

# Test that arguments are well checked -----------------------------------------
test_that("Function stops when Invalid project", {
  expect_error(simulx(project = "thisprojectdoesnorexist.mlxtran"),
               "Project thisprojectdoesnorexist.mlxtran does not exist.")
  smlxpath <- file.path(path.expand("~"), "lixoft", "simulx",
                        paste0("simulx", .lixoftCall("getLixoftConnectorsState")$version), "demos")
  smlxproject <- file.path(smlxpath, "2.models/longitudinal.smlx")
  expect_error(simulx(project = smlxproject),
               "does not exist.")
})

test_that("Function stops when Invalid model", {
  pk.model <- inlineModel("
  [LONGITUDINAL]
  input = {V1, k}
  EQUATION:
  C = pkmodel(V,k)
  ")
  
  C <- list(name='C', time=seq(0, 100, by=1))
  p <- c(V=10, k=0.2)
  adm <- list(time=seq(0,to=66,by=6), amount=50)
  expect_error(res <- simulx(model = pk.model, parameter = p, output = C, treatment = adm),
               "Parse error")
})

test_that("Function stops when a project and a modele are defined together", {
  pk.model <- inlineModel("
  [LONGITUDINAL]
  input = {V, k}
  EQUATION:
  C = pkmodel(V,k)
  ")
  C <- list(name='C', time=seq(0, 100, by=1))
  p <- c(V=10, k=0.2)
  adm <- list(time=seq(0,to=66,by=6), amount=50)
  expect_error(simulx(model = pk.model, parameter = p, output = C, treatment = adm, project = project),
               "You must define either the model or the Monolix project file, not both of them.")

})

test_that("Function stops when neither project nor modele is defined", {
  expect_error(simulx(),
               "You must define either the model or the Monolix project file.")
})

test_that("Function stops when npop and nrep are not integers", {
  expect_error(simulx(project = project, nrep = 1.2),
               "^Invalid nrep.")
  expect_error(simulx(project =project, nrep = -3),
               "^Invalid nrep.")
  expect_error(simulx(project = project, nrep = "toto"),
               "^Invalid nrep.")
})

test_that("Deprecated arguments print message", {
  expect_message(simulx(project = project, npop = 10))
  expect_message(simulx(project = project, fim = "SA"))
})

test_that("Models for which distribution of covariates is defined returns an error", {
  myModel <- inlineModel("
[COVARIATE]
input={p_F}

DEFINITION:
gender = { type=categorical,
           categories={F,M},
           P(gender=F)=p_F }

;---------------------------------------
[INDIVIDUAL]
input={k_pop, omega_k, gender, beta_F}
gender={type=categorical,categories={F,M}}

DEFINITION:
k = { distribution=lognormal,
      reference=k_pop,
      covariate=gender,
      coefficient={beta_F,0},
      sd=omega_k }

;---------------------------------------
[LONGITUDINAL]
input =  {k}

EQUATION:
f = exp(-k*t)
  ")
  p <- c(p_F=0.4,k_pop=0.2, omega_k=0.1, beta_F=0.6)
  f <- list(name='f', time=seq(0, 30, by=0.1))

  expect_error(simulx(model=myModel, parameter=p, output=f),
               "^Invalid model file.")

  model <- inlineModel(
    "[LONGITUDINAL]
input = {V, k, a}

EQUATION:
f = 100/V*exp(-k*t)

DEFINITION:
y = {distribution = normal, prediction = f, sd = a}

;----------------------------------------------
[INDIVIDUAL]
input = {V_pop, omega_V, w, w_pop}

EQUATION:
V_pred = V_pop*(w/w_pop)

DEFINITION:
V = {distribution = lognormal, prediction = V_pred, sd = omega_V}

;----------------------------------------------
[COVARIATE]
input = {w_pop, omega_w}

DEFINITION:
w = {distribution = normal, mean = w_pop, sd = omega_w}"
  )

  p <- c(V_pop=10, omega_V=0.1, beta=1, w_pop=70, omega_w=12, k=0.15, a=0.5)

  f   <- list(name='f', time=seq(0, 30, by=0.1))
  y   <- list(name='y', time=seq(1, 30, by=3))
  out <- list(f, y)
  expect_error(simulx(model=model, parameter=p, output=out),
               "^Invalid model file.")

})

# Test settings ----------------------------------------------------------------
test_that("When no seed specified: 2 simulations gives different results", {
  res1 <- simulx(project = project)
  res2 <- simulx(project = project)
  expect_equal(names(res1), names(res2))
  expect_false(isTRUE(all.equal(res1, res2)))
})

test_that("When a seed is specified: 2 simulations gives same results", {
  res1 <- simulx(project = project, settings = list(seed = 123))
  res2 <- simulx(project = project, settings = list(seed = 123))
  res3 <- simulx(project = project, npop = 2, settings = list(seed = 123))
  res4 <- simulx(project = project, npop = 2, settings = list(seed = 123))
  expect_equal(names(res1), names(res2))
  expect_equal(names(res3), names(res4))
  expect_equal(res1, res2)
  expect_equal(res3, res4)
})

test_that("When id.out is FALSE, when only one group, group columns are removed", {
  pk.model <- inlineModel("
  [LONGITUDINAL]
  input = {V, k}
  EQUATION:
  C = pkmodel(V,k)
  ")
  C <- list(name='C', time=seq(0, 100, by=1))
  p <- c(V=10, k=0.2)
  adm1 <- list(time=seq(0,to=66,by=6), amount=50)
  adm2 <- list(time=seq(0,to=66,by=12), amount=100)
  adm3 <- list(time=seq(0,to=66,by=18), amount=150)
  g1 <- list(treatment=adm1);
  g2 <- list(treatment=adm2);
  g3 <- list(treatment=adm3);
  res1 <- simulx(model = pk.model, parameter = p, output = C, treatment = adm1, settings = list(id.out = FALSE))
  res2 <- simulx(model = pk.model, parameter = p, output = C, group = list(g1, g2, g3), settings = list(id.out = FALSE))

  for (n in setdiff(names(res1), "parameter")) {
    expect_false("group" %in% names(res1[[n]]))
    expect_true("group" %in% names(res2[[n]]))
  }
})

test_that("When id.out is FALSE, when only one id, id columns are removed", {
  pk.model <- inlineModel("
  [LONGITUDINAL]
  input = {V, k}
  EQUATION:
  C = pkmodel(V,k)
  ")
  C <- list(name='C', time=seq(0, 100, by=1))
  p <- c(V=10, k=0.2)
  adm1 <- list(time=seq(0,to=66,by=6), amount=50)
  adm21 <- data.frame(id = 1, list(time=seq(0,to=66,by=12), amount=100))
  adm22 <- data.frame(id = 2, list(time=seq(0,to=66,by=12), amount=50))
  adm2 <- rbind(adm21, adm22)
  res1 <- simulx(model = pk.model, parameter = p, output = C, treatment = adm1, settings = list(id.out = FALSE))
  res2 <- simulx(model = pk.model, parameter = p, output = C, treatment = adm2, settings = list(id.out = FALSE))

  for (n in setdiff(names(res1), "parameter")) {
    expect_false("id" %in% names(res1[[n]]))
    expect_true("id" %in% names(res2[[n]]))
  }
})

test_that("When id.out is TRUE, when only one id, id columns are removed", {
  pk.model <- inlineModel("
  [LONGITUDINAL]
  input = {V, k}
  EQUATION:
  C = pkmodel(V,k)
  ")
  C <- list(name='C', time=seq(0, 100, by=1))
  p <- c(V=10, k=0.2)
  adm1 <- list(time=seq(0,to=66,by=6), amount=50)
  adm21 <- data.frame(id = 1, list(time=seq(0,to=66,by=12), amount=100))
  adm22 <- data.frame(id = 2, list(time=seq(0,to=66,by=12), amount=50))
  adm2 <- rbind(adm21, adm22)
  res1 <- simulx(model = pk.model, parameter = p, output = C, treatment = adm1, settings = list(id.out = TRUE))
  res2 <- simulx(model = pk.model, parameter = p, output = C, treatment = adm2, settings = list(id.out = TRUE))

  for (n in setdiff(names(res1), "parameter")) {
    expect_true("id" %in% names(res1[[n]]))
    expect_true("id" %in% names(res2[[n]]))
  }
})

test_that("When out.trt is FALSE, treatment is not included in ourput", {
  pk.model <- inlineModel("
  [LONGITUDINAL]
  input = {V, k}
  EQUATION:
  C = pkmodel(V,k)
  ")
  C <- list(name='C', time=seq(0, 100, by=1))
  p <- c(V=10, k=0.2)
  adm <- list(time=seq(0,to=66,by=6), amount=50)
  res1 <- simulx(model = pk.model, parameter = p, output = C, treatment = adm, settings = list(out.trt = TRUE))
  res2 <- simulx(model = pk.model, parameter = p, output = C, treatment = adm, settings = list(out.trt = FALSE))

  expect_true("treatment" %in% names(res1))
  expect_false("treatment" %in% names(res2))
})

test_that("When replacement is FALSE, simulx sampling method is keepOrder", {
  res_keepOrder1 <- simulx(project = project, settings = list(seed=1234))
  expect_equal(lixoftConnectors::getSamplingMethod(), "keepOrder")

  res_keepOrder2 <- simulx(project = project, settings = list(samplingMethod="keepOrder", seed=1234))
  expect_equal(lixoftConnectors::getSamplingMethod(), "keepOrder")

  expect_message(res_keepOrder3 <- simulx(project = project, settings = list(replacement = FALSE, seed=1234)))
  expect_equal(lixoftConnectors::getSamplingMethod(), "keepOrder")
  
  expect_equal(res_keepOrder1, res_keepOrder2)
  expect_equal(res_keepOrder1, res_keepOrder3)
  
})

test_that("When replacement is TRUE, simulx sampling method is withReplacement", {
  expect_message(res_replacement1 <- simulx(project = project, settings = list(replacement = TRUE, seed=1234)))
  expect_equal(lixoftConnectors::getSamplingMethod(), "withReplacement")
  
  res_replacement2 <- simulx(project = project, settings = list(samplingMethod="withReplacement", seed=1234))
  expect_equal(lixoftConnectors::getSamplingMethod(), "withReplacement")
  
  expect_equal(res_replacement1, res_replacement2)
  
  res_noreplacement <- simulx(project = project, settings = list(samplingMethod="withoutReplacement", seed=1234))
  expect_equal(lixoftConnectors::getSamplingMethod(), "withoutReplacement")
  
})

# Test Outputs -----------------------------------------------------------------
test_that("cens, rep, id, group columns are factors", {
  pk.model <- inlineModel("
  [LONGITUDINAL]
  input = {V, k}
  EQUATION:
  C = pkmodel(V,k)
  ")
  C <- list(name='C', time=seq(0, 100, by=1), lloq = 0.8)
  p <- c(V=10, k=0.2)
  adm1 <- data.frame(id = 1, list(time=seq(0,to=66,by=12), amount=100))
  adm2 <- data.frame(id = 2, list(time=seq(0,to=66,by=12), amount=50))
  adm <- rbind(adm1, adm2)
  g1 <- list(treatment=as.list(adm1[names(adm1) != "id"]))
  g2 <- list(treatment=as.list(adm2[names(adm2) != "id"]))
  res <- simulx(model = pk.model, parameter = p, output = C, group = list(g1, g2), nrep = 3)

  for (n in names(res)) {
    for (col in intersect(names(res[[n]]), c("cens", "rep", "id", "group"))) {
      expect_true(is.factor(res[[n]][[col]]))
    }
  }
})

test_that("Output results contains the correct number of ids", {
  pk.model <- inlineModel("
  [LONGITUDINAL]
  input = {V, k}
  EQUATION:
  C = pkmodel(V,k)
  ")
  C <- list(name='C', time=seq(0, 100, by=1))
  p <- c(V=10, k=0.2)
  adm1 <- data.frame(id = 1, list(time=seq(0,to=66,by=12), amount=100))
  adm2 <- data.frame(id = 2, list(time=seq(0,to=66,by=12), amount=50))
  adm <- rbind(adm1, adm2)
  res1 <- simulx(model = pk.model, parameter = p, output = C, treatment = adm)
  res2 <- simulx(model = pk.model, parameter = p, output = C, treatment = adm1, settings = list(id.out = TRUE))
  for (n in names(res1)) {
    if ("id" %in% names(res1[[n]])) expect_true(length(unique(res1[[n]]$id)) == 2)
    if ("id" %in% names(res2[[n]])) expect_true(length(unique(res2[[n]]$id)) == 1)
  }
})

test_that("Output results contains the correct number of groups", {
  pk.model <- inlineModel("
  [LONGITUDINAL]
  input = {V, k}
  EQUATION:
  C = pkmodel(V,k)
  ")
  C <- list(name='C', time=seq(0, 100, by=1))
  p <- c(V=10, k=0.2)
  adm1 <- list(time=seq(0,to=66,by=6), amount=50)
  adm2 <- list(time=seq(0,to=66,by=12), amount=100)
  adm3 <- list(time=seq(0,to=66,by=18), amount=150)
  g1 <- list(treatment=adm1)
  g2 <- list(treatment=adm2)
  g3 <- list(treatment=adm3)
  res0 <- simulx(model = pk.model, parameter = p, output = C, treatment = adm1, settings = list(id.out = TRUE))
  res1 <- simulx(model = pk.model, parameter = p, output = C, group = list(g1), settings = list(id.out = TRUE))
  res2 <- simulx(model = pk.model, parameter = p, output = C, group = list(g1, g2), settings = list(id.out = TRUE))
  res3 <- simulx(model = pk.model, parameter = p, output = C, group = list(g1, g2, g3), settings = list(id.out = TRUE))

  for (n in names(res1)) {
    if ("group" %in% names(res0[[n]])) expect_true(length(unique(res0[[n]]$group)) == 1)
    if ("group" %in% names(res1[[n]])) expect_true(length(unique(res1[[n]]$group)) == 1)
    if ("group" %in% names(res2[[n]])) expect_true(length(unique(res2[[n]]$group)) == 2)
    if ("group" %in% names(res3[[n]])) expect_true(length(unique(res3[[n]]$group)) == 3)
  }
})

test_that("Output results contains the correct number of rep", {
  res0 <- simulx(project = project)
  res1 <- simulx(project = project, nrep = 1)
  res2 <- simulx(project = project, nrep = 5)
  res3 <- simulx(project = project, nrep = 42)
  expect_false("rep" %in% names(res0$CONC))
  expect_false("rep" %in% names(res1$CONC))
  expect_true("rep" %in% names(res2$CONC))
  expect_true("rep" %in% names(res3$CONC))
  for (n in names(res1)) {
    if ("rep" %in% names(res0[[n]])) expect_true(length(unique(res0[[n]]$rep)) == 1)
    if ("rep" %in% names(res1[[n]])) expect_true(length(unique(res1[[n]]$rep)) == 1)
    if ("rep" %in% names(res2[[n]])) expect_true(length(unique(res2[[n]]$rep)) == 5)
    if ("rep" %in% names(res3[[n]])) expect_true(length(unique(res3[[n]]$rep)) == 42)
  }

  res0 <- simulx(project=project, parameter="mlx_PopUncertainLin")
  res1 <- simulx(project=project, parameter="mlx_PopUncertainLin", nrep=1)
  res2 <- simulx(project=project, parameter="mlx_PopUncertainLin", nrep=5)
  res3 <- simulx(project=project, parameter="mlx_PopUncertainLin", nrep=42)
  expect_false("rep" %in% names(res0$population))
  expect_false("rep" %in% names(res1$population))
  expect_true("rep" %in% names(res2$population))
  expect_true("rep" %in% names(res3$population))
  expect_true(length(unique(res2$population$rep)) == 5)
  expect_true(length(unique(res3$population$rep)) == 42)
  expect_true(length(unique(res2$CONC$rep)) == 5)
  expect_true(length(unique(res3$CONC$rep)) == 42)
  
  res0 <- simulx(project = project)
  res1 <- simulx(project = project, npop = 1)
  res2 <- simulx(project = project, npop = 5)
  res3 <- simulx(project = project, npop = 42)
  expect_false("rep" %in% names(res0$CONC))
  expect_false("rep" %in% names(res1$CONC))
  expect_true("rep" %in% names(res2$CONC))
  expect_true("rep" %in% names(res3$CONC))
  for (n in names(res1)) {
    if ("rep" %in% names(res0[[n]])) expect_true(length(unique(res0[[n]]$rep)) == 1)
    if ("rep" %in% names(res1[[n]])) expect_true(length(unique(res1[[n]]$rep)) == 1)
    if ("rep" %in% names(res2[[n]])) expect_true(length(unique(res2[[n]]$rep)) == 5)
    if ("rep" %in% names(res3[[n]])) expect_true(length(unique(res3[[n]]$rep)) == 42)
  }
  

})

test_that("When only one set of population parameters, a named vector is returned", {
  res1 <- simulx(project = project, npop = 1)
  res2 <- simulx(project = project, npop = 5)
  res3 <- simulx(project = project, npop = 42)
  expect_true(is.vector(res1$population))
  expect_false(is.list(res1$population))
  expect_true(is.list(res2$population))
  expect_false(is.vector(res2$population))
  expect_true(is.list(res3$population))
  expect_false(is.vector(res3$population))
  expect_equal(nrow(res2$population), 5)
  expect_equal(nrow(res3$population), 42)
  
  res1 <- simulx(project = project, parameter = "mlx_PopUncertainLin", nrep = 1)
  res2 <- simulx(project = project, parameter = "mlx_PopUncertainLin", nrep = 5)
  res3 <- simulx(project = project, parameter = "mlx_PopUncertainLin", nrep = 42)
  expect_true(is.vector(res1$population))
  expect_false(is.list(res1$population))
  expect_true(is.list(res2$population))
  expect_false(is.vector(res2$population))
  expect_true(is.list(res3$population))
  expect_false(is.vector(res3$population))
  expect_equal(nrow(res2$population), 5)
  expect_equal(nrow(res3$population), 42)
  
})

test_that("If treatment in output, amt column is named 'amount'", {
  pk.model <- inlineModel("
  [LONGITUDINAL]
  input = {V, k}
  EQUATION:
  C = pkmodel(V,k)
  ")
  C <- list(name='C', time=seq(0, 100, by=1))
  p <- c(V=10, k=0.2)
  adm <- list(time=seq(0,to=66,by=6), amount=50)
  res <- simulx(model = pk.model, parameter = p, output = C, treatment = adm)
  expect_true("amount" %in% names(res$treatment))

})

test_that("Function print warnings when missing parameters.", {
  model <- inlineModel(
    ";----------------------------------------------
[COVARIATE]
input = {w}

;----------------------------------------------
[INDIVIDUAL]
input = {V_pop, omega_V, w, w_pop}

EQUATION:
V_pred = V_pop*(w/w_pop)

DEFINITION:
V = {distribution = lognormal, prediction = V_pred, sd = omega_V}


[LONGITUDINAL]
input = {V, k, a}

EQUATION:
f = 100/V*exp(-k*t)

DEFINITION:
y = {distribution = normal, prediction = f, sd = a}
")

  p <- c(V_pop=10, omega_V=0.1, w=70, k=0.15, a=0.5)

  f   <- list(name='f', time=seq(0, 30, by=0.1))
  y   <- list(name='y', time=seq(1, 30, by=3))
  out <- list(f, y)

  expect_warning(simulx(model=model,parameter=p, output=out),
                 "'w_pop' has not been specified. It will be set to 1.")
})

test_that("Function print warnings when useless parameters are given.", {
  model <- inlineModel(
    ";----------------------------------------------
[COVARIATE]
input = {w}

;----------------------------------------------
[INDIVIDUAL]
input = {V_pop, omega_V, w, w_pop}

EQUATION:
V_pred = V_pop*(w/w_pop)

DEFINITION:
V = {distribution = lognormal, prediction = V_pred, sd = omega_V}


[LONGITUDINAL]
input = {V, k, a}

EQUATION:
f = 100/V*exp(-k*t)

DEFINITION:
y = {distribution = normal, prediction = f, sd = a}
")

  p <- c(V_pop=10, omega_V=0.1, w_pop=0.1, toto = 42, w=70, k=0.15, a=0.5)

  f   <- list(name='f', time=seq(0, 30, by=0.1))
  y   <- list(name='y', time=seq(1, 30, by=3))
  out <- list(f, y)

  expect_warning(simulx(model=model, parameter=p, output=out),
                 "Found extra parameters. 'toto' is not in the model.")
})

# test_that("Output defined with time = 'none' are removed from the results", {
#   res1 <- simulx(project = project)
#   res2 <- simulx(project = project, output = list(name="y2", time="none"))
#   expect_true("y1" %in% names(res1))
#   expect_false("y2" %in% names(res2))
# })

test_that("No error when cat cov defined as T / F", {
  project_cov <- file.path(demo_path, "1.creating_and_using_models",
                       "1.1.libraries_of_models", "theophylline_project.mlxtran")
  project_cov <- get_project(project_cov)
  .lixoftCall("setCovariateModel", list(list(V=c(SEX=T))))
  .lixoftCall("saveProject", list(project_cov))
  .lixoftCall("runPopulationParameterEstimation")

  initRsSimulx(force = TRUE)
  
  expect_no_error(
    res <- simulx(project = project_cov,
           treatment = list(amount=80, time=0),
           output = list(name="Cc",time=0),
           covariate = data.frame(id=1:4, SEX="F", WEIGHT = 70)) )
  expect_equal(unique(res$parameter$SEX), "F")

  expect_error(
    res <- simulx(project = project_cov,
           treatment = list(amount=80, time=0),
           output = list(name="Cc",time=0),
           covariate = data.frame(id=1:4, SEX="F", WEIGHT = 70)),
    NA)
  expect_equal(unique(res$parameter$SEX), "F")
})

test_that("Model from library", {
  model <- "lib:oral1_1cpt_TlagkaVCl.txt"
  expect_no_error(expect_warning(expect_warning(simulx(model))))
  
  model <- "lib:oral1_1cpt_Tlagka.txt"
  expect_error(expect_warning(simulx(model)), "is not a model from the libraries\n$")
  
})

test_that("sharedIds argument works correctly", {
  model <- inlineModel(
"[COVARIATE]
input = {WT}

EQUATION:
  logtWT = log(WT/55)

[INDIVIDUAL]
input = {Tlag_pop, omega_Tlag, ka_pop, omega_ka, V_pop, omega_V, Cl_pop, omega_Cl, logtWT, beta_V_logtWT, corr_V_Cl}

DEFINITION:
  Tlag = {distribution=logNormal, typical=Tlag_pop, sd=omega_Tlag}
ka = {distribution=logNormal, typical=ka_pop, sd=omega_ka}
V = {distribution=logNormal, typical=V_pop, covariate=logtWT, coefficient=beta_V_logtWT, sd=omega_V}
Cl = {distribution=logNormal, typical=Cl_pop, sd=omega_Cl}
correlation = {level=id, r(V, Cl)=corr_V_Cl}

[LONGITUDINAL]
input = {a, b, Tlag, ka, V, Cl}

EQUATION:
  
  ; PK model definition
Cc = pkmodel(Tlag, ka, V, Cl)

OUTPUT:
output = Cc"
  )
  popparams1 <- c(Tlag_pop=2, omega_Tlag=0.5, ka_pop=1.5, omega_ka=0.7,
                  V_pop=10, omega_V=1, Cl_pop=5, omega_Cl=1, 
                  beta_V_logtWT=4, corr_V_Cl=0.2, a=0.3, b=0.4)
  indparams1 <- c(Tlag=1, ka=1, V=1, Cl=0.5)
  cov1 <- c(WT=75)
  cov2 <- data.frame(id=1:60, WT=runif(n=60, min=45, max=90))
  trt1 <- list(amount=c(10, 20), time=c(0, 24))
  trt2 <- data.frame(id=1:60, time=0, amount=runif(n=60, min=300, max=600))
  trt3 <- data.frame(id=1:65, time=0, amount=runif(n=65, min=300, max=600))
  output1 <- list(name="Cc", time=seq(0, 72, by=12))
  output2 <- list(name="Cc", time=data.frame(id=c(1, 1, 1, rep(2:60, each=7)), time=c(0, 36, 72, rep(seq(0, 72, by=12), times=59))))
  
  # check sharedId format
  expect_error(
    simulx(
      model=model,
      parameter=popparams1,
      covariate=cov1,
      treatment=trt1,
      output=output1,
      settings=list(sharedIds=c("population", "jh"))
    ),
    "setting sharedIds must be in \\{'covariate', 'output', 'treatment', 'regressor', 'population', 'individual'\\}."
  )

  res <- simulx(
    model=model,
    parameter=popparams1,
    covariate=cov1,
    treatment=trt2,
    output=output2,
    settings=list(sharedIds=c("output", "treatment"))
  )
  expect_equal(.lixoftCall("getSharedIds"), c("treatment", "output"))
  
  res <- simulx(
    model=model,
    parameter=popparams1,
    covariate=cov2,
    treatment=trt2,
    output=output2,
    settings=list(sharedIds=c("output", "treatment", "covariate"))
  )
  expect_equal(.lixoftCall("getSharedIds"), c("covariate", "treatment", "output"))
  
  
})

test_that("sameIdsAmongGroups argument works correctly", {
  model <- inlineModel(
    "[COVARIATE]
input = {WT}

EQUATION:
  logtWT = log(WT/55)

[INDIVIDUAL]
input = {Tlag_pop, omega_Tlag, ka_pop, omega_ka, V_pop, omega_V, Cl_pop, omega_Cl, logtWT, beta_V_logtWT, corr_V_Cl}

DEFINITION:
  Tlag = {distribution=logNormal, typical=Tlag_pop, sd=omega_Tlag}
ka = {distribution=logNormal, typical=ka_pop, sd=omega_ka}
V = {distribution=logNormal, typical=V_pop, covariate=logtWT, coefficient=beta_V_logtWT, sd=omega_V}
Cl = {distribution=logNormal, typical=Cl_pop, sd=omega_Cl}
correlation = {level=id, r(V, Cl)=corr_V_Cl}

[LONGITUDINAL]
input = {a, b, Tlag, ka, V, Cl}

EQUATION:
  
  ; PK model definition
Cc = pkmodel(Tlag, ka, V, Cl)

OUTPUT:
output = Cc"
  )
  popparams1 <- c(Tlag_pop=2, omega_Tlag=0.5, ka_pop=1.5, omega_ka=0.7,
                  V_pop=10, omega_V=0.1, Cl_pop=5, omega_Cl=0.9, beta_V_logtWT=0.8,
                  corr_V_Cl=0.7, a=0.15, b=0.23)
  indparams1 <- c(Tlag=1, ka=1, V=1, Cl=0.5)
  cov1 <- c(WT=75)
  cov2 <- data.frame(id=1:60, WT=runif(n=60, min=45, max=90))
  trt1 <- list(amount=c(10, 20), time=c(0, 24))
  trt2 <- data.frame(id=1:60, time=0, amount=runif(n=60, min=300, max=600))
  trt3 <- data.frame(id=1:65, time=0, amount=runif(n=65, min=300, max=600))
  output1 <- list(name="Cc", time=seq(0, 72, by=12))
  output2 <- list(name="Cc", time=data.frame(id=c(1, 1, 1, rep(2:60, each=7)), time=c(0, 36, 72, rep(seq(0, 72, by=12), times=59))))
  
  # check sharedId format
  expect_error(
    simulx(
      model=model,
      parameter=popparams1,
      covariate=cov1,
      treatment=trt1,
      output=output1,
      settings=list(sharedIds=c("population", "jh"))
    ),
    "^setting sharedIds must be in"
  )
  
  # expect_warning(
  #   simulx(
  #     model=model,
  #     parameter=popparams1,
  #     covariate=cov1,
  #     treatment=trt1,
  #     output=output1,
  #     settings=list(sharedIds=c("population", "treatment"))),
  #   "^No id to share"
  # )
  
  # expect_warning(
  #   simulx(
  #     model=model,
  #     parameter=popparams1,
  #     covariate=cov1,
  #     treatment=trt1,
  #     output=output2,
  #     settings=list(sharedIds=c("output", "treatment"))),
  #   "^No id to share"
  # )
  
  # expect_warning(
  #   simulx(
  #     model=model,
  #     parameter=popparams1,
  #     covariate=cov1,
  #     treatment=trt2,
  #     output=output2,
  #     settings=list(sharedIds=c("covariate", "output", "treatment"))),
  #   "^No id to share"
  # )
  # expect_equal(.lixoftCall("getSharedIds"), c("treatment", "output"))
  
  res <- simulx(
    model=model,
    parameter=popparams1,
    covariate=cov1,
    treatment=trt2,
    output=output2,
    settings=list(sharedIds=c("output", "treatment"))
  )
  expect_equal(.lixoftCall("getSharedIds"), c("treatment", "output"))
  
  res <- simulx(
    model=model,
    parameter=popparams1,
    covariate=cov2,
    treatment=trt2,
    output=output2,
    settings=list(sharedIds=c("output", "treatment", "covariate"))
  )
  expect_equal(.lixoftCall("getSharedIds"), c("covariate", "treatment", "output"))
  
  
})

test_that("simulx save smlx project when saveSmlxProject is specified", {
  res <- simulx(project=project, saveSmlxProject=NULL)
  
  f1 <- paste0(tempfile(), ".smlx")
  res <- simulx(project=project, saveSmlxProject=f1)
  expect_true(file.exists(f1))
  
  f2 <- paste0(tempfile())
  res <- simulx(project=project, saveSmlxProject=f2)
  expect_true(file.exists(paste0(f2, ".smlx")))
  
  f3 <- "/tmp/a/b/c/temp_project.smlx"
  res <- simulx(project=project, saveSmlxProject=f3)
  expect_true(file.exists(f3))
  
  f4 <- paste0(tempfile(), ".wrongextension")
  expect_error(simulx(project=project, saveSmlxProject=f4), "Invalid saveSmlxProject")
  
  expect_warning(res <- simulx(project=project, saveSmlxProject=NULL, settings=list(exportData=T)),
                 "You first need to specify a path to save smlx project in order to export data.")
  
  f5 <- paste0(tempfile(), ".smlx")
  res <- simulx(project=project, saveSmlxProject=f5, settings=list(exportData=T))
  expect_true(file.exists(file.path(.lixoftCall("getProjectSettings")$directory, "Simulation", "simulatedData.csv")))

})

test_that("Parameter argument", {
  model <- "lib:oral1_1cpt_TlagkaVCl.txt"

  # individual parameter
  parameter <- list(Tlag=23, ka=4, V=20, Cl=3)
  output <- list(name="Cc", time=seq(0, 24, 1))
  res <- simulx(model=model, parameter=parameter, output=output)
  expect_equal(res$parameter, unlist(parameter[names(res$parameter)]))

  parameter=data.frame(id=c(1, 2, 3), Tlag=c(23, 24, 30), ka=c(4, 3, 2), V=c(30, 40, 50), Cl=c(3, 2, 1))
  parameter$id <- factor(parameter$id)
  res <- simulx(model=model, parameter=parameter, output=output)
  res$parameter$original_id <- NULL
  expect_equal(res$parameter, parameter[names(res$parameter)])

  parameter_file=.addDataFrameTemp(parameter)
  res <- simulx(model=model, parameter=parameter_file, output=output)
  res$parameter$original_id <- NULL
  expect_equal(res$parameter, parameter[names(res$parameter)])

})

test_that("Covariate argument", {
  model <- inlineModel(
    "[COVARIATE]
input = {WT}

EQUATION:
  logtWT = log(WT/55)

[INDIVIDUAL]
input = {Tlag_pop, omega_Tlag, ka_pop, omega_ka, V_pop, omega_V, Cl_pop, omega_Cl, logtWT, beta_V_logtWT, corr_V_Cl}

DEFINITION:
  Tlag = {distribution=logNormal, typical=Tlag_pop, sd=omega_Tlag}
ka = {distribution=logNormal, typical=ka_pop, sd=omega_ka}
V = {distribution=logNormal, typical=V_pop, covariate=logtWT, coefficient=beta_V_logtWT, sd=omega_V}
Cl = {distribution=logNormal, typical=Cl_pop, sd=omega_Cl}
correlation = {level=id, r(V, Cl)=corr_V_Cl}

[LONGITUDINAL]
input = {a, b, Tlag, ka, V, Cl}

EQUATION:
  
  ; PK model definition
Cc = pkmodel(Tlag, ka, V, Cl)

OUTPUT:
output = Cc"
  )
  output <- list(name="Cc", time=seq(0, 24, 1))
  p <- list(Tlag_pop=3, omega_Tlag=0.2, ka_pop=4, omega_ka=0.5,
            V_pop=30, omega_V=0.9, Cl_pop=6, omega_Cl=0.6, beta_V_logtWT=19,
            corr_V_Cl=0.8, a=1, b=1)
  
  covariate <- list(WT=65)
  res <- simulx(model=model, covariate=covariate, output=output, parameter=p)
  expect_equal(res$covariate, unlist(covariate[names(res$covariate)]))
  
  covariate <- data.frame(id=c(1, 2, 3), WT=c(75, 83, 65))
  covariate$id <- factor(covariate$id)
  res <- simulx(model=model, covariate=covariate, output=output, parameter=p)
  expect_equal(res$parameter[names(covariate)], covariate)
  
  covariate_file <- .addDataFrameTemp(covariate)
  res <- simulx(model=model, covariate=covariate_file, output=output, parameter=p)
  expect_equal(res$parameter[names(covariate)], covariate)
  
})

test_that("Treatment argument", {
  model <- "lib:oral1_1cpt_TlagkaVCl.txt"
  output <- list(name="Cc", time=seq(0, 24, 1))
  p <- list(Tlag=3, ka=12, V=30, Cl=0.5)

  treatment1=list(time=c(0, 24), amount=200, type=c(1, 2))
  treatment2=list(time=48, amount=100, type=1)

  out_treatment1 <- as.data.frame(treatment1)
  out_treatment1$washout <- 0
  out_treatment1 <- .renameColumns(out_treatment1, "type", "admtype")

  out_treatment2 <- as.data.frame(treatment2)
  out_treatment2$washout <- 0
  out_treatment2 <- .renameColumns(out_treatment2, "type", "admtype")
  
  res1 <- simulx(model=model, treatment=treatment1, output=output, parameter=p)
  res2 <- simulx(model=model, treatment=list(treatment1, treatment2), output=output, parameter=p)
  expect_equal(res1$treatment, out_treatment1)
  expect_equal(res2$treatment, rbind(out_treatment1, out_treatment2))

  treatment1 <- data.frame(id=factor(c(1, 1, 2, 2, 3, 3)), time=c(0, 24, 0, 24, 0, 48),
                           amount=c(100, 200, 100, 200, 150, 300), type=c(1, 2, 1, 2, 1, 2))
  treatment2 <- data.frame(id=factor(c(1, 2, 3)), time=c(72, 72, 72),
                           amount=c(50, 55, 60), type=c(2, 2, 2))
  out_treatment1 <- treatment1
  out_treatment1$washout <- 0
  out_treatment1 <- .renameColumns(out_treatment1, "type", "admtype")
  
  out_treatment2 <- treatment2
  out_treatment2$washout <- 0
  out_treatment2 <- .renameColumns(out_treatment2, "type", "admtype")
  
  out_2 <- rbind(out_treatment1, out_treatment2)
  out_2 <- out_2[order(out_2$id, out_2$time),]
  row.names(out_2) <- NULL
  res1 <- simulx(model=model, treatment=treatment1, output=output, parameter=p)
  res2 <- simulx(model=model, treatment=list(treatment1, treatment2), output=output, parameter=p)
  res1$treatment$original_id <- NULL
  expect_equal(res1$treatment, out_treatment1)
  res2$treatment$original_id <- NULL
  expect_equal(res2$treatment, out_2)

  treatment1_file <- .addDataFrameTemp(treatment1)
  treatment2_file <- .addDataFrameTemp(treatment2)
  res1 <- simulx(model=model, treatment=treatment1_file, output=output, parameter=p)
  res1$treatment$original_id <- NULL
  res2 <- simulx(model=model, treatment=list(treatment1_file, treatment2_file), output=output, parameter=p)
  res2$treatment$original_id <- NULL
  expect_equal(res1$treatment, out_treatment1)
  expect_equal(res2$treatment, out_2)
  
})

test_that("Output argument", {
  model <- inlineModel(
    ";----------------------------------------------
[COVARIATE]
input = {w}

;----------------------------------------------
[INDIVIDUAL]
input = {V_pop, omega_V, w, w_pop}

EQUATION:
V_pred = V_pop*(w/w_pop)

DEFINITION:
V = {distribution = lognormal, prediction = V_pred, sd = omega_V}


[LONGITUDINAL]
input = {V, k, a}

EQUATION:
f = 100/V*exp(-k*t)

DEFINITION:
y = {distribution = normal, prediction = f, sd = a}
")
  
  p <- c(V_pop=10, omega_V=0.1, w_pop=70, k=0.15, a=0.5)
  cov <- c(w=75)
  
  # No output
  expect_error(
    simulx(model=model, parameter=p, covariate=cov),
    "When a model is defined without an OUTPUT section, you must define an output element"
  )
  model2 <- .addOutputToFile(model, "f")
  expect_warning(
    simulx(model=model2, parameter=p, covariate=cov),
    "Output has not been defined."
  )

  output1 <- list(name='f', time=seq(0, 30, by=0.1))
  output2 <- list(name='y', time=seq(1, 30, by=3))
  res1 <- simulx(model=model, output=output1, parameter=p, covariate=cov)
  res2 <- simulx(model=model, output=list(output1, output2), parameter=p, covariate=cov)
  expect_true("f" %in% names(res1))
  expect_equal(unique(res1$f$time), output1$time)
  expect_true(all(c("f", "y") %in% names(res2)))
  expect_equal(unique(res2$f$time), output1$time)
  expect_equal(unique(res2$y$time), output2$time)
  
  output1 <- list(name="f",
                  time=data.frame(id=factor(rep(1:3, each=301)), time=rep(seq(0, 30, by=0.1), 3)))
  output2 <- list(name="y",
                  time=data.frame(id=factor(rep(1:3, each=31)), time=rep(seq(0, 30, by=1), 3)))
  res1 <- simulx(model=model, output=output1, parameter=p, covariate=cov)
  res2 <- simulx(model=model, output=list(output1, output2), parameter=p, covariate=cov)
  expect_true("f" %in% names(res1))
  expect_equal(res1$f[c("id", "time")], output1$time)
  expect_true(all(c("f", "y") %in% names(res2)))
  expect_equal(res2$f[c("id", "time")], output1$time)
  expect_equal(res2$y[c("id", "time")], output2$time)
  
  output1_file <- list(name="f", time=.addDataFrameTemp(output1$time))
  output2_file <- list(name="y", time=.addDataFrameTemp(output2$time))
  res1 <- simulx(model=model, output=output1_file, parameter=p, covariate=cov)
  res2 <- simulx(model=model, output=list(output1_file, output2_file), parameter=p, covariate=cov)
  expect_true("f" %in% names(res1))
  expect_equal(res1$f[c("id", "time")], output1$time)
  expect_true(all(c("f", "y") %in% names(res2)))
  expect_equal(res2$f[c("id", "time")], output1$time)
  expect_equal(res2$y[c("id", "time")], output2$time)
  
})

test_that("Occasion argument", {
  warn_txt = "Column 'EVENT ID' added new occasions"
  iov_path <- file.path(demo_path, "5.models_for_individual_parameters/5.4.inter_occasion_variability")
  project1 <- file.path(iov_path, "iov2_project.mlxtran")
  expect_warning(project1 <- get_project(project1),  warn_txt)
  .lixoftCall("runPopulationParameterEstimation")
  initRsSimulx(force = TRUE)
  
  output <- list(name="Cc", time=seq(0, 200, 5))
  
  expect_warning(res <- simulx(project=project1, output=output), warn_txt)
  expect_true("OCCevid" %in% names(res$Cc))
  
  expect_warning(res <- simulx(project=project1, output=output, occasion="none"), warn_txt)
  expect_false("OCCevid" %in% names(res$Cc))
  
  occasion <- list(name='OCCASION', time=c(0, 120))
  output <- list(name="Cc", time=seq(0, 200, 5))
  expect_warning(res <- simulx(project=project1, output=output, occasion=occasion), warn_txt)
  expect_equal(unique(res$Cc[res$Cc$time < 120, "occ"]), 1)
  expect_equal(unique(res$Cc[res$Cc$time >= 120, "occ"]), 2)
  
  occasion <- data.frame(time=c(0, 120), OCCASION=c(1, 2))
  expect_warning(res <- simulx(project=project1, output=output, occasion=occasion), warn_txt)
  expect_equal(unique(res$Cc[res$Cc$time < 120, "occ"]), 1)
  expect_equal(unique(res$Cc[res$Cc$time >= 120, "occ"]), 2)
  
  occasion1 <- data.frame(id=c(1, 1, 2, 2, 3, 3), time=c(0, 120, 0, 100, 0, 130), OCCASION=c(1, 2, 1, 2, 1, 2))
  output <- list(name="Cc", time=seq(0, 200, 5))
  expect_warning(res <- simulx(project=project1, output=output, occasion=occasion1), warn_txt)
  expect_equal(unique(res$Cc[res$Cc$id == 1 & res$Cc$time < 120, "OCCASION"]), 1)
  expect_equal(unique(res$Cc[res$Cc$id == 1 & res$Cc$time >= 120, "OCCASION"]), 2)
  expect_equal(unique(res$Cc[res$Cc$id == 2 & res$Cc$time < 100, "OCCASION"]), 1)
  expect_equal(unique(res$Cc[res$Cc$id == 2 & res$Cc$time >= 100, "OCCASION"]), 2)
  expect_equal(unique(res$Cc[res$Cc$id == 3 & res$Cc$time < 130, "OCCASION"]), 1)
  expect_equal(unique(res$Cc[res$Cc$id == 3 & res$Cc$time >= 130, "OCCASION"]), 2)
  
  occasion2 <- data.frame(ID=c(1, 1, 2, 2, 3, 3), time=c(0, 120, 0, 100, 0, 130), OCCASION=c(1, 2, 1, 2, 1, 2))
  output <- list(name="Cc", time=seq(0, 200, 5))
  expect_warning(res <- simulx(project=project1, output=output, occasion=occasion2), warn_txt)
  expect_equal(unique(res$Cc[res$Cc$id == 1 & res$Cc$time < 120, "OCCASION"]), 1)
  expect_equal(unique(res$Cc[res$Cc$id == 1 & res$Cc$time >= 120, "OCCASION"]), 2)
  expect_equal(unique(res$Cc[res$Cc$id == 2 & res$Cc$time < 100, "OCCASION"]), 1)
  expect_equal(unique(res$Cc[res$Cc$id == 2 & res$Cc$time >= 100, "OCCASION"]), 2)
  expect_equal(unique(res$Cc[res$Cc$id == 3 & res$Cc$time < 130, "OCCASION"]), 1)
  expect_equal(unique(res$Cc[res$Cc$id == 3 & res$Cc$time >= 130, "OCCASION"]), 2)
  
  occasion1_file <- .addDataFrameTemp(occasion1)
  output <- list(name="Cc", time=seq(0, 200, 5))
  expect_warning(res <- simulx(project=project1, output=output, occasion=occasion1_file), warn_txt)
  expect_equal(unique(res$Cc[res$Cc$id == 1 & res$Cc$time < 120, "OCCASION"]), 1)
  expect_equal(unique(res$Cc[res$Cc$id == 1 & res$Cc$time >= 120, "OCCASION"]), 2)
  expect_equal(unique(res$Cc[res$Cc$id == 2 & res$Cc$time < 100, "OCCASION"]), 1)
  expect_equal(unique(res$Cc[res$Cc$id == 2 & res$Cc$time >= 100, "OCCASION"]), 2)
  expect_equal(unique(res$Cc[res$Cc$id == 3 & res$Cc$time < 130, "OCCASION"]), 1)
  expect_equal(unique(res$Cc[res$Cc$id == 3 & res$Cc$time >= 130, "OCCASION"]), 2)
  
  occasion2_file <- .addDataFrameTemp(occasion2)
  output <- list(name="Cc", time=seq(0, 200, 5))
  expect_warning(res <- simulx(project=project1, output=output, occasion=occasion2_file), warn_txt)
  expect_equal(unique(res$Cc[res$Cc$id == 1 & res$Cc$time < 120, "OCCASION"]), 1)
  expect_equal(unique(res$Cc[res$Cc$id == 1 & res$Cc$time >= 120, "OCCASION"]), 2)
  expect_equal(unique(res$Cc[res$Cc$id == 2 & res$Cc$time < 100, "OCCASION"]), 1)
  expect_equal(unique(res$Cc[res$Cc$id == 2 & res$Cc$time >= 100, "OCCASION"]), 2)
  expect_equal(unique(res$Cc[res$Cc$id == 3 & res$Cc$time < 130, "OCCASION"]), 1)
  expect_equal(unique(res$Cc[res$Cc$id == 3 & res$Cc$time >= 130, "OCCASION"]), 2)
  
})

test_that("Treatment and outputs elements when non overlapping occasions", {
  warn_txt = "Column 'EVENT ID' added new occasions"
  iov_path <- file.path(demo_path, "5.models_for_individual_parameters/5.4.inter_occasion_variability")
  project1 <- file.path(iov_path, "iov2_project.mlxtran")
  expect_warning(project1 <- get_project(project1), warn_txt)
  .lixoftCall("runPopulationParameterEstimation")
  initRsSimulx(force = TRUE)
  
  # output
  output <- list(name="Cc", time=seq(0, 140, 5))
  expect_warning(res <- simulx(project=project1, output=output), warn_txt)
  ids <- unique(.lixoftCall("getOccasionElements")$id)
  out_output <- data.frame(id=factor(rep(1:length(ids), each=29)),
                           OCCevid=sapply(output$time, function(t) ifelse(t < 120, 1, 2)),
                           time=output$time)
  expect_equal(res$Cc[c("id", "OCCevid", "time")], out_output)
  
  output <- list(name="Cc", time=data.frame(id=rep(ids, each=29), time=rep(seq(0, 140, 5), length(ids))))
  expect_warning(res <- simulx(project=project1, output=output), warn_txt)
  expect_equal(res$Cc[c("id", "OCCevid", "time")], out_output)

  output_file <- list(name="Cc", time=.addDataFrameTemp(output$time))
  expect_warning(res <- simulx(project=project1, output=output_file), warn_txt)
  expect_equal(res$Cc[c("id", "OCCevid", "time")], out_output)
  
  output$time$OCCevid <- 1
  output$time$OCCevid[output$time$time >= 120] <- 2
  expect_warning(res <- simulx(project=project1, output=output), warn_txt)
  expect_equal(res$Cc[c("id", "OCCevid", "time")], out_output)
  
  output_file <- list(name="Cc", time=.addDataFrameTemp(output$time))
  expect_warning(res <- simulx(project=project1, output=output_file), warn_txt)
  expect_equal(res$Cc[c("id", "OCCevid", "time")], out_output)
  
  output$time <- .renameColumns(output$time, "OCCevid", "occevid")
  expect_warning(res <- simulx(project=project1, output=output), warn_txt)
  expect_equal(res$Cc[c("id", "OCCevid", "time")], out_output)
  
  output_file <- list(name="Cc", time=.addDataFrameTemp(output$time))
  expect_warning(res <- simulx(project=project1, output=output_file), warn_txt)
  expect_equal(res$Cc[c("id", "OCCevid", "time")], out_output)

  # treatment
  treatment <- list(time=c(0, 120), amount=200)
  trt_output <- data.frame(id=factor(rep(1:length(ids), each=2)),
                           OCCevid=sapply(treatment$time, function(t) ifelse(t < 120, 1, 2)),
                           time=treatment$time)

  expect_warning(res <- simulx(project=project1, treatment=treatment), warn_txt)
  expect_equal(res$treatment[c("id", "OCCevid", "time")], trt_output)
  
  treatment <- data.frame(id=rep(ids, each=2), time=rep(c(0, 120), length(ids)), amount=200)
  expect_warning(res <- simulx(project=project1, treatment=treatment), warn_txt)
  expect_equal(res$treatment[c("id", "OCCevid", "time")], trt_output)
  
  treatment_file <- .addDataFrameTemp(treatment)
  expect_warning(res <- simulx(project=project1, treatment=treatment_file), warn_txt)
  expect_equal(res$treatment[c("id", "OCCevid", "time")], trt_output)
  
  treatment$OCCevid <- 1
  treatment$OCCevid[treatment$time >= 120] <- 2
  expect_warning(res <- simulx(project=project1, treatment=treatment), warn_txt)
  expect_equal(res$treatment[c("id", "OCCevid", "time")], trt_output)
  
  treatment_file <- .addDataFrameTemp(treatment)
  expect_warning(res <- simulx(project=project1, treatment=treatment_file), warn_txt)
  expect_equal(res$treatment[c("id", "OCCevid", "time")], trt_output)
  
  treatment <- .renameColumns(treatment, "OCCevid", "occevid")
  expect_warning(res <- simulx(project=project1, treatment=treatment), warn_txt)
  expect_equal(res$treatment[c("id", "OCCevid", "time")], trt_output)
  
  treatment_file <- .addDataFrameTemp(treatment)
  expect_warning(res <- simulx(project=project1, treatment=treatment_file), warn_txt)
  expect_equal(res$treatment[c("id", "OCCevid", "time")], trt_output)
})

test_that("Treatment and outputs elements when overlapping occasions", {
  iov_path <- file.path(demo_path, "5.models_for_individual_parameters/5.4.inter_occasion_variability")
  
  project1 <- file.path(iov_path, "iov1_project.mlxtran")
  project1 <- get_project(project1)
  .lixoftCall("runPopulationParameterEstimation")
  initRsSimulx(force = TRUE)
  
  # output
  output <- list(name="Cc", time=seq(0, 24, 2))
  expect_warning(res <- simulx(project=project1, output=output))
  ids <- unique(.lixoftCall("getOccasionElements")$id)
  out_output <- data.frame(id=factor(rep(1:length(ids), each=26)),
                           OCC=rep(rep(c(1, 2), each=13), length(ids)),
                           time=rep(output$time, 2 * length(ids)))
  expect_equal(res$Cc[c("id", "OCC", "time")], out_output)
  
  output <- list(name="Cc", time=data.frame(id=rep(ids, each=13), time=rep(seq(0, 24, 2), length(ids))))
  expect_warning(res <- simulx(project=project1, output=output))
  expect_equal(res$Cc[c("id", "OCC", "time")], out_output)
  
  output_file <- list(name="Cc", time=.addDataFrameTemp(output$time))
  expect_warning(res <- simulx(project=project1, output=output_file))
  expect_equal(res$Cc[c("id", "OCC", "time")], out_output)
  
  output$time <- as.data.frame(sapply(output$time, rep.int, times=2))
  output$time$time <- as.double(output$time$time)
  output$time$OCC <- rep(c(1, 2), each = 13 * length(ids))
  res <- simulx(project=project1, output=output)
  expect_equal(res$Cc[c("id", "OCC", "time")], out_output)
  
  output_file <- list(name="Cc", time=.addDataFrameTemp(output$time))
  res <- simulx(project=project1, output=output_file)
  expect_equal(res$Cc[c("id", "OCC", "time")], out_output)
  
  output$time <- .renameColumns(output$time, "OCC", "occ")
  res <- simulx(project=project1, output=output)
  expect_equal(res$Cc[c("id", "OCC", "time")], out_output)
  
  output_file <- list(name="Cc", time=.addDataFrameTemp(output$time))
  res <- simulx(project=project1, output=output_file)
  expect_equal(res$Cc[c("id", "OCC", "time")], out_output)
  
  # treatment
  treatment <- list(time=c(0, 120), amount=200)
  trt_output <- data.frame(id=factor(rep(1:length(ids), each=4)),
                           OCC=rep(rep(c(1, 2), each=2), length(ids)),
                           time=rep(treatment$time, 2 * length(ids)))
  
  expect_warning(res <- simulx(project=project1, treatment=treatment))
  expect_equal(res$treatment[c("id", "OCC", "time")], trt_output)
  
  treatment <- data.frame(id=rep(ids, each=2), time=rep(c(0, 120), length(ids)), amount=200)
  expect_warning(res <- simulx(project=project1, treatment=treatment))
  expect_equal(res$treatment[c("id", "OCC", "time")], trt_output)
  
  treatment_file <- .addDataFrameTemp(treatment)
  expect_warning(res <- simulx(project=project1, treatment=treatment_file))
  expect_equal(res$treatment[c("id", "OCC", "time")], trt_output)
  
  treatment <- as.data.frame(sapply(treatment, rep.int, times=2))
  treatment$time <- as.double(treatment$time)
  treatment$amount <- as.double(treatment$amount)
  treatment$OCC <- rep(c(1, 2), each = 2 * length(ids))
  res <- simulx(project=project1, treatment=treatment)
  expect_equal(res$treatment[c("id", "OCC", "time")], trt_output)
  
  treatment_file <- .addDataFrameTemp(treatment)
  res <- simulx(project=project1, treatment=treatment_file)
  expect_equal(res$treatment[c("id", "OCC", "time")], trt_output)
  
  treatment <- .renameColumns(treatment, "OCC", "occ")
  res <- simulx(project=project1, treatment=treatment)
  expect_equal(res$treatment[c("id", "OCC", "time")], trt_output)
  
  treatment_file <- .addDataFrameTemp(treatment)
  res <- simulx(project=project1, treatment=treatment_file)
  expect_equal(res$treatment[c("id", "OCC", "time")], trt_output)
})

test_that("Regressor argument", {
  model <- inlineModel(
"[LONGITUDINAL]
input = {Emax, EC50, C} 
C = {use = regressor}

EQUATION:
E = Emax*C/(C+EC50)"
  )
  t   <- seq(0, 50, by=1)
  out <- list(name='E', time=t)
  
  expect_error(
    simulx(model=model,
           group=list(size=3),
           parameter=c(Emax=100, EC50=0.3),
           regressor=list(name='C', time=t, value=head(exp(-0.1*t), -1)),
           output=out),
    "regressor time vector and regressor value vector must have the same length.")

  reg <- list(name='C', time=t, value=exp(-0.1*t))
  out_reg <- data.frame(id=as.factor(rep(1:3, each=length(reg$time))), time=rep(reg$time, 3), C=rep(reg$value, 3))
  res <- simulx(model=model,
                group=list(size=3),
                parameter=c(Emax=100, EC50=0.3),
                regressor=reg,
                output=out)
  expect_equal(res$regressors, out_reg)

  reg <- rbind(
    data.frame(id=as.factor(rep(1:2, each=length(t))), time=rep(t, 2), C=rep(exp(-0.1*t), 2)),
    data.frame(id=as.factor(rep(3:4, each=length(t))), time=rep(t, 2), C=rep(exp(-0.4*t), 2))
  )
  res <- simulx(model=model,
                parameter=c(Emax=100, EC50=0.3),
                regressor=reg,
                output=out)
  expect_equal(res$regressors[-which(names(res$regressors) == "original_id")], reg)
  
  reg_file <- .addDataFrameTemp(reg)
  res <- simulx(model=model,
                parameter=c(Emax=100, EC50=0.3),
                regressor=reg_file,
                output=out)
  expect_equal(res$regressors[-which(names(res$regressors) == "original_id")], reg)
  
  model <- inlineModel(
"[LONGITUDINAL]
input = {k1, k2, f0, g0, x1, x2}
x1 = {use = regressor}
x2 = {use = regressor}

EQUATION:
t0  = 0
f_0 = f0
g_0 = g0
ddt_f = -k1*f + k2*g + x1
ddt_g =  k1*f - k2*g + x2"
  )
  fg <- list(name=c('f','g'),
             time=seq(-5, 50, by=1))

  x1 <- list(name='x1',
             time=c(0,10,20,30,40),
             value=c(1,-1,1,-1,1)*0.5)
  x2 <- list(name='x2',
             time=c(5,15,25,35),
             value=c(1,-1,1,-1)*0.3)
  t <- sort(unique(c(-5, x1$time, x2$time))) # include output time too
  out_reg <- data.frame(id=as.factor(rep(1:3, each=length(t))), time=rep(t, 3))
  out_reg[out_reg$time %in% x1$time, "x1"] <- rep(x1$value, 3)
  out_reg[out_reg$time %in% x2$time, "x2"] <- rep(x2$value, 3)
  out_reg[out_reg$time == -5, c("x1", "x2")] <- rep(c(0.5, 0.3), each = 3)
  i <- c(TRUE, !is.na(out_reg$x1[-1]))
  out_reg$x1 <- out_reg$x1[i][cumsum(i)]
  i <- c(TRUE, !is.na(out_reg$x2[-1]))
  out_reg$x2 <- out_reg$x2[i][cumsum(i)]
  
  res <- simulx(model=model,
                group=list(size=3),
                parameter=c(k1=0.2, k2=0.1, f0=0, g0=0),
                regressor=list(x1, x2),
                output=list(name=c('f','g'),time=seq(-5, 50, by=1)))
  expect_equal(res$regressors, out_reg)
  
  x1 <- data.frame(id=as.factor(rep(1:3)), time=rep(c(0,10,20,30,40), 3), x1=rep(c(1,-1,1,-1,1)*0.5, 3))
  x2 <- data.frame(id=as.factor(rep(1:3)), time=rep(c(5,15,25,35), 3), x2=rep(c(1,-1,1,-1)*0.3, 3))
  res <- simulx(model=model,
                parameter=c(k1=0.2, k2=0.1, f0=0, g0=0),
                regressor=list(x1, x2),
                output=list(name=c('f','g'),time=seq(-5, 50, by=1)))
  expect_equal(res$regressors[-which(names(res$regressors) == "original_id")], out_reg)
  
  x1_file <- .addDataFrameTemp(x1)
  x2_file <- .addDataFrameTemp(x2)
  res <- simulx(model=model,
                parameter=c(k1=0.2, k2=0.1, f0=0, g0=0),
                regressor=list(x1_file, x2_file),
                output=list(name=c('f','g'),time=seq(-5, 50, by=1)))
  expect_equal(res$regressors[-which(names(res$regressors) == "original_id")], out_reg)
  
})

Try the RsSimulx package in your browser

Any scripts or data that you put into this service are public.

RsSimulx documentation built on June 22, 2024, 9:36 a.m.