tests/testthat/test-other-logical-groups.R

In neuhausi/canvasXpress: Visualization Package for CanvasXpress in R

context("canvasXpress Charts - logical groups")

vals  <- c(0.41,0.39,0.49,0.34,0.34,0.38)
vars  <- c("QC_PercentDuplication")
smps  <- c("1","2","3","4","5","6")
data  <- as.data.frame(matrix(vals, nrow = 1, ncol = 6, byrow = TRUE, dimnames = list(vars, smps)))
varx  <- c("Imputed")
valx  <- c(TRUE, TRUE, TRUE, FALSE, FALSE, FALSE)
datx  <- as.data.frame(matrix(valx, nrow = 1, ncol = 6, byrow = TRUE, dimnames = list(varx, smps)))

annot_data <- datx %>%
    t() %>%
    as.data.frame() %>%
    mutate(NumericVar  = 1.5:6.5,
           CategoryVar = c("A", "B", "A", "B", "A", "B"))

# different scenarios of annotation data to send to CX
annot_data_list <- list(
    logical_only = select(annot_data, Imputed),

    # logical + numeric metadata -- we have to convert the logical field to character ("TRUE" and "FALSE")
    # to prevent CX from converting it to numeric (0 and 1)
    logical_and_num = annot_data %>%
        mutate(Imputed = as.character(Imputed)) %>%
        select(Imputed, NumericVar),

    logical_and_char = select(annot_data, Imputed, CategoryVar)
)

subtitle_list <- list(logical_only     = NULL,
                      logical_and_num  = "with additional numeric metadata",
                      logical_and_char = "with additional categorical metadata")

test_that("boxplot values are logical", {
    for (i in seq_along(annot_data_list)) {
        result <- canvasXpress(
            data             = data,
            smpAnnot         = annot_data_list[[i]],
            graphType        = "Boxplot",
            graphOrientation = "vertical",
            groupingFactors  = list("Imputed"),
            colorBy          = "Imputed",
            title            = "BoxPlot uses logical True and False",
            subtitle         = subtitle_list[[i]])

        check_ui_test(result)
    }
})

test_that("dotplot values are logical", {
    for (i in seq_along(annot_data_list)) {
        result <- canvasXpress(
            data             = data,
            smpAnnot         = annot_data_list[[i]],
            graphType        = "Dotplot",
            graphOrientation = "vertical",
            groupingFactors  = list("Imputed"),
            colorBy          = "Imputed",
            title            = "DotPlot uses logical True and False",
            subtitle         = subtitle_list[[i]])

        check_ui_test(result)
    }
})

test_that("bar plot values are logical", {
    for (i in seq_along(annot_data_list)) {
        result <- canvasXpress(
            data             = data,
            smpAnnot         = annot_data_list[[i]],
            graphType        = "Bar",
            graphOrientation = "vertical",
            groupingFactors  = list("Imputed"),
            colorBy          = "Imputed",
            title            = "Bar plot uses logical True and False",
            subtitle         = subtitle_list[[i]])

        check_ui_test(result)
    }
})

test_that("pre-calculated bar plot values are logical", {
    precalc_data <- data.frame(mean      = c(5, 10),
                               stdev     = c(0.5, 1),
                               row.names = c(FALSE, TRUE)) %>%
        t() %>%
        as.data.frame()

    precalc_annot <- data.frame(NumericVar  = c(1.5, 2.5),
                                CategoryVar = c("A", "B"))
    rownames(precalc_annot) <- c(FALSE, TRUE)

    precalc_annot_list <- list(NULL,
                               select(precalc_annot, NumericVar),
                               select(precalc_annot, CategoryVar))

    for (i in seq_along(precalc_annot_list)) {
        result <- canvasXpress(
            data             = precalc_data,
            smpAnnot         = precalc_annot_list[[i]],
            graphType        = "Bar",
            graphOrientation = "vertical",
            colorBy          = "Imputed",
            title            = "Pre-calculated bar plot uses logical True and False",
            subtitle         = subtitle_list[[i]])

        check_ui_test(result)
    }
})

test_that("histogram values are logical", {
    hist_data <- data.frame("TRUE" = vals, "FALSE" = vals, check.names = FALSE)

    hist_annot_list <- list(NULL,
                            select(annot_data, NumericVar),
                            select(annot_data, CategoryVar))

    for (i in seq_along(annot_data_list)) {
        result <- canvasXpress(
            data           = hist_data,
            varAnnot       = hist_annot_list[[i]],
            graphType      = "Scatter2D",
            title          = "Histogram uses logical True and False",
            subtitle       = subtitle_list[[i]],
            xAxisTitle     = "Some Metric",
            yAxisTitle     = "Frequency",
            citation       = "To view metadata, remove histogram before viewing table",
            afterRender    = list(list("createHistogram")))

        check_ui_test(result)
    }
})

test_that("scatter plot values are logical", {
    scatter_data <- data %>%
        t() %>%
        as.data.frame() %>%
        mutate(QC_Var2 = 1:6)

    for (i in seq_along(annot_data_list)) {
        result <- canvasXpress(
            data             = scatter_data,
            varAnnot         = annot_data_list[[i]],
            graphType        = "Scatter2D",
            shapeBy          = "Imputed",
            title            = "Scatter plot uses logical True and False",
            subtitle         = subtitle_list[[i]],
            legendOrder      = list(Imputed = list("false", "true")),
            shapeKey         = list(Imputed = list("true"  = "triangle",
                                                   "false" = "circle")))

        check_ui_test(result)
    }
})