tests/testthat/test-iCov.R

In nlmixr2/rxode2: Facilities for Simulating from ODE-Based Models

rxTest({
  test_that("proper errors from event tables with single id", {

    m <- function() {
      ini({
        tCL20 <-  c(10)
        tV1 <- 20
        tCL12 <- 30
        tV2 <- 40
        tCL23 <- 50
        tCL32 <- 60
        betaWTCL20 <- 0.1
        betaSexV1 <- 0.2
        prop.err <- c(0, 0.268724820805969)
        eta.V1 + eta.CL12 + eta.V2 + eta.CL20 + eta.CL23 + eta.CL32 ~
          cor(sd(1,
                 0.25, 1.10,
                 -0.25, 0.25, 1.2,
                 -0.35, 0.35, -0.45, 1.3,
                 -0.2,  0.2,  0.2,   -0.2, 1.4,
                 -0.1,  0.1, -0.1, 0.1, -0.1, 1.4))
      })
      model({
        CL20 <- exp(tCL20 + eta.CL20) * ((WTBL/85)^betaWTCL20)
        V1 <- exp(tV1 + eta.V1) * (1 + betaSexV1 * SEXN)
        CL12 <- exp(tCL12 + eta.CL12)
        V2 <- exp(tV2 + eta.V2)
        CL23 <- exp(tCL23 + eta.CL23)
        CL32 <- exp(tCL32 + eta.CL32)
        k12 <- CL12/V1
        k20 <- CL20/V2
        k23 <- CL23/V2
        k32 <- CL32/V1
        d/dt(central) = -k12 * central
        d/dt(tissue) = k12 * central - (k20 + k23) * tissue +    k32 * central_ext
        d/dt(central_ext) = k23 * tissue - k32 * central_ext
        d/dt(central_tot) = (central + central_ext)/V1
        conc = (central + central_ext)/V1
        IPRED = conc
        IPRED ~ prop(prop.err)
      })
    }


    ev <- eventTable() %>%
      add.dosing(dose=900630, nbr.doses=1, rate=900630/2) %>%
      et(0, 600, length.out=10)

    expect_error(rxSolve(m, ev,

                 # Create individual covariate data-frame
                 iCov=data.frame(ID=1:10,
                                 WTBL=runif(n = 1000, min = 50, max = 150),
                                 SEXN=rbinom(n = 1000, size = 1, prob = 0.5)),
                 # in this case it would be useful to keep the WT in the output dataset
                 keep=c("WTBL","SEXN")),
                 "to use 'iCov' you must have an id in your event table")
  })


  test_that("iCov", {

    nsub <- 10 # 100 sub-problems

    mod1 <- rxode2({
      C2 = centr/V2
      C3 = peri/V3
      d/dt(depot) = -KA*depot
      d/dt(centr) = KA*depot - CL*C2 - Q*C2 + Q*C3
      d/dt(peri) = Q*C2 - Q*C3
      d/dt(eff) = Kin - Kout*(1-C2/(EC50+C2))*eff
      eff(0) = 1
    })


    ev <- et() %>%
      et(amt=10000, addl=9,ii=12) %>%
      et(time=120, amt=20000, addl=4, ii=24) %>%
      et(0:240) %>% ## Add Sampling
      et(id=1:nsub) ## Add id

    sigma <- matrix(c(0.09,0.08,0.08,0.25),2,2) # IIV covariance matrix
    mv <- rxRmvn(n=nsub, rep(0,2), sigma) # Sample from covariance matrix
    CL <- 7*exp(mv[,1])
    V2 <- 40*exp(mv[,2])
    params.all <- cbind(KA=0.3, CL=CL, V2=V2, Q=10, V3=300,
                        Kin=0.2, Kout=0.2, EC50=8)
    paramsDf <- as.data.frame(params.all)
    paramsDf$ptS=paste(1:nsub, "pt")
    paramsDf$ptF <- factor(paramsDf$ptS)
    paramsDf$ptI <- 1:nsub
    paramsDf$ptL <- paramsDf$ptI <=50

    expect_error(etTrans(ev, mod1, iCov=paramsDf, keep=c("CL", "V2")),
                 "'iCov' must have an 'id' column")

    paramsDf$id <- 1:nsub+1
    expect_error(etTrans(ev, mod1, iCov=paramsDf, keep=c("CL", "V2")),
                 "some of the 'id' values do not match the input event table")


    paramsDf$id <- 1:nsub

    paramsDf2 <- paramsDf

    paramsDf2$id <- paste("pt ",paramsDf2$id)

    expect_error(etTrans(ev, mod1, iCov=paramsDf2),
                 "data 'id' column is an integer; 'iCov' 'id' also needs to be an integer")

    paramsDf2 <- paramsDf[-1,]

    expect_error(etTrans(ev, mod1, iCov=paramsDf2),
                 "the 'id' in the iCov must have 1 unique match to the event table")

    paramsDf2 <- rbind(paramsDf[1,], paramsDf)

    expect_error(etTrans(ev, mod1, iCov=paramsDf2),
                 "the 'id' in the iCov must have 1 unique match to the event table")

    # Now check for proper behavior

    tmp <- etTrans(ev, mod1, iCov=paramsDf)
    tmp2 <- attr(class(tmp), ".rxode2.lst")
    class(tmp2) <- NULL

    for (v in c("EC50", "Kout", "Kin", "V3", "Q", "V2", "CL", "KA")) {
      expect_equal(tmp2$cov1[[v]], paramsDf[[v]])
      expect_equal(tmp2$pars[v,], paramsDf[[v]])
    }

    # Check keep of various sorts in iCov
    tmp <- rxSolve(mod1, ev, iCov=paramsDf, keep=c("CL", "V2", "ptS", "ptF", "ptI", "ptL"))
    expect_true(is.character(tmp$ptS))
    expect_true(all(paste(1:nsub, "pt") %in% unique(tmp$ptS)))
    expect_true(is.factor(tmp$ptF))
    expect_true(all(paste(1:nsub, "pt") %in% unique(tmp$ptF)))
    expect_true(is.integer(tmp$ptI))
    expect_true(is.logical(tmp$ptL))
    expect_true(all((tmp$ptI <= 50) == tmp$ptL))

    for (v in
         c("evid",  "time", "amt", "value", "cmt", "ytype", "state", "var", "dv",
           "rate","dur", "addl", "ii", "mdv", "cens", "limit", "method")) {
      names(paramsDf)[9] <- v
      expect_error(etTrans(ev, mod1, iCov=paramsDf),
                   paste0("cannot specify '", v,"' in 'iCov'"))
    }

  })
})