tests/testthat/test-nonlinComb.R

data("exampleData1")
Data <- exampleData1[-c(83:138), ]
markers <- Data[, -1]
status <- factor(Data$group, levels = c("not_needed", "needed"))

load("result_data/mayo.rda")
Data2 <- mayo[-c(42:119), ]
markers2 <- Data2[, 3:4]
status2 <- factor(Data2[, 2], levels = c(1, 0))

Data3 <-
  read.csv(
    "result_data/wdbc.data.txt",
    header = FALSE
  )
Data3 <- Data3[-c(121:262), ]
markers3 <- Data3[, 4:5]
status3 <- factor(Data3[, 2], levels = c("B", "M"))

###############################################################################

load("result_data/test_nonlinComb.rda")

for (method in c(
  "polyreg",
  "ridgereg"
)) {
  set.seed(14042022)
  res <- nonlinComb(
    markers = markers,
    status = status,
    event = "needed",
    method = method,
    resample = "none",
    direction = "<",
    cutoff.method = "Youden"
  )

  test_that("nonlinComb functions ...", {
    expect_length(res, 15)
    expect_equal(as.numeric(res$AUC_table$AUC[[3]]), r$AUC[r$Method == method][1],
      tolerance =
        0.01
    )
    expect_equal(as.numeric(res$DiagStatCombined$detail[4, 2]),
      r$SPE[r$Method == method][1],
      tolerance = 0.01
    )
    expect_equal(as.numeric(res$DiagStatCombined$detail[3, 2]),
      r$SENS[r$Method == method][1],
      tolerance = 0.01
    )
    expect_equal(as.numeric(res$ThresholdCombined), r$Cutoff[r$Method == method][1],
      tolerance =
        0.01
    )
  })
}

###############################################################################

for (method in c(
  "lassoreg",
  "elasticreg"
)) {
  set.seed(14042022)
  res <- nonlinComb(
    markers = markers2,
    status = status2,
    event = "1",
    method = method,
    resample = "none",
    direction = "<",
    cutoff.method = "Youden"
  )

  test_that("nonlinComb functions ...", {
    expect_length(res, 15)
    expect_equal(as.numeric(res$AUC_table$AUC[[3]]), r$AUC[r$Method == method][1],
      tolerance =
        0.01
    )
    expect_equal(as.numeric(res$DiagStatCombined$detail[4, 2]),
      r$SPE[r$Method == method][1],
      tolerance = 0.01
    )
    expect_equal(as.numeric(res$DiagStatCombined$detail[3, 2]),
      r$SENS[r$Method == method][1],
      tolerance = 0.01
    )
    expect_equal(as.numeric(res$ThresholdCombined), r$Cutoff[r$Method == method][1],
      tolerance =
        0.01
    )
  })
}

###############################################################################

for (method in c(
  "splines",
  "sgam",
  "nsgam"
)) {
  set.seed(14042022)
  res <- nonlinComb(
    markers = markers3,
    status = status3,
    event = "M",
    method = method,
    resample = "none",
    direction = "<",
    cutoff.method = "Youden"
  )

  test_that("nonlinComb functions ...", {
    expect_length(res, 15)
    expect_equal(as.numeric(res$AUC_table$AUC[[3]]), r$AUC[r$Method == method][1],
      tolerance =
        0.01
    )
    expect_equal(as.numeric(res$DiagStatCombined$detail[4, 2]),
      r$SPE[r$Method == method][1],
      tolerance = 0.01
    )
    expect_equal(as.numeric(res$DiagStatCombined$detail[3, 2]),
      r$SENS[r$Method == method][1],
      tolerance = 0.01
    )
    expect_equal(as.numeric(res$ThresholdCombined), r$Cutoff[r$Method == method][1],
      tolerance =
        0.01
    )
  })
}

###############################################################################

status4 <- factor(Data3[, 2], levels = c("B", "M", "C"))
status4[[9]] <- "C"

