tests/testthat/test-lag.R

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

rxTest({

  test_that("test lag-time information parsing", {

    m1 <- rxode2parse("KA=2.94E-01;
    CL=1.86E+01;
    V2=4.02E+01;
    Q=1.05E+01;
    V3=2.97E+02;
    Kin=1;
    Kout=1;
    EC50=200;
    fdepot = 1;
    durDepot = 8;
    rateDepot = 1250;
    C2 = centr/V2;
    C3 = peri/V3;
    d/dt(depot) =-KA*depot;
    f(depot) = fdepot
    dur(depot) = durDepot
    rate(depot) = rateDepot
    alag(depot) = alagDepot
    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")
    expect_equal(m1$alag, 1L)

    m1 <- rxode2parse("KA=2.94E-01;
    CL=1.86E+01;
    V2=4.02E+01;
    Q=1.05E+01;
    V3=2.97E+02;
    Kin=1;
    Kout=1;
    EC50=200;
    fdepot = 1;
    durDepot = 8;
    rateDepot = 1250;
    C2 = centr/V2;
    C3 = peri/V3;
    d/dt(depot) =-KA*depot;
    f(depot) = fdepot
    dur(depot) = durDepot
    rate(depot) = rateDepot
    d/dt(centr) = KA*depot - CL*C2 - Q*C2 + Q*C3;
    alag(centr) = alagDepot
    d/dt(peri)  =                    Q*C2 - Q*C3;
    d/dt(eff)  = Kin - Kout*(1-C2/(EC50+C2))*eff;
    eff(0) = 1")
    expect_equal(m1$alag, 2L)

    m1 <- rxode2parse("KA=2.94E-01;
    CL=1.86E+01;
    V2=4.02E+01;
    Q=1.05E+01;
    V3=2.97E+02;
    Kin=1;
    Kout=1;
    EC50=200;
    fdepot = 1;
    durDepot = 8;
    rateDepot = 1250;
    C2 = centr/V2;
    C3 = peri/V3;
    d/dt(depot) =-KA*depot;
    f(depot) = fdepot
    dur(depot) = durDepot
    rate(depot) = rateDepot
    d/dt(centr) = KA*depot - CL*C2 - Q*C2 + Q*C3;
    d/dt(peri)  =                    Q*C2 - Q*C3;
    alag(peri) = alagDepot
    d/dt(eff)  = Kin - Kout*(1-C2/(EC50+C2))*eff;
    eff(0) = 1")
    expect_equal(m1$alag, 3L)

    m1 <- rxode2parse("KA=2.94E-01;
    CL=1.86E+01;
    V2=4.02E+01;
    Q=1.05E+01;
    V3=2.97E+02;
    Kin=1;
    Kout=1;
    EC50=200;
    fdepot = 1;
    durDepot = 8;
    rateDepot = 1250;
    C2 = centr/V2;
    C3 = peri/V3;
    d/dt(depot) =-KA*depot;
    f(depot) = fdepot
    dur(depot) = durDepot
    rate(depot) = rateDepot
    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;
    alag(eff) = alagDepot
    eff(0) = 1")
    expect_equal(m1$alag, 4L)

    m1 <- rxode2parse("KA=2.94E-01;
    CL=1.86E+01;
    V2=4.02E+01;
    Q=1.05E+01;
    V3=2.97E+02;
    Kin=1;
    Kout=1;
    EC50=200;
    fdepot = 1;
    durDepot = 8;
    rateDepot = 1250;
    C2 = centr/V2;
    C3 = peri/V3;
    d/dt(depot) =-KA*depot;
    f(depot) = fdepot
    dur(depot) = durDepot
    rate(depot) = rateDepot
    alag(depot) = alagDepot
    d/dt(centr) = KA*depot - CL*C2 - Q*C2 + Q*C3;
    alag(centr) = alagDepot
    d/dt(peri)  =                    Q*C2 - Q*C3;
    alag(peri) = alagDepot
    d/dt(eff)  = Kin - Kout*(1-C2/(EC50+C2))*eff;
    alag(eff) = alagDepot
    eff(0) = 1")
    expect_equal(m1$alag, 1:4)

    m1 <- rxode2parse("KA=2.94E-01;
    CL=1.86E+01;
    V2=4.02E+01;
    Q=1.05E+01;
    V3=2.97E+02;
    Kin=1;
    Kout=1;
    EC50=200;
    fdepot = 1;
    durDepot = 8;
    rateDepot = 1250;
    C2 = centr/V2;
    C3 = peri/V3;
    d/dt(depot) =-KA*depot;
    f(depot) = fdepot
    dur(depot) = durDepot
    rate(depot) = rateDepot
    alag(depot) = alagDepot
    d/dt(centr) = KA*depot - CL*C2 - Q*C2 + Q*C3;
    d/dt(peri)  =                    Q*C2 - Q*C3;
    alag(peri) = alagDepot
    d/dt(eff)  = Kin - Kout*(1-C2/(EC50+C2))*eff;
    alag(eff) = alagDepot
    eff(0) = 1")
    expect_equal(m1$alag, c(1L, 3:4))

    m1 <- rxode2parse("KA=2.94E-01;
    CL=1.86E+01;
    V2=4.02E+01;
    Q=1.05E+01;
    V3=2.97E+02;
    Kin=1;
    Kout=1;
    EC50=200;
    fdepot = 1;
    durDepot = 8;
    rateDepot = 1250;
    C2 = centr/V2;
    C3 = peri/V3;
    d/dt(depot) =-KA*depot;
    f(depot) = fdepot
    dur(depot) = durDepot
    rate(depot) = rateDepot
    d/dt(centr) = KA*depot - CL*C2 - Q*C2 + Q*C3;
    alag(centr) = alagDepot
    d/dt(peri)  =                    Q*C2 - Q*C3;
    alag(peri) = alagDepot
    d/dt(eff)  = Kin - Kout*(1-C2/(EC50+C2))*eff;
    alag(eff) = alagDepot
    eff(0) = 1")
    expect_equal(m1$alag, 2:4)

    m1 <- rxode2parse("KA=2.94E-01;
    CL=1.86E+01;
    V2=4.02E+01;
    Q=1.05E+01;
    V3=2.97E+02;
    Kin=1;
    Kout=1;
    EC50=200;
    fdepot = 1;
    durDepot = 8;
    rateDepot = 1250;
    C2 = centr/V2;
    C3 = peri/V3;
    d/dt(depot) =-KA*depot;
    f(depot) = fdepot
    dur(depot) = durDepot
    rate(depot) = rateDepot
    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")
    expect_equal(m1$alag, integer(0))

  })


  et <- et(1:10)
  et$b <- 1:10

  test_that("lag()", {

    suppressMessages(expect_error(rxode2({
      a <- lag()
    })))

    suppressMessages(expect_error(rxode2({
      a <- lag(b, c)
    })))

    m1 <- rxode2({
      c <- b + 2
      a <- lag(b, 3)
    })

    expect_s3_class(m1, "rxode2")

    x1 <- m1 %>% rxSolve(et)

    expect_equal(x1$a, c(NA, NA, NA, 1, 2, 3, 4, 5, 6, 7))

    m1 <- rxode2({
      a <- lag(b, 3)
    })

    expect_s3_class(m1, "rxode2")

    x1 <- m1 %>% rxSolve(et)

    expect_equal(x1$a, c(NA, NA, NA, 1, 2, 3, 4, 5, 6, 7))

    m1 <- rxode2({
      a <- lag(b, -1)
    })

    expect_s3_class(m1, "rxode2")

    x1 <- m1 %>% rxSolve(et)

    expect_equal(x1$a, c(2, 3, 4, 5, 6, 7, 8, 9, 10, NA))

    m1 <- rxode2({
      a <- lag(b, 0)
    })

    expect_s3_class(m1, "rxode2")

    x1 <- m1 %>% rxSolve(et)

    expect_equal(x1$a, 1:10)

    m1 <- rxode2({
      a <- lag(b)
    })

    expect_s3_class(m1, "rxode2")

    x1 <- m1 %>% rxSolve(et)

    expect_equal(x1$a, c(NA, 1, 2, 3, 4, 5, 6, 7, 8, 9))

    m1 <- rxode2({
      a <- b
      c <- lag(a)
    })

    expect_s3_class(m1, "rxode2")

    x1 <- m1 %>% rxSolve(et)

    expect_equal(x1$c, c(NA, 1, 2, 3, 4, 5, 6, 7, 8, 9))

    m1 <- rxode2({
      a <- b
      c <- lag(a, 1)
    })

    expect_s3_class(m1, "rxode2")

    x1 <- m1 %>% rxSolve(et)

    expect_equal(x1$c, c(NA, 1, 2, 3, 4, 5, 6, 7, 8, 9))

    m1 <- rxode2({
      a <- b
      c <- lead(a, -1)
    })

    expect_s3_class(m1, "rxode2")

    x1 <- m1 %>% rxSolve(et)

    expect_equal(x1$c, c(NA, 1, 2, 3, 4, 5, 6, 7, 8, 9))

    m1 <- rxode2({
      c <- b + 3
      a <- lag(b)
    })

    expect_s3_class(m1, "rxode2")

    x1 <- m1 %>% rxSolve(et)

    expect_equal(x1$a, c(NA, 1, 2, 3, 4, 5, 6, 7, 8, 9))
  })

  test_that("lead()", {
    suppressMessages(expect_error(rxode2({
      a <- lead()
    })))

    suppressMessages(expect_error(rxode2({
      a <- lead(b, c)
    })))

    m1 <- rxode2({
      c <- b + 2
      a <- lead(b, 3)
    })

    expect_s3_class(m1, "rxode2")

    x1 <- m1 %>% rxSolve(et)

    expect_equal(x1$a, c(4, 5, 6, 7, 8, 9, 10, NA, NA, NA))

    m1 <- rxode2({
      a <- lead(b, 3)
    })

    expect_s3_class(m1, "rxode2")

    x1 <- m1 %>% rxSolve(et)

    expect_equal(x1$a, c(4, 5, 6, 7, 8, 9, 10, NA, NA, NA))

    m1 <- rxode2({
      a <- lead(b, -1)
    })

    expect_s3_class(m1, "rxode2")

    x1 <- m1 %>% rxSolve(et)

    expect_equal(x1$a, c(NA, 1, 2, 3, 4, 5, 6, 7, 8, 9))

    m1 <- rxode2({
      a <- lead(b, 0)
    })

    expect_s3_class(m1, "rxode2")

    x1 <- m1 %>% rxSolve(et)

    expect_equal(x1$a, 1:10)

    m1 <- rxode2({
      a <- lead(b)
    })

    expect_s3_class(m1, "rxode2")

    x1 <- m1 %>% rxSolve(et)

    expect_equal(x1$a, c(2:10, NA))

    m1 <- rxode2({
      c <- b + 3
      a <- lead(b)
    })

    expect_s3_class(m1, "rxode2")

    x1 <- m1 %>% rxSolve(et)

    expect_equal(x1$a, c(2:10, NA))
  })

  test_that("first()", {
    suppressMessages(expect_error(rxode2({
      a <- first()
    })))

    suppressMessages(expect_error(rxode2({
      a <- first(b, 1)
    })))

    suppressMessages(expect_error(rxode2({
      a <- first(b, 1, 2)
    })))

    m1 <- rxode2({
      a <- first(b)
    })

    expect_s3_class(m1, "rxode2")

    x1 <- m1 %>% rxSolve(et)

    expect_true(all(x1$a == 1))

    m1 <- rxode2({
      c <- b + 3
      a <- first(b)
    })

    expect_s3_class(m1, "rxode2")

    x1 <- m1 %>% rxSolve(et)

    expect_true(all(x1$a == 1))
  })

  test_that("last()", {
    suppressMessages(expect_error(rxode2({
      a <- last()
    })))

    suppressMessages(expect_error(rxode2({
      a <- last(b, 1)
    })))

    suppressMessages(expect_error(rxode2({
      a <- last(b, 1, 2)
    })))

    m1 <- rxode2({
      a <- last(b)
    })

    expect_s3_class(m1, "rxode2")

    x1 <- m1 %>% rxSolve(et)

    expect_true(all(x1$a == 10))

    m1 <- rxode2({
      c <- b + 3
      a <- last(b)
    })

    expect_s3_class(m1, "rxode2")

    x1 <- m1 %>% rxSolve(et)

    expect_true(all(x1$a == 10))
  })


  et <- et(1:10)
  et$b <- 2^(1:10)

  test_that("diff()", {
    suppressMessages(expect_error(rxode2({
      a <- diff()
    })))

    suppressMessages(expect_error(rxode2({
      a <- diff(b, 1, 2)
    })))

    suppressMessages(expect_error(rxode2({
      a <- diff(b, 1.2)
    })))

    suppressMessages(expect_error(rxode2({
      a <- diff(b, c)
    })))

    suppressMessages(expect_error(rxode2({
      a <- diff(b, -1)
    })))

    suppressMessages(expect_error(rxode2({
      a <- diff(b, 0)
    })))

    m1 <- rxode2({
      a <- diff(b)
    })

    expect_s3_class(m1, "rxode2")

    x1 <- m1 %>% rxSolve(et)

    expect_equal(x1$a, c(NA, 2, 4, 8, 16, 32, 64, 128, 256, 512))

    m1 <- rxode2({
      c <- b
      a <- diff(c)
    })

    expect_s3_class(m1, "rxode2")

    x1 <- m1 %>% rxSolve(et)

    expect_equal(x1$a, c(NA, 2, 4, 8, 16, 32, 64, 128, 256, 512))

    m1 <- rxode2({
      c <- b
      a <- diff(c, 1)
    })

    expect_s3_class(m1, "rxode2")

    x1 <- m1 %>% rxSolve(et)

    expect_equal(x1$a, c(NA, 2, 4, 8, 16, 32, 64, 128, 256, 512))

    m1 <- rxode2({
      a <- diff(b, 2)
    })

    expect_s3_class(m1, "rxode2")

    x1 <- m1 %>% rxSolve(et)

    expect_equal(x1$a, c(NA, NA, 6, 12, 24, 48, 96, 192, 384, 768))
  })

  test_that("bad lag() types", {
    suppressMessages(expect_error(rxode2({
      a ~ c + d
      b <- lag(a)
    })))

    suppressMessages(expect_error(rxode2({
      d / dt(a) <- 3
      b <- lag(a)
    })))

    suppressMessages(expect_error(rxode2({
      a <- a + 3
      b <- lag(a)
    })))

    suppressMessages(expect_error(rxode2({
      a <- 13 + b
      b <- lag(a, 3)
    })))

    suppressMessages(expect_error(rxode2({
      a <- 13 + b
      b <- lead(a)
    })))
  })

  test_that("test sticky lhs", {
    mod1 <- rxode2({
      KA <- 2.94E-01
      CL <- 1.86E+01
      V2 <- 4.02E+01
      Q <- 1.05E+01
      V3 <- 2.97E+02
      Kin <- 1
      Kout <- 1
      EC50 <- 200
      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
      isna <- is.na(amt)
      if (!is.na(amt)) {
        tdose <- time
      } else {
        tad <- time - tdose
      }
    })

    ev <- et(amountUnits = "mg", timeUnits = "hours") %>%
      et(amt = 10000, addl = 9, ii = 12, cmt = "depot") %>%
      et(time = 120, amt = 2000, addl = 4, ii = 14, cmt = "depot") %>%
      et(0, 240)

    r1 <- rxSolve(mod1, ev, addDosing = TRUE)

    expect_equal(max(r1$tad, na.rm = TRUE), 64)

    r2 <- rxSolve(mod1, ev, addDosing = FALSE)

    expect_equal(max(r2$tad, na.rm = TRUE), 64)
  })

  test_that("newind", {
    mod1 <- rxode2({
      KA <- 2.94E-01
      CL <- 1.86E+01
      V2 <- 4.02E+01
      Q <- 1.05E+01
      V3 <- 2.97E+02
      Kin <- 1
      Kout <- 1
      EC50 <- 200
      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
      if (!is.na(amt)) {
        tdose <- time
      } else {
        tad <- time - tdose
      }
      if (newind <= 1) {
        first <- 0
      } else if (tad > 24) {
        first <- 24
      }
    })

    ev <- et(amountUnits = "mg", timeUnits = "hours") %>%
      et(amt = 10000, addl = 9, ii = 12, cmt = "depot") %>%
      et(time = 120, amt = 2000, addl = 4, ii = 14, cmt = "depot") %>%
      et(0, 240)

    r1 <- rxSolve(mod1, ev, addDosing = TRUE)
    expect_equal(unique(r1$first), c(0, 24))

    r1 <- rxSolve(mod1, ev, addDosing = FALSE)
    expect_equal(unique(r1$first), c(0, 24))
  })
})