tests/testthat/test_run.functions.R

In MBNMAdose: Dose-Response MBNMA Models

testthat::context("Testing run.functions")


test_that(paste("run.functions work correctly"), {

  skip_on_appveyor()
  skip_on_ci()
  skip_on_cran()


# Tested datasets must have at least 5 agents - options are HF2PPIT, psoriasis, ssri, osteopain, gout(?)
alldfs <- list(triptans, psoriasis75, ssri, osteopain, gout)
datanams <- c("triptans", "psoriasis75", "ssri", "osteopain", "gout")

# Datasets with no placebo/
network <- mbnma.network(psoriasis90)
psoriasis90.noplac <- network$data.ab[network$data.ab$narm>2 & network$data.ab$agent!=1,]

network <- mbnma.network(ssri)
ssri.noplac <- network$data.ab[network$data.ab$narm>2 & network$data.ab$agent!=1,]

alldfs[[length(alldfs)+1]] <- psoriasis90.noplac
alldfs[[length(alldfs)+1]] <- ssri.noplac
datanams <- append(datanams, c("psoriasis90.noplac", "ssri.noplac"))

for (dat in seq_along(alldfs)) {

  datanam <- datanams[dat]
  dataset <- alldfs[[dat]]

  print(datanam)

  ### Datasets ####
  network <- mbnma.network(dataset)



  # Make class data
  df <- dataset
  df1 <- dataset

  if ("class" %in% names(dataset)) {
    netclass <- mbnma.network(df)
  }

  n.iter=500
  pd <- "pv"

  test_that(paste("check.likelink function correctly for:", datanam), {

    if (all(c("y", "se") %in% names(dataset))) {
      expect_silent(check.likelink(df, likelihood = "normal", link="identity"))
      expect_silent(check.likelink(df, likelihood = "normal", link="logit"))

      # Expect error due to misspecified df
      expect_error(check.likelink(df, likelihood = "binomial", link="identity"))
      expect_error(check.likelink(df, likelihood = "poisson", link="identity"))

      # Expect errror due to misspecified arguments
      expect_error(check.likelink(df, likelihood = "normal", link="badger"))
      expect_error(check.likelink(df, likelihood = "test", link="identity"))

    } else if (all(c("r", "n") %in% names(dataset))) {
      expect_silent(check.likelink(df, likelihood = "binomial", link="identity"))
      expect_silent(check.likelink(df, likelihood = "binomial", link="logit"))

      # Expect error due to misspecified df
      expect_error(check.likelink(df, likelihood = "normal", link="identity"))
      expect_error(check.likelink(df, likelihood = "poisson", link="identity"))

      # Expect errror due to misspecified arguments
      expect_error(check.likelink(df, likelihood = "binomial", link="badger"))
      expect_error(check.likelink(df, likelihood = "test", link="logit"))
    }

  })




  test_that(paste("nma.run function correctly for:", datanam), {
    n.iter <- 500

    # expect_warning(nma.run(network, method="random", n.iter=100, warn.rhat = TRUE))

    expect_warning(nma.run(network, method="common", n.iter=n.iter, pd=pd, warn.rhat = FALSE), NA)

    result <- nma.run(network, method="random", n.iter=n.iter, pd=pd, warn.rhat = FALSE)
    expect_equal(names(result), c("jagsresult", "trt.labs", "UME"))
    expect_equal(all(c("d", "sd") %in% result$jagsresult$parameters.to.save), TRUE)

    result <- nma.run(network, method="random", n.iter=n.iter, pd=pd, warn.rhat = FALSE,
                      UME=TRUE)
    expect_equal("d[1,1]" %in% rownames(result$jagsresult$BUGSoutput$summary), TRUE)


    # Creating a broken network
    df.num <- mbnma.network(df1)$data.ab

    sepcomp <- mbnma.comparisons(df.num)[nrow(mbnma.comparisons(df.num)),]
    keep <- df.num$studyID[df.num$treatment %in% c(sepcomp$t1, sepcomp$t2)]
    df.num <- df.num[!(df.num$studyID %in% keep & !df.num$treatment  %in% c(sepcomp$t1, sepcomp$t2)),]

    df.num <- df.num %>% dplyr::group_by(studyID) %>% dplyr::mutate(narm=dplyr::n())
    df.num <- df.num[df.num$narm>1,]

    fullrow <- nrow(df.num)
    network.disc <- mbnma.network(df.num)

    result.1 <- nma.run(network.disc, method="random", n.iter=n.iter, pd=pd, warn.rhat = FALSE,
                        UME=TRUE, drop.discon = TRUE)
    result.2 <- nma.run(network.disc, method="random", n.iter=n.iter, pd=pd, warn.rhat = FALSE,
                        UME=TRUE, drop.discon = FALSE)
    result.3 <- nma.run(network.disc, method="random", n.iter=n.iter, pd=pd, warn.rhat = FALSE,
                        UME=TRUE, drop.discon = TRUE)
    expect_equal(length(result.1$trt.labs)!=length(result.2$trt.labs), TRUE)
    expect_equal(length(result.1$trt.labs)==length(result.3$trt.labs), TRUE)
  })



  test_that(paste("pDcalc functions correctly for:", datanam), {
    n.iter=1000

    if (all(c("y", "se") %in% names(dataset))) {
      likelihood <- "normal"
      link <- "identity"

      # Prevents skip
      expect_equal(5,5)

    } else if (all(c("r", "n") %in% names(dataset))) {
      likelihood <- "binomial"
      link <- "logit"


      # For binomial likelihood
      result <- mbnma.run(network, fun=dexp(), method="random",
                          parameters.to.save = c("psi", "resdev"),
                          n.iter=n.iter, pd=pd)

      jagsdata <- getjagsdata(network$data.ab, likelihood = likelihood, link=link)

      obs1 <- jagsdata$r
      obs2 <- jagsdata$n

      pd.est <- pDcalc(obs1=obs1, obs2=obs2, narm=jagsdata[["narm"]], NS=jagsdata[["NS"]],
                   theta.result=result$BUGSoutput$mean$psi, resdev.result=result$BUGSoutput$mean$resdev,
                   likelihood=likelihood, type="dose")
      expect_equal(length(pd.est),1)
      expect_equal(class(pd.est),"numeric")

      pd.est <- pDcalc(obs1=obs1, obs2=obs2, narm=jagsdata[["narm"]], NS=5,
                   theta.result=result$BUGSoutput$mean$psi, resdev.result=result$BUGSoutput$mean$resdev,
                   likelihood=likelihood, type="dose")
      expect_equal(length(pd.est),1)
      expect_equal(class(pd.est),"numeric")

      pd.est <- pDcalc(obs1=obs1, obs2=obs2, narm=jagsdata[["narm"]], NS=5,
                   theta.result=result$BUGSoutput$mean$psi, resdev.result=result$BUGSoutput$mean$resdev,
                   likelihood="poisson", type="dose")

      expect_error(pDcalc(obs1=obs1, obs2=obs2, narm=jagsdata[["narm"]], NS=jagsdata[["NS"]],
                          theta.result=result$BUGSoutput$mean$psi, resdev.result=result$BUGSoutput$mean$resdev,
                          likelihood="poisson", type="time"))

      expect_error(pDcalc(obs1=obs1, obs2=obs2, narm=jagsdata[["narm"]], NS=jagsdata[["NS"]],
                          theta.result=NULL, resdev.result=result$BUGSoutput$mean$resdev,
                          likelihood="poisson", type="dose"))

      expect_error(pDcalc(obs1=obs1, obs2=obs2, narm=jagsdata[["narm"]], NS=NULL,
                          theta.result=result$BUGSoutput$mean$psi, resdev.result=result$BUGSoutput$mean$resdev,
                          likelihood="poisson", type="dose"))
    }

  })





  test_that(paste("mbnma.update function correctly for:", datanam), {

    result <- mbnma.run(network, fun=demax(), method="common",
                        n.iter=500)

    expect_error(mbnma.update(result, param="test", n.iter=100))

    update <- mbnma.update(result, param="resdev", n.iter=100)
    expect_equal(names(update), c("study", "arm", "mean", "facet", "fupdose", "groupvar"))

    update <- mbnma.update(result, param="theta", n.iter=100)
    expect_equal(names(update), c("study", "arm", "mean", "facet", "fupdose", "groupvar"))

    update <- mbnma.update(result, param="theta", n.iter=100, armdat = FALSE)
    expect_equal(names(update), c("study", "arm", "mean"))

  })

}




})