tests/testthat/test_facets.R

In loon: Interactive Statistical Data Visualization

library(loon)
library(grid)
context("test_facets")

pdf(NULL)
test_that("l_plot facets work with serialaxes glyph", {
    p <- with(quakes, l_plot(long, lat,
                             xlab = "long",
                             ylab = "lat",
                             linkingGroup = "quakes",
                             title = "earthquakes"))
    p["color"][quakes$mag < 5 & quakes$mag >= 4] <- "lightgreen"
    p["color"][quakes$mag < 6 & quakes$mag >= 5] <- "lightblue"
    p["color"][quakes$mag >= 6] <- "firebrick"
    gs <- l_glyph_add_serialaxes(p, data = quakes, showArea=FALSE)
    p['glyph'][1:100] <- gs
    f <- l_facet(p, by = "color", layout = "grid", linkingGroup = "quakes")
    expect_equal(class(f), c("l_facet_grid", "l_facet",    "l_compound", "loon" ))
    expect_equal(length(f), 3L)

    # loonGrob
    g <- loonGrob(f)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))
})

test_that("l_plot facets work with  pointrange glyph", {
    p <- l_plot(x = rep(1:3, 2),
                color = rep(c('red', 'blue', 'green'), 2),
                showScales=TRUE)
    g <- l_glyph_add_pointrange(p, ymin=(1:6)-(1:6)/5, ymax=(1:6)+(1:6)/5)
    p['glyph'][1:2] <- g
    f <- l_facet(p, layout = "grid", by = "color")
    expect_equal(class(f), c("l_facet_grid", "l_facet",    "l_compound", "loon" ))
    expect_equal(length(f), 3L)

    # loonGrob
    g <- loonGrob(f)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))
})
#
# test_that("l_plot facets work with  image glyph", {
#     p <- with(olive, l_plot(palmitic ~ stearic, color = Region))
#     img_paths <- list.files(file.path(find.package(package = 'loon'), "images"), full.names = TRUE)
#     imgs <- setNames(l_image_import_files(img_paths),
#                      tools::file_path_sans_ext(basename(img_paths)))
#     i <- pmatch(gsub("^[[:alpha:]]+-","", olive$Area), names(imgs), duplicates.ok = TRUE)
#
#     g <- l_glyph_add_image(p, imgs[i], label="Flags")
#     p['glyph'] <- g
#     f <- l_facet(p, layout = "grid", by = "color")
#     expect_equal(class(f), c("l_facet_grid", "l_facet",    "l_compound", "loon" ))
#     expect_equal(length(f), 3L)
# })

test_that("l_plot facets work with  polygon glyph", {
    ########## l_glyph_add_polygon ##########
    x_star <-
        c(-0.000864304235090734, 0.292999135695765, 0.949870354364736,
          0.474503025064823, 0.586862575626621, -0.000864304235090734,
          -0.586430423509075, -0.474070872947277, -0.949438202247191,
          -0.29256698357822)
    y_star <-
        c(-1, -0.403630077787381, -0.308556611927398, 0.153846153846154,
          0.808556611927398, 0.499567847882455, 0.808556611927398,
          0.153846153846154, -0.308556611927398, -0.403630077787381)
    x_cross <-
        c(-0.258931143762604, -0.258931143762604, -0.950374531835206,
          -0.950374531835206, -0.258931143762604, -0.258931143762604,
          0.259651397291847, 0.259651397291847, 0.948934024776722,
          0.948934024776722, 0.259651397291847, 0.259651397291847)
    y_cross <-
        c(-0.950374531835206, -0.258931143762604, -0.258931143762604,
          0.259651397291847, 0.259651397291847, 0.948934024776722,
          0.948934024776722, 0.259651397291847, 0.259651397291847,
          -0.258931143762604, -0.258931143762604, -0.950374531835206)
    x_hexagon <-
        c(0.773552290406223, 0, -0.773552290406223, -0.773552290406223,
          0, 0.773552290406223)
    y_hexagon <-
        c(0.446917314894843, 0.894194756554307, 0.446917314894843,
          -0.447637568424085, -0.892754249495822, -0.447637568424085)

    p <- l_plot(1:6, 1:6, color = rep(c('red', 'blue', 'green'), 2))

    gl <- l_glyph_add_polygon(p, x = list(x_star, x_cross, x_hexagon, x_star, x_cross, x_hexagon),
                              y = list(y_star, y_cross, y_hexagon, y_star, y_cross, y_hexagon))

    p['glyph'] <- gl
    f <- l_facet(p, layout = "grid", by = "color")
    expect_equal(class(f), c("l_facet_grid", "l_facet",    "l_compound", "loon" ))

    # loonGrob
    g <- loonGrob(f)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))

    # test hidden glyphs
    p['glyph'] <- "triangle"
    gl <- l_glyph_add_pointrange(p, ymin = 1:6 - 1/2,
                                 ymax = 1:6 + 1/2)
    f <- l_facet(p, by = "color")
    expect_equal(l_glyph_ids(f[[1]]), c("glyph0", "glyph1"))
    expect_equal(l_glyph_ids(f[[2]]), c("glyph0", "glyph1"))
    expect_equal(l_glyph_ids(f[[3]]), c("glyph0", "glyph1"))

    # loonGrob
    g <- loonGrob(f)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))
})

