tests/testthat/test-monolix.R

In nlmixr2/babelmixr: Use 'nlmixr2' to Interact with Open Source and Commercial Software

.b <- loadNamespace("babelmixr2")

if (FALSE) {
  test_that("pure mu refrence parsing", {

    # this was moved to rxode2

    expect_equal(.b$getPureMuRef(quote(cl <- tcl),
                                 muRefCurEval=data.frame(parameter="tcl", curEval="",
                                                         low=NA_character_, hi=NA_character_)),
                 c(tcl="cl"))

    expect_equal(.b$.getPureMuRef(quote(cl <- tcl),
                                  muRefCurEval=data.frame(parameter="tcl", curEval="exp",
                                                          low=NA_character_, hi=NA_character_)), NULL)

    expect_equal(.b$.getPureMuRef(quote(cl <- exp(tcl)),
                                  muRefCurEval=data.frame(parameter="tcl", curEval="exp",
                                                          low=NA_character_, hi=NA_character_)),
                 c(tcl="cl"))

    expect_equal(.b$.getPureMuRef(quote(cl <- exp(tcl)),
                                  muRefCurEval=data.frame(parameter="tcl", curEval="",
                                                          low=NA_character_, hi=NA_character_)),
                 NULL)


    expect_equal(.b$.getPureMuRef(quote(cl <- expit(tcl, 0, 1)),
                                  muRefCurEval=data.frame(parameter="tcl", curEval="expit",
                                                          low=NA_character_, hi=NA_character_)),
                 c(tcl="cl"))


    expect_equal(.b$.getPureMuRef(quote(cl <- expit(tcl, 0, 2)),
                                  muRefCurEval=data.frame(parameter="tcl", curEval="expit",
                                                          low=NA_character_, hi=NA_character_)),
                 NULL)


    expect_equal(.b$.getPureMuRef(quote(cl <- expit(tcl, 0, 2)),
                                  muRefCurEval=data.frame(parameter="tcl", curEval="expit",
                                                          low=0, hi=2)),
                 c(tcl="cl"))


    expect_equal(.b$.getPureMuRef(quote(cl <- expit(tcl, 0.5, 1)),
                                  muRefCurEval=data.frame(parameter="tcl", curEval="expit",
                                                          low=NA_character_, hi=NA_character_)),
                 NULL)

    expect_equal(.b$.getPureMuRef(quote(cl <- expit(tcl, 0.5, 1)),
                                  muRefCurEval=data.frame(parameter="tcl", curEval="expit",
                                                          low=0.5, hi=NA_character_)),
                 c(tcl="cl"))


    expect_equal(.b$.getPureMuRef(quote(cl <- expit(tcl, 0.5)),
                                  muRefCurEval=data.frame(parameter="tcl", curEval="expit",
                                                          low=0.5, hi=NA_character_)),
                 c(tcl="cl"))


    expect_equal(.b$.getPureMuRef(quote(cl <- expit(tcl, 0.5)),
                                  muRefCurEval=data.frame(parameter="tcl", curEval="expit",
                                                          low=0.4, hi=NA_character_)),
                 NULL)

    expect_equal(.b$.getPureMuRef(quote(cl <- expit(tcl)),
                                  muRefCurEval=data.frame(parameter="tcl", curEval="expit",
                                                          low=0, hi=1)),
                 c(tcl="cl"))

    expect_equal(.b$.getPureMuRef(quote(cl <- expit(tcl)),
                                  muRefCurEval=data.frame(parameter="tcl", curEval="expit",
                                                          low=NA_real_, hi=1)),
                 c(tcl="cl"))

    expect_equal(.b$.getPureMuRef(quote(cl <- expit(tcl)),
                                  muRefCurEval=data.frame(parameter="tcl", curEval="expit",
                                                          low=0, hi=NA_real_)),
                 c(tcl="cl"))

    expect_equal(.b$.getPureMuRef(quote(cl(0) <- tcl),
                                  muRefCurEval=data.frame(parameter="tcl", curEval="",
                                                          low=NA_real_, hi=NA_real_)),
                 NULL)
  })

}


test_that("individual distribution switch", {
  expect_equal(.b$.mlxTranCurEvalToDistribution("exp"),
               "distribution=logNormal")
  expect_equal(.b$.mlxTranCurEvalToDistribution("expit"),
               "distribution=logitNormal")
  expect_equal(.b$.mlxTranCurEvalToDistribution("probitInv"),
               "distribution=probitNormal")
  expect_equal(.b$.mlxTranCurEvalToDistribution(""),
               "distribution=normal")
  expect_error(.b$.mlxTranCurEvalToDistribution("log"))
})

test_that("can determine if parameter is population only", {
  .df <- data.frame(theta = c("tktr", "tka", "tcl", "tv", "tkout", "te0", "tdepot"),
                    eta = c("eta.ktr", "eta.ka", "eta.cl", "eta.v", "eta.kout", "eta.e0", "eta.depot"),
                    level="id")
  expect_true(.b$.mlxTranIsPopOnly("temax", .df))
  expect_false(.b$.mlxTranIsPopOnly("tka", .df))
})

