tests/testthat/test-cacheGeo.R

In PredictiveEcology/reproducible: Enhance Reproducibility of R Code

test_that("lightweight tests for code coverage", {
  skip_on_cran()
  testInit(c("sf", "terra"),
    opts = list(
      "reproducible.overwrite" = TRUE,
      "reproducible.inputPaths" = NULL
    ),
    needGoogleDriveAuth = TRUE
  )
  dPath <- checkPath(file.path(tempdir2()), create = TRUE)
  localFileLux <- system.file("ex/lux.shp", package = "terra")

  # 1 step for each layer
  # 1st step -- get study area
  full <- prepInputs(localFileLux, dest = dPath) # default is sf::st_read
  zoneA <- full[3:6, ]
  zoneB <- full[8, ] # not in A
  zoneC <- full[3, ] # yes in A
  zoneD <- full[7:8, ] # not in A, B or C
  zoneE <- full[3:5, ] # yes in A
  # 2nd step: re-write to disk as read/write is lossy; want all "from disk" for this ex.
  co <- capture.output({
    writeTo(zoneA, writeTo = "zoneA.shp", destinationPath = dPath)
    writeTo(zoneB, writeTo = "zoneB.shp", destinationPath = dPath)
    writeTo(zoneC, writeTo = "zoneC.shp", destinationPath = dPath)
    writeTo(zoneD, writeTo = "zoneD.shp", destinationPath = dPath)
    writeTo(zoneE, writeTo = "zoneE.shp", destinationPath = dPath)
    # Must re-read to get identical columns
    zoneA <- sf::st_read(file.path(dPath, "zoneA.shp"))
    zoneB <- sf::st_read(file.path(dPath, "zoneB.shp"))
    zoneC <- sf::st_read(file.path(dPath, "zoneC.shp"))
    zoneD <- sf::st_read(file.path(dPath, "zoneD.shp"))
    zoneE <- sf::st_read(file.path(dPath, "zoneE.shp"))
  })

  # The function that is to be run. This example returns a data.frame because
  #    saving `sf` class objects with list-like columns does not work with
  #    many st_driver()
  fun <- function(domain, newField) {
    domain |>
      as.data.frame() |>
      cbind(params = I(lapply(seq_len(NROW(domain)), function(x) newField)))
  }

  # Run sequence -- A, B will add new entries in targetFile, C will not,
  #                 D will, E will not
  for (z in list(zoneA, zoneB, zoneC, zoneD, zoneE)) {
    if (identical(z, zoneA) || identical(z, zoneB) || identical(z, zoneD)) {
      mess <- "Domain is not contained within the targetFile"
    }
    if (identical(z, zoneC) || identical(z, zoneE)) {
      mess <- "Spatial domain is contained within the url"
    }
    expect_message(out <- CacheGeo(
      targetFile = "fireSenseParams.rds",
      domain = z,
      FUN = fun(domain, newField = I(list(list(a = 1, b = 1:2, c = "D")))),
      fun = fun, # pass whatever is needed into the function
      destinationPath = dPath,
      action = "update"
    ), mess)
  }
})