test_that("l_plot facets work with  text glyph", {
    n <- 149
    ########## l_glyph_add_text ##########
    iris_ <- iris[seq(n), ]
    p <- l_plot(iris_, color = iris_$Species)
    g <- l_glyph_add_text(p, iris_$Species, "test_label")
    p['glyph'][1:100] <- g
    f <- l_facet(p, layout = "grid", by = "color")
    expect_equal(class(f), c("l_facet_grid", "l_facet",    "l_compound", "loon" ))

    # loonGrob
    g <- loonGrob(f)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))
})

test_that("test facet l_facet class:l_plot", {
    n <- 149
    iris_ <- iris[seq(n), ]
    ########## l_plot ##########
    p <- l_plot(iris_, color = iris_$Species)
    p['size'][1:20] <- 8
    p['size'][21:40] <- 12
    p['size'][41:60] <- 16
    f <- l_facet(p, layout = "wrap", by = c("color", "size"))
    expect_equal(class(f), c("l_facet_wrap", "l_facet",    "l_compound", "loon" ))
    expect_equal(length(f), 12L)

    # loonGrob
    g <- loonGrob(f)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))

    f <- l_facet(p, layout = "grid", by = c("color", "size"))
    expect_equal(class(f), c("l_facet_grid", "l_facet",    "l_compound", "loon" ))

    # loonGrob
    g <- loonGrob(f)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))

    f <- l_facet(p, layout = "separate", by = c("color", "size"))
    expect_equal(class(f), c("l_facet",    "l_compound", "loon" ))
})

test_that("test facet l_facet class:l_plot3D", {
    n <- 149
    iris_ <- iris[seq(n), ]
    ########## l_plot3D ##########
    p <-  l_plot3D(iris_, color = iris_$Species)
    p['size'][1:20] <- 8
    p['size'][21:40] <- 12
    p['size'][41:60] <- 16
    f <- l_facet(p, layout = "wrap", by = c("color", "size"))
    expect_equal(class(f), c("l_facet_wrap", "l_facet",    "l_compound", "loon" ))

    # loonGrob
    g <- loonGrob(f)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))

    # f <- l_facet(p, layout = "grid", by = c("color", "size"))
    # expect_equal(class(f), c("l_facet_grid", "l_facet",    "l_compound", "loon" ))
    # f <- l_facet(p, layout = "separate", by = c("color", "selected"))
    # expect_equal(class(f), c("l_facet",    "l_compound", "loon" ))
})

test_that("test facet l_facet class:l_hist", {
    n <- 149
    iris_ <- iris[seq(n), ]
    ########## l_hist ##########
    h <- l_hist(iris_, color = iris_$Species)
    h['selected'][1:30] <- TRUE
    h['selected'][31:60] <- TRUE
    # f <- l_facet(h, layout = "wrap", by = c("color", "selected"))
    # expect_equal(class(f), c("l_facet_wrap", "l_facet",    "l_compound", "loon" ))
    f <- l_facet(h, layout = "grid", by = c("color", "selected"))
    expect_equal(class(f), c("l_facet_grid", "l_facet",    "l_compound", "loon" ))
    # f <- l_facet(h, layout = "separate", by = c("color", "selected"))
    # expect_equal(class(f), c("l_facet",    "l_compound", "loon" ))

    # loonGrob
    g <- loonGrob(f)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))
})

