Nothing
## block B
test_that("image content is not error-free", {
testInit("terra", opts = list(quickPlot.verbose = TRUE), dev = FALSE)
on.exit(
{
if (length(dev.list()) > 0) dev.off()
# unlink(tmpdir, recursive = TRUE)
},
add = TRUE) # nolint
ncol <- 3
nrow <- 4
N <- ncol * nrow
nLevels <- 4
# Test legend with a factor raster
set.seed(24334)
ras <- rast(matrix(sample(1:nLevels, size = N, replace = TRUE), ncol = ncol, nrow = nrow))
levels(ras) <- data.frame(ID = 1:nLevels, Class = paste0("Level", 1:nLevels))
# New Section
for (os in oses) {
fil <- fn(tmpdir, desc, counter, os)
announce_snapshot_file(name = basename(fil))
if (correctOS(os))
testthat::expect_snapshot_file(
{
png(filename = fil, width = 400, height = 300)
clearPlot()
Plot(ras, new = TRUE)
dev.off()
fil
},
basename(fil))
}
# Test legend with a factor raster
set.seed(24334)
ras <- rast(matrix(sample(1:nLevels, size = N, replace = TRUE), ncol = ncol, nrow = nrow))
for (os in oses) {
fil <- fn(tmpdir, desc, counter, os)
announce_snapshot_file(name = basename(fil))
if (correctOS(os))
expect_snapshot_file({
png(filename = fil, width = 400, height = 300)
clearPlot()
Plot(ras)
dev.off()
fil
})
}
# test non contiguous factor raster
fil <- file.path(tmpdir, "test3.png")
nLevels <- 6
N <- ncol * nrow
set.seed(24334)
levs <- (1:nLevels)[-((nLevels - 2):(nLevels - 1))] # nolint
ras <- rast(matrix(sample(levs, size = N, replace = TRUE),
ncol = ncol, nrow = nrow))
levels(ras) <- data.frame(ID = levs, Class = paste0("Level", levs))
ras <- setColors(ras, n = 4, c("red", "orange", "blue", "yellow"))
for (os in oses) {
fil <- fn(tmpdir, desc, counter, os)
announce_snapshot_file(name = basename(fil))
if (correctOS(os))
expect_snapshot_file({
png(filename = fil, width = 400, height = 300)
clearPlot()
Plot(ras, new = TRUE)
dev.off()
fil
})
}
})
# # ## block C
test_that("plotting colors", {
testInit("terra", opts = list(quickPlot.verbose = TRUE), dev = FALSE)
on.exit(
{
if (length(dev.list()) > 0) dev.off()
},
add = TRUE) # nolint
rasts <- list()
# should be a 2 x 2 raster, bottom left red, top row blue, bottom right green
rasts[[1]] <- rast(matrix(c(1, 0, 1, 2), ncol = 2))
setColors(rasts[[1]], n = 3) <- c("red", "blue", "green")
ras2 <- rast(matrix(c(3, 1, 1, 2), ncol = 2))
rasts[[2]] <- c(rasts[[1]], ras2)
names(rasts[[2]]) <- c("ras", "ras2")
setColors(rasts[[2]], n = 3) <- list(ras = c("black", "blue", "green"))
rasts[[3]] <- setColors(rasts[[1]], c("red", "purple", "orange"), n = 3)
##
if (requireNamespace("raster", quietly = TRUE)) {
rasterVec <- seq_along(rasts) + length(rasts)
rasts[rasterVec] <- lapply(rasts, function(r) {
if (length(names(r)) == 1) {
raster::raster(r)
} else {
raster::stack(r)
}
})
}
# # envirHere <- environment()
Map(testNum = seq_along(rasts), ras = rasts, function(testNum, ras) {
for (os in oses) {
fil <- fn(tmpdir, desc, counter, os, envir = envirHere)
announce_snapshot_file(name = basename(fil))
if (correctOS(os))
expect_snapshot_file({
png(filename = fil, width = 400, height = 300)
clearPlot()
Plot(ras, new = TRUE)
dev.off()
fil
})
}
})
})
# ## test.png 10 to 11
test_that("internal functions in Plot", {
testInit("terra", opts = list(quickPlot.verbose = TRUE), dev = FALSE)
on.exit(
{
if (length(dev.list()) > 0) dev.off()
},
add = TRUE) # nolint
on.exit(
{
if (length(dev.list()) > 0) dev.off()
},
add = TRUE) # nolint
# Test .makeColorMatrix for subsampled rasters
# (i.e., where speedup is high compared to ncells)
rasts <- list()
# 1 Test .makeColorMatrix for subsampled rasters
# (i.e., where speedup is high compared to ncells)
set.seed(1234)
rasts[[1]] <- rast(matrix(sample(1:3, size = 100, replace = TRUE), ncol = 10))
setColors(rasts[[1]], n = 3) <- c("red", "blue", "green")
# 2 Test that NA rasters plot correctly, i.e., with na.color only
rasts[[2]] <- matrix(NA_real_, ncol = 3, nrow = 3)
rasts[[2]] <- rast(rasts[[2]]) # There is a min and max warning on NA rasters
setColors(rasts[[2]], n = 3) <- c("red", "blue", "green")
# 3 Test legendRange in Plot
set.seed(1234)
rasts[[3]] <- rast(matrix(sample(1:3, size = 100, replace = TRUE), ncol = 10))
setColors(rasts[[3]], n = 3) <- c("red", "blue", "green")
set.seed(123)
rasts[[4]] <- rast(matrix(sample(1:3, size = 100, replace = TRUE), ncol = 10))
if (requireNamespace("raster", quietly = TRUE)) {
rasterVec <- seq_along(rasts) + length(rasts)
rasts[rasterVec] <- Map(r = rasts, i = seq_along(rasts), function(r, i) {
r <- if (length(names(r)) == 1) raster::raster(r) else raster::stack(r)
cols <- getColors(rasts[[i]])[[1]]
if (length(cols))
setColors(r, n = length(cols)) <- cols
r
})
}
# envirHere <- environment()
Map(testNum = seq_along(rasts), ras = rasts, function(testNum, ras) {
val <- (testNum - 1) %% (length(rasts) / 2) + 1
for (os in oses) {
fil <- fn(tmpdir, desc, counter, os, envir = envirHere)
announce_snapshot_file(name = basename(fil))
aaaa <<- 1
on.exit(rm(aaaa, envir = .GlobalEnv))
if (correctOS(os))
expect_snapshot_file({
png(filename = fil, width = 400, height = 300)
clearPlot()
set.seed(123)
switch(val,
`1` = Plot(rasts[[1]], new = TRUE, speedup = 3.21e4),
`2` = suppressWarnings(Plot(rasts[[2]], new = TRUE, speedup = 2e5)),
`3` = Plot(rasts[[3]], legendRange = 0:5, new = TRUE),
`4` = Plot(rasts[[4]], visualSqueeze = 0.88, title = FALSE,
legend = FALSE, cols = colorRampPalette(c("black", "red"))(3))
)
dev.off()
fil
})
}
})
})
## block E 15 to
test_that("Plot 2 is not error-free", {
testInit("terra", opts = list(quickPlot.verbose = TRUE), dev = FALSE)
on.exit(
{
if (length(dev.list()) > 0) dev.off()
},
add = TRUE) # nolint
on.exit(
{
if (length(dev.list()) > 0) dev.off()
},
add = TRUE) # nolint
rasts <- list()
set.seed(123)
v <- c(128, 400, 1806)
r <- rast(matrix(sample(v, size = 100, replace = TRUE), ncol = 10))
rasts <- list()
## 128 < vals < 1806
rasts[[1]] <- r # Expect rainbow colors, lots of peach, little green
## -71 < vals < 1606
rasts[[2]] <- r - 200 # Expect legend from below 0 to just above 1500
# Expect legend from below 0.2 to exactly 1
rasts[[3]] <- r / max(as.numeric(values(r)), na.rm = TRUE)
# Expect legend from exactly 0 to above 0.8
rasts[[4]] <- (r - min(as.numeric(values(r)), na.rm = TRUE)) / max(as.numeric(values(r)), na.rm = TRUE)
# Expect legend from exactly 0 to exactly 1
rasts[[5]] <- r - min(as.numeric(values(r)), na.rm = TRUE)
rasts[[5]] <- rasts[[5]] / max(as.numeric(values(rasts[[5]])), na.rm = TRUE)
# integers - 0, 1, 2 and 3 should line up with centre of
# each color, even though there is no peach in plot
rasts[[6]] <- rast(ncol = 3, nrow = 3)
set.seed(391) # no yellow in plot, yes in legend
rasts[[6]][] <- sample(0:3, replace = TRUE, size = 9)
# only Green and light grey with 0 and 1
rasts[[7]] <- rast(ncol = 3, nrow = 3)
rasts[[7]][] <- sample(0:1, replace = TRUE, size = 9)
# many colours 0 to 30
rasts[[8]] <- rast(ncol = 30, nrow = 30)
rasts[[8]][] <- sample(0:30, replace = TRUE, size = 900)
## 0, 1, 2, 3, 4, 5, 6
rasts[[9]] <- rast(ncol = 30, nrow = 30)
rasts[[9]][] <- sample(0:6, replace = TRUE, size = 900)
## 1, 2, 3, 4, 5, 6, ... 200
rasts[[10]] <- rast(ncol = 30, nrow = 30)
rasts[[10]][] <- sample(1:200, replace = TRUE, size = 900)
rasts[[11]] <- rast(ncol = 30, nrow = 30)
rasts[[11]][] <- sample(31:40, replace = TRUE, size = 900)
rasts[[12]] <- rast(xmin = 50, xmax = 50 + 3 * 100,
ymin = 50, ymax = 50 + 3 * 100,
res = c(100, 100), val = 1)
rasts[[12]][1] <- -1
rasts[[12]][2:6] <- 2
rasts[[13]] <- r - 200
# Plot(rasts[[13]], new = TRUE, zero.color = "black") # NO BLACK
rasts[[14]] <- r - 1000
rasts[[14]] <- round(rasts[[14]] / 300, 0)
rasts[[14]][4] <- 0
if (requireNamespace("raster", quietly = TRUE)) {
rasterVec <- seq_along(rasts) + length(rasts)
rasts[rasterVec] <- Map(r = rasts, i = seq_along(rasts), function(r, i) {
r <- if (length(names(r)) == 1) raster::raster(r) else raster::stack(r)
cols <- getColors(rasts[[i]])[[1]]
if (length(cols))
setColors(r, n = length(cols)) <- cols
r
})
}
hasRasterLayer <- sum(vapply(rasts, is, "Raster", FUN.VALUE = logical(1))) > 0
# if RasterLayer are present, then it will be 14 * 2 long, otherwise, just 14
# envirHere <- environment()
Map(testNum = seq_along(rasts), function(testNum) {
val <- (testNum - 1) %% (length(rasts) / (1 + hasRasterLayer)) + 1 # this tests whether SpatRaster is same as Raster
for (os in oses) {
fil <- fn(tmpdir, desc, counter, os, envir = envirHere)
announce_snapshot_file(name = basename(fil))
if (correctOS(os))
expect_snapshot_file({
png(filename = fil, width = 400, height = 300)
clearPlot()
Plot(rasts[[testNum]], new = TRUE)
dev.off()
fil
})
}
})
# envirHere <- environment()
Map(testNum = seq_along(rasts), function(testNum) {
val <- (testNum - 1) %% (length(rasts) / (1 + hasRasterLayer)) + 1
if (val %in% c(7, 8, 10, 11, 12, 14)) {
for (os in oses) {
fil <- fn(tmpdir, desc, counter, os, envir = envirHere)
announce_snapshot_file(name = basename(fil))
if (correctOS(os))
expect_snapshot_file({
png(filename = fil, width = 400, height = 300)
clearPlot()
set.seed(123)
switch(as.character(val),
"7" = Plot(rasts[[testNum]], new = TRUE, zero.color = "black"), # black zeros
"8" = {
a <- testNum
Plot(rasts[[testNum]], new = TRUE, zero.color = "black") # black zeros, some scattered
## black zeros, plus legend -10 to 40
Plot(rasts[[a]], new = TRUE, zero.color = "black", legendRange = c(-10, 40)) # legend changed
},
"10" = {
a <- testNum
Plot(rasts[[testNum]], new = TRUE, zero.color = "black") # should be no black because no zeros
Plot(rasts[[a]], new = TRUE, zero.color = "black", legendRange = c(-10, 200))
},
## should be slim black in legend, none in fig
#
## Test legend that is pre-set, even with various types of rasters
## should be dark red raster, legend from 0 to 200
"11" = {
clearPlot()
# should be mostly red raster, a bit of green, legend 0 to 200
Plot(rasts[[11]], legendRange = c(0, 200), new = TRUE, cols = c("red", "green"))
# should be mostly almost entirely red raster, legend below 0 to 2000
f <- e <- d <- b <- a <- 11
Plot(rasts[[a]], legendRange = c(-200, 2000), new = TRUE, cols = c("red", "green"))
Plot(rasts[[b]], new = TRUE)
Plot(rasts[[d]], new = TRUE, legendRange = c(0, 40)) # legend from 0 to 40, mostly green
Plot(rasts[[e]], new = TRUE, zero.color = "black") # no black
Plot(rasts[[f]], new = TRUE, zero.color = "black", legendRange = c(35, 40)) # lots of white
},
## legend Should have all colors in legend
"12" = {
a <- 12
clearPlot()
Plot(rasts[[12]], new = TRUE)
Plot(rasts[[a]], new = TRUE, cols = c("red", "yellow", "green", "blue"))
},
"14" = {
# zero.color on Integer numbers should work - expect BLACK both in legend and in a few cells
a <- 14
clearPlot()
Plot(rasts[[14]], new = TRUE, zero.color = "black")
# zero.color on Integer numbers should work - expect red both in legend and in a few cells
Plot(rasts[[a]], zero.color = "red")
}
)
dev.off()
fil
})
}
}
})
# After thought -- move raster values outside of legend
for (os in oses) {
fil <- fn(tmpdir, desc, counter, os, envir = envirHere)
announce_snapshot_file(name = basename(fil))
if (correctOS(os))
expect_snapshot_file({
png(filename = fil, width = 800, height = 600)
clearPlot()
set.seed(123)
Plot(rasts[[12]], cols = "Blues", new = TRUE, legendRange = c(-3, 4))
rasts[[12]][] <- rasts[[12]][] + 5
Plot(rasts[[12]], na.color = "white") # Should keep one dark Blue, rest white
dev.off()
fil
})
}
})
## block F
test_that("setColors is not error-free", {
# skip("Apparently color palettes are not universal")
testInit("terra", opts = list(quickPlot.verbose = TRUE), dev = FALSE)
on.exit(
{
if (length(dev.list()) > 0) dev.off()
},
add = TRUE) # nolint
set.seed(1234)
ras1 <- rast(matrix(sample(1:3, size = 100, replace = TRUE), ncol = 10))
ras2 <- rast(matrix(sample(1:3, size = 100, replace = TRUE), ncol = 10))
rasStack <- c(ras1, ras2)
expect_no_error(setColors(rasStack, n = c(ras1 = 3, ras2 = 5)) <-
list(ras1 = c("red", "blue", "green"), ras2 = c("purple", "yellow")))
names(rasStack) <- c("ras1", "ras2")
expect_no_error({
setColors(rasStack, n = c(ras1 = 3, ras2 = 5)) <-
list(ras1 = c("red", "blue", "green"), ras2 = c("purple", "yellow"))
})
expect_true(identical(
getColors(rasStack),
structure(list(ras1 = c("#FF0000FF", "#0000FFFF", "#00FF00FF"),
ras2 = c("#A020F0FF", "#B757B3FF", "#CF8F78FF", "#E7C73CFF",
"#FFFF00FF")),
.Names = c("ras1", "ras2"))
))
ras3 <- rast(matrix(sample(1:3, size = 100, replace = TRUE), ncol = 10))
rasStack <- c(rasStack, ras3)
names(rasStack)[3] <- "ras3"
expect_warning({
setColors(rasStack, n = c(ras1 = 3, 5)) <- list(
ras1 = c("red", "blue", "green"),
ras2 = c("purple", "yellow"),
ras3 = c("orange", "yellow")
)
})
expect_true(identical(
getColors(rasStack),
structure(list(
ras1 = c("#FF0000FF", "#0000FFFF", "#00FF00FF"),
ras2 = c("#A020F0FF", "#B757B3FF", "#CF8F78FF", "#E7C73CFF", "#FFFF00FF"),
ras3 = c("#FFA500FF", "#FFD200FF", "#FFFF00FF")),
.Names = c("ras1", "ras2", "ras3"))
))
})
# block G
test_that("Plot with base is not error-free", {
testInit("terra", opts = list(quickPlot.verbose = TRUE), dev = FALSE)
on.exit(
{
if (length(dev.list()) > 0) dev.off()
},
add = TRUE) # nolint
set.seed(123)
rasOrig <- rast(ext(0, 40, 0, 20), vals = sample(1:8, replace = TRUE, size = 800), res = 1)
ras <- rasOrig
aTime <- Sys.time()
# # New Section
for (os in oses) {
fil <- fn(tmpdir, desc, counter, os, envir = envirHere)
announce_snapshot_file(name = basename(fil))
if (correctOS(os))
expect_snapshot_file({
png(filename = fil, width = 800, height = 600)
clearPlot()
set.seed(123)
ras5 <- ras6 <- ras7 <- ras2 <- ras3 <- ras4 <- ras1 <- ras
Plot(ras, ras1, ras2, ras3, ras4, ras5, ras6, ras7)
Plot(1:10, ylab = "hist")
Plot(2:22, addTo = "newOne")
# New Section
ras <- rasOrig
set.seed(123)
Plot(rnorm(10), addTo = "hist", ylab = "test")
a <- hist(rnorm(10), plot = FALSE)
Plot(a, addTo = "histogram", axes = "L", col = "#33EEAA33", xlim = c(-3, 3))
a <- hist(rnorm(100), plot = FALSE)
Plot(a, addTo = "histogram", axes = FALSE, col = paste0("#1133FF", "33"),
xlim = c(-3, 3), xlab = "", ylab = "")
ras2 <- rast(ras)
ras2[] <- sample(1:8)
Plot(ras2)
dev.off()
fil
})
}
for (os in oses) {
fil <- fn(tmpdir, desc, counter, os, envir = envirHere)
announce_snapshot_file(name = basename(fil))
if (requireNamespace("ggplot2", quietly = TRUE)) {
if (correctOS(os))
expect_snapshot_file({
png(filename = fil, width = 800, height = 600)
clearPlot()
set.seed(123)
gg1 <- ggplot2::ggplot(data.frame(x = 1:10, y = 1:10)) +
ggplot2::geom_point(ggplot2::aes(x, y))
clearPlot()
suppressMessages(Plot(gg1, title = "gg plot"))
Plot(ras1, ras2, ras3)
Plot(rnorm(1:10), ylab = "hist")
dev.off()
fil
})
}
}
# New Section
for (os in oses) {
fil <- fn(tmpdir, desc, counter, os, envir = envirHere)
announce_snapshot_file(name = basename(fil))
if (correctOS(os))
expect_snapshot_file({
png(filename = fil, width = 800, height = 600)
clearPlot()
set.seed(123)
ras <- rasOrig
a <- rnorm(1e2)
b <- rnorm(1e2)
Plot(a, axes = TRUE, addTo = "first", visualSqueeze = 0.6)
Plot(a, b, axes = TRUE, addTo = "second", visualSqueeze = 0.6)
Plot(1:10, axes = FALSE, addTo = "third", visualSqueeze = 0.6)
Plot(1:10, 1:10, axes = "L", addTo = "fourth", visualSqueeze = 0.6,
main = "test4", title = FALSE)
Plot(1:10, 1:10, axes = TRUE, addTo = "fourth", visualSqueeze = 0.6,
main = "test4", title = "test5")
Plot(1:10, 1:10, axes = TRUE, addTo = "fifth", visualSqueeze = 0.6,
main = "test4", title = "test5")
Plot(ras)
dev.off()
fil
})
}
# New Section
for (os in oses) {
fil <- fn(tmpdir, desc, counter, os, envir = envirHere)
announce_snapshot_file(name = basename(fil))
set.seed(123)
if (correctOS(os))
expect_snapshot_file({
png(filename = fil, width = 800, height = 600)
ras <- rasOrig
ras2 <- ras
ras2[] <- sample(ras[])
clearPlot()
Plot(ras, title = "test", new = TRUE)
Plot(ras2, addTo = "ras", cols = "Reds")
Plot(ras2, title = "test2", new = TRUE)
Plot(ras, addTo = "ras2", cols = "Blues")
dev.off()
fil
})
}
})
## block H
test_that("Plot messages and warnings and errors", {
testInit("terra", opts = list(quickPlot.verbose = TRUE), dev = FALSE)
rasOrig <- rast(ext(0, 40, 0, 20), vals = sample(1:8, replace = TRUE, size = 800), res = 1)
ras <- rasOrig
expect_error(Plot(ras, rnorm(10)), "Can't mix base plots with .quickPlottables")
})
## block I
test_that("rePlot doesn't work", {
testInit("terra", opts = list(quickPlot.verbose = TRUE), dev = FALSE)
for (os in oses) {
fil <- fn(tmpdir, desc, counter, os, envir = envirHere)
announce_snapshot_file(name = basename(fil))
if (correctOS(os))
expect_snapshot_file({
png(filename = fil, width = 400, height = 300)
a <- dev.cur()
set.seed(123)
rasOrig <- rast(ext(0, 40, 0, 20), vals = sample(1:8, replace = TRUE, size = 800), res = 1)
ras <- rasOrig
clearPlot()
ras <- ras + 1
Plot(ras)
Plot(rnorm(10), ylab = "hist")
dev.off(a)
fil
})
unlink(fil)
# same file for snapshot b/c basename is same as previous
announce_snapshot_file(name = basename(fil))
if (correctOS(os))
expect_snapshot_file({
png(filename = fil, width = 400, height = 300)
b <- dev.cur()
rePlot(a, b)
dev.off(b)
fil
})
}
})
## block J
test_that("Plot - going through package coverage", {
testInit("terra", opts = list(quickPlot.verbose = TRUE), dev = FALSE)
set.seed(123)
rasOrig <- rast(ext(0, 40, 0, 20), vals = sample(1:8, replace = TRUE, size = 800), res = 1)
ras <- rasOrig
expect_no_error(Plot(ras, new = TRUE))
clearPlot(force = TRUE)
## do.call version:
# expect_error(do.call(Plot, list(ras = ras)), "Currently,") # nolint
try(dev.off())
})
# block K
test_that("Plot lists", {
prevLastPlotNumber <- 48
testInit("terra", opts = list(quickPlot.verbose = TRUE), dev = FALSE)
clearPlot()
set.seed(123)
rasOrig <- rast(
ext(0, 40, 0, 20), vals = sample(1:8, replace = TRUE, size = 800), res = 1
)
ras1 <- ras2 <- ras3 <- ras4 <- rasOrig
a <- list()
for (i in 1:4) a[[paste0("ras", i)]] <- get(paste0("ras", i))
Sr1 <- cbind(object = 1, cbind(c(2, 4, 4, 1, 2), c(2, 3, 5, 4, 2)) * 20 - 50)
Sr2 <- cbind(object = 2, cbind(c(5, 4, 2, 5), c(2, 3, 2, 2)) * 20 - 50)
SpP <- rbind(Sr1, Sr2)
# Srs1 <- Polygons(list(Sr1), "s1")
# Srs2 <- Polygons(list(Sr2), "s2")
# SpP <- SpatialPolygons(list(Srs1, Srs2), 1:2)
SpP <- terra::vect(SpP, "polygons")
set.seed(123)
rasOrig <- rast(ext(0, 40, 0, 20), vals = sample(1:8, replace = TRUE, size = 800), res = 1)
ras <- rasOrig
aTime <- Sys.time()
# # New Section
for (os in oses) {
# Mixing base and grid
a$SpP <- SpP
fil <- fn(tmpdir, desc, counter, os, envir = envirHere)
announce_snapshot_file(name = basename(fil))
if (correctOS(os))
# fil <- paste0("test", prevLastPlotNumber + 1 ,".png")
# fil <- file.path(tmpdir, fil)
# announce_snapshot_file(name = basename(fil))
# if (isLinux()) {
expect_snapshot_file({
png(filename = fil, width = 800, height = 600)
clearPlot()
set.seed(123)
Plot(a)
dev.off()
fil
})
}
for (os in oses) {
if (correctOS(os)) {
ggplotVersion <- if (utils::packageVersion("ggplot2") > "3.5.2") "newer" else "older"
fil <- fn(tmpdir, paste0(desc, "ggplotV", ggplotVersion), counter, os, envir = envirHere)
announce_snapshot_file(name = basename(fil))
if (requireNamespace("ggplot2", quietly = TRUE)) {
ggplotVer <- utils::packageVersion("ggplot2")
gg <- ggplot2::ggplot(data.frame(x = 1:10, y = sample(1:10))) +
ggplot2::geom_point(ggplot2::aes(x, y))
gg1 <- ggplot2::ggplot(data.frame(x = 1:10, y = sample(1:10))) +
ggplot2::geom_point(ggplot2::aes(x, y))
b <- list(gg = gg, gg1 = gg1)
expect_snapshot_file({
png(filename = fil, width = 800, height = 600)
clearPlot()
set.seed(123)
clearPlot()
Plot(append(a, b))
dev.off()
fil
})
}
}
}
})
## block L
test_that("Plot non-complicated object names", {
testInit("terra", opts = list(quickPlot.verbose = TRUE), dev = FALSE)
a <- list()
a$e <- new.env()
rasOrig <- rast(ext(0, 40, 0, 20), vals = sample(1:8, replace = TRUE, size = 800), res = 1)
rasOrig2 <- rasOrig
a$e$p <- rasOrig
a$e$s <- c(rasOrig2, lyr.2 = rasOrig)
clearPlot()
expect_no_error(Plot(a$e$p))
expect_no_error(Plot(a$e[["p"]]))
expect_no_error(Plot(a$e[["s"]]$lyr.1))
expect_no_error(Plot(a$e[["s"]]$lyr.1[1:10], addTo = "secondPlot"))
# add the same data as a different plot -- use a named list
expect_no_error(Plot(list("thirdPlot" = a$e[["s"]]$lyr.1), new = TRUE))
a$e[["s"]]$lyr.1[2] <- terra::minmax(a$e[["s"]]$lyr.1)[2]
expect_no_error(Plot(list("thirdPlot" = a$e[["s"]]$lyr.1), new = TRUE))
dev.off()
})
## block M
test_that("Plot functions NOT in quickPlot, i.e. redefining Plot", {
testInit("terra", opts = list(quickPlot.verbose = TRUE), dev = FALSE)
Plot <- function(x) {
quickPlot::Plot(x)
}
clearPlot()
expect_no_error(Plot(terra::rast(matrix(1:100, 10, 10))))
try(dev.off())
})
test_that("Issue 20; arr working", {
testInit("terra", opts = list(quickPlot.verbose = TRUE), dev = FALSE)
files <- dir(system.file("maps", package = "quickPlot"), full.names = TRUE, pattern = "tif")
maps <- lapply(files, rast)
names(maps) <- lapply(maps, names)
for (os in oses) {
fil <- fn(tmpdir, desc, counter, os, envir = envirHere)
announce_snapshot_file(name = basename(fil))
if (correctOS(os))
expect_snapshot_file({
png(filename = fil, width = 800, height = 600)
clearPlot()
Plot(maps$DEM, maps$forestCover, maps$forestAge)
Plot(maps$habitatQuality) ## I get a 2 row 2 column layout
Plot(maps$habitatQuality, arr = c(1, 4), new = TRUE) ## doesn't change the layout.
dev.off()
fil
})
}
})
test_that("Issue 32 Plot factors lower case id", {
prevLastPlotNumber <- 51
testInit("terra", opts = list(quickPlot.verbose = TRUE), dev = FALSE)
for (colPalette in 1:2) {
r <- rast(ncols = 3, nrows = 2, vals = 1:6)
col <- if (colPalette == 1) rainbow(6, end = .9) else colorRampPalette(c("light green", "dark green"))(6)
coltb <- data.frame(value = 1:6, col = col)
coltab(r) <- coltb
cls <- data.frame(id = 1:6, class = LETTERS[1:6])
levels(r) <- cls
for (os in oses) {
fil <- fn(tmpdir, desc, counter, os, envir = envirHere)
announce_snapshot_file(name = basename(fil))
if (correctOS(os))
expect_snapshot_file({
png(filename = fil, width = 800, height = 600)
clearPlot()
Plot(r, new = TRUE)
dev.off()
fil
})
}
}
for (fn in 3) {
r <- rast(ncols = 3, nrows = 2, vals = 1:6)
cls <- data.frame(id = 1:6, class = LETTERS[1:6])
levels(r) <- cls
for (os in oses) {
fil <- fn(tmpdir, desc, counter, os, envir = envirHere)
announce_snapshot_file(name = basename(fil))
if (correctOS(os))
expect_snapshot_file({
png(filename = fil, width = 800, height = 600)
clearPlot()
Plot(r, col = "Reds")
dev.off()
fil
})
}
}
})
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.