tests/testthat/test-ggplot.R

In RStoolbox: Remote Sensing Data Analysis

context("ggplot: ggR, ggRGB & fortify")
library(terra)

test_that("ggR returns proper ggplot2 classes or data.frames", {
  suppressWarnings({
    tests  <- expand.grid(forceCat = c(TRUE, FALSE), anno = c(TRUE, FALSE), ggLayer = c(TRUE, FALSE), ggObj = c(TRUE,FALSE))
    builds <- lapply(seq_len(nrow(tests)), function(i) ggR(rlogo, forceCat = tests$forceCat[i], ggObj = tests$ggObj[i], geom_raster = !tests$anno[i], ggLayer = tests$ggLayer[i]))
    tinfo  <- paste0("forceCat=", tests[,1], ", anno=", tests[,2], ", ggLayer=", tests[,3], ", ggObj=", tests[,4])

    ## Annotation vs geom_raster
    for(s in which(with(tests, ggObj & !ggLayer))) expect_is(builds[[s]], c("gg", "ggplot"), info = tinfo[s])

    ## ggLayers
    if(!inherits(builds[[which(with(tests, ggObj & ggLayer))[1]]], "ggproto")){
      ## Current ggplot2 release version
      for(s in which(with(tests, ggObj & ggLayer))) expect_is(builds[[s]], "proto", info = tinfo[s])
      for(s in which(with(tests, ggObj & ggLayer & anno)))  expect_equal(builds[[s]]$geom$objname, "raster_ann", info = tinfo[s])
      for(s in which(with(tests, ggObj & ggLayer & !anno))) expect_equal(builds[[s]]$geom$objname, "raster", info = tinfo[s])
    } else {
      ## Upcoming ggplot2 version (>=1.0.1.9002)
      for(s in which(with(tests, ggObj & ggLayer & anno)))  expect_is(builds[[s]]$geom, "GeomRasterAnn", info = tinfo[s])
      for(s in which(with(tests, ggObj & ggLayer & !anno))) expect_is(builds[[s]]$geom, "GeomRaster", info = tinfo[s])
    }
    ## Data.frames
    for(s in  which(with(tests, !ggObj))) expect_is(builds[[s]], "data.frame", info = tinfo[s])
    for(s in  which(with(tests, !ggObj & forceCat))) expect_is(builds[[s]][,3], "factor", info = tinfo[s])
    for(s in  which(with(tests, !ggObj ))) expect_is(builds[[s]]$fill, "character", info = tinfo[s])

  })
})

test_that("ggR works with single valued rasters", {
  r <- rast(vals = 1, ncol = 2, nrow = 1)[[c(1,1,1)]]
  suppressWarnings(r[[1]][]<- NA)
  r[[2]][]<- 17
  r[[3]][]<- c(NA,2)

  for(i in 1:3) {
    expect_is(ggR(r,i), c("gg", "ggplot"))
  }
  for(i in 1:3) {
    expect_is(ggR(r,i,geom_raster = TRUE), c("gg", "ggplot"))
  }

  ## All NAs
  expect_equal(sum(is.na(ggR(r,1, ggObj = FALSE)[,c("value", "fill")])), 4)

  ## Single value
  gp <- ggR(r, 2, ggObj = FALSE)
  expect_equal(unique(gp[, "fill"]), "#FFFFFFFF")  ## fill colour
  expect_equal(unique(gp[, 3]), 17) ## actual value

  ## Single values + NAs
  gp <- ggR(r, 3, ggObj = FALSE)
  expect_equal(gp[,"fill"], c(NA, "#FFFFFFFF"))  ## fill colour
  expect_equal(gp[,3], c(NA, 2)) ## actual values
})


test_that("ggRGB returns proper ggplot2 classes or data.frames", {

  tests  <- expand.grid(anno = c(TRUE, FALSE), ggLayer = c(TRUE, FALSE), ggObj = c(TRUE,FALSE), stretch=c("sqrt", "hist", "log", "lin"))
  builds <- lapply(seq_len(nrow(tests)), function(i) ggRGB(rlogo, ggObj = tests$ggObj[i], geom_raster = !tests$anno[i], ggLayer = tests$ggLayer[i], stretch = tests$stretch[i] ))
  tinfo <- paste0("anno=", tests$anno, ", ggLayer=", tests$ggLayer, ", ggObj=", tests$ggObj)

  ## Stand-alone
  for(s in which(with(tests, ggObj & !ggLayer))) expect_is(builds[[s]], c("gg", "ggplot"), info = tinfo[s])

  ## ggLayers
  if(!inherits(builds[[which(with(tests, ggObj & ggLayer))[1]]], "ggproto")){
    ## Current ggplot2 release version
    for(s in which(with(tests, ggObj & ggLayer))) expect_is(builds[[s]], "proto", info = tinfo[s])
    for(s in which(with(tests, ggObj & ggLayer & anno)))  expect_equal(builds[[s]]$geom$objname, "raster_ann", info = tinfo[s])
    for(s in which(with(tests, ggObj & ggLayer & !anno))) expect_equal(builds[[s]]$geom$objname, "raster", info = tinfo[s])
  } else {
    ## Upcoming ggplot2 version (>=1.0.1.9002)
    for(s in which(with(tests, ggObj & ggLayer & anno)))  expect_is(builds[[s]]$geom, "GeomRasterAnn", info = tinfo[s])
    for(s in which(with(tests, ggObj & ggLayer & !anno))) expect_is(builds[[s]]$geom, "GeomRaster", info = tinfo[s])
  }

  ## Data.frames
  for(s in  which(with(tests, !ggObj))) expect_is(builds[[s]], "data.frame", info = tinfo[s])
  for(s in  which(with(tests, !ggObj))) expect_is(builds[[s]]$fill, "character", info = tinfo[s])

})

test_that("fortify returns proper data.frames", {
  df <- fortifySpatRaster(rlogo)
  expect_named(df, c("x", "y", "red", "green", "blue"))
  expect_identical(nrow(df), 7777L)
  ## Single layer
  expect_named(fortifySpatRaster(rlogo[[1]]), c("x", "y", "red"))
})