test_that("get variability component", {

  .df <- data.frame(theta = c("tktr", "tka", "tcl", "tv", "tkout", "te0", "tdepot"),
                    eta = c("eta.ktr", "eta.ka", "eta.cl", "eta.v", "eta.kout", "eta.e0", "eta.depot"),
                    level="id")
  expect_equal(.b$.mlxTranGetVaraibility("emax", "temax", .df),
               "no-variability")

  expect_equal(.b$.mlxTranGetVaraibility("ka", "tka", .df),
               "sd=omega_ka")

})

test_that("test datafile use", {

  one.cmt <- function() {
    ini({
      tka <- 0.45 ; label("Ka")
      tcl <- log(c(0, 2.7, 100)) ; label("Log Cl")
      tv <- 3.45; label("log V")
      cl.wt <- 0
      v.wt <- 0
      eta.ka ~ 0.6
      eta.cl ~ 0.3
      eta.v ~ 0.1
      add.sd <- 0.7
    })
    model({
      ka <- exp(tka + eta.ka)
      cl <- exp(tcl + eta.cl + wt * cl.wt)
      v <- exp(tv + eta.v) + wt2 ^ 2 * v.wt
      linCmt() ~ add(add.sd)
    })
  }

  ui <- rxode2::rxode2(one.cmt)

  expect_equal(.b$.monolixMapDataUse("ID", ui), "ID = {use=identifier}")
  expect_equal(.b$.monolixMapDataUse("TIME", ui), "TIME = {use=time}")
  expect_equal(.b$.monolixMapDataUse("EVID", ui), "EVID = {use=eventidentifier}")
  expect_equal(.b$.monolixMapDataUse("AMT", ui), "AMT = {use=amount}")
  expect_equal(.b$.monolixMapDataUse("II", ui), "II = {use=interdoseinterval}")
  expect_equal(.b$.monolixMapDataUse("DV", ui), "DV = {use=observation, name=rx_prd_rxLinCmt, type=continuous}")
  expect_equal(.b$.monolixMapDataUse("CENS", ui), "CENS = {use=censored}")
  expect_equal(.b$.monolixMapDataUse("LIMIT", ui), "LIMIT = {use=limit}")
  expect_equal(.b$.monolixMapDataUse("YTYPE", ui), "YTYPE = {use=observationtype}")
  expect_equal(.b$.monolixMapDataUse("ADM", ui), "ADM = {use=administration}")
  expect_equal(.b$.monolixMapDataUse("SS", ui), "SS = {use=steadystate}")
  expect_equal(.b$.monolixMapDataUse("wt2", ui), "wt2 = {use=regressor}")
  expect_equal(.b$.monolixMapDataUse("wt", ui), "wt = {use=covariate, type=continuous}")
  expect_equal(.b$.monolixMapDataUse("nlmixrRowNums", ui), "")

  one.cmt <- function() {
    ini({
      tka <- 0.45 ; label("Ka")
      tcl <- log(c(0, 2.7, 100)) ; label("Log Cl")
      tv <- 3.45; label("log V")
      cl.wt <- 0
      v.wt <- 0
      eta.ka ~ 0.6
      eta.cl ~ 0.3
      eta.v ~ 0.1
      add.sd <- 0.7
    })
    model({
      ka <- exp(tka + eta.ka)
      cl <- exp(tcl + eta.cl + WT * cl.wt)
      v <- exp(tv + eta.v)+ WT ^ 2 * v.wt
      linCmt() ~ add(add.sd)
    })
  }

  ui <- rxode2::rxode2(one.cmt)

  expect_equal(.monolixMapDataUse("wt2", ui), "")
  # This is only true with the new rxode2;
  expect_equal(.monolixMapDataUse("WT", ui), "WT = {use=regressor}")

})

