tests/testthat/test-datalabelmatrix.R

In Displayr/flipChartTests3: Visual unit tests for flipChart and flipStandardCharts

context("Data label matrix")
library(flipStandardCharts)
library(flipChartTests)

set.seed(12345)
dat2d <- matrix(rnorm(35, 5, 4), 7, 5, dimnames = list(letters[1:7], LETTERS[1:5]))
dat2dpos <- matrix(abs(rnorm(35, 5, 4)), 7, 5, dimnames = list(letters[1:7], LETTERS[1:5]))
dshow <- matrix(FALSE, 7, 5)
dshow[1,2] <- TRUE
dshow[2,3] <- TRUE
dshow[5,4] <- TRUE
dpfix <- matrix("", 7, 5)
dpfix[which(dshow)] <- paste0(letters[1:3], "<")
dsfix <- matrix("", 7, 5)
dsfix[dshow] <- paste0(">", 1:3)

missing1 <- structure(c(NA, 4L, 7L, 3L, 5L, 8L, 5L, 3L, 3L, 3L, 8L, 6L, 3L,
    5L, 4L, 5L, 4L, 5L, 4L, 5L, 6L, 3L, 9L, 5L, 4L, 6L, 5L, 3L, 2L,
    5L, 5L, 5L, 5L, 5L, 4L, 7L, 5L, 7L, 3L, 5L, 4L, 4L, 5L, 4L, 5L,
    5L, 2L, 6L, 3L, 4L, 2L, 7L, 4L, 1L, 6L, 1L, 6L, 5L, 1L, 6L), .Dim = c(20L, 3L),
    .Dimnames = list(c("25", "26", "27", "28", "29", "30", "31",
    "32", "33", "34", "35", "36", "37", "38", "39", "40", "41", "42",
    "43", "44"), c("A", "B", "C")))

missing124 <- structure(c(NA, NA, 7L, NA, 5L, 8L, 5L, 3L, 3L, 3L, 8L, 6L, 3L,
   5L, 4L, 5L, 4L, 5L, 4L, 5L, 6L, 3L, 9L, 5L, 4L, 6L, 5L, 3L, 2L,
   5L, 5L, 5L, 5L, 5L, 4L, 7L, 5L, 7L, 3L, 5L, 4L, 4L, 5L, 4L, 5L,
   5L, 2L, 6L, 3L, 4L, 2L, 7L, 4L, 1L, 6L, 1L, 6L, 5L, 1L, 6L), .Dim = c(20L,
   3L), .Dimnames = list(c("25", "26", "27", "28", "29", "30", "31",
   "32", "33", "34", "35", "36", "37", "38", "39", "40", "41", "42",
   "43", "44"), c("A", "B", "C")))