test_that("test facet l_facet class:l_serialaxes", {
    n <- 149
    iris_ <- iris[seq(n), ]
    ########## l_serialaxes ##########
    s <- l_serialaxes(iris_, color = iris_$Species)
    s['selected'][1:30] <- TRUE
    s['selected'][31:60] <- TRUE
    # f <- l_facet(s, layout = "wrap", by = c("color", "selected"))
    # expect_equal(class(f), c("l_facet_wrap", "l_facet",    "l_compound", "loon" ))
    # f <- l_facet(s, layout = "grid", by = c("color", "selected"))
    # expect_equal(class(f), c("l_facet_grid", "l_facet",    "l_compound", "loon" ))
    f <- l_facet(s, layout = "separate", by = c("color", "selected"))
    expect_equal(class(f), c("l_facet",    "l_compound", "loon" ))
})

test_that("test some facet args in l_plot", {
    # p <- with(mtcars, l_plot(wt, mpg, by = data.frame(am = am, gear = gear, cyl  = cyl, vs = vs),
    #                          labelLocation = c("bottom", "left"),
    #                          labelBackground = "lightblue", labelForeground = "red",
    #                          labelBorderwidth = 5, labelRelief = "flat"))
    # expect_equal(class(p), c("l_facet_grid", "l_facet",    "l_compound", "loon" ))
    p <- with(mtcars, l_plot(wt, mpg, by = data.frame(am = am, gear = gear, cyl  = cyl),
                             color = "blue",
                             layout = "wrap",
                             labelLocation = c("bottom"),
                             labelBackground = "lightblue", labelForeground = "red",
                             labelBorderwidth = 5, labelRelief = "flat"))
    expect_equal(class(p), c("l_facet_wrap", "l_facet",    "l_compound", "loon" ))
    # p <- with(mtcars, l_plot(wt, mpg, by = data.frame(am = am, gear = gear, cyl  = cyl),
    #                          color = "blue",
    #                          layout = "separate",
    #                          labelLocation = c("bottom"),
    #                          labelBackground = "lightblue", labelForeground = "red",
    #                          labelBorderwidth = 5, labelRelief = "flat"))
    # expect_equal(class(p), c("l_facet",    "l_compound", "loon" ))

    # loonGrob
    g <- loonGrob(p)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))
})


test_that("test some facet args in l_plot3D", {
    p <- with(mtcars, l_plot3D(wt, mpg, hp, by = data.frame(am = am, gear = gear, cyl  = cyl),
                               labelLocation = c("bottom", "left"),
                               labelBackground = "lightblue", labelForeground = "red",
                               labelBorderwidth = 5, labelRelief = "flat"))
    expect_equal(class(p), c("l_facet_grid", "l_facet",    "l_compound", "loon" ))
    # p <- with(mtcars, l_plot3D(wt, mpg, hp, by = data.frame(am = am, gear = gear, cyl  = cyl),
    #                            color = "blue",
    #                            layout = "wrap", labelLocation = c("bottom"),
    #                            labelBackground = "lightblue", labelForeground = "red",
    #                            labelBorderwidth = 5, labelRelief = "flat"))
    # expect_equal(class(p), c("l_facet_wrap", "l_facet",    "l_compound", "loon" ))

    # loonGrob
    g <- loonGrob(p)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))
})


test_that("test some facet args in l_hist", {
    p <- with(mtcars, l_hist(mpg, by = data.frame(am = am, gear = gear, cyl  = cyl),
                             labelLocation = c("bottom", "left"),
                             labelBackground = "lightblue", labelForeground = "red",
                             labelBorderwidth = 5, labelRelief = "flat"))
    expect_equal(class(p), c("l_facet_grid", "l_facet",    "l_compound", "loon" ))

    # loonGrob
    g <- loonGrob(p)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))

    p <- with(mtcars, l_hist(mpg, by = data.frame(am = am, gear = gear, cyl  = cyl), layout = "wrap",
                             labelLocation = c("bottom"),
                             labelBackground = "lightblue", labelForeground = "red",
                             labelBorderwidth = 5, labelRelief = "flat"))
    expect_equal(class(p), c("l_facet_wrap", "l_facet",    "l_compound", "loon" ))

    # loonGrob
    g <- loonGrob(p)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))
})

