tests/testthat/test-contourmap_inla.R

In davidbolin/excursions: Excursion Sets and Contour Credibility Regions for Random Fields

test_that("stack extraction", {
  skip_on_cran()
  local_exc_safe_inla()

  data <- testdata.inla.small()
  tmp <- excursions:::inla.output.indices(data$result,
    stack = data$stack,
    tag = "pred"
  )
  ind <- tmp$index
  if (tmp$result.updated) {
    result <- tmp$result
  } else {
    result <- data$result
  }

  expect_equal(ind, c(6, 7, 8, 9, 10, 11, 12), tolerance = 1e-7)
  for (i in 1:result$misc$configs$nconfig) {
    config <- excursions:::private.get.config(result, i)
    if (config$lp == 0) {
      break
    }
  }

  # Only check prediction of unobserved values
  expect_snapshot_value(config$mu[ind[2:6]],
    style = "serialize",
    tolerance = 1e-2
  )

  # test compact mode
  data2 <- testdata.inla.small(inla.mode = "compact")
  tmp <- excursions:::inla.output.indices(data2$result,
    stack = data$stack,
    tag = "pred", compressed = FALSE
  )
  ind2 <- tmp$index
  result <- tmp$result
  expect_equal(ind2, c(6, 7, 8, 9, 10, 11, 12), tolerance = 1e-7)
  for (i in 1:result$misc$configs$nconfig) {
    config2 <- excursions:::private.get.config(result, i)
    if (config2$lp == 0) {
      break
    }
  }
  expect_equal(config2$mu, config$mu, tolerance = 1e-2)

  tmp <- excursions:::inla.output.indices(data2$result,
    stack = data$stack,
    tag = "pred", compressed = TRUE
  )
  ind3 <- tmp$index
  result <- tmp$result
  expect_equal(ind3, seq_along(c(6, 7, 8, 9, 10, 11, 12)), tolerance = 1e-7)
  for (i in 1:result$misc$configs$nconfig) {
    config3 <- excursions:::private.get.config(result, i)
    if (config3$lp == 0) {
      break
    }
  }
  expect_equal(config3$mu[ind3], config2$mu[ind2], tolerance = 1e-2)
})

test_that("Contourmap.inla, test ind", {
  skip_on_cran()
  local_exc_safe_inla()

  data <- testdata.inla()
  ind1 <- c(1, 2, 3, 4)
  ind2 <- c(4, 3, 2, 1)
  ind3 <- rep(FALSE, data$n)
  ind3[1:4] <- TRUE

  res1 <- contourmap.inla(data$result, data$stack,
    tag = "pred",
    n.levels = 2, ind = ind1, seed = data$seed,
    alpha = 0.1, max.threads = 1
  )
  res2 <- contourmap.inla(data$result, data$stack,
    tag = "pred",
    n.levels = 2, ind = ind2, seed = data$seed,
    alpha = 0.1, max.threads = 1
  )
  res3 <- contourmap.inla(data$result, data$stack,
    tag = "pred",
    n.levels = 2, ind = ind3, seed = data$seed,
    alpha = 0.1, max.threads = 1
  )

  expect_equal(res1$F, res2$F, tolerance = 1e-4)
  expect_equal(res2$F, res3$F, tolerance = 1e-4)

  data2 <- testdata.inla(inla.mode = "compact")
  res4 <- contourmap.inla(data2$result, data2$stack,
    tag = "pred",
    n.levels = 2, ind = ind1, seed = data2$seed,
    alpha = 0.1, max.threads = 1, compressed = FALSE
  )
  res5 <- contourmap.inla(data2$result, data2$stack,
    tag = "pred",
    n.levels = 2, ind = ind2, seed = data2$seed,
    alpha = 0.1, max.threads = 1, compressed = FALSE
  )
  res6 <- contourmap.inla(data2$result, data2$stack,
    tag = "pred",
    n.levels = 2, ind = ind3, seed = data2$seed,
    alpha = 0.1, max.threads = 1, compressed = FALSE
  )

  expect_equal(res3$F[1:4], res4$F[1:4], tolerance = 5e-2)
  expect_equal(res4$F, res5$F, tolerance = 1e-4)
  expect_equal(res5$F, res6$F, tolerance = 1e-4)

  res7 <- contourmap.inla(data2$result, data2$stack,
    tag = "pred",
    n.levels = 2, ind = ind1, seed = data2$seed,
    alpha = 0.1, max.threads = 1, compressed = TRUE
  )
  res8 <- contourmap.inla(data2$result, data2$stack,
    tag = "pred",
    n.levels = 2, ind = ind2, seed = data2$seed,
    alpha = 0.1, max.threads = 1, compressed = TRUE
  )
  res9 <- contourmap.inla(data2$result, data2$stack,
    tag = "pred",
    n.levels = 2, ind = ind3, seed = data2$seed,
    alpha = 0.1, max.threads = 1, compressed = TRUE
  )

  expect_equal(res6$F[1:4], res7$F[1:4], tolerance = 5e-2)
  expect_equal(res7$F, res8$F, tolerance = 1e-4)
  expect_equal(res8$F, res9$F, tolerance = 1e-4)
})


test_that("Contourmap.inla, P measures", {
  skip_on_cran()
  local_exc_safe_inla()

  data <- testdata.inla.small()

  ind <- 2:6
  res1 <- contourmap.inla(data$result, data$stack,
    tag = "pred",
    n.levels = 4, seed = data$seed,
    max.threads = 1, ind = ind,
    compute = list(F = FALSE, measures = c("P2", "P1")),
    method = "EB"
  )

  expect_snapshot_value(res1$P1,
    style = "serialize",
    tolerance = 1e-2
  )
  expect_snapshot_value(res1$P2,
    style = "serialize",
    tolerance = 1e-2
  )

  res2 <- contourmap.inla(data$result, data$stack,
    tag = "pred",
    n.levels = 4, seed = data$seed,
    max.threads = 1, ind = ind,
    compute = list(F = FALSE, measures = c("P2", "P1")),
    method = "QC"
  )
  expect_snapshot_value(res2$P1,
    style = "serialize",
    tolerance = 1e-2
  )
  expect_snapshot_value(res2$P2,
    style = "serialize",
    tolerance = 1e-2
  )

  data2 <- testdata.inla.small(inla.mode = "compact")
  res3 <- contourmap.inla(data2$result, data2$stack,
    tag = "pred",
    n.levels = 4, seed = data2$seed,
    max.threads = 1, ind = ind,
    compute = list(F = FALSE, measures = c("P2", "P1")),
    method = "EB"
  )
  expect_equal(res1$P1, res3$P1, tolerance = 1e-2)
  expect_equal(res1$P2, res3$P2, tolerance = 1e-2)

  res4 <- contourmap.inla(data2$result, data2$stack,
    tag = "pred",
    n.levels = 4, seed = data2$seed,
    max.threads = 1, ind = ind,
    compute = list(F = FALSE, measures = c("P2", "P1")),
    method = "QC"
  )

  expect_equal(res2$P1, res4$P1, tolerance = 1e-2)
  expect_equal(res2$P2, res4$P2, tolerance = 6e-2)
})