context("visualizeResults Functions") library(nbTransmission) #### Testing Network and Heatmap Plots #### nbNetworkWrapper <- function(nbResults, dateVar = "infectionDate", indIDVar = "individualID", pVar = "pScaled", clustMethod = "none", cutoff = NA, blackAndWhite = FALSE, probBreaks = c(-0.01, 0.001, 0.005, 0.01, 0.05, 0.1, 0.25, 0.5, 0.75, 1)){ nbNetwork(nbResults, indIDVar = indIDVar, dateVar = dateVar, pVar = pVar, clustMethod = clustMethod, cutoff = cutoff, blackAndWhite = blackAndWhite, probBreaks = probBreaks) } nbHeatmapWrapper <- function(nbResults, dateVar = "infectionDate", indIDVar = "individualID", pVar = "pScaled", clustMethod = "none", cutoff = NA, blackAndWhite = FALSE, probBreaks = c(-0.01, 0.001, 0.005, 0.01, 0.05, 0.1, 0.25, 0.5, 0.75, 1)){ nbHeatmap(nbResults, indIDVar = indIDVar, dateVar = dateVar, pVar = pVar, clustMethod = clustMethod, cutoff = cutoff, blackAndWhite = blackAndWhite, probBreaks = probBreaks) } #Internal function for both nbNetwork and nbHeatmap createNetworkWrapper <- function(nbResults, dateVar = "infectionDate", indIDVar = "individualID", pVar = "pScaled", clustMethod = "none", cutoff = NA, probBreaks = c(-0.01, 0.001, 0.005, 0.01, 0.05, 0.1, 0.25, 0.5, 0.75, 1)){ createNetwork(nbResults, indIDVar = indIDVar, dateVar = dateVar, pVar = pVar, clustMethod = clustMethod, cutoff = cutoff, probBreaks = probBreaks) } #Shortening dataset for sake of speed testData <- nbResults[1:500, ] test_that("Plot functions return null objects with no errors",{ net1 <- nbNetworkWrapper(testData) net2 <- nbNetworkWrapper(testData, clustMethod = "hc_absolute", cutoff = 0.05) net3 <- nbNetworkWrapper(testData, clustMethod = "hc_absolute", cutoff = 0.05, blackAndWhite = TRUE) expect_true(class(net1) == "NULL") expect_true(class(net2) == "NULL") expect_true(class(net3) == "NULL") heat1 <- nbHeatmapWrapper(testData) heat2 <- nbHeatmapWrapper(testData, clustMethod = "hc_absolute", cutoff = 0.05) heat3 <- nbHeatmapWrapper(testData, clustMethod = "hc_absolute", cutoff = 0.05, blackAndWhite = TRUE) expect_true(class(heat1) == "pheatmap") expect_true(class(heat2) == "pheatmap") expect_true(class(heat3) == "pheatmap") }) test_that("Internal createNetwork function returns igraph object",{ net1 <- createNetworkWrapper(testData) net2 <- createNetworkWrapper(testData, clustMethod = "hc_absolute", cutoff = 0.05) expect_true(class(net1) == "igraph") expect_true(class(net2) == "igraph") }) #Only need to test for the internal function because both nbNetwork and nbHeatmap call it test_that("Descriptive error messages returned from internal createNetwork function",{ expect_error(createNetworkWrapper(testData, indIDVar = "garbage"), "garbage.1 is not in the data frame.") expect_error(createNetworkWrapper(testData, dateVar = "garbage"), "garbage.1 is not in the data frame.") expect_error(createNetworkWrapper(testData, pVar = "garbage"), "garbage is not in the data frame.") #Removing individualID columns testData2 <- testData[!names(testData) %in% c("individualID.1")] expect_error(createNetworkWrapper(testData2, indIDVar = "individualID"), "individualID.1 is not in the data frame.") testData3 <- testData[!names(testData) %in% c("individualID.2")] expect_error(createNetworkWrapper(testData3, indIDVar = "individualID"), "individualID.2 is not in the data frame.") #Removing the date columns testData4 <- testData[!names(testData) %in% c("infectionDate.1")] expect_error(createNetworkWrapper(testData4, dateVar = "infectionDate"), "infectionDate.1 is not in the data frame.") testData5 <- testData[!names(testData) %in% c("infectionDate.2")] expect_error(createNetworkWrapper(testData5, dateVar = "infectionDate"), "infectionDate.2 is not in the data frame.") #Changing dates to character variables testData$infectionDatec.1 <- as.character(testData$infectionDate.1) testData$infectionDatec.2 <- testData$infectionDate.2 expect_error(createNetworkWrapper(testData, dateVar = "infectionDatec"), "infectionDatec.1 must be either a date or a date-time (POSIXt) object.", fixed = TRUE) testData$infectionDatec.1 <- testData$infectionDate.1 testData$infectionDatec.2 <- as.character(testData$infectionDate.2) expect_error(createNetworkWrapper(testData, dateVar = "infectionDatec"), "infectionDatec.2 must be either a date or a date-time (POSIXt) object.", fixed = TRUE) testData5 <- testData[!names(testData) %in% c("infectionDate.2")] expect_error(createNetworkWrapper(testData5, indIDVar = "infectionDate"), "infectionDate.2 is not in the data frame.") #Testing that clustMethod gets set to none and gives warning expect_warning(createNetwork(testData, dateVar = "infectionDate", indIDVar = "individualID", pVar = "pScaled"), "No clustMethod was provided so it was set to 'none'") #Providing an invalid clustering method expect_error(createNetworkWrapper(testData, clustMethod = "garbage"), "clustMethod must be one of: none, n, kd, hc_absolute, hc_relative") #Providing a clust method with no cutoff expect_error(createNetworkWrapper(testData, clustMethod = "hc_absolute"), "Please provide one or more cutoff values") }) #Only need to test for the internal function because both nbNetwork and nbHeatmap call it test_that("Descriptive error messages returned for probBreaks",{ expect_error(createNetworkWrapper(nbResults, probBreaks = c(-0.01, 5, 1)), "All values of probBreaks should be less than 1") expect_error(createNetworkWrapper(nbResults, probBreaks = c(-0.01, 1)), "Please make sure probBreaks has between 3 and 10 elements") expect_error(createNetworkWrapper(nbResults, probBreaks = c(-0.01, seq(0.01, 0.99, 0.01), 1)), "Please make sure probBreaks has between 3 and 10 elements") expect_message(createNetworkWrapper(nbResults, probBreaks = c(0.01, 0.05, 1)), "First element of probBreaks is not negative so -0.01 was added to the beginning") expect_message(createNetworkWrapper(nbResults, probBreaks = c(-0.01, 0.05)), "Last element of probBreaks is not 1 so 1 was added to the end") expect_message(createNetworkWrapper(nbResults, probBreaks = c(0.01, 0.05)), "First element of probBreaks is not negative so -0.01 was added to the beginning") expect_message(createNetworkWrapper(nbResults, probBreaks = c(0.01, 0.05)), "Last element of probBreaks is not 1 so 1 was added to the end") }) #### Testing Rt Plot #### rFinal <- estimateR(nbResults, dateVar = "infectionDate", indIDVar = "individualID", pVar = "pScaled", timeFrame = "months", rangeForAvg = c(10, 150), bootSamples = 2, alpha = 0.05) rFinal2 <- estimateR(nbResults, dateVar = "infectionDate", indIDVar = "individualID", pVar = "pScaled", timeFrame = "days", alpha = 0.05) test_that("Plot functions return null objects with no errors",{ rt1 <- plotRt(rFinal, includeRtAvg = TRUE, includeRtCI = TRUE, includeRtAvgCI = TRUE) rt2 <- plotRt(rFinal, includeRtAvg = TRUE, includeRtCI = TRUE, includeRtAvgCI = FALSE) rt3 <- plotRt(rFinal, includeRtAvg = FALSE, includeRtCI = TRUE, includeRtAvgCI = FALSE) rt4 <- plotRt(rFinal, includeRtAvg = TRUE, includeRtCI = FALSE, includeRtAvgCI = TRUE) rt5 <- plotRt(rFinal, includeRtAvg = TRUE, includeRtCI = FALSE, includeRtAvgCI = FALSE) rt6 <- plotRt(rFinal, includeRtAvg = FALSE, includeRtCI = FALSE, includeRtAvgCI = FALSE) rt7 <- plotRt(rFinal2, includeRtAvg = TRUE) expect_true("ggplot" %in% class(rt1)) expect_true("ggplot" %in% class(rt2)) expect_true("ggplot" %in% class(rt3)) expect_true("ggplot" %in% class(rt4)) expect_true("ggplot" %in% class(rt5)) expect_true("ggplot" %in% class(rt6)) expect_true("ggplot" %in% class(rt7)) }) test_that("Descriptive error messages returned for plotRt", { expect_error(plotRt("garbage"), "The rData argument should be the list output from the function estimateR") expect_error(plotRt(list("garbage")), "The rData argument should be the list output from the function estimateR") expect_error(plotRt(rFinal2, includeRtAvgCI = TRUE), "Please provide a rData list that has confidence intervals") expect_error(plotRt(rFinal2, includeRtCI = TRUE), "Please provide a rData list that has confidence intervals") expect_error(plotRt(rFinal2, includeRtCI = TRUE, includeRtAvgCI = TRUE), "Please provide a rData list that has confidence intervals") })