tests/testthat/test_subjectProfileSummaryPlot-xVar.R

In inTextSummaryTable: Creation of in-Text Summary Table

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

library(ggplot2)
library(plyr)

test_that("A plot is correctly created with a continuous x variable", {
			
	summaryTable <- data.frame(
		visit = c(1, 2), 
		statMean = rnorm(2)
	)
			
	gg <- subjectProfileSummaryPlot(
		data = summaryTable, 
		xVar = "visit"
	)
	
	ggData <- ggplot_build(gg)$data
	
	# combine across layers
	ggDataAll <- do.call(plyr::rbind.fill, ggData)
	ggDataAll <- unique(ggDataAll[, c("x", "y")])
	
	expect_equal(
		object = ggDataAll, 
		expected = summaryTable, 
		check.attributes = FALSE
	)
	
})

test_that("A plot is successfully created with a continuous x variable with only one element", {
			
	expect_s3_class(
		subjectProfileSummaryPlot(
			data = data.frame(
				visit = 1, 
				statMean = rnorm(1)
			), 
			xVar = "visit"
		),
		"ggplot"
	)
			
})

test_that("A plot is correctly created with a discrete x variable", {
			
	summaryTable <- data.frame(
		visit = factor(c("B", "A")), 
		statMean = rnorm(2)
	)
			
	gg <- subjectProfileSummaryPlot(
		data = summaryTable, 
		xVar = "visit"
	)
			
	ggData <- ggplot_build(gg)$data
			
	# combine across layers
	ggDataAll <- do.call(plyr::rbind.fill, ggData)
	ggDataAll <- unique(ggDataAll[, c("x", "y")])
			
	summaryTable$visitN <- as.numeric(summaryTable$visit)
	summaryTable <- summaryTable[order(summaryTable$visitN), ]
	ggDataAll$x <- as.numeric(ggDataAll$x) # x is also of type: 'mapped_discrete'
	expect_equal(
		object = ggDataAll, 
		expected = summaryTable[, c("visitN", "statMean")], 
		check.attributes = FALSE
	)
		
})

test_that("The x-axis labels are correctly set", {
			
	summaryTable <- data.frame(
		visit = c(1, 2), 
		statMean = rnorm(2)
	)
	xAxisLabs <- c("Visit 1" = 2, "Baseline" = 1)
	
	gg <- subjectProfileSummaryPlot(
		data = summaryTable, 
		xVar = "visit",
		xAxisLabs = xAxisLabs
	)
	
	# extract labels from the ggplot object
	ggScales <- gg$scales$scales
	isScaleX <- sapply(ggScales, function(x) 
		"x" %in% x[["aesthetics"]]
	)
	ggScaleX <- gg$scales$scales[[which(isScaleX)]]
	ggXAxisLabs <- setNames(ggScaleX$breaks, ggScaleX$labels)
	expect_equal(
		object = ggXAxisLabs, 
		expected = xAxisLabs
	)
	
})

test_that("A x-axis gap is correctly set", {

	summaryTable <- data.frame(
		visit = c(1, 2, 3), 
		statMean = rnorm(3)
	)
	xGap <- c(1, 3)
	gg <- subjectProfileSummaryPlot(
		data = summaryTable,
		xVar = "visit", xGap = xGap
	)
	ggData <- ggplot_build(gg)$data
	
	# a '//' symbol is included in the x-axis
	idxLabel <- which(
		sapply(ggData, function(x) 
			"label" %in% colnames(x) && x$label == "//")
	)
	expect_length(idxLabel, 1)
	expect_equal(ggData[[idxLabel]]$x, 2)
	expect_equal(ggData[[idxLabel]]$y, -Inf)
	
	# vertical lines are included
	idxVLine <- which(
		sapply(ggData, function(x) 
			"xintercept" %in% colnames(x)
		)
	)
	expect_length(idxVLine, 1)
	expect_equal(ggData[[idxVLine]]$xintercept, xGap)
	
	# check that data is correctly filtered:
	ggDataPlot <- ggData[-c(idxVLine, idxLabel)]
	ggDataPlot <- lapply(ggDataPlot, `[`, c("x", "y"))
	ggDataPlot <- unique(do.call(rbind, ggDataPlot))
	expect_equal(
		object = ggDataPlot,
		expected = setNames(summaryTable[-2, ], c("x", "y")),
		check.attributes = FALSE
	)
	
})

