tests/testthat/test-plot.R

In pROC: Display and Analyze ROC Curves

context("plot")

# Tests powered by vdiffr. 
# To update the reference with vdiffr:
# > library(vdiffr)
# > source("tests/testthat.R")
# > manage_cases()

test_that("plot draws correctly", {
	skip_if(getRversion() < "4.1")
	test_basic_plot <- function() plot(r)
	# S100b
	r <- r.s100b
	expect_doppelganger("basic-s100b", test_basic_plot)
	
	r <- r.ndka
	expect_doppelganger("basic-ndka", test_basic_plot)
	
	r <- r.wfns
	expect_doppelganger("basic-wfns", test_basic_plot)
})

test_that("legacy.axis works correctly", {
	skip_if(getRversion() < "4.1")
	r <- r.s100b
	test_legacy.axis_plot <- function() plot(r, legacy.axes=TRUE)
	expect_doppelganger("legacy.axes", test_legacy.axis_plot)
})

test_that("Advanced screenshot 1 works correctly", {
	skip_if(getRversion() < "4.1")
	test_advanced_screenshot_1 <- function() {
		plot(r.s100b.percent,
			 reuse.auc = FALSE, partial.auc=c(100, 90), partial.auc.correct=TRUE, # define a partial AUC (pAUC)
			 print.auc=TRUE, #display pAUC value on the plot with following options:
			 print.auc.pattern="Corrected pAUC (100-90%% SP):\n%.1f%%", print.auc.col="#1c61b6",
			 auc.polygon=TRUE, auc.polygon.col="#1c61b6", # show pAUC as a polygon
			 max.auc.polygon=TRUE, max.auc.polygon.col="#1c61b622", # also show the 100% polygon
			 main="Partial AUC (pAUC)")
		
		plot(r.s100b.percent,
			 reuse.auc = FALSE, partial.auc=c(100, 90), partial.auc.correct=TRUE,
			 partial.auc.focus="se", # focus pAUC on the sensitivity
			 add=TRUE, type="n", # add to plot, but don't re-add the ROC itself (useless)
			 print.auc=TRUE, print.auc.pattern="Corrected pAUC (100-90%% SE):\n%.1f%%", print.auc.col="#008600",
			 print.auc.y=40, # do not print auc over the previous one
			 auc.polygon=TRUE, auc.polygon.col="#008600",
			 max.auc.polygon=TRUE, max.auc.polygon.col="#00860022")
	}
	expect_doppelganger("advanced.screenshot.1", test_advanced_screenshot_1)
})


test_that("Advanced screenshot 2 works correctly", {
	skip_slow()
	skip_if(getRversion() < "4.1")
	test_advanced_screenshot_2 <- function() {
		RNGkind(sample.kind="Rejection")
		set.seed(42) # For reproducible CI
		suppressMessages(rocobj <- plot.roc(aSAH$outcome, aSAH$s100b,
						   main="Confidence intervals", percent=TRUE,
						   ci=TRUE, # compute AUC (of AUC by default)
						   print.auc=TRUE)) # print the AUC (will contain the CI)

		ciobj <- ci.se(rocobj, progress = "none", # CI of sensitivity
					   specificities=seq(0, 100, 5)) # over a select set of specificities

		plot(ciobj, type="shape", col="#1c61b6AA") # plot as a blue shape
		plot(ci(rocobj, of="thresholds", thresholds="best", progress="none")) # add one threshold
	}
	expect_doppelganger("advanced.screenshot.2", test_advanced_screenshot_2)
})


test_that("Advanced screenshot 3 works correctly", {
	skip_if(getRversion() < "4.4.0")
	test_advanced_screenshot_3 <- function() {
		plot(r.s100b.percent, main="Smoothing")
		
		lines(smooth(r.s100b.percent), # smoothing (default: binormal)
			  col = "#1c61b6")
		
		lines(smooth(r.s100b.percent, method = "density"), # density smoothing
			  col = "#008600")
		
		lines(smooth(r.s100b.percent, method = "fitdistr", # fit a distribution
					 density = "lognormal"), # let the distribution be log-normal
			  col = "#840000")
		
		legend("bottomright", legend = c("Empirical", "Binormal", "Density", "Fitdistr\n(Log-normal)"), col = c("black", "#1c61b6", "#008600", "#840000"),lwd = 2)
	}
	expect_doppelganger("advanced.screenshot.3", test_advanced_screenshot_3)
})



test_that("Advanced screenshot 4 works correctly", {
	skip_slow()
	skip_if(getRversion() < "4.1")
	test_advanced_screenshot_4 <- function() {
		RNGkind(sample.kind="Rejection")
		set.seed(42) # For reproducible CI
		suppressMessages(rocobj <- plot.roc(aSAH$outcome, aSAH$s100b,
						   main="Confidence intervals of specificity/sensitivity", percent=TRUE,
						   ci=TRUE, of="se", # ci of sensitivity
						   specificities=seq(0, 100, 5), # on a select set of specificities
						   ci.type="shape", ci.col="#1c61b6AA", # plot the CI as a blue shape
						   progress = "none")) # hide progress bar
		
		plot(ci.sp(rocobj, sensitivities=seq(0, 100, 5), progress = "none"), # ci of specificity
			 type="bars") # print this one as bars
	}
	expect_doppelganger("advanced.screenshot.4", test_advanced_screenshot_4)
})



test_that("Advanced screenshot 5 works correctly", {
	skip_slow()
	skip_if(getRversion() < "4.1")
	test_advanced_screenshot_5 <- function() {
		RNGkind(sample.kind="Rejection")
		set.seed(42) # For reproducible CI
		suppressMessages(plot.roc(aSAH$outcome, aSAH$s100b,
				 main="Confidence interval of a threshold", percent=TRUE,
				 ci=TRUE, of="thresholds", # compute AUC (of threshold)
				 thresholds="best", # select the (best) threshold
				 print.thres="best", # also highlight this threshold on the plot
				 progress = "none")) # hide progress bar
	}
	expect_doppelganger("advanced.screenshot.5", test_advanced_screenshot_5)
})


test_that("Advanced screenshot 6 works correctly", {
	skip_if(getRversion() < "4.1")
	test_advanced_screenshot_6 <- function() {
		plot(r.s100b.percent, main="Statistical comparison", col="#1c61b6")
		lines(r.ndka.percent, col="#008600")
		testobj <- roc.test(r.s100b.percent, r.ndka.percent)
		text(50, 50, labels=paste("p-value =", format.pval(testobj$p.value)), adj=c(0, .5))
		legend("bottomright", legend=c("S100B", "NDKA"), col=c("#1c61b6", "#008600"), lwd=2)
	}
	expect_doppelganger("advanced.screenshot.6", test_advanced_screenshot_6)
})


test_that("plot and lines work with formula and subset", {
	skip_if(getRversion() < "4.1")
	test_plot_formula <- function() {
		suppressMessages(plot.roc(outcome ~ ndka, data = aSAH, subset = gender == "Female", col="red"))
		suppressMessages(lines.roc(outcome ~ ndka, data = aSAH))
		suppressMessages(lines.roc(outcome ~ ndka, data = aSAH, subset = gender == "Male", col="blue"))
	}
	expect_doppelganger("plot_formula", test_plot_formula)
})