tests/testthat/test_subjectProfileSummaryPlot-yVar.R

In inTextSummaryTable: Creation of in-Text Summary Table

context("Create a subject profile summary plot with a y variable")

library(ggplot2)
library(plyr)

test_that("The mean data is correctly set", {
			
	summaryTable <- data.frame(
		visit = c(1, 2), 
		statMean1 = rnorm(2)
	)	
	
	gg <- subjectProfileSummaryPlot(
		data = summaryTable, 
		xVar = "visit",
		meanVar = "statMean1"
	)
	expect_s3_class(gg, "ggplot")
	
	# check data is correctly retained
	ggData <- lapply(ggplot_build(gg)$data, `[`, c("x", "y"))
	ggData <- unique(do.call(rbind, ggData))
	expect_identical(
		object = ggData,
		expected = setNames(summaryTable, c("x", "y"))
	)
	
})


test_that("The standard error data is correctly set", {
			
	summaryTable <- data.frame(
		visit = c(1, 2), 
		statMean = rnorm(2),
		statSE = c(1, 2)
	)
			
	gg <- subjectProfileSummaryPlot(
		data = summaryTable, 
		xVar = "visit",
		meanVar = "statMean",
		seVar = "statSE"
	)
			
	expect_s3_class(gg, "ggplot")
			
	# extract data behind the error bars
	isGeomErrorBar <- sapply(gg$layers, function(l) inherits(l$geom, "GeomErrorbar"))
	expect_length(which(isGeomErrorBar), 1)
	
	ggErrorBar <- layer_data(gg, which(isGeomErrorBar))

	expect_identical(
		ggErrorBar[, c("ymin", "ymax")],
		setNames(
			with(summaryTable, cbind.data.frame(statMean-statSE, statMean+statSE)),
			c("ymin", "ymax")
		)
	)
			
})

test_that("The data with the minimum and maximum values are correctly set", {
		
	summaryTable <- data.frame(
		visit = c(1, 2), 
		statMean = c(1, 2),
		statMin = c(0, 1),
		statMax = c(2, 3)
	)		

	gg <- subjectProfileSummaryPlot(
		data = summaryTable, 
		xVar = "visit",
		minVar = "statMin", maxVar = "statMax"
	)
	isGeomErrorBar <- sapply(gg$layers, function(l) inherits(l$geom, "GeomErrorbar"))
	expect_length(which(isGeomErrorBar), 1)
	ggErrorBar <- layer_data(gg, which(isGeomErrorBar))

	expect_identical(
		object = ggErrorBar[, c("ymin", "ymax")],
		expected = setNames(
			summaryTable[, c("statMin", "statMax")],
			c("ymin", "ymax")
		)
	)

})

test_that("A warning is generated if a variable is specified for the minimum value but not for the maximum value", {
			
	summaryTable <- data.frame(
		visit = c(1, 2), 
		statMean = c(1, 2),
		statMin = c(0, 1)
	)
			
	expect_warning(
		gg <- subjectProfileSummaryPlot(
			data = summaryTable, 
			xVar = "visit",
			minVar = "statMin"
		),
		"'minVar' is not used because 'maxVar' is not specified."
	)
	isGeomErrorBar <- sapply(gg$layers, function(l) inherits(l$geom, "GeomErrorbar"))
	expect_length(which(isGeomErrorBar), 0)
	
})

test_that("A warning is generated if a variable is specified for the maximum value but not for the minimum value", {
			
	summaryTable <- data.frame(
		visit = c(1, 2), 
		statMean = c(1, 2),
		statMax = c(2, 3)
	)
			
	expect_warning(
		gg <- subjectProfileSummaryPlot(
			data = summaryTable, 
			xVar = "visit",
			maxVar = "statMax"
		),
		"'maxVar' is not used because 'minVar' is not specified."
	)
	isGeomErrorBar <- sapply(gg$layers, function(l) inherits(l$geom, "GeomErrorbar"))
	expect_length(which(isGeomErrorBar), 0)
	
})
			
test_that("A y-axis transformation is correctly set", {
			
	summaryTable <- data.frame(
		visit = c(1, 2), 
		statMean = rlnorm(2)
	)
			
	gg <- subjectProfileSummaryPlot(
		data = summaryTable, 
		xVar = "visit",
		yTrans = "log10"
	)
	ggDataAll <- do.call(rbind.fill, ggplot_build(gg)$data)
	ggDataAll <- unique(ggDataAll[, c("x", "y")])
	
	ggDataWithInput <- merge(
		x = summaryTable, y = ggDataAll, 
		by.x = "visit",
		by.y = "x",
		all = TRUE
	)	
	with(ggDataWithInput, 
		expect_equal(
			object = y, 
			expected = log10(statMean)
		)
	)		
	
})

