tests/testthat/test_get.relative.R

In MBNMAdose: Dose-Response MBNMA Models

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


test_that(paste("get.relative functions work correctly"), {

  skip_on_appveyor()
  skip_on_ci()
  skip_on_cran()

  n.iter <- 1000
  pd <- "pv"

  # 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"))

  # alldfs <- list(triptans)
  # datanams <- c("triptans")

  for (dat in seq_along(alldfs)) {

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

    print(datanam)

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


    # Make class data
    df <- dataset

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

    emax <- mbnma.run(network, fun=demax(), method="random", n.iter=n.iter, pd=pd)

    emax2 <- mbnma.run(network, fun=demax(hill=0.2), method="random", n.iter=n.iter, pd=pd)

    bs <- mbnma.run(network, fun=dspline(knots=2), n.iter=n.iter, pd=pd)

    ns <- mbnma.run(network, fun=dspline(knots=c(0.5)), method="random", n.iter=n.iter, pd=pd)

    mult <- dmulti(c(list(dloglin()),
                     list(dspline("bs", knots=2)),
                     list(dspline("ns", knots=0.5)),
                     rep(list(dloglin()), length(network$agents)-3)
    ))
    multifun1 <- mbnma.run(network, fun=mult, n.iter=n.iter, pd=pd)


    mult <- dmulti(
      c(rep(list(dpoly(degree=1)),2),
        rep(list(dspline(knots = 2, type="ns", beta.1=0.2)),1),
        rep(list(dfpoly(degree=2)),length(network$agents)-3)
      ))

    multifun2 <- mbnma.run(network, fun=mult,
                           method="random", n.iter=n.iter, pd=pd)


    test_that(paste("get.relative works correctly for:", datanam), {

      expect_error(get.relative(emax, treatments=list("Placebo"=0, "Badger"=c(5,10))), "are not all named agents in")

      treatments <- list()

      temp <- get.relative(emax, treatments = treatments)
      expect_equal(anyNA(temp$relarray[2,1,]), FALSE)
      expect_equal(round(temp$mean[3,1] - temp$mean[2,1], 1), round(temp$mean[3,2], 1))
      expect_error(rank(temp), NA)

      temp <- get.relative(emax2, treatments=treatments)
      expect_equal(anyNA(temp$relarray[2,1,]), FALSE)
      expect_equal(round(temp$mean[3,1] - temp$mean[2,1], 1), round(temp$mean[3,2], 1))
      expect_error(rank(temp), NA)

      temp <- get.relative(bs, treatments=treatments)
      expect_equal(anyNA(temp$relarray[2,1,]), FALSE)
      expect_equal(round(temp$mean[3,1] - temp$mean[2,1], 1), round(temp$mean[3,2], 1))
      expect_error(rank(temp), NA)

      temp <- get.relative(ns, treatments=treatments)
      expect_equal(anyNA(temp$relarray[2,1,]), FALSE)
      expect_equal(round(temp$mean[3,1] - temp$mean[2,1], 1), round(temp$mean[3,2], 1))
      expect_error(rank(temp), NA)

      temp <- get.relative(multifun1, treatments=treatments)
      expect_equal(anyNA(temp$relarray[2,1,]), FALSE)
      if (!grepl("noplac", datanam)) {
        expect_equal(round(temp$mean[3,1] - temp$mean[2,1], 1), round(temp$mean[3,2], 1))
      }
      expect_error(rank(temp), NA)

      temp <- get.relative(multifun2, treatments=treatments)
      expect_equal(anyNA(temp$relarray[2,1,]), FALSE)
      if (!grepl("noplac", datanam)) {
        expect_equal(round(temp$mean[3,1] - temp$mean[2,1], 1), round(temp$mean[3,2], 1))
      }
      expect_error(rank(temp), NA)

      if (datanam %in% "triptans") {
        temp <- get.relative(ns, treatments=list(Placebo=0, eletriptan=1))
        expect_equal(anyNA(temp$relarray[2,1,]), FALSE)

        temp <- get.relative(ns, treatments=list(Placebo=0, zolmitriptan=10))
        expect_equal(anyNA(temp$relarray[2,1,]), FALSE)

        temp <- get.relative(multifun2, treatments=list(zolmitriptan=1, eletriptan=1))
        expect_equal(anyNA(temp$relarray[2,1,]), FALSE)
      }

      # Check prediction intervals
      # For common effects model
      temp <- get.relative(bs)
      temp2 <- get.relative(bs, lim="pred")
      expect_equal(temp$se[2], temp2$se[2])

      # For random effects model
      temp <- get.relative(ns)
      temp2 <- get.relative(ns, lim="pred")
      expect_gte(temp2$se[2], temp$se[2])

      if (datanam %in% "osteopain") {
        temp <- get.relative(bs, treatments=list("Celebrex"=c(0,100,250,400,500)))
        expect_equal(anyNA(temp$relarray[2,1,]), FALSE)
      }

      # Datasets with logit link
      if (datanam %in% c("triptans", "psoriasis90.noplac", "psoriasis75", "ssri")) {

        # Check eform
        temp <- get.relative(emax, treatments=treatments, eform=TRUE)
        expect_equal(all(temp$relarray>0, na.rm=TRUE), TRUE)

      }
    })

  }

})