tests/testthat/test-scatter.R

In dittoViz: User Friendly Data Visualization

# Tests for scatterPlot function
# library(dittoViz); library(testthat); source("tests/testthat/setup.R"); for (i in list.files("R", pattern="^utils", full.names = TRUE)) source(i); source("tests/testthat/test-scatter.R")

df$number <- as.numeric(seq_len(nrow(df)))
cont <- "number"
cont2 <- "bill_length_mm"
disc <- "species"
disc2 <- "island"

test_that("scatterPlot can plot continuous or discrete data", {
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc),
        "ggplot")
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", cont),
        "ggplot")
})

test_that("scatterPlot basic tweaks work", {
    # Manuel Check: big dots
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", cont,
            size = 10),
        "ggplot")
    # Manuel Check: triangles
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", cont,
            shape.panel = 17),
        "ggplot")
    # Manuel Check: see through large dots
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", cont,
            size = 5,
            opacity = 0.5),
        "ggplot")
})

test_that("scatterPlot main legend can be removed or adjusted, color and shape", {

    ### Manual Check: Legend removed
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc,
            legend.show = FALSE),
        "ggplot")

    ### Manual Check: Legend title = "WOW" & Legend symbols LARGE (color)
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc,
            legend.color.size = 45,
            legend.color.title = "WOW"),
        "ggplot")
    ### Manual Check: Legend title = "WOW" & Legend symbols LARGE (shape)
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", shape.by = disc,
            legend.shape.size = 45,
            legend.shape.title = "WOW"),
        "ggplot")

    ### Manual Check: Legend breaks not evenly dispersed & labeled with given text
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", "number",
            legend.color.breaks = c(1, 50, 150, 200),
            legend.color.breaks.labels = c("1", "fifty", "one-fifty", "two hundred plus")),
        "ggplot")

    ### Manual Check: Legend breaks not evenly dispersed & labeled with given text
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", "number",
            min.value = -50,
            max.value = 1000),
        "ggplot")
})

test_that("scatterPlot color scale can be adjusted", {

    ### Manual Check:
    # Scale extends from below zero to 1000, all points in yellow to green range
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", "number",
            min.value = -50,
            max.value = 1000),
        "ggplot")

    ### Manual Check:
    # Gray-scale
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", "number",
            min.color = "black",
            max.color = "grey70"),
        "ggplot")
})

test_that("scatterPlots can be subset to show only certain rows with any rows.use method", {
    expect_s3_class(
        {c1 <- scatterPlot(
            df, "PC1", "PC2", disc, data.out = TRUE,
            rows.use = rows.names)
        c1$p},
        "ggplot")
    expect_s3_class(
        {c2 <- scatterPlot(
            df, "PC1", "PC2", disc, data.out = TRUE,
            rows.use = rows.logical)
        c2$p},
        "ggplot")
    expect_s3_class(
        {c3 <- scatterPlot(
            df, "PC1", "PC2", disc, data.out = TRUE,
            rows.use = rows.nums)
        c2$p},
        "ggplot")

    # All equal?
    expect_equal(c1$Target_data, c2$Target_data)
    expect_equal(c1$Target_data, c3$Target_data)
    expect_equal(nrow(c3$Target_data), 40)

    # And if we remove an entire grouping...
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc,
            rows.use = df[[disc]]!="Adelie"),
        "ggplot")
})

test_that("scatterPlot shapes and colors can be adjusted", {
    ### Manual check:
    # Shapes should be triangle, diamond, circle
    # Color should be red, blue, yellow
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2",
            color.by = disc,
            shape.by = disc2,
            shape.panel = 17:19,
            color.panel = cols),
        "ggplot")

    # By names
    ### Manual check:
    # Both flipped compared to above
    # Shapes should be triangle, diamond, circle
    # Color should be red, blue, yellow
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2",
            color.by = disc,
            shape.by = disc2,
            shape.panel = c(Biscoe = 19, Dream = 18, Torgersen = 17),
            color.panel = c(Gentoo = cols[1], Chinstrap = cols[2], Adelie = cols[3])),
        "ggplot")

    # 'colors' input
    ### Manual check:
    # Pink, red, darker blue
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2",
            color.by = disc,
            colors = 7:5),
        "ggplot")
})

test_that("scatterPlots titles and theme can be adjusted", {
    ### Manual check: All titles should be adjusted.
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", cont,
            main = "Gotta catch", sub = "em all",
            xlab = "Pokemon", ylab = "Pokedex #s",
            legend.color.title = "types"),
        "ggplot")
    ### Manual check: top and right plot outline removed
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", cont,
            theme = theme_classic()),
        "ggplot")
})

