Nothing
tests/testthat/test_scatterplotClinData.R
In clinDataReview: Clinical Data Review Tool
context("Visualize clinical data with a scatterplot")
library(plotly)
library(grDevices)
test_that("A scatterplot is correctly created", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTRESNBL = c(10, 12, 13, 14, 9),
stringsAsFactors = FALSE
)
pl <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL",
xLab = "Actual value at baseline",
yVar = "LBSTRESN",
yLab = "Actual value at visit X",
aesPointVar = list(
color = "USUBJID", fill = "USUBJID",
group = "USUBJID", stroke = "USUBJID",
shape = "USUBJID",
alpha = "LBSTRESNBL", size = "LBSTRESNBL"
),
aesLineVar = c(
list(
group = "USUBJID", #color = "USUBJID",
alpha = "LBSTRESNBL",
linetype = "USUBJID"
),
setNames(
list("LBSTRESNBL"),
ifelse(packageVersion("ggplot2") >= "3.4.0", "linewidth", "size")
)
),
idVar = "USUBJID"
)
## check input == output data
# extract input data
cols <- c("LBSTRESNBL", "LBSTRESN", "USUBJID")
dataPointLine <- data[, cols]
dataPointLine <- dataPointLine[do.call(order, dataPointLine), ]
dataPointLine <- subset(dataPointLine, ! is.na(LBSTRESNBL))
# check data points
plData <- plotly_build(pl)$x$data
plDataPointsAll <- plData[sapply(plData, function(x)
(x$mode == "markers" & !is.null(x$set)))]
plDataPoints <- lapply(plDataPointsAll, function(x)
data.frame(
x = as.numeric(x$x),
y = as.numeric(x$y),
key = as.character(x$key),
stringsAsFactors = FALSE
)
)
plDataPoints <- setNames(do.call(rbind, plDataPoints), cols)
plDataPoints <- plDataPoints[do.call(order, plDataPoints), ]
expect_equal(
object = plDataPoints,
expected = dataPointLine,
check.attributes = FALSE
)# all equal, no attributes
# check data lines
plDataLinesAll <- plData[sapply(plData, function(x) (x$mode == "lines" & !is.null(x$set)))]
plDataLines <- lapply(plDataLinesAll, function(x)
data.frame(
x = as.numeric(x$x),
y = as.numeric(x$y),
legend = sub("^\\(([^,]*).+", "\\1", x$legendgroup),
stringsAsFactors = FALSE
)
)
plDataLines <- setNames(do.call(rbind, plDataLines), cols)
plDataLines <- plDataLines[do.call(order, plDataLines), ]
expect_equal(
object = plDataLines,
expected = dataPointLine,
check.attributes = FALSE
)# all equal, no attributes
})
test_that('Point parameters are set correctly in a scatterplot', {
pl <- scatterplotClinData(
data = exampleDataScatter(),
xVar = "time", yVar = "response",
pointPars = list( color = 'red'),
idVar = "subj"
)
plData <- plotly_build(pl)$x$data
plmarkerData <- plData[[
which(
sapply(plData, function(x){
x$mode == 'markers'} )
)
]]
# test color parameter correclty
colorRGB <- sub("^rgba\\((\\d{1,},\\d{1,},\\d{1,}),.+", "\\1\\2\\3", plmarkerData$marker$line$color)
expect_setequal(
object = colorRGB,
expected = paste(grDevices::col2rgb('red'), collapse =",")
)
})
test_that("Point parameters with 'colour' (UK English spelling) are set correctly in a scatterplot", {
expect_silent(
pl <- scatterplotClinData(
data = exampleDataScatter(),
xVar = "time", yVar = "response",
pointPars = list(colour = 'red'),
idVar = "subj"
)
)
plData <- plotly_build(pl)$x$data
plmarkerData <- plData[[which(sapply(plData, function(x){x$mode == 'markers'}))]]
colorRGB <- sub("^rgba\\((\\d{1,},\\d{1,},\\d{1,}),.+", "\\1\\2\\3", plmarkerData$marker$line$color)
expect_equal(
object = colorRGB,
expected = paste(grDevices::col2rgb('red'), collapse = ",")
)
})
test_that('Line parameters are set correctly in a scatterplot', {
pl <- scatterplotClinData(
data = exampleDataScatter(),
xVar = "time", yVar = "response",
aesPointVar = list(color = "treat"),
aesLineVar = list(group = 'subj'),
linePars = list(linetype='dotted'),
idVar = "subj"
)
plData <- plotly_build(pl)$x$data
pllineData <- plData[[
which(
sapply(plData, function(x){
x$mode == 'lines'} )
)
]]
expect_equal(pllineData$line$dash , 'dot')
})
test_that("Smoothing variables are set correctly in a scatterplot", {
exampleData <- exampleDataScatter()
plSmoothLayer <- scatterplotClinData(
data = exampleData,
xVar = "time", yVar = "response",
aesSmoothVar = list(group = 'subj'),
idVar = "subj",
smoothPars = list(se=FALSE)
)
plSmoothData <- plotly_build(plSmoothLayer)$x$data
plNoSmooth <- scatterplotClinData(
data = exampleData,
xVar = "time", yVar = "response",
idVar = "subj")
plNoSmoothData <- plotly_build(plNoSmooth)$x$data
# test smoothing line added for each subject
lineData <- plSmoothData[[which(sapply(plSmoothData, `[[`, "mode") == "lines")]]
lineKeys <- unique(unlist(lineData$key))
lineKeys <- lineKeys[!is.na(lineKeys)]
expect_equal(
object = lineKeys,
expected = unique(exampleData$subj)
)
})
test_that("Smoothing parameters are set correctly in a scatterplot", {
exampleData <- exampleDataScatter()
plSmoothLayer <- scatterplotClinData(
data = exampleData,
xVar = "time", yVar = "response",
pointPars = list( color = 'red'),
aesLineVar = list(group = 'subj'),
linePars = list(linetype='dotted'),
aesSmoothVar = list(group = 'subj'),
smoothPars = list(color = 'green', se=TRUE) ,
idVar = "subj")
plSmoothData <- plotly_build(plSmoothLayer)$x$data
# no standard error means one plotting layer less
plSmoothNoSE <- scatterplotClinData(
data = exampleData,
xVar = "time", yVar = "response",
pointPars = list( color = 'red'),
aesLineVar = list(group = 'subj'),
linePars = list(linetype='dotted'),
aesSmoothVar = list(group = 'subj'),
smoothPars = list(color = 'green', se=FALSE),
idVar = "subj"
)
plSmoothNoSEData <- plotly_build(plSmoothNoSE)$x$data
# test that error band parameters added
expect_gt(
length(plSmoothData),
length(plSmoothNoSEData)
)
# test that color in smoothing curves is set correctly
isLine <- sapply(plSmoothNoSEData, `[[`, "mode") == "lines"
colors <- sapply(plSmoothNoSEData[isLine], function(x) x$line$color)
colorsRGB <- sub("^rgba\\((\\d{1,},\\d{1,},\\d{1,}),.+", "\\1\\2\\3", colors)[-1]
expect_setequal(
object = colorsRGB,
expected = paste(grDevices::col2rgb('green'), collapse =",")
)
}
)
test_that("Smoothing layer can be disabled in scatterplot", {
exampleData <- exampleDataScatter()
plWithSmoothLayer <- scatterplotClinData(
data = exampleData,
xVar = "time", yVar = "response",
pointPars = list( color = 'red'),
aesLineVar = list(group = 'subj'),
linePars = list(linetype='dotted'),
aesSmoothVar = list(group = 'subj'),
smoothPars = list(color = 'green', se=TRUE),
smoothInclude = TRUE,
idVar = "subj"
)
dataWithSmooth <- plotly_build(plWithSmoothLayer)$x$data
plNoSmoothLayer <- scatterplotClinData(
data = exampleData,
xVar = "time", yVar = "response",
pointPars = list( color = 'red'),
aesLineVar = list(group = 'subj'),
linePars = list(linetype='dotted'),
aesSmoothVar = list(group = 'subj'),
smoothPars = list(color = 'green', se=TRUE),
smoothInclude = FALSE,
idVar = "subj"
)
dataNoSmooth <- plotly_build(plNoSmoothLayer)$x$data
# test that smoothing layer not included when smoothInclude = FALSE
expect_equal(
length(dataWithSmooth),
length(dataNoSmooth) + 2 # one layer for smooth, 1 for se
)
}
)
test_that("Reference lines are correctly implemented in a scatterplot", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTRESNBL = c(10, 12, 13, 14, 9),
LBSTNRLO = 0,
LBSTNRHI = 50,
VISIT = c("Screening 1", "Screening 1", "Screening 1", "Week 1", "Week 1")
)
xLine <- mean(data$LBSTRESNBL)
yLine <- mean(data$LBSTRESN)
pl <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL", yVar = "LBSTRESN",
aesPointVar = list(color = "USUBJID"),
aesLineVar = list(group = "USUBJID", color = "USUBJID"),
facetPars = list(facets = "VISIT"),
refLinePars = list(
# fixed values, no labels
list(slope = 1, intercept = 0, linetype = 1, color = "black", label = FALSE),
list(xintercept = xLine),
list(yintercept = yLine),
list(slope = 1, intercept = 0, linetype = 1, color = "black", label = FALSE),
# from aesthetic
# default label
list(xintercept = "LBSTNRLO", linetype = 2, color = "orange", alpha = 0.5),
# custom label:
list(yintercept = "LBSTNRHI", linetype = 2, color = "orange", label = "Reference Range Upper Limit"),
# combined
list(slope = 1, intercept = "LBSTNRLO")
)
)
## check input == output data
# extract input values for reference lines
dataRefLines <- unique(data[, c("VISIT", "LBSTNRLO", "LBSTNRHI")])
# extract reference lines from output object
plData <- plotly_build(pl)$x$data
plDataRefLines <- plData[sapply(plData, function(x)
(x$mode == "lines" & is.null(x$set)))]
# check if lines are in the plot
# ideally we should also check if they are in the correct facet
# but the mapping facet <-> line doesn't seem to be easily extracted from the plotly_build output
isRefLineXInPlot <- all(c(dataRefLines$LBSTNRLO, xLine) %in%
unlist(lapply(plDataRefLines, function(x) x$x)))
expect_true(isRefLineXInPlot, info = "All specified horizontal lines are plotted.")
isRefLineYInPlot <- all(c(dataRefLines$LBSTNRHI, yLine) %in%
unlist(lapply(plDataRefLines, function(x) x$y)))
expect_true(isRefLineYInPlot, info = "All specified vertical lines are plotted.")
})
test_that("Reference lines as numeric with x-variable as character are successfully set in a scatterplot", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTNRLO = 0,
LBSTNRHI = 50,
VISIT = c("Screening 1", "Screening 1", "Screening 1", "Week 1", "Week 1"),
stringsAsFactors = FALSE
)
expect_error(
pl <- scatterplotClinData(
data = data,
xVar = "VISIT", yVar = "LBSTRESN",
refLinePars = list(
# from aesthetic
list(yintercept = "LBSTNRLO"),
# custom label:
list(yintercept = "LBSTNRHI")
)
),
NA
)
# check reference lines
plData <- plotly::plotly_build(pl)$x$data
plDataRefLines <- plData[sapply(plData, function(x)
(x$mode == "lines" & is.null(x$set)))]
plDataRefLinesY <- unlist(lapply(plDataRefLines, `[[`, "y"))
expect_setequal(object = plDataRefLinesY, expected = c(0, 50))
# check x-axis
plDataPoints <- plData[sapply(plData, function(x)
(x$mode == "markers" & !is.null(x$set)))]
plDataPointsX <- unlist(lapply(plDataPoints, `[[`, "x"))
expect_setequal(object = plDataPointsX, expected = c(1, 2))
})
test_that("Reference lines as numeric with x-variable as factor are successfully set in a scatterplot", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTNRLO = 0,
LBSTNRHI = 50,
VISIT = c("Screening 1", "Screening 1", "Screening 1", "Week 1", "Week 1"),
stringsAsFactors = TRUE
)
expect_error(
pl <- scatterplotClinData(
data = data,
xVar = "VISIT", yVar = "LBSTRESN",
refLinePars = list(
# from aesthetic
list(yintercept = "LBSTNRLO"),
# custom label:
list(yintercept = "LBSTNRHI")
)
),
NA
)
# check reference lines
plData <- plotly::plotly_build(pl)$x$data
plDataRefLines <- plData[sapply(plData, function(x)
(x$mode == "lines" & is.null(x$set)))]
plDataRefLinesY <- unlist(lapply(plDataRefLines, `[[`, "y"))
expect_setequal(object = plDataRefLinesY, expected = c(0, 50))
# check x-axis
plDataPoints <- plData[sapply(plData, function(x)
(x$mode == "markers" & !is.null(x$set)))]
plDataPointsX <- unlist(lapply(plDataPoints, `[[`, "x"))
expect_setequal(object = plDataPointsX, expected = c(1, 2))
})
test_that("Axis labels and title are correctly set in a scatterplot", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTRESNBL = c(10, 12, 13, 14, 9)
)
labelVars <- c(
LBSTRESN = "Actual value",
LBSTRESNBL = "Actual value at baseline"
)
xLab <- paste("Baseline", labelVars["LBSTRESN"])
title <- "Actual value of lab parameter at each visit vs baseline"
pl <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL", yVar = "LBSTRESN",
xLab = xLab, # custom label
labelVars = labelVars,
title = title
)
## check input == output data
# extract labels from output object
yLab <- labelVars["LBSTRESN"]
plLayout <- plotly_build(pl)$x$layout
plLayoutAnnot <- plLayout$annotations
# title
expect_equal(
object = plLayout$title$text,
expected = title,
check.attributes = FALSE
)
# axes labels
expect_equal(
object = pl$x$layout$xaxis$title$text,
expected = xLab,
check.attributes = FALSE
)
expect_equal(
object = pl$x$layout$yaxis$title$text,
expected = unname(yLab),
check.attributes = FALSE
)
})
test_that("Axis variable(s) are correctly included in a scatterplot", {
data <- data.frame(
LBSTRESNBL = c(10, 12, 13, 14, 9),
LBSTRESNBLU = factor("g/L"),
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTRESU = factor(rep(x = c("mg/mL", "mg/L"), times = c(3, 2))),
stringsAsFactors = FALSE
)
pl <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL", xLabVar = "LBSTRESNBLU",
yVar = "LBSTRESN", yLabVar = "LBSTRESU",
labelVars = c(
LBSTRESNBL = "Actual value at baseline",
LBSTRESNBLU = "Baseline Standard Unit",
LBSTRESN = "Actual value at visit X",
LBSTRESU = "Standard Unit"
)
)
plLayout <- plotly::plotly_build(pl)$x$layout
# title for the x-axis
expect_match(
object = plLayout$xaxis$title$text,
regexp = "Actual value at baseline.+Baseline Standard Unit: g/L"
)
# title for the y-axis
expect_match(
object = plLayout$yaxis$title$text,
regexp = "Actual value at visit X.+Standard Unit: mg/L, mg/mL"
)
# general title
expect_match(
object = plLayout$title$text,
regexp = "Actual value at visit X vs Actual value at baseline"
)
})
test_that("An interactive table is created in addition to the scatterplot", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTRESNBL = c(10, 12, 13, 14, 9)
)
res <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL", yVar = "LBSTRESN",
table = TRUE
)
expect_s3_class(res$table, "datatables")
})
test_that("The scatterplot is successfully facetted based on a variable", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTRESNBL = c(10, 12, 13, 14, 9)
)
# facet_wrap: character test high number of facets
plWrapSt <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL", yVar = "LBSTRESN",
aesPointVar = list(color = "USUBJID"),
aesLineVar = list(group = "USUBJID", color = "USUBJID"),
facetPars = list(facets = "USUBJID"),
themePars = list(legend.position = "right")
)
expect_s3_class(plWrapSt, "plotly")
})
test_that("The scatterplot is successfully facetted based on a formula", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTRESNBL = c(10, 12, 13, 14, 9),
VISIT = c("Screening 1", "Screening 1",
"Screening 1", "Week 1", "Week 1")
)
# facet_wrap: formula
plWrapFm <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL", yVar = "LBSTRESN",
aesPointVar = list(color = "USUBJID"),
aesLineVar = list(group = "USUBJID", color = "USUBJID"),
facetPars = list(facets = as.formula(~VISIT + USUBJID))
)
expect_s3_class(plWrapFm, "plotly")
})
test_that("Specified x-axis and y-axis limits are expanded when data is outside of these limits in a scatterplot", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTRESNBL = c(10, 12, 13, 14, 9)
)
xLim <- c(min(data$LBSTRESNBL) + diff(range(data$LBSTRESNBL))/2, max(data$LBSTRESNBL))
yLim <- c(min(data$LBSTRESN) + diff(range(data$LBSTRESN))/2, max(data$LBSTRESN))
plNoExpandLim <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL", yVar = "LBSTRESN",
aesPointVar = list(color = "USUBJID"),
aesLineVar = list(group = "USUBJID", color = "USUBJID"),
xLim = xLim, yLim = yLim,
xLimExpandData = FALSE, yLimExpandData = FALSE
)
plExpandLim <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL", yVar = "LBSTRESN",
aesPointVar = list(color = "USUBJID"),
aesLineVar = list(group = "USUBJID", color = "USUBJID"),
xLim = xLim, yLim = yLim
)
expect_gt(
object = diff(plotly_build(plExpandLim)$x$layout$xaxis$range),
expected = diff(plotly_build(plNoExpandLim)$x$layout$xaxis$range),
label = "limits of x-axis expanded from data greater than specified limits"
)
expect_gt(
object = diff(plotly_build(plExpandLim)$x$layout$yaxis$range),
expected = diff(plotly_build(plNoExpandLim)$x$layout$yaxis$range),
label = "limits of y-axis expanded from data greater than specified limits"
)
})
test_that("A scatterplot with specified hover variables is successfully created", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTRESNBL = c(10, 12, 13, 14, 9)
)
plOutput <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL", yVar = "LBSTRESN",
hoverVars = c("LBSTRESNBL", "USUBJID")
)
expect_s3_class(plOutput, "plotly")
})
test_that("A legend is correctly not included in a scatterplot", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTRESNBL = c(10, 12, 13, 14, 9)
)
plOutput <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL", yVar = "LBSTRESN",
themePars = list(legend.position = "none")
)
expect_s3_class(plOutput, "plotly")
})
test_that("A color palette is correctly set in a scatterplot", {
data <- data.frame(
DY = c(1, 2, 1, 2),
AVAL = c(3, 4, 2, 6),
NRIND = c("Normal", "High", "Low", "Normal"),
USUBJID = c(1, 1, 2, 2),
stringsAsFactors = FALSE
)
colorPalette <- c(
Low = "purple",
Normal = "green",
High = "blue"
)
pl <- scatterplotClinData(
data = data,
xVar = "DY",
yVar = "AVAL",
aesPointVar = list(color = "NRIND"),
scalePars = list(
list(aesthetic = "colour", values = colorPalette)
)
)
plData <- plotly_build(pl)$x$data
plData <- lapply(plData, function(x){
data.frame(
x = as.numeric(x$x),
y = as.numeric(x$y),
NRIND = as.character(x$name),
color = as.character(x$marker$line$color),
stringsAsFactors = FALSE
)
})
plData <- do.call(rbind, plData)
plData <- plData[do.call(order, plData), ]
# plotly specifies color in rgba
colorPaletteRGB <- grDevices::col2rgb(colorPalette)
colorPaletteRGBA <- paste0(
"rgba(",
apply(colorPaletteRGB, 2, paste, collapse = ","),
",1)" # + alpha
)
names(colorPaletteRGBA) <- colorPalette
# extract color for input data:
data$color <- colorPaletteRGBA[colorPalette[data$NRIND]]
data <- data[, c("DY", "AVAL", "NRIND", "color")]
data <- data[do.call(order, data), ]
expect_equal(
object = plData,
expected = data,
check.attributes = FALSE
)
})
test_that("The default color palette is correctly extracted", {
data <- data.frame(
DY = c(1, 2, 1, 2),
AVAL = c(3, 4, 2, 6),
NRIND = c("Normal", "High", "Low", "Normal"),
USUBJID = c(1, 1, 2, 2),
stringsAsFactors = FALSE
)
expect_error(
pl <- clinDataReview::scatterplotClinData(
data = data,
xVar = "DY",
yVar = "AVAL",
aesPointVar = list(color = "NRIND")
),
NA
)
# plotly specifies color in rgba
colors <- sapply(plotly::plotly_build(pl)$x$data, function(x){
color <- x$marker$line$color
color <- sub("rgba\\((.+)\\)$", "\\1", color)
color <- strsplit(color, split = ",")[[1]][-4] # (remove transparency)
paste(color, collapse = ",")
})
# default color palette
colorsDefault <- getOption("clinDataReview.colors")(3)
colorsDefault <- sapply(colorsDefault, function(color)
paste(grDevices::col2rgb(color), collapse = ",") # convert to RGB
)
expect_setequal(object = colors, expected = colorsDefault)
})
test_that("The x-axis labels are correctly set from variables in the scatterplot", {
data <- data.frame(
AVISIT = factor(
c("Day 4", "Screening"),
levels = c("Screening", "Day 4")
),
AVAL = c(1, 2),
USUBJID = c("1", "2"),
n = c("N = 4", "N = 3"),
stringsAsFactors = FALSE
)
pl <- scatterplotClinData(
data = data,
xVar = "AVISIT", xLabVars = c("AVISIT", "n"),
yVar = "AVAL"
)
plXAxis <- plotly_build(pl)$x$layout$xaxis
# extract tick labels
plXTickLab <- plXAxis$ticktext
# and sort them
plXTickLab <- plXTickLab[order(plXAxis$tickvals, decreasing = FALSE)]
expect_match(object = plXTickLab[1], regexp = "Screening.+N = 3")
expect_match(object = plXTickLab[2], regexp = "Day 4.+N = 4")
})
test_that("Variables for x-axis labels are correctly combined and ordered if multiple in a scatterplot", {
data <- data.frame(
AVISIT = factor(
c("Day 4", "Screening", "Day 4", "Screening"),
levels = c("Screening", "Day 4")
),
AVAL = c(1, 2, 3, 4),
USUBJID = c("1", "1", "2", "2"),
TREAT = factor(
c("Compound", "Compound", "Placebo", "Placebo"),
levels = c("Placebo", "Compound")
),
stringsAsFactors = FALSE
)
pl <- scatterplotClinData(
data = data,
xVar = "AVISIT", xLabVars = c("AVISIT", "TREAT"),
yVar = "AVAL"
)
plXAxis <- plotly_build(pl)$x$layout$xaxis
# extract tick labels
plXTickLab <- plXAxis$ticktext
# and sort them
plXTickLab <- plXTickLab[order(plXAxis$tickvals, decreasing = FALSE)]
expect_match(object = plXTickLab[1], regexp = "Screening.+Placebo.+Compound")
expect_match(object = plXTickLab[2], regexp = "Day 4.+Placebo.+Compound")
})
test_that("A subtitle is correctly set in a scatterplot", {
data <- data.frame(
DY = c(1, 2, 1, 2),
AVAL = c(3, 4, 2, 6),
USUBJID = c(1, 1, 2, 2),
stringsAsFactors = FALSE
)
subtitle <- paste(sample(LETTERS, 100, replace = TRUE), collapse = "")
subtitle <- paste(rep(subtitle, 10), collapse = "\n")
plSubtitle <- scatterplotClinData(
data = data,
xVar = "DY",
yVar = "AVAL",
subtitle = subtitle
)
# extract annotation
plAnnot <- plotly_build(plSubtitle)$x$layout$annotations
plSubtitleAnnot <- lapply(plAnnot, function(xEl)
if(hasName(xEl, "text"))
xEl[["text"]]
)
plSubtitleAnnot <- unlist(plSubtitleAnnot, recursive = TRUE, use.names = FALSE)
expect_match(plSubtitleAnnot, gsub("\n", ".*", subtitle))
# check that top margin is increased
plNoSubtitle <- scatterplotClinData(
data = data,
xVar = "DY",
yVar = "AVAL"
)
expect_gt(
object = plotly_build(plSubtitle)$x$layout$margin$t,
expected = plotly_build(plNoSubtitle)$x$layout$margin$t
)
})
test_that("Extra margin is correctly set for the subtitle in a facetted plot", {
data <- data.frame(
DY = c(1, 2, 1, 2),
AVAL = c(3, 4, 2, 6),
USUBJID = c(1, 1, 2, 2),
TRT = c("A", "A", "B", "B"),
stringsAsFactors = FALSE
)
subtitle <- paste(sample(LETTERS, 100, replace = TRUE), collapse = "")
subtitle <- paste(rep(subtitle, 10), collapse = "\n")
plSubtitleFacet <- scatterplotClinData(
data = data,
xVar = "DY",
yVar = "AVAL",
subtitle = subtitle,
facetPars = list(facets = "TRT")
)
# check that top margin is increased
plSubtitleNoFacet <- scatterplotClinData(
data = data,
xVar = "DY",
yVar = "AVAL",
subtitle = subtitle
)
expect_gt(
object = plotly_build(plSubtitleFacet)$x$layout$margin$t,
expected = plotly_build(plSubtitleNoFacet)$x$layout$margin$t
)
})
test_that("A caption is correctly set in a scatterplot", {
data <- data.frame(
DY = c(1, 2, 1, 2),
AVAL = c(3, 4, 2, 6),
USUBJID = c(1, 1, 2, 2),
stringsAsFactors = FALSE
)
caption <- paste(sample(LETTERS, 100, replace = TRUE), collapse = "")
caption <- paste(rep(caption, 10), collapse = "\n")
plCaption <- scatterplotClinData(
data = data,
xVar = "DY", xLab = "TEST",
yVar = "AVAL",
caption = caption
)
# extract annotation
plAnnot <- plotly_build(plCaption)$x$layout$annotations
plCaptionAnnot <- lapply(plAnnot, function(xEl)
if(hasName(xEl, "text"))
xEl[["text"]]
)
plCaptionAnnot <- unlist(plCaptionAnnot, recursive = TRUE, use.names = FALSE)
expect_match(plCaptionAnnot, gsub("\n", ".*", caption))
# check that bottom margin is increased
plNoCaption <- scatterplotClinData(
data = data,
xVar = "DY",
yVar = "AVAL"
)
expect_gt(
object = plotly_build(plCaption)$x$layout$margin$b,
expected = plotly_build(plNoCaption)$x$layout$margin$b
)
})
test_that("A selection variable is correctly included in a scatterplot", {
data <- data.frame(
group = factor(c("A", "A", "A", "A", "B"), levels = c("B", "A")),
DY = c(1, 2, 1, 2, 3),
AVAL = c(3, 4, 2, 6, 5),
USUBJID = c(1, 1, 2, 2, 3),
stringsAsFactors = FALSE
)
res <- scatterplotClinData(
data = data,
xVar = "DY",
yVar = "AVAL",
aesLineVar = list(group = "USUBJID"),
selectVars = "group"
)
# check the output:
expect_s3_class(res, "clinDataReview")
expect_named(res, expected = c("buttons", "plot"))
expect_s3_class(res$plot, "plotly")
expect_length(res$buttons, 1)
# check button values
btnScriptTag <- htmltools::tagQuery(res$buttons)$find("script")$selectedTags()
buttonData <- jsonlite::fromJSON(txt = as.character(btnScriptTag[[1]]$children))
expect_equal(object = buttonData$items$value, expected = levels(data$group))
})
test_that("A box to highlight the elements of the ID variable is correctly included in a scatterplot", {
data <- data.frame(
DY = c(1, 2, 1, 2),
AVAL = c(3, 4, 2, 6),
USUBJID = c(1, 1, 2, 2),
stringsAsFactors = FALSE
)
pl <- scatterplotClinData(
data = data,
xVar = "DY",
yVar = "AVAL",
idHighlightBox = TRUE
)
# check the output:
expect_s3_class(pl, "plotly")
expect_true(pl$x$highlight$selectize)
})
test_that("A watermark is correctly included in a (facetted) scatterplot", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTRESNBL = c(10, 12, 13, 14, 9)
)
file <- tempfile(pattern = "watermark", fileext = ".png")
getWatermark(file = file)
pl <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL", yVar = "LBSTRESN",
facetPars = list(facets = "USUBJID"),
watermark = file
)
# check that an image has been included below the plot
plBuild <- plotly::plotly_build(pl)
expect_equal(
object = sapply(plBuild$x$layout$images, `[[`, "layer"),
expected = "below"
)
})
Try the clinDataReview package in your browser
Any scripts or data that you put into this service are public.
clinDataReview documentation built on April 12, 2025, 1:14 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
context("Visualize clinical data with a scatterplot")
library(plotly)
library(grDevices)
test_that("A scatterplot is correctly created", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTRESNBL = c(10, 12, 13, 14, 9),
stringsAsFactors = FALSE
)
pl <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL",
xLab = "Actual value at baseline",
yVar = "LBSTRESN",
yLab = "Actual value at visit X",
aesPointVar = list(
color = "USUBJID", fill = "USUBJID",
group = "USUBJID", stroke = "USUBJID",
shape = "USUBJID",
alpha = "LBSTRESNBL", size = "LBSTRESNBL"
),
aesLineVar = c(
list(
group = "USUBJID", #color = "USUBJID",
alpha = "LBSTRESNBL",
linetype = "USUBJID"
),
setNames(
list("LBSTRESNBL"),
ifelse(packageVersion("ggplot2") >= "3.4.0", "linewidth", "size")
)
),
idVar = "USUBJID"
)
## check input == output data
# extract input data
cols <- c("LBSTRESNBL", "LBSTRESN", "USUBJID")
dataPointLine <- data[, cols]
dataPointLine <- dataPointLine[do.call(order, dataPointLine), ]
dataPointLine <- subset(dataPointLine, ! is.na(LBSTRESNBL))
# check data points
plData <- plotly_build(pl)$x$data
plDataPointsAll <- plData[sapply(plData, function(x)
(x$mode == "markers" & !is.null(x$set)))]
plDataPoints <- lapply(plDataPointsAll, function(x)
data.frame(
x = as.numeric(x$x),
y = as.numeric(x$y),
key = as.character(x$key),
stringsAsFactors = FALSE
)
)
plDataPoints <- setNames(do.call(rbind, plDataPoints), cols)
plDataPoints <- plDataPoints[do.call(order, plDataPoints), ]
expect_equal(
object = plDataPoints,
expected = dataPointLine,
check.attributes = FALSE
)# all equal, no attributes
# check data lines
plDataLinesAll <- plData[sapply(plData, function(x) (x$mode == "lines" & !is.null(x$set)))]
plDataLines <- lapply(plDataLinesAll, function(x)
data.frame(
x = as.numeric(x$x),
y = as.numeric(x$y),
legend = sub("^\\(([^,]*).+", "\\1", x$legendgroup),
stringsAsFactors = FALSE
)
)
plDataLines <- setNames(do.call(rbind, plDataLines), cols)
plDataLines <- plDataLines[do.call(order, plDataLines), ]
expect_equal(
object = plDataLines,
expected = dataPointLine,
check.attributes = FALSE
)# all equal, no attributes
})
test_that('Point parameters are set correctly in a scatterplot', {
pl <- scatterplotClinData(
data = exampleDataScatter(),
xVar = "time", yVar = "response",
pointPars = list( color = 'red'),
idVar = "subj"
)
plData <- plotly_build(pl)$x$data
plmarkerData <- plData[[
which(
sapply(plData, function(x){
x$mode == 'markers'} )
)
]]
# test color parameter correclty
colorRGB <- sub("^rgba\\((\\d{1,},\\d{1,},\\d{1,}),.+", "\\1\\2\\3", plmarkerData$marker$line$color)
expect_setequal(
object = colorRGB,
expected = paste(grDevices::col2rgb('red'), collapse =",")
)
})
test_that("Point parameters with 'colour' (UK English spelling) are set correctly in a scatterplot", {
expect_silent(
pl <- scatterplotClinData(
data = exampleDataScatter(),
xVar = "time", yVar = "response",
pointPars = list(colour = 'red'),
idVar = "subj"
)
)
plData <- plotly_build(pl)$x$data
plmarkerData <- plData[[which(sapply(plData, function(x){x$mode == 'markers'}))]]
colorRGB <- sub("^rgba\\((\\d{1,},\\d{1,},\\d{1,}),.+", "\\1\\2\\3", plmarkerData$marker$line$color)
expect_equal(
object = colorRGB,
expected = paste(grDevices::col2rgb('red'), collapse = ",")
)
})
test_that('Line parameters are set correctly in a scatterplot', {
pl <- scatterplotClinData(
data = exampleDataScatter(),
xVar = "time", yVar = "response",
aesPointVar = list(color = "treat"),
aesLineVar = list(group = 'subj'),
linePars = list(linetype='dotted'),
idVar = "subj"
)
plData <- plotly_build(pl)$x$data
pllineData <- plData[[
which(
sapply(plData, function(x){
x$mode == 'lines'} )
)
]]
expect_equal(pllineData$line$dash , 'dot')
})
test_that("Smoothing variables are set correctly in a scatterplot", {
exampleData <- exampleDataScatter()
plSmoothLayer <- scatterplotClinData(
data = exampleData,
xVar = "time", yVar = "response",
aesSmoothVar = list(group = 'subj'),
idVar = "subj",
smoothPars = list(se=FALSE)
)
plSmoothData <- plotly_build(plSmoothLayer)$x$data
plNoSmooth <- scatterplotClinData(
data = exampleData,
xVar = "time", yVar = "response",
idVar = "subj")
plNoSmoothData <- plotly_build(plNoSmooth)$x$data
# test smoothing line added for each subject
lineData <- plSmoothData[[which(sapply(plSmoothData, `[[`, "mode") == "lines")]]
lineKeys <- unique(unlist(lineData$key))
lineKeys <- lineKeys[!is.na(lineKeys)]
expect_equal(
object = lineKeys,
expected = unique(exampleData$subj)
)
})
test_that("Smoothing parameters are set correctly in a scatterplot", {
exampleData <- exampleDataScatter()
plSmoothLayer <- scatterplotClinData(
data = exampleData,
xVar = "time", yVar = "response",
pointPars = list( color = 'red'),
aesLineVar = list(group = 'subj'),
linePars = list(linetype='dotted'),
aesSmoothVar = list(group = 'subj'),
smoothPars = list(color = 'green', se=TRUE) ,
idVar = "subj")
plSmoothData <- plotly_build(plSmoothLayer)$x$data
# no standard error means one plotting layer less
plSmoothNoSE <- scatterplotClinData(
data = exampleData,
xVar = "time", yVar = "response",
pointPars = list( color = 'red'),
aesLineVar = list(group = 'subj'),
linePars = list(linetype='dotted'),
aesSmoothVar = list(group = 'subj'),
smoothPars = list(color = 'green', se=FALSE),
idVar = "subj"
)
plSmoothNoSEData <- plotly_build(plSmoothNoSE)$x$data
# test that error band parameters added
expect_gt(
length(plSmoothData),
length(plSmoothNoSEData)
)
# test that color in smoothing curves is set correctly
isLine <- sapply(plSmoothNoSEData, `[[`, "mode") == "lines"
colors <- sapply(plSmoothNoSEData[isLine], function(x) x$line$color)
colorsRGB <- sub("^rgba\\((\\d{1,},\\d{1,},\\d{1,}),.+", "\\1\\2\\3", colors)[-1]
expect_setequal(
object = colorsRGB,
expected = paste(grDevices::col2rgb('green'), collapse =",")
)
}
)
test_that("Smoothing layer can be disabled in scatterplot", {
exampleData <- exampleDataScatter()
plWithSmoothLayer <- scatterplotClinData(
data = exampleData,
xVar = "time", yVar = "response",
pointPars = list( color = 'red'),
aesLineVar = list(group = 'subj'),
linePars = list(linetype='dotted'),
aesSmoothVar = list(group = 'subj'),
smoothPars = list(color = 'green', se=TRUE),
smoothInclude = TRUE,
idVar = "subj"
)
dataWithSmooth <- plotly_build(plWithSmoothLayer)$x$data
plNoSmoothLayer <- scatterplotClinData(
data = exampleData,
xVar = "time", yVar = "response",
pointPars = list( color = 'red'),
aesLineVar = list(group = 'subj'),
linePars = list(linetype='dotted'),
aesSmoothVar = list(group = 'subj'),
smoothPars = list(color = 'green', se=TRUE),
smoothInclude = FALSE,
idVar = "subj"
)
dataNoSmooth <- plotly_build(plNoSmoothLayer)$x$data
# test that smoothing layer not included when smoothInclude = FALSE
expect_equal(
length(dataWithSmooth),
length(dataNoSmooth) + 2 # one layer for smooth, 1 for se
)
}
)
test_that("Reference lines are correctly implemented in a scatterplot", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTRESNBL = c(10, 12, 13, 14, 9),
LBSTNRLO = 0,
LBSTNRHI = 50,
VISIT = c("Screening 1", "Screening 1", "Screening 1", "Week 1", "Week 1")
)
xLine <- mean(data$LBSTRESNBL)
yLine <- mean(data$LBSTRESN)
pl <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL", yVar = "LBSTRESN",
aesPointVar = list(color = "USUBJID"),
aesLineVar = list(group = "USUBJID", color = "USUBJID"),
facetPars = list(facets = "VISIT"),
refLinePars = list(
# fixed values, no labels
list(slope = 1, intercept = 0, linetype = 1, color = "black", label = FALSE),
list(xintercept = xLine),
list(yintercept = yLine),
list(slope = 1, intercept = 0, linetype = 1, color = "black", label = FALSE),
# from aesthetic
# default label
list(xintercept = "LBSTNRLO", linetype = 2, color = "orange", alpha = 0.5),
# custom label:
list(yintercept = "LBSTNRHI", linetype = 2, color = "orange", label = "Reference Range Upper Limit"),
# combined
list(slope = 1, intercept = "LBSTNRLO")
)
)
## check input == output data
# extract input values for reference lines
dataRefLines <- unique(data[, c("VISIT", "LBSTNRLO", "LBSTNRHI")])
# extract reference lines from output object
plData <- plotly_build(pl)$x$data
plDataRefLines <- plData[sapply(plData, function(x)
(x$mode == "lines" & is.null(x$set)))]
# check if lines are in the plot
# ideally we should also check if they are in the correct facet
# but the mapping facet <-> line doesn't seem to be easily extracted from the plotly_build output
isRefLineXInPlot <- all(c(dataRefLines$LBSTNRLO, xLine) %in%
unlist(lapply(plDataRefLines, function(x) x$x)))
expect_true(isRefLineXInPlot, info = "All specified horizontal lines are plotted.")
isRefLineYInPlot <- all(c(dataRefLines$LBSTNRHI, yLine) %in%
unlist(lapply(plDataRefLines, function(x) x$y)))
expect_true(isRefLineYInPlot, info = "All specified vertical lines are plotted.")
})
test_that("Reference lines as numeric with x-variable as character are successfully set in a scatterplot", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTNRLO = 0,
LBSTNRHI = 50,
VISIT = c("Screening 1", "Screening 1", "Screening 1", "Week 1", "Week 1"),
stringsAsFactors = FALSE
)
expect_error(
pl <- scatterplotClinData(
data = data,
xVar = "VISIT", yVar = "LBSTRESN",
refLinePars = list(
# from aesthetic
list(yintercept = "LBSTNRLO"),
# custom label:
list(yintercept = "LBSTNRHI")
)
),
NA
)
# check reference lines
plData <- plotly::plotly_build(pl)$x$data
plDataRefLines <- plData[sapply(plData, function(x)
(x$mode == "lines" & is.null(x$set)))]
plDataRefLinesY <- unlist(lapply(plDataRefLines, `[[`, "y"))
expect_setequal(object = plDataRefLinesY, expected = c(0, 50))
# check x-axis
plDataPoints <- plData[sapply(plData, function(x)
(x$mode == "markers" & !is.null(x$set)))]
plDataPointsX <- unlist(lapply(plDataPoints, `[[`, "x"))
expect_setequal(object = plDataPointsX, expected = c(1, 2))
})
test_that("Reference lines as numeric with x-variable as factor are successfully set in a scatterplot", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTNRLO = 0,
LBSTNRHI = 50,
VISIT = c("Screening 1", "Screening 1", "Screening 1", "Week 1", "Week 1"),
stringsAsFactors = TRUE
)
expect_error(
pl <- scatterplotClinData(
data = data,
xVar = "VISIT", yVar = "LBSTRESN",
refLinePars = list(
# from aesthetic
list(yintercept = "LBSTNRLO"),
# custom label:
list(yintercept = "LBSTNRHI")
)
),
NA
)
# check reference lines
plData <- plotly::plotly_build(pl)$x$data
plDataRefLines <- plData[sapply(plData, function(x)
(x$mode == "lines" & is.null(x$set)))]
plDataRefLinesY <- unlist(lapply(plDataRefLines, `[[`, "y"))
expect_setequal(object = plDataRefLinesY, expected = c(0, 50))
# check x-axis
plDataPoints <- plData[sapply(plData, function(x)
(x$mode == "markers" & !is.null(x$set)))]
plDataPointsX <- unlist(lapply(plDataPoints, `[[`, "x"))
expect_setequal(object = plDataPointsX, expected = c(1, 2))
})
test_that("Axis labels and title are correctly set in a scatterplot", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTRESNBL = c(10, 12, 13, 14, 9)
)
labelVars <- c(
LBSTRESN = "Actual value",
LBSTRESNBL = "Actual value at baseline"
)
xLab <- paste("Baseline", labelVars["LBSTRESN"])
title <- "Actual value of lab parameter at each visit vs baseline"
pl <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL", yVar = "LBSTRESN",
xLab = xLab, # custom label
labelVars = labelVars,
title = title
)
## check input == output data
# extract labels from output object
yLab <- labelVars["LBSTRESN"]
plLayout <- plotly_build(pl)$x$layout
plLayoutAnnot <- plLayout$annotations
# title
expect_equal(
object = plLayout$title$text,
expected = title,
check.attributes = FALSE
)
# axes labels
expect_equal(
object = pl$x$layout$xaxis$title$text,
expected = xLab,
check.attributes = FALSE
)
expect_equal(
object = pl$x$layout$yaxis$title$text,
expected = unname(yLab),
check.attributes = FALSE
)
})
test_that("Axis variable(s) are correctly included in a scatterplot", {
data <- data.frame(
LBSTRESNBL = c(10, 12, 13, 14, 9),
LBSTRESNBLU = factor("g/L"),
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTRESU = factor(rep(x = c("mg/mL", "mg/L"), times = c(3, 2))),
stringsAsFactors = FALSE
)
pl <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL", xLabVar = "LBSTRESNBLU",
yVar = "LBSTRESN", yLabVar = "LBSTRESU",
labelVars = c(
LBSTRESNBL = "Actual value at baseline",
LBSTRESNBLU = "Baseline Standard Unit",
LBSTRESN = "Actual value at visit X",
LBSTRESU = "Standard Unit"
)
)
plLayout <- plotly::plotly_build(pl)$x$layout
# title for the x-axis
expect_match(
object = plLayout$xaxis$title$text,
regexp = "Actual value at baseline.+Baseline Standard Unit: g/L"
)
# title for the y-axis
expect_match(
object = plLayout$yaxis$title$text,
regexp = "Actual value at visit X.+Standard Unit: mg/L, mg/mL"
)
# general title
expect_match(
object = plLayout$title$text,
regexp = "Actual value at visit X vs Actual value at baseline"
)
})
test_that("An interactive table is created in addition to the scatterplot", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTRESNBL = c(10, 12, 13, 14, 9)
)
res <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL", yVar = "LBSTRESN",
table = TRUE
)
expect_s3_class(res$table, "datatables")
})
test_that("The scatterplot is successfully facetted based on a variable", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTRESNBL = c(10, 12, 13, 14, 9)
)
# facet_wrap: character test high number of facets
plWrapSt <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL", yVar = "LBSTRESN",
aesPointVar = list(color = "USUBJID"),
aesLineVar = list(group = "USUBJID", color = "USUBJID"),
facetPars = list(facets = "USUBJID"),
themePars = list(legend.position = "right")
)
expect_s3_class(plWrapSt, "plotly")
})
test_that("The scatterplot is successfully facetted based on a formula", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTRESNBL = c(10, 12, 13, 14, 9),
VISIT = c("Screening 1", "Screening 1",
"Screening 1", "Week 1", "Week 1")
)
# facet_wrap: formula
plWrapFm <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL", yVar = "LBSTRESN",
aesPointVar = list(color = "USUBJID"),
aesLineVar = list(group = "USUBJID", color = "USUBJID"),
facetPars = list(facets = as.formula(~VISIT + USUBJID))
)
expect_s3_class(plWrapFm, "plotly")
})
test_that("Specified x-axis and y-axis limits are expanded when data is outside of these limits in a scatterplot", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTRESNBL = c(10, 12, 13, 14, 9)
)
xLim <- c(min(data$LBSTRESNBL) + diff(range(data$LBSTRESNBL))/2, max(data$LBSTRESNBL))
yLim <- c(min(data$LBSTRESN) + diff(range(data$LBSTRESN))/2, max(data$LBSTRESN))
plNoExpandLim <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL", yVar = "LBSTRESN",
aesPointVar = list(color = "USUBJID"),
aesLineVar = list(group = "USUBJID", color = "USUBJID"),
xLim = xLim, yLim = yLim,
xLimExpandData = FALSE, yLimExpandData = FALSE
)
plExpandLim <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL", yVar = "LBSTRESN",
aesPointVar = list(color = "USUBJID"),
aesLineVar = list(group = "USUBJID", color = "USUBJID"),
xLim = xLim, yLim = yLim
)
expect_gt(
object = diff(plotly_build(plExpandLim)$x$layout$xaxis$range),
expected = diff(plotly_build(plNoExpandLim)$x$layout$xaxis$range),
label = "limits of x-axis expanded from data greater than specified limits"
)
expect_gt(
object = diff(plotly_build(plExpandLim)$x$layout$yaxis$range),
expected = diff(plotly_build(plNoExpandLim)$x$layout$yaxis$range),
label = "limits of y-axis expanded from data greater than specified limits"
)
})
test_that("A scatterplot with specified hover variables is successfully created", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTRESNBL = c(10, 12, 13, 14, 9)
)
plOutput <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL", yVar = "LBSTRESN",
hoverVars = c("LBSTRESNBL", "USUBJID")
)
expect_s3_class(plOutput, "plotly")
})
test_that("A legend is correctly not included in a scatterplot", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTRESNBL = c(10, 12, 13, 14, 9)
)
plOutput <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL", yVar = "LBSTRESN",
themePars = list(legend.position = "none")
)
expect_s3_class(plOutput, "plotly")
})
test_that("A color palette is correctly set in a scatterplot", {
data <- data.frame(
DY = c(1, 2, 1, 2),
AVAL = c(3, 4, 2, 6),
NRIND = c("Normal", "High", "Low", "Normal"),
USUBJID = c(1, 1, 2, 2),
stringsAsFactors = FALSE
)
colorPalette <- c(
Low = "purple",
Normal = "green",
High = "blue"
)
pl <- scatterplotClinData(
data = data,
xVar = "DY",
yVar = "AVAL",
aesPointVar = list(color = "NRIND"),
scalePars = list(
list(aesthetic = "colour", values = colorPalette)
)
)
plData <- plotly_build(pl)$x$data
plData <- lapply(plData, function(x){
data.frame(
x = as.numeric(x$x),
y = as.numeric(x$y),
NRIND = as.character(x$name),
color = as.character(x$marker$line$color),
stringsAsFactors = FALSE
)
})
plData <- do.call(rbind, plData)
plData <- plData[do.call(order, plData), ]
# plotly specifies color in rgba
colorPaletteRGB <- grDevices::col2rgb(colorPalette)
colorPaletteRGBA <- paste0(
"rgba(",
apply(colorPaletteRGB, 2, paste, collapse = ","),
",1)" # + alpha
)
names(colorPaletteRGBA) <- colorPalette
# extract color for input data:
data$color <- colorPaletteRGBA[colorPalette[data$NRIND]]
data <- data[, c("DY", "AVAL", "NRIND", "color")]
data <- data[do.call(order, data), ]
expect_equal(
object = plData,
expected = data,
check.attributes = FALSE
)
})
test_that("The default color palette is correctly extracted", {
data <- data.frame(
DY = c(1, 2, 1, 2),
AVAL = c(3, 4, 2, 6),
NRIND = c("Normal", "High", "Low", "Normal"),
USUBJID = c(1, 1, 2, 2),
stringsAsFactors = FALSE
)
expect_error(
pl <- clinDataReview::scatterplotClinData(
data = data,
xVar = "DY",
yVar = "AVAL",
aesPointVar = list(color = "NRIND")
),
NA
)
# plotly specifies color in rgba
colors <- sapply(plotly::plotly_build(pl)$x$data, function(x){
color <- x$marker$line$color
color <- sub("rgba\\((.+)\\)$", "\\1", color)
color <- strsplit(color, split = ",")[[1]][-4] # (remove transparency)
paste(color, collapse = ",")
})
# default color palette
colorsDefault <- getOption("clinDataReview.colors")(3)
colorsDefault <- sapply(colorsDefault, function(color)
paste(grDevices::col2rgb(color), collapse = ",") # convert to RGB
)
expect_setequal(object = colors, expected = colorsDefault)
})
test_that("The x-axis labels are correctly set from variables in the scatterplot", {
data <- data.frame(
AVISIT = factor(
c("Day 4", "Screening"),
levels = c("Screening", "Day 4")
),
AVAL = c(1, 2),
USUBJID = c("1", "2"),
n = c("N = 4", "N = 3"),
stringsAsFactors = FALSE
)
pl <- scatterplotClinData(
data = data,
xVar = "AVISIT", xLabVars = c("AVISIT", "n"),
yVar = "AVAL"
)
plXAxis <- plotly_build(pl)$x$layout$xaxis
# extract tick labels
plXTickLab <- plXAxis$ticktext
# and sort them
plXTickLab <- plXTickLab[order(plXAxis$tickvals, decreasing = FALSE)]
expect_match(object = plXTickLab[1], regexp = "Screening.+N = 3")
expect_match(object = plXTickLab[2], regexp = "Day 4.+N = 4")
})
test_that("Variables for x-axis labels are correctly combined and ordered if multiple in a scatterplot", {
data <- data.frame(
AVISIT = factor(
c("Day 4", "Screening", "Day 4", "Screening"),
levels = c("Screening", "Day 4")
),
AVAL = c(1, 2, 3, 4),
USUBJID = c("1", "1", "2", "2"),
TREAT = factor(
c("Compound", "Compound", "Placebo", "Placebo"),
levels = c("Placebo", "Compound")
),
stringsAsFactors = FALSE
)
pl <- scatterplotClinData(
data = data,
xVar = "AVISIT", xLabVars = c("AVISIT", "TREAT"),
yVar = "AVAL"
)
plXAxis <- plotly_build(pl)$x$layout$xaxis
# extract tick labels
plXTickLab <- plXAxis$ticktext
# and sort them
plXTickLab <- plXTickLab[order(plXAxis$tickvals, decreasing = FALSE)]
expect_match(object = plXTickLab[1], regexp = "Screening.+Placebo.+Compound")
expect_match(object = plXTickLab[2], regexp = "Day 4.+Placebo.+Compound")
})
test_that("A subtitle is correctly set in a scatterplot", {
data <- data.frame(
DY = c(1, 2, 1, 2),
AVAL = c(3, 4, 2, 6),
USUBJID = c(1, 1, 2, 2),
stringsAsFactors = FALSE
)
subtitle <- paste(sample(LETTERS, 100, replace = TRUE), collapse = "")
subtitle <- paste(rep(subtitle, 10), collapse = "\n")
plSubtitle <- scatterplotClinData(
data = data,
xVar = "DY",
yVar = "AVAL",
subtitle = subtitle
)
# extract annotation
plAnnot <- plotly_build(plSubtitle)$x$layout$annotations
plSubtitleAnnot <- lapply(plAnnot, function(xEl)
if(hasName(xEl, "text"))
xEl[["text"]]
)
plSubtitleAnnot <- unlist(plSubtitleAnnot, recursive = TRUE, use.names = FALSE)
expect_match(plSubtitleAnnot, gsub("\n", ".*", subtitle))
# check that top margin is increased
plNoSubtitle <- scatterplotClinData(
data = data,
xVar = "DY",
yVar = "AVAL"
)
expect_gt(
object = plotly_build(plSubtitle)$x$layout$margin$t,
expected = plotly_build(plNoSubtitle)$x$layout$margin$t
)
})
test_that("Extra margin is correctly set for the subtitle in a facetted plot", {
data <- data.frame(
DY = c(1, 2, 1, 2),
AVAL = c(3, 4, 2, 6),
USUBJID = c(1, 1, 2, 2),
TRT = c("A", "A", "B", "B"),
stringsAsFactors = FALSE
)
subtitle <- paste(sample(LETTERS, 100, replace = TRUE), collapse = "")
subtitle <- paste(rep(subtitle, 10), collapse = "\n")
plSubtitleFacet <- scatterplotClinData(
data = data,
xVar = "DY",
yVar = "AVAL",
subtitle = subtitle,
facetPars = list(facets = "TRT")
)
# check that top margin is increased
plSubtitleNoFacet <- scatterplotClinData(
data = data,
xVar = "DY",
yVar = "AVAL",
subtitle = subtitle
)
expect_gt(
object = plotly_build(plSubtitleFacet)$x$layout$margin$t,
expected = plotly_build(plSubtitleNoFacet)$x$layout$margin$t
)
})
test_that("A caption is correctly set in a scatterplot", {
data <- data.frame(
DY = c(1, 2, 1, 2),
AVAL = c(3, 4, 2, 6),
USUBJID = c(1, 1, 2, 2),
stringsAsFactors = FALSE
)
caption <- paste(sample(LETTERS, 100, replace = TRUE), collapse = "")
caption <- paste(rep(caption, 10), collapse = "\n")
plCaption <- scatterplotClinData(
data = data,
xVar = "DY", xLab = "TEST",
yVar = "AVAL",
caption = caption
)
# extract annotation
plAnnot <- plotly_build(plCaption)$x$layout$annotations
plCaptionAnnot <- lapply(plAnnot, function(xEl)
if(hasName(xEl, "text"))
xEl[["text"]]
)
plCaptionAnnot <- unlist(plCaptionAnnot, recursive = TRUE, use.names = FALSE)
expect_match(plCaptionAnnot, gsub("\n", ".*", caption))
# check that bottom margin is increased
plNoCaption <- scatterplotClinData(
data = data,
xVar = "DY",
yVar = "AVAL"
)
expect_gt(
object = plotly_build(plCaption)$x$layout$margin$b,
expected = plotly_build(plNoCaption)$x$layout$margin$b
)
})
test_that("A selection variable is correctly included in a scatterplot", {
data <- data.frame(
group = factor(c("A", "A", "A", "A", "B"), levels = c("B", "A")),
DY = c(1, 2, 1, 2, 3),
AVAL = c(3, 4, 2, 6, 5),
USUBJID = c(1, 1, 2, 2, 3),
stringsAsFactors = FALSE
)
res <- scatterplotClinData(
data = data,
xVar = "DY",
yVar = "AVAL",
aesLineVar = list(group = "USUBJID"),
selectVars = "group"
)
# check the output:
expect_s3_class(res, "clinDataReview")
expect_named(res, expected = c("buttons", "plot"))
expect_s3_class(res$plot, "plotly")
expect_length(res$buttons, 1)
# check button values
btnScriptTag <- htmltools::tagQuery(res$buttons)$find("script")$selectedTags()
buttonData <- jsonlite::fromJSON(txt = as.character(btnScriptTag[[1]]$children))
expect_equal(object = buttonData$items$value, expected = levels(data$group))
})
test_that("A box to highlight the elements of the ID variable is correctly included in a scatterplot", {
data <- data.frame(
DY = c(1, 2, 1, 2),
AVAL = c(3, 4, 2, 6),
USUBJID = c(1, 1, 2, 2),
stringsAsFactors = FALSE
)
pl <- scatterplotClinData(
data = data,
xVar = "DY",
yVar = "AVAL",
idHighlightBox = TRUE
)
# check the output:
expect_s3_class(pl, "plotly")
expect_true(pl$x$highlight$selectize)
})
test_that("A watermark is correctly included in a (facetted) scatterplot", {
data <- data.frame(
USUBJID = as.character(seq.int(5)),
LBSTRESN = c(39, 93, 10, 31, 13),
LBSTRESNBL = c(10, 12, 13, 14, 9)
)
file <- tempfile(pattern = "watermark", fileext = ".png")
getWatermark(file = file)
pl <- scatterplotClinData(
data = data,
xVar = "LBSTRESNBL", yVar = "LBSTRESN",
facetPars = list(facets = "USUBJID"),
watermark = file
)
# check that an image has been included below the plot
plBuild <- plotly::plotly_build(pl)
expect_equal(
object = sapply(plBuild$x$layout$images, `[[`, "layer"),
expected = "below"
)
})
Try the clinDataReview package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.