Nothing
#
# if (requireNamespace("testthat", quietly = TRUE)) {
#
# library(testthat)
library(loon)
library(grid)
context("test_loonGrob")
test_that("plot layers have correct grid structure", {
p <- with(olive,
l_plot(x=linoleic, y=oleic,
color=Region, title="Olive Data"))
## Layer a Group
l.g <- l_layer_group(p, label="Drawings", parent="root", index="end")
l.pts <- l_layer_points(p,
x=c(200, 450, 1800),
y=c(6000, 8000, 7000),
color=c("green", "orange", "lightblue"),
parent=l.g)
l_scaleto_layer(p, l.pts)
l_scaleto_world(p)
l_configure(l.pts, color="thistle", size=30)
l_configure(l.pts,
x=seq(from=200,to=1600, length.out=20),
y=seq(from=6000,to=8000, length.out=20),
color="steelblue", size=20:39)
l_layer_relabel(p, l.pts, "Different Sizes")
l_layer_move(p, l.pts, parent="root")
## Polygon
i <- with(olive, chull(linoleic, oleic))
x.hull <- olive$linoleic[i]
y.hull <- olive$oleic[i]
l_layer_polygon(p, x.hull, y.hull, color="thistle",
linecolor="black", linewidth=4, parent=l.g)
## Rectangle
l_layer_rectangle(p, x=c(1100, 1300), y=c(7600, 8300), linewidth=2)
## Oval
l_layer_oval(p, x=c(1500, 1750), y=c(7900, 8100),
color="", linecolor="orange", linewidth=4)
## Line
x <- with(olive, linoleic[Region=="North"])
y <- with(olive, oleic[Region=="North"])
fit <- lm(y~x)
##summary(fit)
xr <- seq(from=min(x), to=max(x), length.out=20)
yp <- predict(fit, data.frame(x=xr), interval="prediction")
l.pi <- l_layer_polygon(p, x=c(xr, rev(xr)),
y=c(yp[,2],rev(yp[,3])),
color="lightgreen",
linecolor= "darkgreen", linewidth=2,
label="predition interval west liguria")
l.fit <- l_layer_line(p, x=xr, y=yp[,1],
color="darkgreen", linewidth=8,
label="fit west liguria")
l_layer_move(p, l.pi, "root", "end")
l_layer_raise(p, l.pi)
## Text (size does not work and color is gray)
bbox <- l_layer_bbox(p, "root")
l_layer_texts(p, x=seq(from=bbox[1], to=bbox[3], length.out=length(LETTERS)),
y=rev(seq(from=bbox[2], to=bbox[4], length.out=length(LETTERS))),
text=LETTERS, size=seq_along(LETTERS),
angle=seq_along(LETTERS)/length(LETTERS)*360)
lgrob <- loonGrob(p)
expect_equal(class(lgrob), c("gTree", "grob", "gDesc"))
expect_equal(class(lgrob$children), c("gList"))
})
test_that("plots with different glyphs have correct structure", {
# Plot glyphsizes for different glyphs
sizes <- c(0:10) # seq(15,25,by=5)
ns <- length(sizes)
glyphs <- c('sizes', 'circle', 'square', 'triangle', 'diamond',
'text', 'image', 'stars', 'parallel', 'polygon')
ng <- length(glyphs)
## ns+1 for labels
x <- rep(1:(ns+1), ng)
y <- rep(c(9, 8, 7.5, 7, 6.5, 6, 5, 3, 1,-1), each=ns+1)
p <- l_plot(x,y, showLabels=FALSE)
for (i in seq_along(glyphs)) {
assign(paste0('i_',glyphs[i]), seq((i-1)*(ns+1)+1,i*(ns+1)))
}
## Size Labels
labelsize <- 6
psizes <- rep(c(labelsize, sizes), ng)
c_psizes <- as.character(psizes)
c_psizes[c_psizes=="0"] <- "<1"
g_sizes <- l_glyph_add_text(p, text = c_psizes, label="size labels")
p['glyph'] <- g_sizes
p['size'] <- psizes
l_configure(p, color='black', size=labelsize, which=i_sizes)
## Primitive Glyphs
l_configure(p, glyph='circle', which=i_circle)
l_configure(p, glyph='square', which=i_square)
l_configure(p, glyph='triangle', which=i_triangle)
l_configure(p, glyph='diamond', which=i_diamond)
## text glyph
g_text <- l_glyph_add_text(p, text = rep("aA", p['n']), label='text glyphs')
l_configure(p, glyph=g_text, which=i_text)
## Images
data(faces, package = "loon.data")
faces.imgs <- l_image_import_array(faces, 64, 64, img_in_row = FALSE)
g_image <- l_glyph_add_image(p, image=rep(faces.imgs[1], p['n']), label='frey faces')
l_configure(p, glyph=g_image, which=i_image)
## Stars
g_stars <- l_glyph_add_serialaxes(p, data=oliveAcids,
label='star glyphs', showArea=FALSE,
showAxes = TRUE, showEnclosing = TRUE)
l_configure(p, glyph=g_stars, which=i_stars)
## Parallel
g_parallel <- l_glyph_add_serialaxes(p, data=oliveAcids,
label='parallel coords', linewidth = 3, axesLayout = 'parallel',
showAxes = TRUE, showEnclosing = TRUE, showArea=FALSE)
l_configure(p, glyph=g_parallel, which=i_parallel)
# Polygons
# hand drawn
airplane_coords <- c(30.8,0.5,57.4,27.1,85.6,16.5,89.9,17,78.7,30.9,183.5,27.7,
223.5,6.4,234.6,7.4,222.9,22.3,240,21.8,253.8,26.1,264.5,
33.5,276.2,39.4,283.1,42,286.5,50.6,282,57.5,273.5,63.9,
260.2,69.7,246.9,72.4,217.1,76.1,176.6,78.8,151.6,78.8,
88.8,105.9,62.7,95.8,117,70.8,87.7,70.8,73.9,68.1,56.3,
63.3,44.6,53.2,20.7,61.2,11.6,57.5,34,44.2)
x_ap <- airplane_coords[seq(1, length(airplane_coords), by=2)]
y_ap <- airplane_coords[seq(2, length(airplane_coords), by=2)]
## centre-scale
d_ap <- diff(range(x_ap, y_ap))/5 # 5 is min width or height of airplane if size <= 1
x_aps <- (x_ap-mean(x_ap))/d_ap
y_aps <- (y_ap-mean(y_ap))/d_ap
g_polygon <- l_glyph_add_polygon(p, x=lapply(seq_len(p['n']), function(arg) x_aps),
y = lapply(seq_len(p['n']), function(arg) y_aps),
label='airplane')
l_configure(p, glyph=g_polygon, which=i_polygon)
## Row Labels
vapply(glyphs, function(g) {
get(paste0('i_', g))[1]
}, numeric(1))## Row labeling
g_row <- l_glyph_add_text(p, text=rep(glyphs, each= ns+1), label='glyph labels')
i_rowlabels <- vapply(glyphs, function(g) {
get(paste0('i_', g))[1]
}, numeric(1))
l_configure(p, glyph=g_row, color='black', which=i_rowlabels)
lgrob <- loonGrob(p)
# grid.newpage()
# grid.draw(lgrob)
expect_equal(class(lgrob), c("gTree", "grob", "gDesc"))
expect_equal(class(lgrob$children), c("gList"))
})
test_that("graphs have correct structure", {
iris_ <- iris[seq(149), ]
G <- completegraph(names(iris_[,-5]))
LG <- linegraph(G)
g <- l_graph(LG)
nav0 <- l_navigator_add(g)
l_configure(nav0, label = 0)
con0 <- l_context_add_geodesic2d(navigator=nav0, data=iris_[,-5])
nav1 <- l_navigator_add(g, from = "Sepal.Length:Petal.Width",
to = "Petal.Length:Petal.Width", proportion = 0.6)
l_configure(nav1, label = 1)
con1 <- l_context_add_geodesic2d(navigator=nav1, data=iris_[,-5])
nav2 <- l_navigator_add(g, from = "Sepal.Length:Petal.Length",
to = "Sepal.Width:Petal.Length", proportion = 0.5)
l_configure(nav2, label = 2)
con2 <- l_context_add_geodesic2d(navigator=nav2, data=iris_[,-5])
lgrob <- loonGrob(g)
#grid.newpage(); grid.draw(lgrob)
expect_equal(class(lgrob), c("gTree", "grob", "gDesc"))
})
test_that("histograms have correct structure", {
iris_ <- iris[seq(149), ]
h <- l_hist(iris_$Sepal.Length, color=iris_$Species)
g <- loonGrob(h)
#grid.newpage(); grid.draw(g)
expect_equal(class(g), c("gTree", "grob", "gDesc"))
h['showStackedColors'] <- TRUE
g <- loonGrob(h)
#grid.newpage(); grid.draw(g)
expect_equal(class(g), c("gTree", "grob", "gDesc"))
h['colorStackingOrder'] <- c("selected", unique(h['color']))
g <- loonGrob(h)
#grid.newpage(); grid.draw(g)
expect_equal(class(g), c("gTree", "grob", "gDesc"))
h['colorStackingOrder'] <- rev(h['colorStackingOrder'])
g <- loonGrob(h)
#grid.newpage(); grid.draw(g)
expect_equal(class(g), c("gTree", "grob", "gDesc"))
})
test_that("navgation graphs have correct structure", {
ng <- l_navgraph(oliveAcids, separator='-', color=olive$Area)
lgrob <- grid.loon(ng, draw = FALSE)
expect_equal(class(lgrob), c("gTree", "grob", "gDesc"))
})
test_that("l_pairs have correct structure", {
iris_ <- iris[seq(149), ]
p <- l_pairs(iris_[,-5], color=iris_$Species)
lgrob <- loonGrob(p)
#grid.newpage()
#grid.draw(lgrob)
expect_equal(class(lgrob), c("gTree", "grob", "gDesc"))
})
test_that("l_serialaxes have correct structure", {
s <- l_serialaxes(data=oliveAcids, color=olive$Area, title="olive data")
lgrob <- grid.loon(s, draw = FALSE)
expect_equal(class(lgrob), c("gTree", "grob", "gDesc"))
s['axesLayout'] <- 'parallel'
lgrob <- grid.loon(s, draw = FALSE)
expect_equal(class(lgrob), c("gTree", "grob", "gDesc"))
})
test_that("l_ts has correct structure", {
decompose <- decompose(co2)
# or decompose <- stl(co2, "per")
p <- l_plot(decompose, title = "Atmospheric carbon dioxide over Mauna Loa")
lgrob <- loonGrob(p)
expect_equal(class(lgrob), c("gTree", "grob", "gDesc"))
})
#}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.