tests/testthat/test_prepare.functions.R

In MBNMAdose: Dose-Response MBNMA Models

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

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

for (dat in seq_along(alldfs)) {

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

  print(datanam)

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


  df1 <- dataset

  df2 <- df1
  df2$agent <- as.character(df2$agent)
  df2$agent[df2$dose==0] <- network$agents[2]

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

  # df.class <- HF2PPITT
  # df.class$class <- NA
  # df.class$class[df.class$agent %in% c("placebo", "eletriptan")] <- 1
  # df.class$class[is.na(df.class$class)] <- 2

  datalist <- list(df1, df2)


  ################### Testing ################

  testthat::test_that(paste0("mbnma.validate.data functions correctly for: ", datanam), {
    df.err <- dataset
    arm <- df.err[df.err$studyID==df.err$studyID[1],]
    arm <- arm[1,]
    df.err <- df.err[df.err$studyID!=df.err$studyID[1],]
    df.err <- rbind(arm, df.err)
    expect_error(mbnma.validate.data(df.err), regexp = "single study arm")

    df.err <- dataset
    df.err$dose[10] <- -1
    expect_error(mbnma.validate.data(df.err), regexp = "All values for `dose`")

    df.err <- dataset[, !(names(dataset) %in% c("r", "y"))]
    expect_error(mbnma.validate.data(df.err), regexp = "Required variable names are")

    df.err <- dataset
    if ("r" %in% names(df.err)) {
      df.err$r[20] <- NA
    } else if ("y" %in% names(df.err)) {
      df.err$y[20] <- NA
    }
    expect_error(mbnma.validate.data(df.err), regexp = "NA values in:")

    if ("class" %in% names(dataset)) {
      df.err <- dataset
      df.err$class[1] <- 3
      expect_error(mbnma.validate.data(df.err), regexp = "Class codes are different")

      expect_silent(mbnma.validate.data(df.class))
    }

    if ("y" %in% names(dataset)) {
      new.df <- dataset
      new.df$standsd <- 0.5

      expect_silent(mbnma.validate.data(new.df))

      df.err <- new.df
      df.err$standsd[1] <- 2

      expect_error(mbnma.validate.data(df.err), "must be identical within each study")
    }

  })


  test_that(paste0("add_index functions correctly for: ", datanam), {
    df <- dataset

    index <- add_index(df)
    expect_message(add_index(df))

    expect_equal(index[["treatments"]][1], "Placebo_0")
    expect_equal(index[["agents"]][1], "Placebo")

    lvl <- c("treatment", "agent")
    lvls <- c("treatments", "agents")
    if ("class" %in% names(df)) {
      expect_equal(index[["classes"]][1], "Placebo")

      lvl <- append(lvl, "class")
      lvls <- append(lvls, "classes")
    }

    for (i in seq_along(lvls)) {
      expect_equal(length(index[[lvls[i]]]), length(unique(index$data.ab[[lvl[i]]])))
      checkmate::assertNumeric(index$data.ab[[lvl[i]]], lower=1, any.missing = FALSE, finite=TRUE)
    }

  })




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

    if (datanam!="osteopain") {
      expect_message(mbnma.network(df2))
    } else {
      expect_error(mbnma.network(df2), "Class codes are different")
    }

    df.err <- dataset
    arm <- df.err[df.err$studyID==df.err$studyID[1],]
    arm <- arm[1,]
    df.err <- df.err[df.err$studyID!=df.err$studyID[1],]
    df.err <- rbind(arm, df.err)
    expect_error(mbnma.network(df.err), regex="single study arm")

    y <- 5
    expect_error(mbnma.network(y))
  })




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

    for (i in seq_along(datalist)) {

      if (i==2 & datanam!="osteopain") {
        network <- mbnma.network(datalist[[i]])

        expect_error(mbnma.comparisons(network))

        comps <- mbnma.comparisons(network$data.ab)

        expect_equal(names(comps), c("t1", "t2", "nr"))
        checkmate::assertDataFrame(comps, any.missing = FALSE, types="numeric")

        expect_equal(all(comps$t1<=comps$t2), TRUE)
      } else {
        # Created to avoid skips
        expect_equal(5,5)
      }
    }
  })




  test_that(paste0("drop.disconnected functions correctly for: ", datanam), {


    # 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,]

    network <- mbnma.network(df.num)

    expect_warning(plot(network))


    drops <- drop.disconnected(network)
    expect_equal(nrow(df.num) > nrow(drops$data.ab), TRUE)



    # With a complete network
    if (datanam %in% c("triptans", "psoriasis75", "ssri", 2)) {
      df.num <- mbnma.network(df1)$data.ab

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

      expect_warning(plot(network), NA)

      drops <- drop.disconnected(network)
      expect_equal(fullrow, nrow(drops$data.ab))
    }

  })




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

    xlist <- list(c(0:50), c(10,25,89), c(5,10), c(1))
    for (i in seq_along(xlist)) {
      x <- xlist[[i]]
      expect_silent(genspline(x, spline="ns", knots=2, max.dose=max(x)))
      expect_silent(genspline(x, spline="ns", knots=3, max.dose=max(x)))

      knots <- 3
      splines <- genspline(x, spline="ns", knots=knots, max.dose=max(x))
      expect_equal(nrow(splines), length(x))
      expect_equal(ncol(splines), knots+1)

      if (max(x)>10) {
        knots <- c(0.35,0.5,0.1)
        expect_silent(genspline(x, spline="ns", knots=knots, max.dose=10))

        if (length(x)>1) {
          expect_equal(ncol(genspline(x, spline="ns", knots=3, max.dose=10)), length(knots)+1)
        }
      }

      expect_error(genspline(x, spline="ns", knots=5, max.dose=max(x)), "complexity")
      expect_error(genspline(x, spline="ns", knots=c(1,2,3), max.dose=max(x)), "'probs' outside")

      expect_error(genspline(x, spline="badger", knots=3, max.dose=max(x)))

    }



  })


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

    data.ab <- network$data.ab

    expect_error(getjagsdata(data.ab, class=FALSE, fun=demax(), nodesplit = c(1,3)), NA)

    expect_error(getjagsdata(data.ab, fun=dspline(type="ns", knots=c(0.2,0.5), beta.1="common", beta.2 = "rel", beta.3="random")), NA)


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

    expect_error(getjagsdata(data.ab, fun=mult), NA)


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

    expect_error(getjagsdata(data.ab, fun=mult), NA)

    expect_error(getjagsdata(data.ab, class=FALSE, fun=demax(hill=0.5)), NA)

  })

}