test_that("monolix dsl", {

  one.cmt <- function() {
    ini({
      tka <- 0.45 ; label("Ka")
      tcl <- log(c(0, 2.7, 100)) ; label("Log Cl")
      tv <- 3.45; label("log V")
      cl.wt <- 0
      v.wt <- 0
      eta.ka ~ 0.6
      eta.cl ~ 0.3
      eta.v ~ 0.1
      add.sd <- 0.7
    })
    model({
      ka <- exp(tka + eta.ka)
      cl <- exp(tcl + eta.cl + WT * cl.wt)
      v <- exp(tv + eta.v)+ WT ^ 2 * v.wt
      linCmt() ~ add(add.sd)
    })
  }

  ui <- rxode2::rxode2(one.cmt)

  .rxToM <- function(x) {
    rxToMonolix(x, ui)
  }
  .ee <- function(x, y) {
    .x <- gsub(" +", " ", x)
    .x <- gsub("^ +", "", .x)
    .x <- gsub(" +$", "", .x)
    .x <- gsub(" *\n *", "\n", .x)

    .y <- gsub(" +", " ", y)
    .y <- gsub("^ +", "", .y)
    .y <- gsub(" +$", "", .y)
    .y <- gsub(" *\n *", "\n", .y)
    expect_equal(.x, .y)
  }

  .ee(.rxToM("sqrt(a)"), "sqrt(a)")
  .ee(.rxToM("max(a,b)"), "max(a,b)")
  expect_error(.rxToM("max(a,b,c)"))
  expect_error(.rxToM("max(a)"))
  .ee(.rxToM("sum(a,b,c,d)"), "((a)+(b)+(c)+(d))")
  .ee(.rxToM("prod(a,b,c,d)"), "((a)*(b)*(c)*(d))")
  .ee(.rxToM("a<-1+b"), "a = 1+b")
  .ee(.rxToM("a~1+b"), "a = 1+b")
  .ee(.rxToM("a=1+b"), "a = 1+b")
  .ee(.rxToM("expit(a)"), "1/(1+exp(-(a)))")
  .ee(.rxToM("expit(a,b)"), "(1.0-(b))*(1/(1+exp(-(a))))+(b)")
  .ee(.rxToM("expit(a,b,c)"), "((c)-(b))*(1/(1+exp(-(a))))+(b)")
  .ee(.rxToM("logit(a)"), "-log(1/(a)-1)")
  .ee(.rxToM("logit(a,b)"), "-log(1/(((a)-(b))/(1.0-(b)))-1)")
  .ee(.rxToM("logit(a,b,c)"), "-log(1/(((a)-(b))/((c)-(b)))-1)")
  .ee(.rxToM("probitInv(a)"), "normcdf(a)")
  .ee(.rxToM("probitInv(a,b)"), "(1.0-(b))*(normcdf(a))+(b)")
  .ee(.rxToM("probitInv(a,b,c)"), "((c)-(b))*(normcdf(a))+(b)")
  .ee(.rxToM("probit(a)"), "probit(a)")
  .ee(.rxToM("probit(a,b)"), "probit(((a)-(b))/(1.0-(b)))")
  .ee(.rxToM("probit(a,b,c)"), "probit(((a)-(b))/((c)-(b)))")
  .ee(.rxToM("d/dt(depot)=-depot*kel"), "ddt_depot = - depot*kel")
  .ee(.rxToM("depot(0)=50"), "depot_0 = 50")
  .ee(.rxToM("f(depot)=3"), ";f defined in PK section")
  .ee(.rxToM("a**b"), "a^b")
  .ee(.rxToM("if (a<=b){c=1} else if (a==4) {c=2} else {c=4}"), "if a<=b\n  c = 1\nelseif a==4\n  c = 2\nelse \n  c = 4\nend\n")
  .ee(.rxToM("if (a<=b){c=1} else if (a==4) {c=2} else if (a==30) {c=4} else {c=100}"), "if a<=b\n  c = 1\nelseif a==4\n  c = 2\nelseif a==30\n  c = 4\nelse \n  c = 100\nend\n")
  .ee(.rxToM("if (a<=b){c=1} else if (a==4) {c=2}"), "if a<=b\n  c = 1\nelseif a==4\n  c = 2\nend\n")
  .ee(.rxToM("if (a<=b){c=1}"), "if a<=b\n  c = 1\nend\n")
  .ee(.rxToM("time"), "t")
  expect_error(.rxToM("NA"))
  expect_error(.rxToM("newind"))
  .ee(.rxToM("log1pmx(a)"), "(log(1+a)-(a))")

  .ee(.rxToM("4.3"), "4.3")
  .ee(.rxToM("add.sd"), "add__sd")

})

test_that("monolix model creation without running", {
  withr::with_tempdir({

    one.cmt <- function() {
      ini({
        tka <- 0.45 ; label("Ka")
        tcl <- log(c(0, 2.7, 100)) ; label("Log Cl")
        tv <- 3.45; label("log V")
        cl.wt <- 0
        v.wt <- 0
        eta.ka ~ 0.6
        eta.cl ~ 0.3
        eta.v ~ 0.1
        add.sd <- 0.7
      })
      model({
        ka <- exp(tka + eta.ka)
        cl <- exp(tcl + eta.cl + WT * cl.wt)
        v <- exp(tv + eta.v)+ WT ^ 2 * v.wt
        d/dt(depot) <- -depot*ka
        d/dt(central) <- depot*ka - cl*central/v
        cp <-central/v
        cp ~ add(add.sd)
      })
    }

    files <- c("monolixTest-monolix.csv", "monolixTest-monolix.mlxtran",
               "monolixTest-monolix.md5", "monolixTest-monolix.txt")

    nlmixr2(one.cmt, nlmixr2data::theo_sd, "monolix",
            monolixControl(runCommand=NA, modelName="monolixTest"))

    lapply(files, function(f) { expect_true(file.exists(f)) })

    nlmixr2(one.cmt, nlmixr2data::theo_sd, "monolix",
            monolixControl(runCommand=NA, modelName="monolixTest"))
    lapply(files, function(f) {
      expect_true(file.exists(f))
      unlink(f)
    })

  })
})