tests/testthat/test-SESraster.R

In SESraster: Raster Randomization for Null Hypothesis Testing

test_that("SES works", {
  r <- load_ext_data()
  aleats <- 5

  appmean <- function(x, ...){
                        terra::app(x, "mean", ...)
  }

  set.seed(10)
  # test ses by species
  ses <- SESraster(r, FUN=appmean, spat_alg = "bootspat_naive", spat_alg_args=list(random="species"),
                   aleats = aleats)
  nms <- paste0(c("Observed", "Null_Mean", "Null_SD", "SES", "p_lower", "p_upper"), ".mean")

  expect_true(inherits(ses, "SpatRaster"), "TRUE")
  expect_true(terra::nlyr(ses) == length(nms))
  expect_named(ses, nms)

  expect_equal(unlist(ses[1]), setNames(as.double(rep(c(NA, 0), c(4, 2))), nms))

  expect_equal(unlist(ses[2]), setNames(c(0, 0.4, 0.11952286, -3.34664011, 1, 0), nms))

  expect_equal(round(sd(terra::values(ses[[2]]), na.rm = TRUE), 3), as.double(0.081)) # test spat variation

  ## test ses by site
  ses <- SESraster(r, FUN=appmean, spat_alg = "bootspat_naive", spat_alg_args=list(random="site"),
                   aleats = aleats)
  # nms <- c("Observed.mean", "Null_Mean.mean", "Null_SD.std", "SES.mean")

  expect_true(inherits(ses, "SpatRaster"), "TRUE")
  expect_true(terra::nlyr(ses) == length(nms))
  expect_named(ses, nms)

  expect_equal(unlist(ses[1]), setNames(as.double(rep(c(NA, 0), c(4, 2))), nms))

  expect_equal(unlist(ses[2]), setNames(rep(0, length(nms)), nms))

  expect_equal(as.vector(terra::values(ses[[1]])), as.vector(terra::values(ses[[2]]))) # test spat variation

  ses <- SESraster(r, FUN=appmean, spat_alg = "bootspat_naive",
                   spat_alg_args=list(random="species"),
                   aleats = aleats,
                   force_wr_aleat_file = TRUE)

  expect_true(inherits(ses, "SpatRaster"), "TRUE")
  expect_true(terra::nlyr(ses) == length(nms))
  expect_named(ses, nms)

  expect_equal(unlist(ses[1]), setNames(as.double(rep(c(NA, 0), c(4, 2))), nms))

  ## example with 'vec_alg'
  appsv <- function(x, lyrv, na.rm=T, ...){
                        sumw <- function(x, lyrv, na.rm, ...){
                          ifelse(all(is.na(x)), NA,
                                 sum(x*lyrv, na.rm=na.rm, ...))
                        }
                        stats::setNames(terra::app(x, sumw, lyrv = lyrv, na.rm=na.rm, ...), "sumw")
  }
  n2 <- names(appsv(r, seq_len(terra::nlyr(r))))
  ses <- SESraster(r, FUN=appsv, FUN_args = list(lyrv = seq_len(terra::nlyr(r)), na.rm = TRUE),
                   Fa_sample = "lyrv",
                   Fa_alg = "sample", Fa_alg_args = list(replace=TRUE),
                   aleats = aleats,
                   filename = paste0(tempfile(),"ses.tif"))
  # names(ses)
  nms <- paste0(c("Observed", "Null_Mean", "Null_SD" ,"SES", "p_lower", "p_upper"), ".", n2)
  expect_equal(unlist(ses[1]), setNames(as.double(rep(c(NA, 0), c(4, 2))), nms))

  expect_equal(unlist(ses[2]), setNames(rep(0, length(nms)), nms))

  expect_equal(round(sd(terra::values(ses[[2]]), na.rm = TRUE), 3), as.double(4.413)) # test spat variation

  expect_error(SESraster(r, FUN=appsv, FUN_args = list(lyrv = seq_len(terra::nlyr(r)), na.rm = TRUE),
                         Fa_sample = numeric(1),
                         Fa_alg = "sample", Fa_alg_args = list(replace=TRUE),
                         aleats = aleats))

  expect_warning(SESraster(r, FUN=appsv, FUN_args = list(lyrv = seq_len(terra::nlyr(r)), na.rm = TRUE),
                         Fa_sample = c("lyrv", "appmean"),
                         Fa_alg = "sample", Fa_alg_args = list(replace=TRUE),
                         aleats = aleats))

  expect_error(SESraster(r, FUN=appsv, FUN_args = list(lyrv = seq_len(terra::nlyr(r)), na.rm = TRUE),
                         Fa_sample = c("appmean"),
                         Fa_alg = "sample", Fa_alg_args = list(replace=TRUE),
                         aleats = aleats))
  unlink(paste0(tempfile(),"ses.tif"))
})


