tests/testthat/test-hover.R

In dittoViz: User Friendly Data Visualization

# Tests for visualization functions
# 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-hover.R")

cont1 <- "number"
cont2 <- "bill_length_mm"
cont3 <- "flipper_length_mm"
cont4 <- "body_mass_g"
disc <- "groups"
disc2 <- "age"
disc3 <- "sex"
disc4 <- "island"

df$sample <- factor(
    sample(1:15, nrow(df), replace = TRUE),
    levels = 1:15)
df$sample_groups <- "B"
df$sample_groups[df$sample %in% 1:8] <- "A"
df$sample_subgroups <- "sg5"
df$sample_subgroups[df$sample %in% c(1,6,11)] <- "sg1"
df$sample_subgroups[df$sample %in% c(2,7,12)] <- "sg2"
df$sample_subgroups[df$sample %in% c(3,8,13)] <- "sg3"
df$sample_subgroups[df$sample %in% c(4,9,14)] <- "sg4"

plotly_installed <- requireNamespace("plotly", quietly = TRUE)

### scatterPlot
test_that("Showing hover.data works for scatterPlot (with rows.use)", {
    if (plotly_installed) {
        expect_s3_class(
            scatterPlot(df, cont1, cont2, do.hover = TRUE,
                             hover.data = c(cont1,disc2),
                             data.out = TRUE)[[1]],
            "plotly")
        expect_s3_class(
            scatterPlot(df, cont1, cont2, do.hover = TRUE,
                             hover.data = c(cont1,disc2),
                             rows.use = rep(c(TRUE,FALSE), length.out = nrow(df))),
            "plotly")
    } else {
        expect_error(
            scatterPlot(df, cont1, cont2, do.hover = TRUE,
                             hover.data = c(cont1,disc2)),
            "plotly installation required for using hover", fixed = TRUE)
    }
})

test_that("scatterPlot hover.data default captures all desired aspects", {
    skip_if_not(plotly_installed, message = "No plotly")

    # Single var
    expect_s3_class(
        (x <- scatterPlot(
            df, cont1, cont2, cont3,
            x.adjustment = "z-score",
            y.adjustment = "relative.to.max",
            color.adj.fxn = ceiling,
            shape.by = disc, split.by = disc2,
            do.hover = TRUE,
            rows.use = rep(c(TRUE,FALSE), length.out = nrow(df)),
            data.out = TRUE))$plot,
        "plotly")
    first_hover <- x$Target_data$hover.string[1]
    expectations <- c(
        cont1, paste0(cont1, ".x.adj"),
        cont2, paste0(cont2, ".y.adj"),
        cont3, paste0(cont3, ".color.adj"),
        disc, disc2)
    expect_equal(
        vapply(
            expectations,
            function(check) {
                grepl(check, first_hover)
            },
            logical(1)
        ),
        rep(TRUE, length(expectations)),
        ignore_attr = TRUE
    )

    # Multi var
    expect_s3_class(
        (x <- scatterPlot(
            df, cont1, cont2, c(cont3, cont4),
            x.adjustment = "z-score",
            y.adjustment = "relative.to.max",
            color.adj.fxn = ceiling,
            shape.by = disc, split.by = disc2,
            do.hover = TRUE,
            rows.use = rep(c(TRUE,FALSE), length.out = nrow(df)),
            data.out = TRUE))$plot,
        "plotly")
    first_hover <- x$Target_data$hover.string[1]
    expectations <- c(
        cont1, paste0(cont1, ".x.adj"),
        cont2, paste0(cont2, ".y.adj"),
        cont3, cont4, "color.multi", "color.which",
        disc, disc2)
    expect_equal(
        vapply(
            expectations,
            function(check) {
                grepl(check, first_hover)
            },
            logical(1)
        ),
        rep(TRUE, length(expectations)),
        ignore_attr = TRUE
    )
})

