tests/testthat/test-ifelse.R

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

rxTest({
  rx1 <- rxode2({
    b <- -1
    d / dt(X) <- a * X + Y * Z
    d / dt(Y) <- b * (Y - Z)
    d / dt(Z) <- -X * Y + c * Y - Z
    if (t < 0.02 | t > 99.98) {
      print("matt")
    } else {
      print("f")
    }
  })

  test_that("Simple if/else expansion works on model", {
    expect_equal(rxExpandIfElse(rx1, TRUE, FALSE), c("(!(t<0.02||t>99.98))" = "d/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"f\");", "(t<0.02||t>99.98)" = "d/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"matt\");"))
  })

  test_that("Keep initilizations if needed.", {
    expect_equal(
      rxExpandIfElse(rx1, FALSE, FALSE),
      c("(!(t<0.02||t>99.98))" = "b=-1;\nd/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"f\");", "(t<0.02||t>99.98)" = "b=-1;\nd/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"matt\");")
    )
  })

  rx2 <- rxode2({
    b <- -1
    d / dt(X) <- a * X + Y * Z
    d / dt(Y) <- b * (Y - Z)
    d / dt(Z) <- -X * Y + c * Y - Z
    if (t < 0.02 | t > 99.98) {
      print("me")
    }
  })

  test_that("Simple if expansion works on model", {
    expect_equal(rxExpandIfElse(rx2, TRUE, FALSE), c("(!(t<0.02||t>99.98))" = "d/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;", "(t<0.02||t>99.98)" = "d/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"me\");"))
  })

  test_that("Keep initilizations if needed.", {
    expect_equal(
      rxExpandIfElse(rx2, FALSE, FALSE),
      c("(!(t<0.02||t>99.98))" = "b=-1;\nd/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;", "(t<0.02||t>99.98)" = "b=-1;\nd/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"me\");")
    )
  })

  ## Compound if/then
  rx3 <- rxode2({
    b <- -1
    d / dt(X) <- a * X + Y * Z
    d / dt(Y) <- b * (Y - Z)
    d / dt(Z) <- -X * Y + c * Y - Z
    if (t < 0.02 | t > 99.98) {
      print("1")
      if (t > 100) {
        print("2")
      } else {
        print("3")
      }
    }
  })

  test_that("nested if/then", {
    expect_equal(
      rxExpandIfElse(rx3, TRUE, FALSE),
      c("(!(t<0.02||t>99.98))" = "d/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;", "(t<0.02||t>99.98) && (!(t>100))" = "d/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"1\");\nprintf(\"3\");", "(t<0.02||t>99.98) && (t>100)" = "d/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"1\");\nprintf(\"2\");")
    )
  })

  test_that("Keep initilizations", {
    expect_equal(
      rxExpandIfElse(rx3, FALSE, FALSE),
      c("(!(t<0.02||t>99.98))" = "b=-1;\nd/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;", "(t<0.02||t>99.98) && (!(t>100))" = "b=-1;\nd/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"1\");\nprintf(\"3\");", "(t<0.02||t>99.98) && (t>100)" = "b=-1;\nd/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"1\");\nprintf(\"2\");")
    )
  })

  rx4 <- rxode2({
    b <- -1
    d / dt(X) <- a * X + Y * Z
    d / dt(Y) <- b * (Y - Z)
    d / dt(Z) <- -X * Y + c * Y - Z
    if (t < 0.02 | t > 99.98) {
      print("1")
      if (t > 100) {
        print("2")
      }
    }
  })

  test_that("nested if/then #2", {
    expect_equal(
      rxExpandIfElse(rx4, TRUE, FALSE),
      c("(!(t<0.02||t>99.98))" = "d/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;", "(t<0.02||t>99.98) && (!(t>100))" = "d/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"1\");", "(t<0.02||t>99.98) && (t>100)" = "d/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"1\");\nprintf(\"2\");")
    )
  })

  test_that("nested if/then #2 w/ini", {
    expect_equal(
      rxExpandIfElse(rx4, FALSE, FALSE),
      c("(!(t<0.02||t>99.98))" = "b=-1;\nd/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;", "(t<0.02||t>99.98) && (!(t>100))" = "b=-1;\nd/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"1\");", "(t<0.02||t>99.98) && (t>100)" = "b=-1;\nd/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"1\");\nprintf(\"2\");")
    )
  })

  ## Compound if/then
  rx5 <- rxode2({
    b <- -1
    d / dt(X) <- a * X + Y * Z
    d / dt(Y) <- b * (Y - Z)
    d / dt(Z) <- -X * Y + c * Y - Z
    if (t < 0.02 | t > 99.98) {
      print("1")
      if (t > 100) {
        print("2")
      } else {
        print("3")
        if (t < 0.01) {
          printf("Less than <0.001\n")
        } else {
          printf("Between 0.01 and 0.02.\n")
        }
      }
    }
  })

  test_that("nested if/then #3", {
    expect_equal(
      rxExpandIfElse(rx5, TRUE, FALSE),
      c("(!(t<0.02||t>99.98))" = "d/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;", "(t<0.02||t>99.98) && (t>100)" = "d/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"1\");\nprintf(\"2\");", "(t<0.02||t>99.98) && (!(t>100)) && (!(t<0.01))" = "d/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"1\");\nprintf(\"3\");\nprintf(\"Between 0.01 and 0.02.\\n\");", "(t<0.02||t>99.98) && (!(t>100)) && (t<0.01)" = "d/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"1\");\nprintf(\"3\");\nprintf(\"Less than <0.001\\n\");")
    )
  })

  test_that("nested if/then #3 w/ini", {
    expect_equal(
      rxExpandIfElse(rx5, FALSE, FALSE),
      c("(!(t<0.02||t>99.98))" = "b=-1;\nd/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;", "(t<0.02||t>99.98) && (t>100)" = "b=-1;\nd/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"1\");\nprintf(\"2\");", "(t<0.02||t>99.98) && (!(t>100)) && (!(t<0.01))" = "b=-1;\nd/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"1\");\nprintf(\"3\");\nprintf(\"Between 0.01 and 0.02.\\n\");", "(t<0.02||t>99.98) && (!(t>100)) && (t<0.01)" = "b=-1;\nd/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"1\");\nprintf(\"3\");\nprintf(\"Less than <0.001\\n\");")
    )
  })

  rx6 <- rxode2({
    b <- -1
    d / dt(X) <- a * X + Y * Z
    d / dt(Y) <- b * (Y - Z)
    d / dt(Z) <- -X * Y + c * Y - Z
    if (t < 0.02 | t > 99.98) {
      print("1")
      if (t > 100) {
        print("2")
        if (t < 150) {
          printf("Less than 150\n")
        } else {
          printf(">= 150\n")
        }
      } else {
        print("3")
      }
    }
  })

  test_that("nested if/then #4", {
    expect_equal(
      rxExpandIfElse(rx6, TRUE, FALSE),
      c("(!(t<0.02||t>99.98))" = "d/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;", "(t<0.02||t>99.98) && (!(t>100))" = "d/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"1\");\nprintf(\"3\");", "(t<0.02||t>99.98) && (t>100) && (!(t<150))" = "d/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"1\");\nprintf(\"2\");\nprintf(\">= 150\\n\");", "(t<0.02||t>99.98) && (t>100) && (t<150)" = "d/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"1\");\nprintf(\"2\");\nprintf(\"Less than 150\\n\");")
    )
  })

  test_that("nested if/then #4 w/ini", {
    expect_equal(
      rxExpandIfElse(rx6, FALSE, FALSE),
      c("(!(t<0.02||t>99.98))" = "b=-1;\nd/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;", "(t<0.02||t>99.98) && (!(t>100))" = "b=-1;\nd/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"1\");\nprintf(\"3\");", "(t<0.02||t>99.98) && (t>100) && (!(t<150))" = "b=-1;\nd/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"1\");\nprintf(\"2\");\nprintf(\">= 150\\n\");", "(t<0.02||t>99.98) && (t>100) && (t<150)" = "b=-1;\nd/dt(X)=a*X+Y*Z;\nd/dt(Y)=b*(Y-Z);\nd/dt(Z)=-X*Y+c*Y-Z;\nprintf(\"1\");\nprintf(\"2\");\nprintf(\"Less than 150\\n\");")
    )
  })

  ode <- "
   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;
"

  ode1 <- rxode2(ode)
  ode2 <- suppressMessages(rxode2(ode, calcSens = TRUE, collapseModel = TRUE))

  ode3 <- rxode2({
    if (route == 1) {
      C2 <- centr / V2 * F
    } else {
      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
  })

  ode4 <- suppressMessages(rxode2(ode3, calcSens = TRUE, collapseModel = TRUE))

  ode5 <- suppressMessages(rxode2(ode3, calcSens = TRUE))

  ## test_that("LHS variables can be removed", {
  ##     expect_true(length(rxLhs(ode3)) > 1);
  ##     expect_true(length(rxLhs(ode4)) == 0);
  ##     expect_equal(rxLhs(ode3), rxLhs(ode5))
  ## })

  ## pred <- function(){
  ##     if (cmt == 1){
  ##         return(cntr);
  ##     } else {
  ##         return(eff);
  ##     }
  ## }

  ## err <- function(){
  ##     if (cmt == 1){
  ##         return(add(0.1) + prop(0.1))
  ##     } else {
  ##         return(add(0.1))
  ##     }
  ## }

  ## pk <- function(){
  ##     KA <- theta[1];
  ##     CL <- exp(theta[2] + eta[1]);
  ##     V2 <- exp(theta[3] + eta[2]);
  ## }

  ## test_that("Can throw the warning", {
  ##     expect_warning(rxSymPySetupPred(ode3, pred, pk, err));
  ## })

  ## pred <- function(){
  ##     if (cmt == 1){
  ##         return(centr);
  ##     } else {
  ##         return(eff);
  ##     }
  ## }

  ## tmp <- rxSymPySetupPred(ode3, pred, pk, err)
})