test_that("algorithm_metrics works", {
  r <- load_ext_data()
  aleats <- 5
  set.seed(10)
  ambspp <- algorithm_metrics(r, spat_alg = "bootspat_naive", spat_alg_args=list(random="species"),
                              aleats = aleats)
  ambsite <- algorithm_metrics(r, spat_alg = "bootspat_naive", spat_alg_args=list(random="site"),
                               aleats = aleats)

  nms <- c("mean_diff", "sd_diff", "min_diff", "max_diff")

  expect_named(ambspp, c("spp_metrics", "spat_rich_diff"))
  expect_named(ambsite, c("spp_metrics", "spat_rich_diff"))

  ## DF tests
  expect_true(inherits(ambspp$spp_metrics, "data.frame"), "TRUE")
  expect_true(inherits(ambsite$spp_metrics, "data.frame"), "TRUE")

  expect_equal(dim(ambspp$spp_metrics), c(terra::nlyr(r), 11))
  expect_equal(dim(ambsite$spp_metrics), c(terra::nlyr(r), 11))

  expect_equal(ambspp$spp_metrics$actual, ambspp$spp_metrics$rand_avg)
  expect_equal(ambspp$spp_metrics$rand_avg, c(1, 14,  9, 12, 12, 10, 23))

  ## rast tests
  expect_true(inherits(ambspp$spat_rich_diff, "SpatRaster"), "TRUE")
  expect_true(inherits(ambsite$spat_rich_diff, "SpatRaster"), "TRUE")

  expect_true(terra::nlyr(ambsite$spat_rich_diff)==4)
  expect_true(terra::nlyr(ambspp$spat_rich_diff)==4)

  expect_equal(unlist(ambsite$spat_rich_diff[1]), setNames(as.double(rep(NA, 4)), nms))
  expect_equal(unlist(ambsite$spat_rich_diff[2]), setNames(rep(0, 4), nms))

  expect_equal(unlist(ambspp$spat_rich_diff[1]), setNames(as.double(rep(NA, 4)), nms))
  expect_equal(unlist(ambspp$spat_rich_diff[2]), setNames(c(2.8, 0.83666003, 2, 4), nms))

  expect_equal(round(mean(terra::values(ambspp$spat_rich_diff[[2]]), na.rm = TRUE), 3), as.double(1.144)) # test spat variation
  expect_equal(round(mean(terra::values(ambspp$spat_rich_diff[[1]]), na.rm = TRUE), 3), as.double(0)) # test spat variation

  ambff <- algorithm_metrics(r, spat_alg = "bootspat_naive", spat_alg_args=list(random="species"),
                              aleats = aleats,
                              force_wr_aleat_file = TRUE)

  expect_named(ambff, c("spp_metrics", "spat_rich_diff"))

  ## DF tests
  expect_true(inherits(ambff$spp_metrics, "data.frame"), "TRUE")

  ## rast tests
  expect_true(inherits(ambff$spat_rich_diff, "SpatRaster"), "TRUE")
})

test_that("algorithm_metrics works", {
  r <- load_ext_data()
  aleats <- 5
  set.seed(10)
  ambspp <- algorithm_metrics(r, spat_alg = "bootspat_naive", spat_alg_args=list(random="species"),
                              aleats = aleats)

  img <- function() {
    metrics <- ambspp[["spp_metrics"]]
    oldpar <- graphics::par()
    graphics::par(mfrow=c(3,1), mar=c(4,5,1,1))

    plot(metrics[,1], metrics[,"sp_reldiff"], pch=19,
         ylim=range(c(metrics[,"sp_reldiff_l"], metrics[,"sp_reldiff_u"])),
         xlab="Actual frequency", ylab="Species relative difference \n in frequency")

    plot(metrics[,1], metrics[,"global_reldiff"], pch=19, xlab="Actual frequency", ylab="Global relative difference \n in frequency",
         ylim=range(c(metrics[,"global_reldiff_l"], metrics[,"global_reldiff_u"])))

    plot(metrics[order(metrics[,1]),1], pch=19, ylab="Frequency", xlab="Species i")

    suppressWarnings(graphics::par(oldpar))
  }

  expect_identical(plot_alg_metrics(ambspp) , img())

  expect_identical(plot_alg_metrics(ambspp, what = "site") , terra::plot(ambspp[["spat_rich_diff"]]))
})