test_that("A warning is generated if the y-axis transformation is not set as a character", {
			
	summaryTable <- data.frame(
		visit = c(1, 2), 
		statMean = rlnorm(2)
	)

	expect_warning(
		subjectProfileSummaryPlot(
			data = summaryTable, 
			xVar = "visit",
			yTrans = log
		)
	)
	
})

test_that("A warning is generated if the y-axis transformation is not available", {
	
	summaryTable <- data.frame(
		visit = c(1, 2), 
		statMean = rlnorm(2)
	)	
	
	expect_warning(
		subjectProfileSummaryPlot(
			data = summaryTable, 
			xVar = "visit",
			yTrans = 'sqrt'
		)
	)
	
})

test_that("Negative values are correctly set to a default minimum value with a log10 transformation with a warning", {
		
	summaryTable <- data.frame(
		visit = c(1, 2), 
		statMean = c(1, 2),
		statSE = c(0.5, 3)
	)
	
	expect_warning(
		gg <- subjectProfileSummaryPlot(
			data = summaryTable, 
			xVar = "visit",
			yTrans = "log10"
		),
		"1 negative value\\(s\\) in the error bars"
	)
	
	# extract data behind the error bars
	isGeomEB <- sapply(gg$layers, function(l) inherits(l$geom, "GeomErrorbar"))
	ggDataEB <- layer_data(gg, which(isGeomEB))

	expect_equal(
		object = subset(ggDataEB, x == 2)$ymin, 
		expected = log10(0.5/10)
	)
	
})

test_that("Negative values are correctly set to a specified minimum value with a log10 transformation with a warning", {
			
	summaryTable <- data.frame(
		visit = c(1, 2), 
		statMean = c(1, 2),
		statSE = c(0.5, 3)
	)
	
	## set negative values to lower limit of y if specified
	expect_warning(
		gg <- subjectProfileSummaryPlot(
			data = summaryTable, 
			xVar = "visit",
			yTrans = "log10",
			yLim = c(0.005, 20)
		),
		"1 negative value\\(s\\) in the error bars"
	)
	
	# extract data behind the lines
	isGeomEB <- sapply(gg$layers, function(l) inherits(l$geom, "GeomErrorbar"))
	ggDataEB <- layer_data(gg, which(isGeomEB))
	
	expect_equal(subset(ggDataEB, x == 2)$ymin, log10(0.005))
			
})

test_that("The limits are correctly set for the y-axis", {
			
	summaryTable <- data.frame(
		visit = c(1, 2), 
		statMean = rnorm(2)
	)
	
	yLim <- c(-1, 1)
	gg <- subjectProfileSummaryPlot(
		data = summaryTable, 
		xVar = "visit",
		yLim = yLim
	)
	expect_equal(
		object = ggplot_build(gg)$layout$coord$limits$y, 
		expected = yLim
	)		
	
})

test_that("The y-axis is correctly expanded", {
			
	summaryTable <- data.frame(
		visit = c(1, 2), 
		statMean = rnorm(2)
	)
	
	yAxisExpand <- expansion(mult = 0, add = 2)
	gg <- subjectProfileSummaryPlot(
		data = summaryTable, 
		xVar = "visit",
		yAxisExpand = yAxisExpand
	)
			
	# extract labels from the ggplot object
	ggScales <- gg$scales$scales
	isScaleY <- sapply(ggScales, function(x) 
		"y" %in% x[["aesthetics"]]
	)
	expect_equal(
		object = ggScales[[which(isScaleY)]]$expand, 
		expected = yAxisExpand
	)
			
})

test_that("A warning is generated if the old specification to expand the y-axis is used", {
			
	summaryTable <- data.frame(
		visit = c(1, 2), 
		statMean = rnorm(2)
	)
	yAxisExpand <- expansion(mult = 0, add = 2)
	expect_warning(
		subjectProfileSummaryPlot(
			data = summaryTable, 
			xVar = "visit",
			yLimExpand = yAxisExpand
			),
		"'yLimExpand' is deprecated."
	)
	
})