test_that("scatterPlot allows plotting of multiple vars, via faceting", {
    expect_s3_class(
        scatterPlot(
            data_frame=df, x.by=cont, y.by=cont2, c(cont, cont2)),
        "ggplot")

    # These should have transposed facet grids
    expect_s3_class(
        print(scatterPlot(
            data_frame=df, x.by=cont, y.by=cont2, c(cont, cont2),
            split.by = disc2)),
        "ggplot")
    expect_s3_class(
        print(scatterPlot(
            data_frame=df, x.by=cont, y.by=cont2, c(cont, cont2),
            split.by = disc2, multivar.split.dir = "row")),
        "ggplot")

    # Works with rows.use
    expect_s3_class(
        scatterPlot(
            data_frame=df, x.by=cont, y.by=cont2, c(cont, cont2),
            rows.use = rows.logical),
        "ggplot")

    expect_error(
        scatterPlot(
            data_frame=df, x.by=cont, y.by=cont2, c(disc, cont, cont2)),
        "Only numeric", fixed = TRUE)

    expect_warning(
        scatterPlot(
            data_frame=df, x.by=cont, y.by=cont2, c(cont, cont2),
            split.by = c(disc2,disc)),
        "will be ignored", fixed = TRUE)
})

test_that("scatterPlots discrete labels can be adjusted", {
    ### Manual Check:
    # Legend labels = 5:7
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc,
            rename.color.groups = 5:7),
        "ggplot")
    ### Manual Check:
    # Legend labels = 3:5
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2",
            shape.by = disc2,
            rename.shape.groups = 3:5),
        "ggplot")
})

test_that("scatterPlot can be labeled or circled", {
    ### Manual Check (next 2)
    # Labels should move around between plots, only boxed in 1st
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc,
            do.label = TRUE),
        "ggplot")
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc,
            do.label = TRUE,
            labels.highlight = FALSE),
        "ggplot")

    ### Manual Check (next 2)
    # No movement of lebels, only boxed in 1st
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc,
            do.label = TRUE,
            labels.repel = FALSE),
        "ggplot")
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc,
            do.label = TRUE,
            labels.highlight = FALSE,
            labels.repel = FALSE),
        "ggplot")

    ### Manual Check
    # smaller labels
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc,
            do.label = TRUE,
            labels.size = 3),
        "ggplot")

    ### Manual Check
    # labels to right side
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc,
            do.label = TRUE,
            labels.repel.adjust = list(xlim=c(5,NA))),
        "ggplot")
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc,
            do.label = TRUE,
            labels.repel.adjust = list(xlim=c(5,NA)),
            labels.highlight = FALSE),
        "ggplot")
})

test_that("scatterPlot labeling is robust to NAs", {

    # In color data
    na_in_color <- df
    na_in_color$species[df$sex=="male"] <- NA
    expect_warning(
        scatterPlot(
            na_in_color, "PC1", "PC2", "species",
            do.label = TRUE),
        NA)

    na_in_pc1 <- df
    na_in_pc1$PC1[1:10] <- NA

    # Manual Check: Should be all four labels!
    # There should be a warning here form the x/y coords, but not the labeling
    expect_true(
        all(!grepl(
            "label",
            names(warnings(
                scatterPlot(na_in_pc1, "PC1", "PC2", "species", do.label = TRUE)
            ))
        ))
    )

})

test_that("scatterPlot trajectory adding works", {
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc,
            add.trajectory.by.groups = list(
                c("Adelie","Chinstrap","Gentoo"),
                c("Gentoo","Adelie")),
            trajectory.group.by = disc,
            do.label = TRUE),
        "ggplot")
    # Manual Check: Arrows should move & GROW.
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", cont,
            add.trajectory.by.groups = list(
                c("Chinstrap","Adelie")),
            trajectory.group.by = disc,
            trajectory.arrow.size = 1),
        "ggplot")
    # Manual Check: Arrows should be detached from points
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc,
            add.trajectory.curves = list(
                data.frame(
                    c(-20,20,-50),
                    c(-20,-10,0)),
                data.frame(
                    c(5:20)*10,
                    c(5:10,9:5,6:10)
                )),
            trajectory.group.by = disc),
        "ggplot")
})

test_that("scatterPlot lettering works", {
    ### Manual Check: Letters should be added
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc,
            do.letter = TRUE, size = 3),
        "ggplot")
    ### Manual Check: see through dots and letters
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc,
            do.letter = TRUE, size = 3,
            opacity = 0.5),
        "ggplot")
})