test_that("test some facet args in l_serialaxes", {
    n <- 149
    iris_ <- iris[seq(n), ]
    s <- l_serialaxes(iris_, sequence = sample(colnames(iris_), 10, replace = TRUE),
                      by = iris_$Species, scaling = "observation")
    expect_equal(class(s), c("l_facet_grid", "l_facet",    "l_compound", "loon" ))

    # loonGrob
    g <- loonGrob(s)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))

    s <- l_serialaxes(iris_, sequence = sample(colnames(iris_), 10, replace = TRUE),
                      by = iris_$Species, scaling = "observation", axesLayout = "parallel",
                      layout = "wrap")
    expect_equal(class(s), c("l_facet_wrap", "l_facet",    "l_compound", "loon" ))

    # loonGrob
    g <- loonGrob(s)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))
})

test_that("test all possible 'by's", {
    n <- 149
    iris_ <- iris[seq(n), ]
    p <- l_plot(iris_)

    # by is a data.frame
    fp <- l_facet(p, layout = "grid", by = data.frame(iris_$Species, iris_$Species))
    expect_equal(class(fp), c("l_facet_grid", "l_facet",    "l_compound", "loon" ))

    # loonGrob
    g <- loonGrob(fp)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))

    # by is a list
    fp <- l_facet(p, layout = "grid", by = list(iris_$Species, iris_$Species))
    expect_equal(class(fp), c("l_facet_grid", "l_facet",    "l_compound", "loon" ))

    # loonGrob
    g <- loonGrob(fp)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))

    p['color'][sample(1:n, 70)] <- "red"
    fp <- l_facet(p, by = list("color", iris_ = iris_$Species))
    expect_equal(class(fp), c("l_facet_grid", "l_facet", "l_compound", "loon" ))

    # loonGrob
    g <- loonGrob(fp)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))

    p['size'][sample(1:n, 70)] <- 8
    fp <- l_facet(p, by = c("color", "size"))

    # loonGrob
    g <- loonGrob(fp)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))

    expect_equal(class(fp), c("l_facet_grid", "l_facet",    "l_compound", "loon" ))
    expect_warning(l_facet(p, by = list("color", 1:10)))
    expect_warning(l_facet(p, by = list("foo", "color")))

    # by is a vector
    h <- l_hist(iris_)
    fp <- l_facet(h, layout = "wrap", by = iris_$Species)
    expect_equal(class(fp), c("l_facet_wrap", "l_facet",    "l_compound", "loon" ))
})

test_that("test separate layouts", {
    n <- 149
    iris_ <- iris[seq(n), ]
    p <- l_plot(iris_, by = iris_$Species,
                layout = "separate")
    expect_equal(class(p), c("l_facet",    "l_compound", "loon" ))
    p <- l_plot3D(iris_, by = iris_$Species,
                  layout = "separate")
    expect_equal(class(p), c("l_facet",    "l_compound", "loon" ))
    p <- l_hist(iris_, by = iris_$Species,
                layout = "separate")
    expect_equal(class(p), c("l_facet",    "l_compound", "loon" ))
    s <- l_serialaxes(iris_, by = iris_$Species,
                      layout = "separate")
    expect_equal(class(s), c("l_facet",    "l_compound", "loon" ))
})

test_that("test layers inherits", {
    p <- l_plot(rnorm(10), rnorm(10))
    p['color'][1:5] <- "red"
    group <- l_layer_group(p)
    line <- l_layer_line(p, 1:5, c(1:3, 3,4), parent = group)
    rect <- l_layer_rectangle(p, x = c(2,3), y = c(3,4))
    l_layer_hide(p, rect)
    fp <- l_facet(p, by = "color")

    # loonGrob
    g <- loonGrob(fp)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))

    layers <- l_layer_getChildren(fp[[1]])
    expect_equal(length(layers), 3)
    layer1 <- l_create_handle(c(p, layers[1]))
    expect_equal(class(layer1)[1], "l_layer_rectangle")
    expect_false(l_layer_isVisible(layer1))
    layer2 <- l_create_handle(c(p, layers[2]))
    expect_equal(class(layer2)[1], "l_layer_group")
    expect_equal(length(l_layer_getChildren(layer2)), 1)
})