test_that("scatterPlot hover.round.digits rounds numeric data", {
    skip_if_not(plotly_installed, message = "No plotly")

    length2 <- nchar(
        scatterPlot(
            df, cont1, cont2, do.hover = TRUE,
            hover.data = "PC1", data.out = TRUE,
            hover.round.digits = 2)$Target_data$hover.string[1]
    )
    length1 <- nchar(
        scatterPlot(
            df, cont1, cont2, do.hover = TRUE,
            hover.data = "PC1", data.out = TRUE,
            hover.round.digits = 1)$Target_data$hover.string[1]
    )

    expect_gt(length2, length1)
})

### yPlot
test_that("Showing hover.data works for yPlot, with rows.use", {
    if (plotly_installed) {
        expect_s3_class(
            yPlot(
                df, cont1,
                group.by = disc, color.by = disc,
                do.hover = TRUE,
                hover.data = c(cont1,disc2),
                data.out = TRUE)[[1]],
            "plotly")
        expect_s3_class(
            yPlot(
                df, cont1,
                group.by = disc, color.by = disc,
                do.hover = TRUE,
                hover.data = c(cont1,disc2),
                rows.use = rep(c(TRUE,FALSE), length.out = nrow(df))),
            "plotly")
        ### MANUAL CHECK: jitters should be centered within violins
        expect_s3_class(
            yPlot(
                df, cont1,
                group.by = disc, color.by = "sex",
                do.hover = TRUE,
                hover.data = c(cont1,disc2), vlnplot.width = 1,
                rows.use = rep(c(TRUE,FALSE), length.out = nrow(df))),
            "plotly")
    } else {
        expect_error(
            yPlot(
                df, cont1,
                group.by = disc, color.by = disc,
                do.hover = TRUE,
                hover.data = c(cont1,disc2)),
            "plotly installation required for using hover", fixed = TRUE)
    }
})

test_that("yPlot hover.data default captures all desired aspects", {
    skip_if_not(plotly_installed, message = "No plotly")

    # Single var
    expect_s3_class(
        (x <- yPlot(
            df, cont1,
            var.adjustment = "z-score",
            group.by = disc, color.by = disc3,
            shape.by = disc2, split.by = disc4,
            do.hover = TRUE,
            plots = "jitter",
            rows.use = rep(c(TRUE,FALSE), length.out = nrow(df)),
            data.out = TRUE))$p,
        "plotly")
    first_hover <- x$data$hover.string[1]
    expectations <- c(cont1, paste0(cont1, ".adj"), disc, disc2, disc3, disc4)
    expect_equal(
        vapply(
            expectations,
            function(check) {
                grepl(check, first_hover)
            },
            logical(1)
        ),
        rep(TRUE, length(expectations)),
        ignore_attr = TRUE
    )

    # Multi var
    expect_s3_class(
        (x <- yPlot(
            df, c(cont1, cont2),
            var.adjustment = "z-score",
            group.by = disc, color.by = disc3,
            shape.by = disc2, split.by = disc4,
            do.hover = TRUE,
            plots = "jitter",
            rows.use = rep(c(TRUE,FALSE), length.out = nrow(df)),
            data.out = TRUE))$p,
        "plotly")
    first_hover <- x$data$hover.string[1]
    expectations <- c(cont1, cont2, "var.multi", "var.which", disc, disc2, disc3, disc4)
    expect_equal(
        vapply(
            expectations,
            function(check) {
                grepl(check, first_hover)
            },
            logical(1)
        ),
        rep(TRUE, length(expectations)),
        ignore_attr = TRUE
    )
})

test_that("yPlot hover.round.digits rounds numeric data", {
    skip_if_not(plotly_installed, message = "No plotly")

    length2 <- nchar(
        yPlot(
            df, cont1, group.by = disc, do.hover = TRUE,
            hover.data = "PC1", data.out = TRUE,
            hover.round.digits = 2)$data$hover.string[1]
    )
    length1 <- nchar(
        yPlot(
            df, cont1, group.by = disc, do.hover = TRUE,
            hover.data = "PC1", data.out = TRUE,
            hover.round.digits = 1)$data$hover.string[1]
    )

    expect_gt(length2, length1)
})

