test_that("Errors are handled gracefully", {
expect_error(TernaryCoords(c(1, 2)))
expect_error(TernaryCoords(c("a", "b", "c")))
expect_error(TernaryPlot(point = "nowhere"))
expect_error(TernaryPoints(rep(1, 5)))
expect_error(HorizontalGrid(direction = 5))
expect_warning(
TernaryPlot(xlim = c(0, 10), ylim = c(0, 1), isometric = TRUE),
"x range > y range.+setting ylim"
)
expect_warning(
TernaryPlot(xlim = c(0, 1), ylim = c(0, -10), isometric = TRUE),
"x range < y range.+setting xlim"
)
expect_error(CoordinatesToXY(array(1, dim = c(1, 1, 1))))
})
test_that("TernaryCoords gives correct coordinates", {
options("ternDirection" = 2L)
input <- cbind(
c(a = 0, b = 0, c = 1),
c(a = 0, b = 2, c = 0),
c(a = 3, b = 0, c = 0),
c(a = 0, b = 9, c = 9),
c(a = 2, b = 1, c = 1)
)
listInput <- lapply(1:5, function(i) input[, i])
output <- cbind(
c(0, 0.5),
c(0, -0.5),
c(sin(pi / 3), 0),
c(0, 0),
c(sin(pi / 3) / 2, 0)
)
expect_equal(output, apply(input, 2, TernaryCoords))
expect_equal(output, CoordinatesToXY(listInput))
expect_equal(output, CoordinatesToXY(input))
expect_equal(matrix(output[, 1], 2, 1), CoordinatesToXY(input[, 1]))
expect_equal(input / rep(colSums(input), each = 3),
XYToTernary(output[1, ], output[2, ]))
expect_error(TernaryCoords(rep(1, 5), 1, 1))
expect_equal(c(0, 0.5), TernaryCoords(0, 0, 1))
})
test_that("Ternary plotting functions", {
TernaryPlotterXlim <- function() {
TernaryPlot("A", "B", "C", xlim = c(0, 0.86), point = 2)
JoinTheDots(list(c(1, 1, 1), c(0, 1, 2)), lwd = 2, col = "green")
TernaryPoints(c(0.5, 1, 1))
TernaryText(c(1.5, 1, 1), "A")
}
TernaryPlotterYlim <- function() {
TernaryPlot("A", "B", "C", ylim = c(0, 0.82),
point = 1, main = "... to plot")
TernaryLines(list(c(1, 1, 1), c(0, 1, 2)), lwd = 2)
TernaryArrows(c(1, 1.2, 1), c(0, 1.2, 2), lwd = 1)
TernaryPolygon(matrix(c(
30, 40, 30,
30, 30, 40,
55, 20, 25
), ncol = 3, byrow = TRUE))
}
skip_if_not_installed("vdiffr")
vdiffr::expect_doppelganger("plot-to-ternary-x", TernaryPlotterXlim)
vdiffr::expect_doppelganger("plot-to-ternary-y", TernaryPlotterYlim)
})
test_that("Axes can be styled individually", {
AxisStyle <- function() {
par(mfrow = 1:2, xpd = NA)
cols <- c("red", "darkgreen", "blue")
TernaryPlot(
alab = "a", blab = "b", clab = "c",
atip = "a", btip = "b", ctip = "c",
lab.col = cols,
lab.cex = 1:3 / 2,
lab.offset = 1:3 / 15,
grid.lines = 4,
axis.lwd = 1:3,
axis.lty = 1:3,
axis.lab = list(0:4, 10:14, 20:24),
ticks.lwd = 1:3,
grid.col = cols,
grid.lwd = 1:3,
grid.lty = 1:3,
grid.minor.col = c("#ff9999", "#99ff99", "#9999ff"),
grid.minor.lty = 4:6,
grid.minor.lwd = 1:3,
axis.col = cols,
axis.font = 1:3,
ticks.col = cols,
ticks.length = 1:3 / 50,
tip.font = 1:3,
tip.col = cols
)
TernaryPoints(c(2, 1, 0))
TernaryPlot(
alab = "a", blab = "b", clab = "c",
atip = "a", btip = "b", ctip = "c",
clockwise = FALSE,
lab.col = cols,
lab.cex = 1:3 / 2,
lab.offset = 1:3 / 15,
grid.lines = 4,
axis.lwd = 1:3,
axis.lty = 1:3,
ticks.lwd = 1:3,
grid.col = cols,
grid.lwd = 1:3,
grid.lty = 1:3,
grid.minor.col = c("#ff9999", "#99ff99", "#9999ff"),
grid.minor.lty = 4:6,
grid.minor.lwd = 1:3,
axis.col = cols,
axis.font = 2,
ticks.col = cols,
ticks.length = 1:3 / 50,
tip.font = 1:3,
tip.col = cols
)
TernaryPoints(c(2, 1, 0))
}
skip_if_not_installed("vdiffr")
vdiffr::expect_doppelganger("AxisStyle", AxisStyle)
})
test_that("panel.xxst parameter", {
skip_if_not_installed("vdiffr")
vdiffr::expect_doppelganger("panel.xxst-parameter", function() {
TernaryPlot(
panel.first = rect(0, -1, -1, 1, col = 2),
panel.last = rect(0, -1, 1, 1, col = 3),
atip = "Tip A", btip = "Tip B", clab = "Axis C",
xpd = NA
)
})
})
test_that("Vignette plots are rendered correctly", {
skip_if_not_installed("vdiffr")
vdiffr::expect_doppelganger("Blank plot", TernaryPlot)
BlankTernary <- function(dir, clockwise = TRUE) {
TernaryPlot(
point = dir,
atip = "A vertex", btip = "B vertex", ctip = "C vertex",
alab = "Aness", blab = "Bness", clab = "Cness",
clockwise = clockwise
)
TernaryText(list(A = c(10, 01, 01), B = c(01, 10, 01), C = c(01, 01, 10)),
col = cbPalette8[4], font = 2
)
HorizontalGrid(grid.col = "red")
}
TernaryUp <- function() BlankTernary("up")
TernaryRight <- function() BlankTernary("right")
TernaryDown <- function() BlankTernary("down")
TernaryLe <- function() BlankTernary("le")
TernaryUpAC <- function() BlankTernary("up", clockwise = FALSE)
TernaryRightAC <- function() BlankTernary("right", clockwise = FALSE)
TernaryDownAC <- function() BlankTernary("down", clockwise = FALSE)
TernaryLeAC <- function() BlankTernary("le", clockwise = FALSE)
vdiffr::expect_doppelganger("Blank up", TernaryUp)
vdiffr::expect_doppelganger("Blank right", TernaryRight)
vdiffr::expect_doppelganger("Blank down", TernaryDown)
vdiffr::expect_doppelganger("Blank le", TernaryLe)
vdiffr::expect_doppelganger("Blank up anticlockwise", TernaryUpAC)
vdiffr::expect_doppelganger("Blank right anticlockwise", TernaryRightAC)
vdiffr::expect_doppelganger("Blank down anticlockwise", TernaryDownAC)
vdiffr::expect_doppelganger("Blank le anticlockwise", TernaryLeAC)
TernaryCols <- function() {
par(mfrow = c(1, 2), mar = rep(0.3, 4))
TernaryPlot(
alab = "Redder \u2192", blab = "\u2190 Greener", clab = "Bluer \u2192",
lab.col = c("red", "green", "blue"),
point = "right", lab.cex = 0.8, grid.minor.lines = 0,
grid.lty = "solid", grid.col = "white",
axis.col = rgb(0.6, 0.6, 0.6), ticks.col = rgb(0.6, 0.6, 0.6),
padding = 0.08
)
cols <- TernaryPointValues(rgb)
ColourTernary(cols, spectrum = NULL)
data_points <- list(
R = c(255, 0, 0),
O = c(240, 180, 52),
Y = c(210, 222, 102),
G = c(111, 222, 16),
B = c(25, 160, 243),
I = c(92, 12, 243),
V = c(225, 24, 208)
)
AddToTernary(points, data_points,
pch = 21, cex = 2.8,
bg = vapply(
data_points,
function(x) rgb(x[1], x[2], x[3], 128, maxColorValue = 255),
character(1)
)
)
AddToTernary(text, data_points, names(data_points), cex = 0.8, font = 2)
legend("bottomright",
legend = c("Red", "Orange", "Yellow", "Green"),
cex = 0.8, bty = "n", pch = 21, pt.cex = 1.8,
pt.bg = c(
rgb(255, 0, 0, 128, NULL, 255),
rgb(240, 180, 52, 128, NULL, 255),
rgb(210, 222, 102, 128, NULL, 255),
rgb(111, 222, 16, 128, NULL, 255)
),
)
TernaryPlot("Steam", "Ice", "Water",
grid.lines = 5L, grid.lty = "dotted",
grid.minor.lines = 1L, grid.minor.lty = "dotted",
btip.rotate = 330L, ctip.rotate = 30L,
col = rgb(0.9, 0.9, 0.9, alpha = 0.2),
point = "West"
)
HorizontalGrid()
middle_triangle <- matrix(c(
30, 40, 30,
30, 30, 40,
55, 20, 25
), ncol = 3, byrow = TRUE)
TernaryPolygon(middle_triangle, col = "#aaddfa", border = "grey")
TernaryLines(list(c(0, 100, 0), middle_triangle[1, ]), col = "grey")
TernaryLines(list(c(0, 0, 100), middle_triangle[2, ]), col = "grey")
TernaryLines(list(c(100, 0, 0), middle_triangle[3, ]), col = "grey")
TernaryArrows(c(20, 20, 60), c(30, 30, 40), length = 0.2, col = "darkblue")
TernarySegments(rbind(c(25, 15, 60), c(15, 25, 60)),
rbind(c(30, 30, 40), c(30, 30, 40)),
col = c("lightblue", "#0000eecc")
)
}
skip_if_not_installed("vdiffr")
vdiffr::expect_doppelganger("colours-and-water", TernaryCols)
Cartesian <- function() {
TernaryPlot(point = "right")
arrows(x0 = 0.5, y0 = 0.4, x1 = sqrt(3) / 2, y1 = 0.4,
length = 0.1, col = cbPalette8[2])
text(x = mean(c(0.5, sqrt(3) / 2)), y = 0.4, "Increasing X",
pos = 3, col = cbPalette8[2])
text(x = 0.5, y = 0, "(0.5, 0)", col = cbPalette8[3])
text(x = 0.8, y = -0.5, "(0.8, -0.5)", col = cbPalette8[3])
}
skip_if_not_installed("vdiffr")
vdiffr::expect_doppelganger("Cartesian", Cartesian)
Padding <- function() {
TernaryPlot(xlim = c(0.28, 0.38), ylim = c(0.1, 0.2), padding = 0.04)
# Annotate grid lines at user-specified points:
TernaryText(
list(c(8, 72, 20), c(8, 82, 10)),
c(20, 10), srt = -60, cex = 0.9, col = "darkgrey")
TernaryText(list(c(10, 69, 21), c(20, 64, 16)),
c(10, 20), srt = 0, cex = 0.9, col = "darkgrey")
# Plot desired polygon
my_corners <- list(c(22, 66, 12), c(22, 72, 6), c(15, 80, 5), c(12, 76, 12))
TernaryPolygon(my_corners, col = "#2cbe4e")
# Show xlim, ylim and padding, using cartesian coordinates
lines(c(0.28, 0.28, 0.38, 0.38, 0.28), c(0.1, 0.2, 0.2, 0.1, 0.1))
text(0.28, 0.15, "xlim[1]", pos = 2, srt = 90)
text(0.38, 0.15, "xlim[2]", pos = 4, srt = 90)
text(0.33, 0.1, "ylim[1]", pos = 1)
text(0.33, 0.2, "ylim[2]", pos = 3)
text(0.38, 0.1, "<padding>", pos = 4, cex = 0.75)
text(0.38, 0.1, "<padding> ", pos = 2, cex = 0.75, srt = 90)
}
skip_if_not_installed("vdiffr")
vdiffr::expect_doppelganger("padding", Padding)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.