tests/testthat/test_get.relative.R

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

testthat::context("Testing get.relative")

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

n.iter <- 2000
seed <- 890421

# Iterations start at 2 so that they are compared to osteopain
for (i in 2:length(datalist)) {

  print(names(datalist)[i])

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

  testthat::test_that(paste0(names(datalist)[i], ": get.relative tests pass correctly"), {

    skip_on_ci()
    skip_on_cran()
    skip_on_appveyor()

    if (names(datalist)[i] %in% c("goutSUA_CFBcomb", "hyalarthritis", "alog_pcfb")) {
      itp <- mb.run(network, tpoly(degree=2), corparam = FALSE, n.iter=n.iter, jags.seed=seed)
    } else {
      itp <- mb.run(network, titp(), corparam = FALSE, n.iter=n.iter, jags.seed=seed)
    }

    loglin <- mb.run(mb.network(datalist[[i-1]]), tloglin(), n.iter=n.iter, jags.seed=seed)

    expect_error(get.relative(mbnma=loglin, mbnma.add=itp, time=20),
                 "mbnma and mbnma.add must have a single treatment")


    # Create new network with same treatment
    netnew <- datalist[[i-1]]
    if (class(datalist[[i-1]]$treatment) != class(datalist[[i]]$treatment)) {

      netnew <- datalist[[i-2]]

    }

    if (is.factor(netnew$treatment)) {
      levels(netnew$treatment)[1] <- itp$network$treatments[1]
    } else if (is.character(netnew$treatment)) {
      netnew$treatment[netnew$treatment==netnew$treatment[1]] <-
        itp$network$treatments[1]
    } else if (is.numeric(netnew$treatment)) {
      netnew$treatment[netnew$treatment==netnew$treatment[1]] <-
        as.numeric(itp$network$treatments[1])
    }


    netnew <- mb.network(netnew)

    loglin <- mb.run(netnew, tloglin(), n.iter=n.iter, jags.seed=seed)


    expect_error(get.relative(mbnma=loglin, mbnma.add=itp), NA)

    expect_error(get.relative(mbnma=loglin, mbnma.add=itp, time=200), NA)

    treats <- c(network$treatments[1:2], netnew$treatments[3])
    rels <- get.relative(mbnma=loglin, mbnma.add=itp, treats=treats)
    expect_equal(any(is.na(match(treats, rownames(rels$mean)))), FALSE)

    treats <- c(netnew$treatments[3], network$treatments[c(1,3)])
    rels <- get.relative(mbnma=loglin, mbnma.add=itp, treats=treats)
    expect_equal(c(network$treatments[1],
                   netnew$treatments[3],
                   network$treatments[3]),
                 rownames(rels$mean))

    expect_error(get.relative(mbnma=loglin, mbnma.add=itp,
                              treats=c(network$treatments[2], netnew$treatments[3])),
                 "mbnma and mbnma.add must have a single treatment")


    # Test performing MBNMA with a different reference treatment for alog and check again
    ref <- ifelse(is.numeric(datalist[[i]]$treatment),
                  as.numeric(network$treatments[3]),
                  network$treatments[3])

    netref <- mb.network(datalist[[i]], reference=ref)
    loglin2 <- mb.run(netref, tloglin(), n.iter=n.iter, jags.seed=seed)


    # Create new network with same treatment
    netnew <- datalist[[i-1]]
    if (class(datalist[[i-1]]$treatment) != class(datalist[[i]]$treatment)) {
      netnew <- datalist[[i-2]]
    }

    if (is.factor(netnew$treatment)) {
      levels(netnew$treatment)[1] <- loglin2$network$treatments[1]
    } else if (is.character(netnew$treatment)) {
      netnew$treatment[netnew$treatment==netnew$treatment[1]] <-
        loglin2$network$treatments[1]
    } else if (is.numeric(netnew$treatment)) {
      netnew$treatment[netnew$treatment==netnew$treatment[1]] <-
        as.numeric(loglin2$network$treatments[1])
    }

    netnew <- mb.network(netnew)

    if (names(datalist)[i-1] %in% c("diabetes", "hyalarthritis")) {

      # WARNING CAN BE REMOVED AFTER v0.2.2
      itp2 <- suppressWarnings(mb.run(netnew, temax(), corparam = TRUE, n.iter=n.iter, jags.seed=seed))
    } else {
      itp2 <- mb.run(netnew, titp(), corparam = TRUE, n.iter=n.iter, jags.seed=seed)
    }


    treats <- c(netnew$treatments[3], netref$treatments[c(1,3)])
    rels <- get.relative(mbnma=loglin2, mbnma.add=itp2, treats=treats)
    expect_equal(any(is.na(match(treats, rownames(rels$mean)))), FALSE)

  })

}