tests/testthat/test-state-dep-f.R

In rxode2: Facilities for Simulating from ODE-Based Models

rxTest({
  # -- Analytical background --------------------------------------------------
  # f(depot) <- f0 + state scales the bioavailable fraction of each dose.
  # For a bolus dose of amount `amt` at time t_dose into a depot that drains
  # with first-order rate constant ka:
  #
  #   depot(t) = amt * (f0 + S0) * exp(-ka * (t - t_dose))   for t >= t_dose
  #
  # Multiple doses contribute additively.  Constant state (d/dt(state)=0)
  # keeps S0 fixed, making the expected trajectory fully analytical.

  # -- Test 1 -----------------------------------------------------------------
  # state = 0 throughout  ->  f(depot) = f0 + 0 = f0 exactly.
  # Effective bioavailable amount = amt * f0; trajectory is mono-exponential.
  test_that("state-dep f with state=0 uses exactly f0 (no state shift)", {
    mod <- rxode2({
      # Bioavailability depends on a state variable.
      # With state held at 0, this reduces to the fixed-f0 case.
      f(depot) <- f0 + state
      d/dt(depot) <- -ka * depot
      d/dt(state) <- 0         # constant state; initial value is the only value
    })

    amt  <- 100
    f0   <- 0.8
    ka   <- 0.5
    times <- seq(0, 20, by = 0.5)

    et <- eventTable() |>
      add.dosing(dose = amt, nbr.doses = 1) |>
      add.sampling(times)

    s <- solve(mod, et,
               inits  = c(state = 0, depot = 0),
               params = c(f0 = f0, ka = ka))

    # Expected: depot(t) = amt * f0 * exp(-ka * t)
    expected <- amt * f0 * exp(-ka * times)

    # A mismatch would mean the bioavailable fraction was not f0.
    expect_equal(s$depot[s$time %in% times], expected,
                 tolerance = 1e-4,
                 label = "depot matches amt*f0*exp(-ka*t) when state=0")
  })

  # -- Test 2 -----------------------------------------------------------------
  # state = S0 (constant, various values)  ->  f(depot) = f0 + S0 exactly.
  # Effective bioavailable amount = amt * (f0 + S0); different for each S0.
  test_that("state-dep f shifts bioavailable amount by state value: f = f0 + state_at_dose", {
    mod <- rxode2({
      # f(depot) is evaluated at the moment the dose fires.
      # With constant state the evaluation time doesn't matter.
      f(depot) <- f0 + state
      d/dt(depot) <- -ka * depot
      d/dt(state) <- 0
    })

    amt  <- 100
    f0   <- 0.8
    ka   <- 0.5
    times <- seq(0, 20, by = 0.5)

    for (S0 in c(0.1, 0.5, -0.2)) {
      et <- eventTable() |>
        add.dosing(dose = amt, nbr.doses = 1) |>
        add.sampling(times)

      s <- solve(mod, et,
                 inits  = c(state = S0, depot = 0),
                 params = c(f0 = f0, ka = ka))

      F_eff    <- f0 + S0                          # effective bioavailability
      expected <- amt * F_eff * exp(-ka * times)   # analytical trajectory

      # Full trajectory must match the analytical formula for f = f0 + S0.
      expect_equal(s$depot[s$time %in% times], expected,
                   tolerance = 1e-4,
                   label = paste0("depot matches amt*(f0+S0)*exp(-ka*t) for S0=", S0))

      # Also confirm that this differs from the S0=0 baseline,
      # i.e., the state contribution is not silently ignored.
      expected_s0 <- amt * f0 * exp(-ka * times)
      expect_false(isTRUE(all.equal(expected, expected_s0)),
                   label = paste0("S0=", S0, " gives a different trajectory than state=0"))
    }
  })

  # -- Test 3 -----------------------------------------------------------------
  # Multiple doses: each dose's bioavailable amount = dose * (f0 + state_at_dose_time).
  # With a decaying state, consecutive doses get decreasing f values and
  # therefore decreasing effective amounts.
  # depot(t) = sum over fired doses of:  amt*(f0+state(t_d)) * exp(-ka*(t-t_d))
  test_that("state-dep f: each dose evaluated at its own firing-time state", {
    mod <- rxode2({
      f(depot)    <- f0 + state
      d/dt(depot) <- -ka * depot
      d/dt(state) <- -kstate * state   # state decays so each dose sees a different f
    })

    f0     <- 0.8
    ka     <- 0.5
    kstate <- 0.3
    amt    <- 100

    dose_times <- c(0, 5)
    times      <- seq(0, 15, by = 1)

    et <- et() |>
      et(amt = amt, time = dose_times[1], cmt = "depot") |>
      et(amt = amt, time = dose_times[2], cmt = "depot") |>
      et(times)

    for (S0 in c(0, 0.2)) {
      s <- rxSolve(mod, et,
                   params = c(f0 = f0, ka = ka, kstate = kstate),
                   inits  = c(depot = 0, state = S0))

      # Analytical: state(t) = S0 * exp(-kstate * t)
      # f at each dose time:  f_d = f0 + S0*exp(-kstate*t_d)
      # contribution of dose d at observation time t:
      #   amt * f_d * exp(-ka*(t - t_d))  [if t >= t_d]
      expected_depot <- vapply(times, function(t) {
        contrib <- 0
        for (td in dose_times) {
          if (t >= td) {
            f_at_td  <- f0 + S0 * exp(-kstate * td)
            contrib  <- contrib + amt * f_at_td * exp(-ka * (t - td))
          }
        }
        contrib
      }, numeric(1))

      obs <- s$depot[s$time %in% times]
      expect_equal(obs, expected_depot,
                   tolerance = 1e-3,
                   label = paste0("two-dose depot matches analytic f=f0+state(t_dose), S0=", S0))
    }
  })

  # -- Test 4 -----------------------------------------------------------------
  # Robustness: no NAs produced when state is non-zero and f varies between
  # subjects (two-row data frame with different initial state values).
  test_that("state-dep f: no NAs across subjects with different initial state", {
    mod <- rxode2({
      f(depot) <- f0 + state
      d/dt(depot) <- -ka * depot
      d/dt(state) <- 0
    })

    et <- eventTable() |>
      add.dosing(dose = 100, nbr.doses = 1) |>
      add.sampling(seq(0, 10, by = 1))

    s0 <- solve(mod, et, inits = c(state = 0,   depot = 0),
                params = c(f0 = 0.8, ka = 0.5))
    s1 <- solve(mod, et, inits = c(state = 0.3, depot = 0),
                params = c(f0 = 0.8, ka = 0.5))

    expect_false(any(is.na(s0$depot)), label = "no NAs when state=0")
    expect_false(any(is.na(s1$depot)), label = "no NAs when state=0.3")
    # Different initial f -> different trajectories
    expect_false(isTRUE(all.equal(s0$depot, s1$depot)),
                 label = "different state gives different f and depot")
  })
})