test_that("test formula by", {
    n <- 149
    iris_ <- iris[seq(n), ]
    ps <- l_serialaxes(iris_,
                       by = linewidth ~ color,
                       linewidth = sample(c(1,3), size = n, replace = TRUE),
                       color = sample(c("red", "green"), size = n, replace = TRUE))
    expect_equal(length(ps), 4)


    # loonGrob
    g <- loonGrob(ps)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))

    pp <- l_plot(x = 1:6, y = 1:6,
                 by = size ~ color,
                 size = c(rep(50, 2), rep(25, 2), rep(50, 2)),
                 color = c(rep("red", 3), rep("green", 3)))
    expect_equal(length(pp), 4)

    # loonGrob
    g <- loonGrob(pp)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))


    on <- data.frame(size = c(rep(50, 2), rep(25, 2), rep(50, 2)),
                     color = c(rep("red", 3), rep("green", 3)),
                     glyph = c("ocircle", "ccircle", "ocircle", "ccircle", "ocircle", "ccircle"))

    p <- l_plot(x = 1:6, y = 1:6,
                glyph = c("ocircle", "ccircle", "ocircle", "ccircle", "ocircle", "ccircle"),
                size = c(rep(50, 2), rep(25, 2), rep(50, 2)),
                color = c(rep("red", 3), rep("green", 3)),
                by = size ~ color,
                on = on)

    # loonGrob
    g <- loonGrob(p)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))

    # avoid hex code in tests
    # it is because, in solaris X64 system, the 12 digit hex code is slightly different from that in
    # windows and mac
    # expect_equal(p[[1]]['color'], l_hexcolor("green")) # green
    expect_equal(p[[1]]['size'], 25)

    # expect_equal(p[[2]]['color'], c(l_hexcolor("green"), l_hexcolor("green"))) # green
    expect_equal(p[[2]]['size'], c(50, 50))


    size <- c(rep(50, 2), rep(25, 2), rep(50, 2))
    color <- c(rep("red", 3), rep("green", 3))
    glyph <- c("ocircle", "ccircle", "ocircle", "ccircle", "ocircle", "ccircle")

    p <- l_plot(x = 1:6, y = 1:6,
                glyph = glyph,
                size = size,
                color = color,
                by = size ~ color + glyph)

    # loonGrob
    g <- loonGrob(p)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))

    # expect_equal(p[[1]]['color'], l_hexcolor("green")) # green
    expect_equal(p[[1]]['size'], 25)
    expect_equal(p[[1]]['glyph'], "ccircle")


    # expect_equal(p[[8]]['color'], l_hexcolor("red")) # red
    expect_equal(p[[8]]['size'], 50)
    expect_equal(p[[8]]['glyph'], "ocircle")


    p <- l_plot(x = 1:6, y = 1:6,
                glyph = c("ocircle", "ccircle", "ocircle", "ccircle", "ocircle", "ccircle"),
                size = c(rep(50, 2), rep(25, 2), rep(50, 2)),
                color = c(rep("red", 3), rep("green", 3)))

    g <- l_glyph_add_text(p, text = 1:6)
    p['glyph'] <- g
    f <- l_facet(p, by = color ~ size, layout = "wrap")

    # loonGrob
    g <- loonGrob(f)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))

    expect_equal(f[[1]]['size'], 25)
    # expect_equal(f[[1]]['color'], l_hexcolor("green")) # green

    expect_equal(f[[2]]['size'], c(50, 50))
    # expect_equal(f[[2]]['color'], l_hexcolor("red")) # red

    f <- l_facet(p, by = color ~ size)

    # loonGrob
    g <- loonGrob(f)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))

    expect_equal(f[[1]]['size'], 25)
    # expect_equal(f[[1]]['color'], l_hexcolor("green")) # green

    expect_equal(f[[2]]['size'], 25)
    # expect_equal(f[[2]]['color'], l_hexcolor("red")) # red


    on <- data.frame(Factor1 = c(rep("A", 3), rep("B", 3)),
                     Factor2 = rep(c("C", "D"), 3))

    f <- l_facet(p, by = Factor1 ~ Factor2, on = on)
    expect_true(all(c("l_facet",    "l_compound", "loon" ) %in% class(f)))


    # loonGrob
    g <- loonGrob(f)
    grid.draw(g)
    expect_equal(class(g), c("gTree", "grob", "gDesc"))

    # by with NA
    by <- iris_$Species
    by[1:10] <- NA
    expect_warning(
        p <- l_plot(iris_, by = by, linkingGroup = "foo")
    )
    expect_equal(length(p$x1y1['x']), 40)
    expect_warning(
        s <- l_serialaxes(iris_, by = by)
    )
    expect_equal(nrow(s$x1y1['data']), 40)
})