require(testthat)
require(matter)
context("vizi")
test_that("vizi - parse", {
set.seed(1, kind="default")
x1 <- runif(10)
x2 <- runif(10)
x3 <- runif(10)
y1 <- rnorm(10)
y2 <- rnorm(10)
g1 <- sample(c("a", "b"), 10, replace=TRUE)
g2 <- sample(c("c", "d"), 10, replace=TRUE)
data <- data.frame(
x1=x1, x2=x2, x3=x3,
y1=y1, y2=y2,
g1=g1, g2=g2)
p1 <- parse_formula(y ~ x)
expect_length(p1$lhs, 1L)
expect_length(p1$rhs, 1L)
expect_length(p1$g, 0L)
expect_equal(p1$lhs[[1L]], quote(y))
expect_equal(p1$rhs[[1L]], quote(x))
p2 <- parse_formula(y ~ x1 * x2)
expect_length(p2$lhs, 1L)
expect_length(p2$rhs, 2L)
expect_length(p2$g, 0L)
expect_equal(p2$lhs[[1L]], quote(y))
expect_equal(p2$rhs[[1L]], quote(x1))
expect_equal(p2$rhs[[2L]], quote(x2))
p3 <- parse_formula(y1 + y2 ~ x1 * x2)
expect_length(p3$lhs, 2L)
expect_length(p3$rhs, 2L)
expect_length(p3$g, 0L)
expect_equal(p3$lhs[[1L]], quote(y1))
expect_equal(p3$lhs[[2L]], quote(y2))
expect_equal(p3$rhs[[1L]], quote(x1))
expect_equal(p3$rhs[[2L]], quote(x2))
p4 <- parse_formula(y ~ x1 * x2 | g)
expect_length(p4$lhs, 1L)
expect_length(p4$rhs, 2L)
expect_length(p4$g, 1L)
expect_equal(p4$lhs[[1L]], quote(y))
expect_equal(p4$rhs[[1L]], quote(x1))
expect_equal(p4$rhs[[2L]], quote(x2))
expect_equal(p4$g[[1L]], quote(g))
p5 <- parse_formula(y1 + y2 ~ x1 * x2 | g1 * g2)
expect_length(p5$lhs, 2L)
expect_length(p5$rhs, 2L)
expect_length(p5$g, 2L)
expect_equal(p5$lhs[[1L]], quote(y1))
expect_equal(p5$lhs[[2L]], quote(y2))
expect_equal(p5$rhs[[1L]], quote(x1))
expect_equal(p5$rhs[[2L]], quote(x2))
expect_equal(p5$g[[1L]], quote(g1))
expect_equal(p5$g[[2L]], quote(g2))
p6 <- parse_formula(y1 + y2 ~ x1 * x2, envir=data)
expect_equal(p6$lhs[[1L]], y1)
expect_equal(p6$lhs[[2L]], y2)
expect_equal(p6$rhs[[1L]], x1)
expect_equal(p6$rhs[[2L]], x2)
p7 <- parse_formula(y1 ~ x1 | g1 * g2, envir=data)
expect_equal(p7$lhs[[1L]], y1)
expect_equal(p7$rhs[[1L]], x1)
expect_equal(p7$g[[1L]], g1)
expect_equal(p7$g[[2L]], g2)
})
test_that("vizi - eval", {
set.seed(1, kind="default")
xla <- replicate(10, sort(rnorm(10)), simplify=FALSE)
xlb <- replicate(10, sort(rnorm(10)), simplify=FALSE)
names(xla) <- paste0("a", seq_along(xla))
names(xlb) <- paste0("b", seq_along(xlb))
xl <- list(a=xla, b=xlb)
xmu <- matrix(sort(rnorm(100)), nrow=10, ncol=10)
xmv <- matrix(sort(rnorm(100)), nrow=10, ncol=10)
xm <- list(u=xmu, v=xmv)
expect_equal(eval_at(quote(a), data=xl), xla)
expect_equal(eval_at(quote(b), data=xl), xlb)
expect_equal(eval_at(quote(u), data=xm), xmu)
expect_equal(eval_at(quote(v), data=xm), xmv)
e1 <- eval_at(quote(a), data=xl, i=1:2)
e2 <- eval_at(quote(a), data=xl, i=1:2, j=1:5)
expect_equal(e1, xla[1:2])
expect_equal(e2, list(a1=xla[[1L]][1:5], a2=xla[[2L]][1:5]))
e3 <- eval_at(quote(a + b), data=xl, i=1:2, recursive=TRUE)
e4 <- eval_at(quote(a + b), data=xl, i=1:2, j=1:5, recursive=TRUE)
expect_equal(e3[[1L]], xla[[1L]] + xlb[[1L]])
expect_equal(e3[[2L]], xla[[2L]] + xlb[[2L]])
expect_equal(e4[[1L]], (xla[[1L]] + xlb[[1L]])[1:5])
expect_equal(e4[[2L]], (xla[[2L]] + xlb[[2L]])[1:5])
ii <- c("1"=1, "1"=2, "2"=3, "2"=4)
gg <- names(ii)
e5 <- eval_at(quote(a), data=xl, i=ii, group=gg)
expect_equal(e5[[1L]], xla[[1L]] + xla[[2L]])
expect_equal(e5[[2L]], xla[[3L]] + xla[[4L]])
e6 <- eval_at(quote(u), data=xm, i=1:3, split_along=1L)
e7 <- eval_at(quote(u), data=xm, j=1:3, split_along=2L)
e8 <- eval_at(quote(u), data=xm, i=ii, split_along=1L, group=gg)
expect_equal(do.call(rbind, e6), xmu[1:3,,drop=FALSE])
expect_equal(do.call(cbind, e7), xmu[,1:3,drop=FALSE])
expect_equal(do.call(rbind, e8), rowsum(xmu[1:4,,drop=FALSE], group=gg))
e9 <- eval_at(quote(u + v), data=xm, j=1:2, split_along=2L)
expect_equal(e9[[1L]], xmu[,1L,drop=TRUE] + xmv[,1L,drop=TRUE])
expect_equal(e9[[2L]], xmu[,2L,drop=TRUE] + xmv[,2L,drop=TRUE])
es <- eval_exprs(list(foo=quote(a), bar=quote(a + b)),
data=xl, i=1:2, recursive=TRUE)
expect_equal(es[[1L]], e1)
expect_equal(es[[2L]], e3)
expect_true(attr(es, "recursive"))
})
test_that("vizi - plot", {
set.seed(1, kind="default")
x <- rnorm(100)
y <- rnorm(100)
g <- factor(rep(c("a", "b", "c", "d"), each=25))
df <- data.frame(VAR1=x, VAR2=y, GROUP=g)
v1 <- vizi(x=x, y=y, color=g)
expect_setequal(x, v1$encoding$x)
expect_setequal(y, v1$encoding$y)
expect_setequal(g, v1$encoding$color)
expect_equal("x", v1$channels$x$label)
expect_equal("y", v1$channels$y$label)
expect_equal("color", v1$channels$color$label)
expect_equal(range(x), v1$channels$x$limits)
expect_equal(range(y), v1$channels$y$limits)
expect_equal(levels(g), v1$channels$color$limits)
v2 <- vizi(df, x=~VAR1, y=~VAR2, color=~GROUP)
expect_setequal(x, v2$encoding$x)
expect_setequal(y, v2$encoding$y)
expect_setequal(g, v2$encoding$color)
expect_equal("VAR1", v2$channels$x$label)
expect_equal("VAR2", v2$channels$y$label)
expect_equal("GROUP", v2$channels$color$label)
expect_equal(range(x), v2$channels$x$limits)
expect_equal(range(y), v2$channels$y$limits)
expect_equal(levels(g), v2$channels$color$limits)
})
test_that("vizi - facets", {
set.seed(1, kind="default")
x <- rnorm(100)
y <- rnorm(100)
g <- factor(rep(c("a", "b", "c", "d"), each=25))
df <- data.frame(VAR1=x, VAR2=y, GROUP=g)
ia <- which(g == "a")
ib <- which(g == "b")
ic <- which(g == "c")
id <- which(g == "d")
xa <- x[ia]
xb <- x[ib]
xc <- x[ic]
xd <- x[id]
ya <- y[ia]
yb <- y[ib]
yc <- y[ic]
yd <- y[id]
v1 <- vizi(x=x, y=y)
v1 <- add_facets(v1, by=g)
expect_setequal(xa, v1$plots[[1L]]$encoding$x)
expect_setequal(xb, v1$plots[[2L]]$encoding$x)
expect_setequal(xc, v1$plots[[3L]]$encoding$x)
expect_setequal(xd, v1$plots[[4L]]$encoding$x)
expect_setequal(ya, v1$plots[[1L]]$encoding$y)
expect_setequal(yb, v1$plots[[2L]]$encoding$y)
expect_setequal(yc, v1$plots[[3L]]$encoding$y)
expect_setequal(yd, v1$plots[[4L]]$encoding$y)
expect_equal("x", v1$channels$x$label)
expect_equal("y", v1$channels$y$label)
expect_equal(range(x), v1$channels$x$limits)
expect_equal(range(y), v1$channels$y$limits)
expect_equal(levels(g), v1$labels)
expect_setequal(ia, v1$subscripts[[1L]])
expect_setequal(ib, v1$subscripts[[2L]])
expect_setequal(ic, v1$subscripts[[3L]])
expect_setequal(id, v1$subscripts[[4L]])
v2 <- vizi(df, x=~VAR1, y=~VAR2)
v2 <- add_facets(v2, by=~GROUP, data=df)
expect_equal(v1$plots, v2$plots)
expect_equal("VAR1", v2$channels$x$label)
expect_equal("VAR2", v2$channels$y$label)
expect_equal(range(x), v2$channels$x$limits)
expect_equal(range(y), v2$channels$y$limits)
expect_equal(levels(g), v2$labels)
expect_equal(v1$subscripts, v2$subscripts)
v3a <- vizi(x=xa, y=ya)
v3b <- vizi(x=xb, y=yb)
v3c <- vizi(x=xc, y=yc)
v3d <- vizi(x=xd, y=yd)
v3 <- as_facets(list(v3a, v3b, v3c, v3d))
expect_equal(v1$plots, v3$plots)
expect_equal(v1$channels, v3$channels)
v4 <- as_facets(list(v2, v2))
expect_equal(c(v2$plots, v2$plots), v4$plots)
expect_equal(v2$channels, v4$channels)
})
test_that("vizi - mark - xy", {
set.seed(1, kind="default")
n <- 500
g <- factor(sample(c("a", "b"), n, replace=TRUE))
x <- rnorm(n)
y <- runif(2)[as.integer(g)] * x + rnorm(n, sd=sqrt(0.1))
v1 <- vizi(x=x, y=y)
v1 <- add_mark(v1, "points")
expect_no_error(plot(v1))
v2 <- vizi(x=x, y=y, color=g, shape=g)
v2 <- add_mark(v2, "points")
expect_no_error(plot(v2))
v3 <- vizi(x=x, y=y, color=g, linetype=g)
v3 <- add_mark(v3, "lines",
trans=list(sort=TRUE, n=100, downsampler="lttb"))
expect_no_error(plot(v3))
v4 <- vizi(x=x, y=y, color=g)
v4 <- add_mark(v4, "peaks")
expect_no_error(plot(v4))
set.seed(1, kind="default")
z <- rnorm(n)
v5 <- vizi(x=x, y=y, z=z, color=g, shape=g)
v5 <- add_mark(v5, "points")
v5 <- set_par(v5, theta=30, phi=30)
expect_no_error(plot(v5))
})
test_that("vizi - mark - text", {
set.seed(1, kind="default")
n <- 100
g <- factor(sample(c("a", "b"), n, replace=TRUE))
x <- rnorm(n)
y <- runif(2)[as.integer(g)] * x + rnorm(n, sd=sqrt(0.1))
v1 <- vizi(x=x, y=y, text=g)
v1 <- add_mark(v1, "text")
expect_no_error(plot(v1))
v2 <- vizi(x=x, y=y, text=g, color=g)
v2 <- add_mark(v2, "text")
expect_no_error(plot(v2))
})
test_that("vizi - mark - intervals", {
set.seed(1, kind="default")
n <- 6
x <- letters[seq_len(n)]
y1 <- runif(n)
y2 <- runif(n) + 1
g <- rep(c("foo", "bar"), each=n %/% 2)
v1 <- vizi(x=x, ymin=y1, ymax=y2)
v1 <- add_mark(v1, "intervals")
expect_no_error(plot(v1))
v2 <- vizi(x=x, ymin=y1, ymax=y2, color=g)
v2 <- add_mark(v2, "intervals")
expect_no_error(plot(v2))
})
test_that("vizi - mark - rules", {
set.seed(1, kind="default")
n <- 100
x <- rnorm(n)
y <- runif(1) * x + rnorm(n, sd=sqrt(0.1))
v1 <- vizi(x=x, y=y)
v1 <- add_mark(v1, "points")
v1 <- add_mark(v1, "rules", x=numeric(0), y=0)
expect_no_error(plot(v1))
v2 <- vizi(x=x, y=y)
v2 <- add_mark(v2, "points")
v2 <- add_mark(v2, "rules", x=0, y=numeric(0))
expect_no_error(plot(v2))
v3 <- vizi(x=x, y=y)
v3 <- add_mark(v3, "points")
v3 <- add_mark(v3, "rules", x=0, y=0)
expect_no_error(plot(v3))
})
test_that("vizi - mark - bars", {
set.seed(1, kind="default")
n <- 5
x <- letters[seq_len(n)]
y <- runif(n)
v1 <- vizi(x=x, y=y)
v1 <- add_mark(v1, "bars")
expect_no_error(plot(v1))
v2 <- vizi(x=x, y=y, fill=x)
v2 <- add_mark(v2, "bars", params=list(width=0.8))
expect_no_error(plot(v2))
x2 <- rep.int(x, 2)
y2 <- c(y, runif(n))
g <- rep(c("foo", "bar"), each=n)
v3 <- vizi(x=x2, y=y2, fill=g)
v3 <- add_mark(v3, "bars", params=list(width=0.8))
expect_no_error(plot(v3))
v4 <- vizi(x=x2, y=y2, fill=g)
v4 <- add_mark(v4, "bars", params=list(width=0.8, stack=TRUE))
v4 <- set_coord(v4, ylim=c(0, 2))
expect_no_error(plot(v4))
set.seed(1, kind="default")
n2 <- 100
x2 <- sample(x, n2, replace=TRUE)
g <- rep(c("foo", "bar"), each=n2 %/% 2)
v5 <- vizi(x=x2, y=1)
v5 <- add_mark(v5, "bars", params=list(width=0.8))
v5 <- set_coord(v5, ylim=c(0, length(x2)))
expect_no_error(plot(v5))
v6 <- vizi(x=x2, y=1, fill=g)
v6 <- add_mark(v6, "bars", params=list(width=0.8))
v6 <- set_coord(v6, ylim=c(0, length(x2)))
expect_no_error(plot(v6))
set.seed(1, kind="default")
x3 <- rnorm(500)
v7 <- vizi(x=cut(x3, breaks=20), y=1 / length(x3))
v7 <- add_mark(v7, "bars")
v7 <- set_coord(v7, ylim=c(0, 1))
expect_no_error(plot(v7))
})
test_that("vizi - mark - boxplot", {
set.seed(1, kind="default")
n <- 500
x <- factor(sample(letters[1:6], n, replace=TRUE))
y <- rnorm(n)
g <- rep(c("foo", "bar"), each=n %/% 2)
v1 <- vizi(x=x, y=y)
v1 <- add_mark(v1, "boxplot")
expect_no_error(plot(v1))
v2 <- vizi(x=x, y=y, fill=g)
v2 <- add_mark(v2, "boxplot")
expect_no_error(plot(v2))
})
test_that("vizi - mark - image", {
set.seed(1, kind="default")
nr <- 32
nc <- 32
img <- matrix(rlnorm(nr * nc), nrow=nr, ncol=nc)
i <- (nr %/% 3):(2 * nr %/% 3)
j <- (nc %/% 3):(2 * nc %/% 3)
img[i,j] <- img[i,j] + max(img)
img <- rescale_range(img, c(0, 1))
v1 <- vizi(xmin=0, xmax=1, ymin=0, ymax=1, image=list(img))
v1 <- add_mark(v1, "image")
expect_no_error(plot(v1))
v2 <- vizi(xmin=0, xmax=1, ymin=0, ymax=1, image=img)
v2 <- add_mark(v2, "image")
expect_error(plot(v2))
})
test_that("vizi - mark - pixels/voxels", {
set.seed(1, kind="default")
nr <- 32
nc <- 32
x <- seq(-4, 4, length.out=nr)
y <- seq(1, 3, length.out=nc)
co <- expand.grid(x=x, y=y)
x <- co$x
y <- co$y
vals <- matrix(atan(x / y), nrow=nr, ncol=nc)
vals <- 10 * (vals - min(vals)) / diff(range(vals))
vals <- vals + 2.5 * runif(length(vals))
v1 <- vizi(x=x, y=y, color=vals)
v1 <- add_mark(v1, "pixels")
expect_no_error(plot(v1))
v2 <- vizi(x=x, y=y, color=vals)
v2 <- add_mark(v2, "pixels", trans=list(smooth="gaussian"))
expect_no_error(plot(v2))
v3 <- vizi(x=x, y=y, color=vals)
v3 <- add_mark(v3, "pixels", trans=list(enhance="histeq"))
expect_no_error(plot(v3))
v4 <- vizi(x=x, y=y, color=vals)
v4 <- add_mark(v4, "pixels", trans=list(scale=TRUE))
expect_no_error(plot(v4))
v5 <- vizi(x=x, y=y, color=vals)
v5 <- add_mark(v5, z=0, "pixels")
v5 <- add_mark(v5, z=1, "pixels")
v5 <- add_mark(v5, z=2, "pixels")
expect_no_error(plot(v5))
x2 <- rep.int(x, 5)
y2 <- rep.int(y, 5)
z2 <- rep(1:5, each=nr * nc)
vals2 <- c(vals, 2 * vals, 3 * vals, 4 * vals, 5 * vals)
v6 <- vizi(x=x2, y=y2, z=z2, color=vals2)
v6 <- add_mark(v6, "voxels")
expect_no_error(plot(v6))
})
test_that("plot_signal", {
set.seed(1, kind="default")
y <- simspec(1)
y2 <- simspec(1)
y3 <- simspec(1)
y4 <- simspec(1)
x <- attr(y, "domain")
x2 <- attr(y2, "domain")
x3 <- attr(y3, "domain")
x4 <- attr(y4, "domain")
p1 <- plot_signal(x, y)
expect_is(p1, "vizi_plot")
expect_is(p1$marks[[1L]], "vizi_lines")
expect_setequal(names(p1$channels), c("x", "y"))
expect_equal(p1$marks[[1L]]$encoding$x, x)
expect_equal(p1$marks[[1L]]$encoding$y, y)
expect_no_error(plot(p1))
p2 <- plot_signal(list(x, x2), list(y, y2))
expect_is(p2, "vizi_facets")
expect_is(p2$plots[[1L]]$marks[[1L]], "vizi_lines")
expect_is(p2$plots[[2L]]$marks[[1L]], "vizi_lines")
expect_setequal(names(p2$channels), c("x", "y"))
expect_equal(p2$plots[[1L]]$marks[[1L]]$encoding$x, x)
expect_equal(p2$plots[[1L]]$marks[[1L]]$encoding$y, y)
expect_equal(p2$plots[[2L]]$marks[[1L]]$encoding$x, x2)
expect_equal(p2$plots[[2L]]$marks[[1L]]$encoding$y, y2)
expect_no_error(plot(p2))
p3 <- plot_signal(list(x, x2, x3, x4), list(y, y2, y3, y4),
by=c("a", "a", "b", "b"), group=c("1", "2", "1", "2"))
expect_is(p3, "vizi_facets")
expect_length(p3$plots, 2L)
expect_setequal(names(p3$channels), c("x", "y", "color"))
expect_equivalent(p3$plots[[1L]]$marks[[1L]]$encoding$y, y)
expect_equivalent(p3$plots[[1L]]$marks[[2L]]$encoding$y, y2)
expect_equivalent(p3$plots[[2L]]$marks[[1L]]$encoding$y, y3)
expect_equivalent(p3$plots[[2L]]$marks[[2L]]$encoding$y, y4)
expect_no_error(plot(p3))
})
test_that("plot_image", {
set.seed(1, kind="default")
nr <- 32
nc <- 32
i <- seq(-4, 4, length.out=nr)
j <- seq(1, 3, length.out=nc)
co <- expand.grid(i=i, j=j)
vals <- matrix(atan(co$i / co$j), nrow=nr, ncol=nc)
vals <- 10 * (vals - min(vals)) / diff(range(vals))
vals <- as.vector(vals + 2.5 * runif(length(vals)))
x <- as.integer(factor(co$i))
y <- as.integer(factor(co$j))
p1 <- plot_image(x, y, vals)
expect_is(p1, "vizi_plot")
expect_is(p1$marks[[1L]], "vizi_pixels")
expect_setequal(names(p1$channels), c("x", "y", "color"))
expect_equal(p1$marks[[1L]]$encoding$x, x)
expect_equal(p1$marks[[1L]]$encoding$y, y)
expect_equal(p1$marks[[1L]]$encoding$color, vals)
expect_no_error(plot(p1))
vals2 <- max(vals) - vals
vals3 <- log2(vals + 1)
vals4 <- log2(vals2 + 1)
p2 <- plot_image(x, y, list(a=vals, b=vals2))
expect_is(p2, "vizi_facets")
expect_is(p2$plots[[1L]]$marks[[1L]], "vizi_pixels")
expect_is(p2$plots[[2L]]$marks[[1L]], "vizi_pixels")
expect_setequal(names(p2$channels), c("x", "y", "color"))
expect_equal(p2$plots[[1L]]$marks[[1L]]$encoding$x, x)
expect_equal(p2$plots[[1L]]$marks[[1L]]$encoding$y, y)
expect_equal(p2$plots[[1L]]$marks[[1L]]$encoding$color, vals)
expect_equal(p2$plots[[2L]]$marks[[1L]]$encoding$x, x)
expect_equal(p2$plots[[2L]]$marks[[1L]]$encoding$y, y)
expect_equal(p2$plots[[2L]]$marks[[1L]]$encoding$color, vals2)
expect_no_error(plot(p2))
p3 <- plot_image(x, y, list(vals, vals2, vals3, vals4),
by=c("a", "a", "b", "b"), group=c("1", "2", "1", "2"))
expect_is(p3, "vizi_facets")
expect_length(p3$plots, 2L)
expect_setequal(names(p3$channels), c("x", "y", "color", "alpha"))
expect_equal(p3$plots[[1L]]$marks[[1L]]$encoding$alpha, vals)
expect_equal(p3$plots[[1L]]$marks[[2L]]$encoding$alpha, vals2)
expect_equal(p3$plots[[2L]]$marks[[1L]]$encoding$alpha, vals3)
expect_equal(p3$plots[[2L]]$marks[[2L]]$encoding$alpha, vals4)
expect_no_error(plot(p3))
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.