### barPlot
test_that("Showing hover.data works for barPlot (with rows.use)", {
    if (requireNamespace("plotly", quietly = TRUE)) {
        expect_s3_class(
            barPlot(
                df, disc2,
                group.by = disc,
                do.hover = TRUE,
                data.out = TRUE)[[1]],
            "plotly")
        expect_s3_class(
            barPlot(
                df, disc2,
                group.by = disc,
                do.hover = TRUE,
                rows.use = rep(c(TRUE,FALSE), length.out = nrow(df))),
            "plotly")
    } else {
        expect_error(
            barPlot(
                df, disc2,
                group.by = disc,
                do.hover = TRUE),
            "plotly installation required for using hover", fixed = TRUE)
    }
})

test_that("barPlot hover.data default captures all desired aspects", {
    skip_if_not(plotly_installed, message = "No plotly")

    # var and group.by
    expect_s3_class(
        (x <- barPlot(
            df, disc,
            group.by = disc2, split.by = disc3,
            do.hover = TRUE,
            rows.use = rep(c(TRUE,FALSE), length.out = nrow(df)),
            data.out = TRUE))$p,
        "plotly")
    first_hover <- x$data$hover.string[1]
    expectations <- c(disc, disc2, disc3, "count", "percent")
    expect_equal(
        vapply(
            expectations,
            function(check) {
                grepl(check, first_hover)
            },
            logical(1)
        ),
        rep(TRUE, length(expectations)),
        ignore_attr = TRUE
    )
})

test_that("barPlot hover.round.digits rounds numeric data", {
    skip_if_not(plotly_installed, message = "No plotly")

    length2 <- nchar(
        barPlot(
            df, disc, group.by = disc2, do.hover = TRUE, data.out = TRUE,
            hover.round.digits = 2)$data$hover.string[1]
    )
    length0 <- nchar(
        barPlot(
            df, disc, group.by = disc2, do.hover = TRUE, data.out = TRUE,
            hover.round.digits = 0)$data$hover.string[1]
    )
    expect_gt(length2, length0)
})

### freqPlot
test_that("Showing hover.data works for freqPlot (with rows.use)", {
    if (requireNamespace("plotly", quietly = TRUE)) {
        expect_s3_class(
            freqPlot(
                df, disc2,
                group.by = disc,
                do.hover = TRUE,
                data.out = TRUE)[[1]],
            "plotly")
        expect_s3_class(
            freqPlot(
                df, disc2,
                group.by = disc,
                do.hover = TRUE,
                rows.use = rep(c(TRUE,FALSE), length.out = nrow(df))),
            "plotly")
    } else {
        expect_error(
            freqPlot(
                df, disc2,
                group.by = disc,
                do.hover = TRUE),
            "plotly installation required for using hover", fixed = TRUE)
    }
})

test_that("freqPlot hover.data default captures all desired aspects", {
    skip_if_not(plotly_installed, message = "No plotly")

    # var and group.by
    expect_s3_class(
        (x <- freqPlot(
            df, "species",
            sample.by = "sample",
            group.by = "sample_groups",
            color.by = "sample_subgroups",
            do.hover = TRUE,
            plots = "jitter",
            rows.use = rep(c(TRUE,FALSE), length.out = nrow(df)),
            data.out = TRUE))$p,
        "plotly")
    first_hover <- x$data$hover.string[1]
    expectations <- c("label", "sample", "grouping", "sample_subgroups", "count", "percent")
    expect_equal(
        vapply(
            expectations,
            function(check) {
                grepl(check, first_hover)
            },
            logical(1)
        ),
        rep(TRUE, length(expectations)),
        ignore_attr = TRUE
    )
})

test_that("freqPlot hover.round.digits rounds numeric data", {
    skip_if_not(plotly_installed, message = "No plotly")

    length2 <- nchar(
        freqPlot(
            df, disc2, group.by = disc, do.hover = TRUE, data.out = TRUE,
            hover.round.digits = 2)$data$hover.string[1]
    )
    length0 <- nchar(
        freqPlot(
            df, disc2, group.by = disc, do.hover = TRUE, data.out = TRUE,
            hover.round.digits = 0)$data$hover.string[1]
    )
    expect_gt(length2, length0)
})