test_that("nonlinComb functions ...", {
  expect_error(
    nonlinComb(
      markers = Data3[, 4:5],
      status = status4,
      event = "M",
      method = "polyreg",
      direction = direction,
      standardize = "zScore",
      cutoff.method = cutoff.method
    ),
    "the number of status levels should be 2"
  )

  expect_error(
    nonlinComb(
      markers = Data3[, 4:6],
      status = status3,
      event = "M",
      method = "ridgereg",
      direction = direction,
      standardize = "zScore",
      cutoff.method = cutoff.method
    ),
    "the number of markers should be 2"
  )
})

test_that("nonlinComb functions ...", {
  expect_error(
    nonlinComb(
      markers = markers3,
      status = status3,
      event = "M",
      direction = "<",
      standardize = "none",
      cutoff.method = "Youden"
    ),
    "method should be one of 'polyreg', 'ridgereg', 'lassoreg', 'elasticreg', 'splines', 'sgam', 'nsgam'"
  )

  expect_error(
    nonlinComb(
      markers = markers3,
      status = status3,
      event = "M",
      method = "asaddsa",
      direction = "auto",
      standardize = "none",
      cutoff.method = "Youden"
    ),
    "method should be one of 'polyreg', 'ridgereg', 'lassoreg', 'elasticreg', 'splines', 'sgam', 'nsgam'"
  )

  expect_error(
    nonlinComb(
      markers = markers3,
      status = status3,
      event = "M",
      method = "ridgereg",
      direction = "auto",
      resample = "cv",
      standardize = "asdada",
      cutoff.method = "Youden"
    ),
    "standardize should be one of 'range', 'zScore', 'tScore', 'mean', 'deviance'"
  )

  expect_error(
    nonlinComb(
      markers = markers2,
      status = status2,
      event = "1",
      method = "ridgereg",
      direction = "asdada",
      standardize = "none",
      cutoff.method = "Youden"
    ),
    "direction should be one of 'auto', '<', '>'"
  )

  expect_error(
    nonlinComb(
      markers = markers2,
      status = status2,
      event = "1",
      method = "lassoreg",
      direction = "auto",
      standardize = "tScore",
      cutoff.method = "sadda"
    ),
    "The entered cutoff.method is invalid"
  )
  expect_error(
    nonlinComb(
      markers = markers2,
      status = status2,
      event = "1",
      method = "splines",
      resample = "sada",
      standardize = "range",
      direction = "<",
      cutoff.method = "Youden"
    ),
    "resample should be one of 'none', 'cv', 'repeatedcv', 'boot'"
  )
})

###############################################################################

markers3[44, 1:2] <- "assay"

test_that("nonlinComb functions ...", {
  expect_error(
    nonlinComb(
      markers = markers3,
      status = status3,
      event = "M",
      method = "ridgereg",
      direction = "<",
      standardize = "zScore",
      cutoff.method = "Youden"
    ),
    "at least one variable is not numeric"
  )
  expect_error(
    nonlinComb(
      markers = markers,
      status = status,
      event = "C",
      method = "ridgereg",
      direction = "<",
      standardize = "zScore",
      cutoff.method = "Youden"
    ),
    "status does not include event"
  )
})

###############################################################################

markers3 <- Data3[, 4:5]
status3[[12]] <- NA

test_that("nonlinComb functions ...", {
  expect_warning(
    nonlinComb(
      markers = markers3,
      status = status3,
      event = "M",
      method = "ridgereg",
      direction = "<",
      standardize = "zScore",
      cutoff.method = "Youden"
    ),
    "Rows with NA removed from the dataset since status include NA"
  )
})

markers3[44, 1:2] <- NA
status3 <- factor(Data3[, 2], levels = c("B", "M"))

test_that("nonlinComb functions ...", {
  expect_warning(
    nonlinComb(
      markers = markers3,
      status = status3,
      event = "M",
      method = "ridgereg",
      direction = "<",
      standardize = "zScore",
      cutoff.method = "Youden"
    ),
    "Rows with NA removed from the dataset since markers include NA"
  )
})

Try the dtComb package in your browser

Any scripts or data that you put into this service are public.

dtComb documentation built on June 24, 2024, 5:15 p.m.