test_that("scatterPlot plotting order can be ordered by the data, or have order randomized", {
    un <- scatterPlot(df, "PC1", "PC2", disc, data.out = TRUE, size = 10, plot.order = "unordered")
    dec <- scatterPlot(df, "PC1", "PC2", disc, data.out = TRUE, size = 10, plot.order = "decreasing")
    inc <- scatterPlot(df, "PC1", "PC2", disc, data.out = TRUE, size = 10, plot.order = "increasing")
    set.seed(42) # Hopefully with 2 different seeds, we can ensure that 1 will diverge from the original
    ran <- scatterPlot(df, "PC1", "PC2", disc, data.out = TRUE, size = 10, plot.order = "randomize")
    set.seed(12345)
    ran2 <- scatterPlot(df, "PC1", "PC2", disc, data.out = TRUE, size = 10, plot.order = "randomize")
    ### Manual Check:
    # Orange always in front
    expect_s3_class(
        dec$p,
        "ggplot")
    ### Manual Check:
    # Plots different
    expect_s3_class(
        un$p,
        "ggplot")
    expect_s3_class(
        ran$p,
        "ggplot")
    expect_s3_class(
        ran2$p,
        "ggplot")
    expect_false(
        all(c(
            identical(
                rownames(un$Target_data),
                rownames(ran$Target_data)),
            identical(
                rownames(un$Target_data),
                rownames(ran2$Target_data))
        ))
    )
    ### Manual Check: Dark blue always in front
    expect_equal(
        dec$Target_data$color,
        rev(inc$Target_data$color)
    )
})

test_that("scatterPlot adding contours", {
    expect_s3_class(
        scatterPlot(df, "PC1", "PC2", disc,
                    do.contour = TRUE),
        "ggplot")

    ### Manual Check:
    # Contour lines light blue and dashed (not black as above)
    expect_s3_class(
        scatterPlot(df, "PC1", "PC2", disc,
                    do.contour = TRUE,
                    contour.color = "lightblue", contour.linetype = "dashed"),
        "ggplot")
})

test_that("scatterPlot with and without rasterization produces identical plots", {
    ### Manual Check:
    # These plots should appear nearly identical
    expect_s3_class(
        scatterPlot(df, "PC1", "PC2", disc,
                    do.raster = TRUE),
        "ggplot")

    expect_s3_class(
        scatterPlot(df, "PC1", "PC2", disc),
        "ggplot")
})

test_that("scatterPlot ignores do.letter/do.label/do.ellipse for continuous data", {
    expect_message(scatterPlot(df, "PC1", "PC2", cont,
                                do.label = TRUE),
                   "do.label was/were ignored for non-discrete data", fixed = TRUE)
    expect_message(scatterPlot(df, "PC1", "PC2", cont,
                                do.letter = TRUE),
                   "do.letter was/were ignored for non-discrete data", fixed = TRUE)
    expect_message(scatterPlot(df, "PC1", "PC2", cont,
                                do.ellipse = TRUE),
                   "do.ellipse was/were ignored for non-discrete data", fixed = TRUE)

    # No message for discrete data && MANUAL CHECK: ellipse is drawn
    expect_message(scatterPlot(df, "PC1", "PC2", disc,
                                do.ellipse = TRUE),
                   NA)
})

test_that("scatterPlot can be faceted with split.by (1 or 2 vars)", {
    # MANUAL CHECK: FACETING
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc,
            split.by = disc2),
        "ggplot")
    # horizontal
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc,
            split.by = disc2,
            split.nrow = 1),
        "ggplot")
    # vertical
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc,
            split.by = disc2,
            split.ncol = 1),
        "ggplot")
    # Grid with rows=island, cols=species
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc,
            split.by = c(disc2,disc)),
        "ggplot")
})

test_that("scatterPlot faceting and rows.use and split.show.all.others work together", {
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc,
            split.by = c(disc2),
            rows.use = rows.logical,
            split.show.all.others = FALSE),
        "ggplot")
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc,
            split.by = c(disc2,disc),
            rows.use = rows.logical,
            split.show.all.others = FALSE),
        "ggplot")

    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc,
            split.by = c(disc2,disc),
            rows.use = rows.logical,
            split.show.all.others = TRUE),
        "ggplot")
    expect_s3_class(
        scatterPlot(
            df, "PC1", "PC2", disc,
            split.by = c(disc2,disc),
            rows.use = rows.logical,
            split.show.all.others = TRUE),
        "ggplot")
})

