tests/testthat/test_write.functions.R

In hugaped/MBNMAtime: Run Time-Course Model-Based Network Meta-Analysis (MBNMA) Models

testthat::context("Testing write.functions")
network <- mb.network(osteopain)

testthat::test_that("write functions pass correctly:", {

  testthat::expect_equal(1,1) # Avoids empty tests

  datalist <- list(osteopain=osteopain, copd=copd, goutSUA_CFBcomb=goutSUA_CFBcomb,
                   hyalarthritis=hyalarthritis, diabetes=diabetes, alog_pcfb=alog_pcfb)

  skip_on_appveyor()
  skip_on_ci()
  skip_on_cran()

  for (i in seq_along(datalist)) {

    print(names(datalist)[i])
    network <- mb.network(datalist[[i]])


    testthat::test_that("testing prior writing functions", {

      testthat::expect_equal(1,1) # Avoids empty tests

      emax1 <- suppressWarnings(mb.run(network,
                                       fun=temax(pool.emax="rel", method.emax="random",
                                                 pool.et50="rel", method.et50="common"),
                                       corparam = TRUE,
                                       n.chain=3, n.iter=200, n.burnin=100))

      emax2 <- suppressWarnings(mb.run(network,
                                       fun=temax(pool.emax="rel", method.emax="random",
                                                 pool.et50="rel", method.et50="common"),
                                       corparam = FALSE,
                                       n.chain=3, n.iter=200, n.burnin=100))

      ############### Testing prior writing functions ###############

      testthat::test_that(paste0("get.prior for ", names(datalist)[i]), {

        vars <- c("mu.z", "sd.emax", "z", "rhoparam")
        vars2 <- c("mu.1", "mu.2", "sd.emax", "et50", "emax")

        if (!names(datalist)[i] %in% c("goutSUA_CFBcomb", "hyalarthritis", "diabetes", "copd", "alog_pcfb")) {
          vars <- append(vars, "alpha")
          vars2 <- append(vars2, "alpha")
        }
        testthat::expect_equal(sort(names(get.prior(emax1$model.arg$jagscode))), sort(vars))

        testthat::expect_equal(class(get.prior(emax1$model.arg$jagscode)), "list")
        testthat::expect_equal(class(get.prior(emax1$model.arg$jagscode)[[1]]), "character")

        testthat::expect_equal(sort(names(get.prior(emax2$model.arg$jagscode))), sort(vars2))

        priors <- get.prior(emax1$model.arg$jagscode)
        for (i in seq_along(priors)) {
          expect_equal(grepl("d[a-z]+\\(.+\\)", priors[i]), TRUE)
        }

        testthat::expect_error(get.prior(5))
      })



      testthat::test_that("replace.prior", {
        priors <- list("z"="dnorm(-1, 0.01)",
                       "sd.emax"="dnorm(0,0.5) T(0,)")

        testthat::expect_equal(grep("T\\(0,\\)", MBNMAtime:::replace.prior(priors, mbnma=emax1)) %in% grep("sd.emax", emax1$model.arg$jagscode),
                               TRUE)

        priors <- list("banana"="dnorm(-1,0.01)")

        testthat::expect_error(MBNMAtime:::replace.prior(priors, mbnma=emax1))

      })

    })

  }


  ################### Testing mb.write ################

  testthat::test_that("test.mb.write", {
    funlist <- list(tpoly(degree=1, pool.1 = "rel", method.1="common"), tloglin(pool.rate="rel", method.rate="common"))

    jags <- mb.write(fun=tpoly(degree=1, pool.1 = "rel", method.1="common"), intercept=TRUE, positive.scale = TRUE)
    testthat::expect_equal(length(grep("alpha\\[i", jags))>0, TRUE)
    testthat::expect_equal(length(grep("exp\\(alpha\\[i", jags))>0, TRUE)

    jags <- mb.write(fun=tpoly(degree=1, pool.1 = "rel", method.1="common"), intercept=FALSE, positive.scale = FALSE)
    testthat::expect_equal(length(grep("alpha\\[i", jags))>0, FALSE)

    jags <- mb.write(fun=tloglin(pool.rate="rel", method.rate="random"))
    testthat::expect_equal(length(grep("rate", jags))>0, TRUE)
    testthat::expect_equal(length(grep("sd\\.rate ~ dnorm", jags))>0, TRUE)
    testthat::expect_equal(length(grep("dev", jags))>0, TRUE)

    jags <- mb.write(fun=tloglin(pool.rate="rel", method.rate="random"), rho="dunif(0,1)", covar="CS")
    testthat::expect_equal(length(grep("rho ~ dunif\\(0\\,1\\)", jags))>0, TRUE)
    testthat::expect_equal(length(grep("cor\\[i,r,c\\]", jags))>0, FALSE)
    testthat::expect_equal(length(grep("dev", jags))>0, FALSE)

    jags <- mb.write(fun=tpoly(degree=2, pool.1 = "rel", method.1="common",
                               pool.2="abs", method.2="random"),
                     rho=0.1)
    testthat::expect_equal(length(grep("rho <- 0.1", jags))>0, TRUE)

    jags <- mb.write(fun=tpoly(degree=2, pool.1 = "rel", method.1="common",
                               pool.2="abs", method.2="random"),
                     rho="dunif(-1,1)", covar="AR1")
    testthat::expect_equal(length(grep("rho ~ dunif\\(-?[0-9],1", jags))>0, TRUE)
    testthat::expect_equal(length(grep("cor\\[i,r,c\\]", jags))>0, TRUE)
    testthat::expect_equal(length(grep("dev", jags))>0, FALSE)

    testthat::expect_error(mb.write(fun=tpoly(degree=2, pool.1 = "rel", method.1="common",
                                              pool.2="abs", method.2="random"),
                                    rho=5, covar="AR1"), "cannot be outside the bounds")

    testthat::expect_error(mb.write(fun=tloglin(pool.rate="rel", method.rate="random"), class.effect="alpha"))
    testthat::expect_error(mb.write(fun=tloglin(pool.rate="rel", method.rate="random"), class.effect=list(fake="common"), "list element names in `class.effect`"))


    jags <- mb.write(fun=tfpoly(degree=2, pool.1="abs", method.1="common",
                                pool.2="rel", method.2="random", method.power1=1, method.power2=-1),
                     rho="dunif(-1,1)", covar="AR1")
    testthat::expect_equal(length(grep("beta\\.1", jags))>0, TRUE)
    testthat::expect_equal(length(grep("d\\.1", jags))>0, FALSE)
    testthat::expect_equal(length(grep("d\\.2", jags))>0, TRUE)
    testthat::expect_equal(length(grep("power1", jags))>0, TRUE)
    testthat::expect_equal(length(grep("power2", jags))>0, TRUE)
    testthat::expect_equal(length(grep("sd\\.1", jags))>0, FALSE)
    testthat::expect_equal(length(grep("sd\\.beta\\.2", jags))>0, TRUE)
    testthat::expect_equal(length(grep("sd\\.power1", jags))>0, FALSE)
    testthat::expect_equal(length(grep("sd\\.power2", jags))>0, FALSE)
    testthat::expect_equal(length(grep("rho ~ dunif\\(-?[0-9],1", jags))>0, TRUE)
    testthat::expect_equal(length(grep("cor\\[i,r,c\\]", jags))>0, TRUE)
    testthat::expect_equal(length(grep("dev", jags))>0, FALSE)


    # Class effects
    jags <- mb.write(fun=tspline(type="ns", nknots=3, pool.1 = "rel", method.1="common",
                                 pool.2="rel", method.2="random", pool.3="abs", method.3="common", pool.4="abs", method.4="random"),
                     class.effect=list(beta.1="common", beta.2="random"), rho="dunif(0,1)", covar="varadj")
    testthat::expect_equal(length(grep("D\\.1", jags))>0, TRUE)
    testthat::expect_equal(length(grep("D\\.2", jags))>0, TRUE)
    testthat::expect_equal(length(grep("D\\.3", jags))>0, FALSE)
    testthat::expect_equal(length(grep("sd.D\\.1", jags))>0, FALSE)
    testthat::expect_equal(length(grep("sd.D\\.2", jags))>0, TRUE)
    testthat::expect_equal(length(grep("beta\\.3", jags))>0, TRUE)
    testthat::expect_equal(length(grep("beta\\.4", jags))>0, TRUE)
    testthat::expect_equal(length(grep("sd.beta\\.4", jags))>0, TRUE)
    testthat::expect_equal(length(grep("sd.beta\\.3", jags))>0, FALSE)


    # UME
    jags <- mb.write(fun=tspline(type="bs", degree=3, nknots=1, pool.1 = "rel", method.1="common",
                                 pool.2="abs", method.2="random", pool.3="rel", method.3="common", pool.4="rel", method.4="random"),
                     UME=c("beta.1", "beta.4"))
    testthat::expect_equal(length(grep("d\\.1\\[1\\,", jags))>0, TRUE)
    testthat::expect_equal(length(grep("d\\.3\\[1\\,", jags))>0, FALSE)
    testthat::expect_equal(length(grep("beta\\.2 ~", jags))>0, TRUE)
    testthat::expect_equal(length(grep("d\\.4\\[1\\,", jags))>0, TRUE)
    testthat::expect_equal(length(grep("sd.beta\\.2", jags))>0, TRUE)
    testthat::expect_equal(length(grep("sd.beta\\.1", jags))>0, FALSE)
    testthat::expect_equal(length(grep("sd.beta\\.3", jags))>0, FALSE)
    testthat::expect_equal(length(grep("sd\\.beta\\.4", jags))>0, TRUE)

    testthat::expect_error(mb.write(fun=tspline(type="bs", degree=3, nknots=1, pool.1 = "rel", method.1="common",
                                                pool.2="abs", method.2="random", pool.3="rel", method.3="common", pool.4="rel", method.4="random"),
                                    UME=c("beta.1", "beta.2", "beta.3")), "can only be specified for time-course")


    testthat::expect_silent(mb.write())

  })

})