context("Test miscellaneous functions")
library(DT)
test_that("Paths and links to patient profiles are successfully created", {
data <- data.frame(USUBJID = c("subj1", "subj2", "subj3"))
patientProfilePath <- tempfile(pattern = "patientProfiles")
dataUpdated <- createPatientProfileVar(
data = data,
patientProfilePath = patientProfilePath,
checkExist = FALSE
)
# Patient profile columns properly created
patientProfileVars <- c("patientProfileLink", "patientProfilePath")
expect_true(all(patientProfileVars %in% colnames(dataUpdated)))
expect_true(all(sapply(dataUpdated[, patientProfileVars], inherits, "character")))
})
test_that("An error is generated if the path to the patient profiles does not exist", {
data <- data.frame(USUBJID = c("subj1", "subj2", "subj3"))
expect_error(
createPatientProfileVar(
data = data,
patientProfilePath = "unExistingFolder"
),
regex = "*not found"
)
})
test_that("A warning is generated if the subject variable to extract the patient profile paths and links is not available in the data", {
data <- data.frame(USUBJID = c("subj1", "subj2", "subj3"))
patientProfilePath <- tempfile(pattern = "patientProfiles")
dir.create(patientProfilePath)
expect_warning(
createPatientProfileVar(
data = data,
patientProfilePath = patientProfilePath,
subjectVar = "usubjid"
),
regex = "patient profile variable is not created"
)
})
test_that("Hover text is correctly formatted", {
x <- c("A", "B", "C", "D")
myLabel <- "myLabel"
formatText <- formatHoverText(x = x, label = myLabel)
myLabelFormat <- sprintf("%s: %s", myLabel, paste(x, collapse = ", "))
expect_identical(
object = formatText,
expected = setNames(myLabelFormat, myLabelFormat)
)
})
test_that("Hover text is correctly formatted with a specified width", {
x <- c("A", "B", "C", "D")
myLabel <- "myLabel"
formatTextShort <- formatHoverText(x = x, label = myLabel, width = 3)
textFormat <- sprintf("%s:
%s", myLabel, paste(x, collapse = ",
"))
names(textFormat) <- sprintf("%s: %s", myLabel, paste(x, collapse = ", "))
expect_identical(object = formatTextShort, expected = textFormat)
})
test_that("One variable is correctly converted to a formula", {
varFormula <- varToFm("CHG")
expect_s3_class(varFormula, "formula")
expect_equal(
object = varFormula,
expected = as.formula("~CHG"),
check.attributes = FALSE
)
})
test_that("Multiple variables are correctly combined when converted to a formula", {
varsFormula <- varToFm(c("AVAL", "CHG"))
expect_s3_class(varsFormula, "formula")
expect_equal(
object = as.formula("~AVAL + CHG"),
expected = varsFormula,
check.attributes = FALSE
)
})
test_that("A variable with non syntactically valid name is correctly converted to a formula", {
varFormula <- varToFm("%m")
expect_s3_class(varFormula, "formula")
expect_equal(
object = as.formula("~`%m`"),
expected = varFormula,
check.attributes = FALSE
)
})
test_that("All JavaScript dependencies for the clinical data review report are correctly extracted", {
dependencies <- getJsDepClinDataReview()
expect_type(dependencies, "list")
expect_length(dependencies, 5)
matrixRes <- sapply(dependencies, expect_length, 10)
for(iDep in seq_along(dependencies))
expect_s3_class(dependencies[[!!iDep]], "html_dependency")
})
test_that("The Javascript dependency for collapsible button in the clinical data review report is correctly extracted", {
dependency <- getJsDepClinDataReview(type = "collapsibleButton")
expect_type(dependency, "list")
expect_length(dependency, n = 1)
expect_s3_class(dependency[[1]], "html_dependency")
expect_equal(object = dependency[[1]]$name, expected = "collapsibleButton")
})
test_that("The Javascript dependency for patient profiles in the clinical data review report is correctly extracted", {
dependency <- getJsDepClinDataReview("patientProfiles")
expect_type(dependency, "list")
expect_length(dependency, n = 4)
for(iDep in seq_along(dependency))
expect_s3_class(dependency[[!!iDep]], "html_dependency")
expect_setequal(
object = sapply(dependency, `[[`, "name"),
expected = c("FileSaver", "jszip", "jszip-utils", "PatientProfiles")
)
})
test_that("HTML content is correctly collapsed", {
x <- matrix(LETTERS[1 : 10])
button <- collapseHtmlContent(input = DT::datatable(x))
expect_s3_class(button, "shiny.tag.list")
names <- sapply(button, function(x) x$name)
names(names) <- NULL
expect_identical(
object = unlist(names),
c("input", "div", "br", "br")
)
outputConsole <- capture.output(button)
expect_type(outputConsole, "character")
expect_true(any(grepl("datatables", outputConsole)))
})