if (FALSE) {
if (require("fmesher")) {
  ## Generate mesh and SPDE model
  n.lattice <- 20 # increase for more interesting, but slower, examples
  x <- seq(from = 0, to = 10, length.out = n.lattice)
  lattice <- fm_lattice_2d(x = x, y = x)
  mesh <- fm_rcdt_2d_inla(lattice = lattice, extend = FALSE, refine = FALSE)
  ## Generate an artificial sample
  sigma2.e <- 0.1
  n.obs <- 1000
  obs.loc <- cbind(
    runif(n.obs) * diff(range(x)) + min(x),
    runif(n.obs) * diff(range(x)) + min(x)
  )
  Q <- fm_matern_precision(mesh, alpha = 2, rho = 3, sigma = 1)
  x <- fm_sample(n = 1, Q = Q)
  A <- fm_basis(mesh, loc = obs.loc)
  Y <- as.vector(A %*% x + rnorm(n.obs) * sqrt(sigma2.e))
  ## Calculate posterior
  Q.post <- (Q + (t(A) %*% A) / sigma2.e)
  mu.post <- as.vector(solve(Q.post, (t(A) %*% Y) / sigma2.e))
  ## Calculate continuous contours
  tric <- tricontour(mesh,
    z = mu.post,
    levels = as.vector(quantile(x, c(0.25, 0.75)))
  )
  ## Discrete domain contours
  map <- contourmap(
    n.levels = 2, mu = mu.post, Q = Q.post,
    alpha = 0.1, compute = list(F = FALSE), max.threads = 1
  )
  ## Calculate continuous contour map
  setsc <- tricontourmap(mesh,
    z = mu.post,
    levels = as.vector(quantile(x, c(0.25, 0.75)))
  )
  ## Plot the results
  reo <- mesh$idx$lattice
  idx.setsc <- setdiff(names(setsc$map), "-1")
  cols2 <- contourmap.colors(map,
    col = heat.colors(100, 0.5, rev = TRUE),
    credible.col = grey(0.5, 0)
  )
  names(cols2) <- as.character(-1:2)
  par(mfrow = c(1, 2))
  image(matrix(mu.post[reo], n.lattice, n.lattice),
    main = "mean", axes = FALSE, asp = 1
  )
  plot(setsc$map[idx.setsc], col = cols2[idx.setsc])
  par(mfrow = c(1, 1))
}
}
Run the code above in your browser using DataLab