test_that("A warning is generated if a gap is requested for the x-axis but the x variable is not continuous", {

	summaryTable <- data.frame(
		visit = c("1", "2"), 
		statMean = rnorm(2)
	)			
	
	expect_warning(
		subjectProfileSummaryPlot(
			data = summaryTable,
			xVar = "visit",
			xGap = c(1, 2)
		),
		"'xGap' should only be specified for continuous x-variable"
	)
	
})

test_that("A warning is generated if a gap is requested for the x-axis but the x variable is not specified", {

	summaryTable <- data.frame(
		visit = c("1", "2"), 
		statMean = rnorm(2)
	)
	expect_warning(
		subjectProfileSummaryPlot(
			data = summaryTable,
			colorVar = "visit",
			xGap = c(1, 2)
		),
		"'xGap' should only be specified if 'xVar' is specified"
	)		

})

test_that("A warning is generated if a x-axis gap is not of length 2", {

	summaryTable <-  data.frame(
		visit = c(1, 2), 
		statMean = rnorm(2)
	)
	expect_warning(
		subjectProfileSummaryPlot(
			data = summaryTable,
			xVar = "visit",
			xGap = 1
		),
		"'xGap' should be of length 2"
	)	

})

test_that("The range of the x-axis gap is correctly set to a specified value", {
	
	summaryTable <- data.frame(
		visit = c(1, 2, 3), 
		statMean = rnorm(3)
	)
	xGap <- c(1, 2)
	gg <- subjectProfileSummaryPlot(
		data = summaryTable,
		xVar = "visit", 
		xGap = xGap, xGapDiffNew = 0.5
	)
	ggData <- ggplot_build(gg)$data
	
	# a '//' symbol is included in the x-axis
	idxLabel <- which(
		sapply(ggData, function(x) 
			"label" %in% colnames(x) && x$label == "//")
	)
	expect_length(idxLabel, 1)
	expect_equal(ggData[[idxLabel]]$x, 1.25)
	
	# check that data is correctly filtered:
	ggDataPlot <- ggData[-c(idxLabel)]
	ggDataX <- lapply(ggDataPlot, function(x){
		if("x" %in% colnames(x))
			x[, c("x")]
	})
	ggDataX <- unique(unlist(ggDataX))
	expect_equal(
		object = ggDataX,
		expected = c(1, 1.5, 2.5)
	)
	
})
		
test_that("A jitter is correctly set for the x-axis ", {
		
	summaryTable <- data.frame(
		visit = c(1, 1, 2, 2), 
		TRT = c("A", "B", "A", "B"),
		statMean = rnorm(4)
	)
		
	jitter <- 1
	gg <- subjectProfileSummaryPlot(
		data = summaryTable,
		xVar = "visit", 
		colorVar = "TRT",
		jitter = jitter
	)
		
	ggDataAll <- do.call(plyr::rbind.fill, ggplot_build(gg)$data)
	ggXJitter <- unique(with(ggDataAll, xmax-xmin)*2)
	expect_equal(
		object = ggXJitter, 
		expected = jitter
	)
		
})
		
test_that("The limits are correctly set for the x-axis", {
	
	summaryTable <- data.frame(
		visit = c(1, 2), 
		statMean = rnorm(2)
	)
	
	xLim <- c(1, 10)
	gg <- subjectProfileSummaryPlot(
		data = summaryTable, 
		xVar = "visit",
		xLim = xLim
	)
	expect_equal(
		object = ggplot_build(gg)$layout$coord$limits$x, 
		expected = xLim
	)		
	
})

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