tests/testthat/test-Plot-snapshots.R

## 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
        })
    }
  }
})

Try the quickPlot package in your browser

Any scripts or data that you put into this service are public.

quickPlot documentation built on Aug. 8, 2025, 7:17 p.m.