test_plot.functions.R
In MBNMAdose: Dose-Response MBNMA Models

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

test_that("plot functions correctly", {

  skip_on_appveyor()
  skip_on_ci()
  skip_on_cran()

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

  # Tested datasets must have at least 5 agents - options are HF2PPIT, psoriasis, 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 <- list(triptans, psoriasis90.noplac, osteopain, gout, psoriasis75, ssri, ssri.noplac)
  datanams <- c("triptans", "psoriasis90.noplac", "osteopain", "gout", "psoriasis75", "ssri", "ssri.noplac")

  for (dat in seq_along(alldfs)) {

      datanam <- datanams[dat]

      network <- mbnma.network(alldfs[[dat]])

      # Models
      linear <- mbnma.run(network, fun=dpoly(), n.iter=n.iter, pd=pd)

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

      if (!grepl("noplac", datanam)) {
        nonparam <- mbnma.run(network, fun=dnonparam(direction = "increasing"), n.iter=n.iter, pd=pd)
      }

      resdev <- mbnma.run(network, fun=dpoly(), parameters.to.save = "resdev", 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)
      ))
      multifun <- mbnma.run(network, fun=mult, n.iter=n.iter, pd=pd)

      modellist <- NULL
      modellist <- list(linear, emax, ns, multifun)

      if ("class" %in% names(alldfs[[dat]])) {
        emax.class <- suppressWarnings(mbnma.run(network, fun=demax(emax="rel", ed50="random"), method="common",
                                                  class.effect=list(emax="random"), n.iter=1000))

        emax.class2 <- suppressWarnings(mbnma.run(network, demax(), method="common",
                                                   class.effect=list(emax="random"), n.iter=1000))

        modellist[[length(modellist)+1]] <- emax.class
      }




      ###################################################
      ################## Run Tests ######################
      ###################################################

      test_that(paste0("plot.mbnma.network functions correctly for:", datanam), {

        if (!(grepl("noplac", datanam) | ("gout" %in% datanam))) {
          expect_silent(plot(network, layout = igraph::as_star(),
                             edge.scale=1, label.distance=0))

          expect_silent(plot(network, layout = igraph::with_fr(),
                             edge.scale=1, label.distance=0))

          expect_silent(plot(network, layout = igraph::in_circle(),
                             edge.scale=0.5, label.distance=10))

          expect_silent(plot(network, layout = igraph::in_circle(),
                             level="agent", remove.loops = TRUE))
        } else {
          expect_warning(plot(network, layout = igraph::as_star(),
                              edge.scale=1, label.distance=0), "not connected")

          expect_warning(plot(network, layout = igraph::with_fr(),
                              edge.scale=1, label.distance=0), "not connected")

          expect_warning(plot(network, layout = igraph::in_circle(),
                              level="agent", remove.loops = TRUE), "not connected")
        }


        g1 <- suppressWarnings(plot(network, level="treatment"))
        g2 <- suppressWarnings(plot(network, level="agent"))

        expect_silent(plot(g1))
        expect_silent(plot(g2))

        expect_equal(length(igraph::V(g1))==length(igraph::V(g2)), FALSE)


        if (grepl("noplac", datanam) | "gout" %in% datanam) {
          expect_warning(plot(network, layout=igraph::as_star(),
                              level="agent"))

          expect_warning(plot(network, layout=igraph::with_fr(),
                              level="agent", doselink = 10))

          expect_message(suppressWarnings(plot(network, layout=igraph::with_fr(),
                                               level="agent", doselink = 10)), "degrees of freedom")

        } else {
          g1 <- plot(network,
                     level="treatment", v.color = "agent")

          expect_equal("Placebo_0" %in% names(igraph::V(g1)), TRUE)
          expect_equal(length(network$treatments), length(igraph::V(g1)))
          expect_equal(length(unique(igraph::V(g1)$color)), length(network$agents))

          expect_error(plot(network, layout=igraph::in_circle(),
                            level="class"))
        }


      })



      testthat::test_that(paste0("plot.mbnma functions correctly for: ", datanam), {
        for (i in seq_along(modellist)) {
          mbnma <- modellist[[i]]
          expect_silent(plot(mbnma))
        }

        if (!grepl("noplac", datanam)) {
          expect_equal("ggplot" %in% class(plot(nonparam)), TRUE)
        }

        # Test number of panels is equal to number of rel effect parameters
        g <- plot(emax)
        expect_equal(length(unique(g$data$doseparam)), 2)

        expect_error(plot(multifun), NA)
        expect_error(plot(ns), NA)

        # params argument
        expect_error(plot(emax, params="rabbit"))
        g <- plot(emax, params = "emax")
        expect_equal(length(unique(g$data$doseparam)), 1)

        # No relative effects saved
        expect_error(plot(resdev), "can be identified from the model")

        if ("class" %in% datanam) {
          g <- plot(emax.class)
          expect_equal(length(unique(g$data$doseparam)), 1)

          # Class labs
          expect_silent(
            plot(emax.class2, agent.labs = netclass$agents, class.labs=netclass$classes))
        }

      })




      testthat::test_that(paste0("plot.mbnma.predict functions correctly for: ", datanam), {
        pred <- predict(linear, E0 = 0.5)
        expect_silent(plot(pred))

        pred <- predict(emax, E0 = "rbeta(n, shape1=1, shape2=5)")
        expect_silent(plot(pred))

        pred <- predict(ns, E0 = "rbeta(n, shape1=1, shape2=5)")
        expect_silent(plot(pred))

        pred <- predict(multifun, E0 = 0.5)
        expect_silent(plot(pred))

        # Test disp.obs

        if (!grepl("noplac", datanam)) {
          expect_message(plot(pred, disp.obs = TRUE))
        } else {
          expect_silent(plot(pred, disp.obs = TRUE))

          doses <- list()
          doses[[network$agents[2]]] <- c(0,1,2,3)
          doses[[network$agents[5]]] <- c(0.5,1,2)
          pred <- predict(emax, E0=0.1, exact.doses = doses)
          expect_message(plot(pred, disp.obs=TRUE), "placebo arms")
        }

        pred <- predict(emax, E0 = 0.5)

        # Test agent.labs
        doses <- list()
        doses[[network$agents[2]]] <- c(0,1,2,3)
        doses[[network$agents[5]]] <- c(0.5,1,2)
        pred <- predict(multifun, E0=0.1, exact.doses = doses)
        g <- plot(pred, agent.labs = c("Badger", "Ferret"))
        expect_identical(levels(g$data$agent), c("Placebo", "Badger", "Ferret"))

        expect_error(plot(pred, agent.labs = c("Badger", "Ferret", "Whippet")))


        # Test overlay.split
        if (!grepl("noplac", datanam)) {
          pred <- predict(linear, E0 = 0.5)
          expect_output(plot(pred, overlay.split = TRUE))

          pred <- predict(emax, E0 = 0.5)
          expect_output(plot(pred, overlay.split = TRUE))

          doses <- list()
          doses[[network$agents[2]]] <- c(0,1,2,3)
          doses[[network$agents[5]]] <- c(0.5,1,2)
          pred <- predict(ns, E0=0.1, exact.doses = doses)
          expect_output(suppressWarnings(plot(pred, overlay.split = TRUE)))

          doses[[network$agents[2]]] <- c(1,2,3)
          doses[[network$agents[5]]] <- c(0.5,1,2)
          pred <- predict(multifun, E0=0.1, exact.doses = doses)
          expect_output(plot(pred, overlay.split = TRUE))


          # Test method="common"
          pred <- predict(ns, E0 = 0.5)
          expect_output(plot(pred, overlay.split = TRUE, method="random"),
                        "SD")

          pred <- predict(emax, E0 = 0.5)
          expect_output(plot(pred, overlay.split = TRUE, method="random"),
                        "SD")

        } else {
          pred <- predict(linear, E0 = 0.5)
          expect_error(plot(pred, overlay.split = TRUE), "Placebo required")

        }

        # Test scales
        pred <- predict(multifun, E0 = "rbeta(n, shape1=1, shape2=5)")
        expect_silent(plot(pred, scales="fixed"))
        expect_error(plot(pred, scales="badger"))

      })



      testthat::test_that(paste0("devplot functions correctly for: ", datanam), {
        expect_message(devplot(emax, dev.type="resdev", plot.type = "scatter", n.iter=100))

        if ("class" %in% datanam) {
          expect_message(devplot(emax.class, dev.type="resdev", plot.type = "box", n.iter=100))
        }

        expect_silent(devplot(resdev, dev.type="resdev", n.iter=100))

        expect_error(devplot(emax, dev.type="dev", n.iter=100))

      })



      testthat::test_that(paste0("fitplot functions correctly for: ", datanam), {

        expect_message(fitplot(emax, disp.obs = TRUE, n.iter=100))

        if ("class" %in% datanam) {
          expect_message(fitplot(emax.class, disp.obs=FALSE, n.iter=100))
        }

        theta.run <- mbnma.run(network, fun=dpoly(degree=1), parameters.to.save = "theta", n.iter=1000)

        if (!grepl("noplac", datanam)) {
          expect_silent(fitplot(theta.run, n.iter=100))
        }

      })


      testthat::test_that(paste0("plot.mbnma.rank functions correctly for: ", datanam), {
        rank <- rank.mbnma(emax)
        g <- plot(rank)
        expect_equal(length(g), 2)

        if (grepl("noplac", datanam)) {
          expect_error(plot(rank, treat.labs = network$agents), NA)
        } else {
          expect_error(plot(rank, treat.labs = network$agents), "same length as the number of ranked")
        }

        if ("class" %in% datanam) {
          rank <- rank.mbnma(emax.class2)
          expect_silent(plot(rank))
        }

        rank <- rank.mbnma(ns)
        g <- plot(rank, params="beta.2")
        expect_equal(length(g), 1)

        rank <- rank(get.relative(multifun))
        expect_error(plot(rank), NA)

      })


      testthat::test_that(paste0("cumrank functions correctly for: ", datanam), {
        rank <- rank.mbnma(emax)
        g <- cumrank(rank)
        expect_equal(names(g), c("cumplot", "sucra"))

        expect_silent(cumrank(rank, params="emax", sucra=FALSE))
        expect_error(cumrank(rank, params="badger", sucra=FALSE))

      })

  }
})