test_that("scatterPlot added features work with single-column faceting", {
    expect_error(
        print(scatterPlot(
            df, "PC1", "PC2", disc,
            split.by = disc2,
            do.label = TRUE,
            split.show.all.others = FALSE)),
        NA)
    expect_error(
        print(scatterPlot(
            df, "PC1", "PC2", disc,
            split.by = disc2,
            do.ellipse = TRUE,
            split.show.all.others = FALSE)),
        NA)
    expect_error(
        print(scatterPlot(
            df, "PC1", "PC2", disc,
            split.by = disc2,
            do.letter = TRUE,
            split.show.all.others = FALSE)),
        NA)
    expect_error(
        print(scatterPlot(
            df, "PC1", "PC2", disc,
            split.by = disc2,
            do.contour = TRUE,
            split.show.all.others = FALSE)),
        NA)
    expect_error(
        print(scatterPlot(
            df, "PC1", "PC2", disc,
            split.by = disc2,
            add.trajectory.by.groups = list(
                c("C","A")),
            trajectory.group.by = disc,
            split.show.all.others = FALSE)),
        NA)
    expect_error(
        print(scatterPlot(
            df, "PC1", "PC2", disc,
            split.by = disc2,
            add.trajectory.curves = list(
                data.frame(
                    c(-10,0,-20),
                    c(-20,-10,0)),
                data.frame(
                    c(5:20),
                    c(5:10,9:5,6:10))),
            split.show.all.others = FALSE)),
        NA)
})

test_that("scatterPlot added features work with double-column faceting", {
    expect_error(
        print(scatterPlot(
            df, "PC1", "PC2", disc,
            split.by = c(disc2,disc),
            do.label = TRUE,
            split.show.all.others = FALSE)),
        NA)
    expect_error(
        print(scatterPlot(
            df, "PC1", "PC2", disc,
            split.by = c(disc2,disc),
            do.ellipse = TRUE,
            split.show.all.others = FALSE)),
        NA)
    expect_error(
        print(scatterPlot(
            df, "PC1", "PC2", disc,
            split.by = c(disc2,disc),
            do.letter = TRUE,
            split.show.all.others = FALSE)),
        NA)
    expect_error(
        print(scatterPlot(
            df, "PC1", "PC2", disc,
            split.by = c(disc2,disc),
            add.trajectory.by.groups = list(
                c("C","A")),
            trajectory.group.by = disc,
            split.show.all.others = FALSE)),
        NA)
    expect_error(
        print(scatterPlot(
            df, "PC1", "PC2", disc,
            split.by = c(disc2,disc),
            add.trajectory.curves = list(
                data.frame(
                    c(-10,0,-20),
                    c(-20,-10,0)),
                data.frame(
                    c(5:20),
                    c(5:10,9:5,6:10))),
            split.show.all.others = FALSE)),
        NA)
})

# adjustments
test_that("scatterPlot data adjustments applied", {
    expect_s3_class(
        (p <- scatterPlot(
            cont, data_frame = df, x.by=cont, y.by=cont, data.out = TRUE,
            x.adj.fxn=function(x) as.vector(scale(x)),
            y.adj.fxn=function(x) {round(as.vector(scale(x)), 0)},
            color.adjustment = "z-score"))$plot, "ggplot")
    expect_equal(
        p$Target_data[[p$cols_used$y.by]],
        round(p$Target_data[[p$cols_used$x.by]],0))
    expect_equal(
        round(mean(p$Target_data[[p$cols_used$x.by]]),0),
        0)
    expect_equal(
        p$Target_data[[p$cols_used$color.by]],
        p$Target_data[[p$cols_used$x.by]])
    expect_s3_class(
        (p <- scatterPlot(
            cont, data_frame = df, x.by=cont, y.by=cont, data.out = TRUE,
            y.adjustment= "relative.to.max"))$plot, "ggplot")
    expect_equal(
        max(p$Target_data[[p$cols_used$y.by]]), 1)
})

test_that("scatterPlot added arbitrary horizontal and vertical lines work", {
    expect_s3_class(
        scatterPlot(df, "PC1", "PC2", disc,
                    add.yline = c(-1, 1), add.xline = c(2)),
        "ggplot")

    ### Manual Check:
    # Vertical lines dotted and horizontal line red (not black and dashed as above)
    expect_s3_class(
        scatterPlot(df, "PC1", "PC2", disc,
                    add.yline = c(-1, 1), add.xline = c(2),
                    yline.color = "red", xline.linetype = "dotted"),
        "ggplot")
})