test_that("Matrix of data label inputs", {

    # 2d inputs
    expect_error(pp <- Column(dat2d, data.label.show = dshow, data.label.prefix = dpfix, data.label.suffix = dsfix, type = "Column"), NA)
    expect_true(TestWidget(pp, "datalabelmatrix-column-2d"))
    expect_error(pp <- Column(dat2d, data.label.show = dshow, data.label.prefix = dpfix, data.label.suffix = dsfix, type = "Stacked"), NA)
    expect_true(TestWidget(pp, "datalabelmatrix-columnstacked-2d"))
    expect_error(pp <- Bar(dat2d, data.label.show = dshow, data.label.prefix = dpfix, data.label.suffix = dsfix, type = "Column"), NA)
    expect_true(TestWidget(pp, "datalabelmatrix-bar-2d"))
    expect_error(pp <- Bar(dat2d, data.label.show = dshow, data.label.prefix = dpfix, data.label.suffix = dsfix, type = "Stacked"), NA)
    expect_true(TestWidget(pp, "datalabelmatrix-barstacked-2d"))
    expect_error(pp <- Line(dat2d, data.label.show = dshow, data.label.prefix = dpfix, data.label.suffix = dsfix,
         marker.show = dshow), NA)
    expect_true(TestWidget(pp, "datalabelmatrix-line-2d"))
    expect_error(pp <- Radar(dat2dpos, data.label.show = dshow, data.label.prefix = dpfix, data.label.suffix = dsfix), NA)
    expect_true(TestWidget(pp, "datalabelmatrix-radar-2d"))
    expect_error(pp <- Area(dat2dpos, data.label.show = dshow, data.label.prefix = dpfix, data.label.suffix = dsfix, type = "Stacked"), NA)
    expect_true(TestWidget(pp, "datalabelmatrix-area-2d"))
    
    # 1D input
    expect_error(pp <- Column(1:5, data.label.show = c(T,F,T,F,F), data.label.prefix = LETTERS[1:5]), NA)
    expect_true(TestWidget(pp, "datalabelmatrix-column-1d"))
    expect_error(pp <- Pyramid(1:5, data.label.show = c(T,F,T,F,F), data.label.prefix = LETTERS[1:5]), NA)
    expect_true(TestWidget(pp, "datalabelmatrix-pyramid-1d"))
    expect_error(pp <- BarMultiColor(1:5, data.label.show = c(T,F,T,F,F), data.label.prefix = LETTERS[1:5]), NA)
    expect_true(TestWidget(pp, "datalabelmatrix-barmulticolor-1d"))
    
    # Small Multiples
    expect_error(pp <- SmallMultiples(dat2d, "Column", data.label.show = dshow, data.label.prefix = dpfix,
        average.show = T, data.label.format = ".2f"), NA)
    expect_true(TestWidget(pp, "datalabelmatrix-column-smallmult"))
    expect_error(pp <- SmallMultiples(dat2d, "BarMultiColor", data.label.show = dshow, data.label.prefix = dpfix,
        average.show = T, data.label.format = ".2f"), NA)
    expect_true(TestWidget(pp, "datalabelmatrix-barmulticolor-smallmult"))
    expect_error(pp <- SmallMultiples(dat2dpos, "Pyramid", data.label.show = dshow, data.label.prefix = dpfix,
        average.show = T, data.label.format = ".2f"), NA)
    expect_true(TestWidget(pp, "datalabelmatrix-pyramid-smallmult"))
    expect_error(pp <- SmallMultiples(dat2d, "Line", data.label.show = dshow, data.label.prefix = dpfix, average.show = T), NA)
    expect_true(TestWidget(pp, "datalabelmatrix-line-smallmult"))
    expect_error(pp <- SmallMultiples(dat2d, "Area", data.label.show = dshow, data.label.prefix = dpfix, average.show = T), NA)
    expect_true(TestWidget(pp, "datalabelmatrix-area-smallmult"))
    expect_error(pp <- SmallMultiples(dat2dpos, "Radar", data.label.show = dshow, data.label.prefix = dpfix, average.show = T,
                   opacity = 0.8, line.thickness = 2), NA)
    expect_true(TestWidget(pp, "datalabelmatrix-radar-smallmult"))
    
    # Data labels at ends
    expect_error(pp <- Line(dat2d, data.label.show.at.ends = T, marker.show.at.ends = T), NA)
    expect_true(TestWidget(pp, "datalabelmatrix-line-ends-with-markers"))
    expect_error(pp <- Line(dat2d, data.label.show.at.ends = T, marker.show = T), NA)
    expect_true(TestWidget(pp, "datalabelmatrix-line-ends"))
    
    expect_warning(pp <- Line(missing1, data.label.show.at.ends = T, marker.show.at.ends = T,
        data.label.font.autocolor = TRUE, marker.size = 20), "Missing values have been omitted")
    expect_true(TestWidget(pp, "datalabelmatrix-line-ends-missing1"))
    expect_warning(pp <- Line(missing124, data.label.show.at.ends = T, marker.show.at.ends = T,
        data.label.font.autocolor = TRUE, marker.size = 20), "Missing values have been omitted")
    expect_true(TestWidget(pp, "datalabelmatrix-line-ends-missing124"))
    expect_warning(pp <- Line(missing1, data.label.show.at.ends = T, marker.show.at.ends = T,
        data.label.font.autocolor = TRUE, marker.size = 20, data.label.format = ".2f",
        data.label.prefix = "$", data.label.suffix = letters[1:6]))
    expect_true(TestWidget(pp, "datalabelmatrix-line-ends-datalabelformat"))
    
    showmat <- matrix(FALSE, 20, 3)
    showmat[c(3,5, 19),] <- TRUE
    expect_warning(pp <- Line(missing1, data.label.show = showmat, marker.show = showmat, marker.size = 20,
        opacity = 0.5), "Missing values have been omitted")
    expect_true(TestWidget(pp, "datalabelmatrix-line-missing1"))
    expect_warning(pp <- Line(missing124, data.label.show = showmat, marker.show = showmat, marker.size = 20), "Missing values have been omitted")
    expect_true(TestWidget(pp, "datalabelmatrix-line-missing124"))
    
    sizemat <- matrix(3, 20, 3)
    sizemat[c(3, 5, 19),] <- 8
    expect_warning(pp <- Line(missing124, marker.show = TRUE, 
        marker.size = sizemat*3, opacity = 0.2,
        data.label.show = TRUE, data.label.position = c("top", "bottom", "bottom"),
        data.label.font.autocolor = TRUE), "Missing values have been omitted")
    expect_true(TestWidget(pp, "datalabelmatrix-line-markersizes"))
    
    # Invisible markers to reposition datalabels
    m.size <- rep(1, 20)
    m.size[c(37, 39, 41, 43) - 24] <- 10
    m.size[c(37) - 24] <- 20
    m.prefix <- rep("", 20)
    m.prefix[c(31, 32, 36) - 24] <- "   "
    m.suffix <- rep("", 20)
    m.suffix[c(29, 34) - 24] <- "   "
    expect_warning(pp <- Line(missing124[,1], data.label.show = TRUE, 
        marker.show = TRUE, marker.opacity = 0, marker.size = m.size, 
        data.label.prefix = m.prefix, data.label.suffix = m.suffix), "Missing values have been omitted")
    expect_true(TestWidget(pp, "datalabelmatrix-markers-invisible"))

    # Line markers in secondary data series
    expect_error(pp <- Column(dat2dpos, x2 = dat2d, opacity = 0.2, x2.data.label.show.at.ends = TRUE,
        x2.marker.show.at.ends = TRUE), NA)
    expect_true(TestWidget(pp, "datalabelmatrix-combined-chart"))
    expect_error(pp <- Column(dat2dpos, x2 = dat2d, opacity = 0.2, x2.data.label.show.at.ends = TRUE,
        x2.marker.show.at.ends = TRUE, type = "Stacked"), NA)
    expect_true(TestWidget(pp, "datalabelmatrix-combined-chart-stacked"))
})