R/rgl.R

In inlabru-org/inlabru: Bayesian Latent Gaussian Modelling using INLA and Extensions

#' Visualize a globe using RGL
#'
#' @description
#' Creates a textured sphere and lon/lat coordinate annotations.
#' This function requires the `rgl` and `sphereplot` packages.
#'
#' @export
#' @param R Radius of the globe
#' @param R.grid Radius of the annotation sphere.
#' @param specular Light color of specular effect.
#' @param axes If TRUE, plot x, y and z axes.
#' @param box If TRUE, plot a box around the globe.
#' @param xlab,ylab,zlab Axes labels
#'
#' @return No value, used for plotting side effect.
#'
#' @family inlabru RGL tools
#'
#' @example inst/examples/rgl.R

globe <- function(R = 1,
                  R.grid = 1.05,
                  specular = "black",
                  axes = FALSE,
                  box = FALSE,
                  xlab = "", ylab = "", zlab = "") {
  # coordinates for texture
  n.smp <- 50
  lat <- matrix(-asin(seq(-1, 1, length.out = n.smp)), n.smp, n.smp, byrow = TRUE)
  long <- matrix(seq(-180, 180, length.out = n.smp) * pi / 180, n.smp, n.smp)
  x <- R * cos(lat) * cos(long)
  y <- R * cos(lat) * sin(long)
  z <- R * sin(lat)

  # globe and texture
  requireNamespace("rgl")
  rgl::persp3d(x, y, z,
    col = "white",
    texture = system.file("misc/Lambert_ocean.png", package = "inlabru"),
    specular = "black", axes = axes, box = box, xlab = xlab, ylab = ylab, zlab = zlab,
    normal_x = x, normal_y = y, normal_z = z
  )

  # spheric grid
  requireNamespace("sphereplot")
  sphereplot::rgl.sphgrid(longtype = "D", add = TRUE, radius = R.grid)
}

#' Render objects using RGL
#'
#' `glplot()` is a generic function for renders various kinds of spatial objects, i.e. `Spatial*` data
#' and `fm_mesh_2d` objects. The function invokes particular methods which depend on the class of
#' the first argument.
#'
#' @name glplot
#' @export
#' @param object an object used to select a method.
#' @param ... further arguments passed to or from other methods.
#'
#' @family inlabru RGL tools
#'
#' @example inst/examples/rgl.R

glplot <- function(object, ...) {
  UseMethod("glplot")
}

#' @describeIn glplot This function will calculate the cartesian coordinates of the points provided
#' and use points3d() in order to render them.
#'
#' @export
#'
#' @param add If TRUE, add the points to an existing plot. If FALSE, create new plot.
#' @param color vector of R color characters. See material3d() for details.
#'
#' @family inlabru RGL tools


glplot.SpatialPoints <- function(object, add = TRUE, color = "red", ...) {
  if (length(coordnames(object)) < 3) {
    ll <- data.frame(object)
    ll$TMP.ZCOORD <- 0
    coordinates(ll) <- c(coordnames(object), "TMP.ZCOORD")
    proj4string(ll) <- fm_CRS(object)
    object <- ll
  }

  object <- fm_transform(object, crs = fm_crs("sphere"))
  cc <- coordinates(object)
  requireNamespace("rgl")
  rgl::points3d(x = cc[, 1], y = cc[, 2], z = cc[, 3], add = add, color = color, ...)
}

#' @describeIn glplot This function will calculate a cartesian representation of the lines provided
#' and use lines3d() in order to render them.
#'
#' @export
#'
#' @family inlabru RGL tools

glplot.SpatialLines <- function(object, add = TRUE, ...) {
  qq <- coordinates(object)
  sp <- do.call(rbind, lapply(qq, function(k) do.call(rbind, lapply(k, function(x) x[1:(nrow(x) - 1), ]))))
  ep <- do.call(rbind, lapply(qq, function(k) do.call(rbind, lapply(k, function(x) x[2:(nrow(x)), ]))))
  sp <- data.frame(x = sp[, 1], y = sp[, 2], z = 0)
  ep <- data.frame(x = ep[, 1], y = ep[, 2], z = 0)

  coordinates(sp) <- c("x", "y", "z")
  coordinates(ep) <- c("x", "y", "z")
  proj4string(sp) <- fm_CRS(object)
  proj4string(ep) <- fm_CRS(object)

  sp <- fm_transform(sp, crs = fm_crs("sphere"))
  ep <- fm_transform(ep, crs = fm_crs("sphere"))

  cs <- coordinates(sp)
  ce <- coordinates(ep)
  na <- matrix(NA, ncol = 3, nrow = nrow(cs))

  mm <- matrix(t(cbind(cs, ce, na)), ncol = 3, nrow = 3 * nrow(ce), byrow = TRUE)

  requireNamespace("rgl")

  rgl::lines3d(mm, add = add, ...)
}


#' @describeIn glplot This function transforms the mesh to 3D cartesian coordinates and uses
#' inla.plot.mesh() with `rgl=TRUE` to plot the result.
#'
#' @export
#'
#' @param col Color specification. A single named color, a vector of scalar values, or a matrix of RGB values.
#' @param ... Parameters passed on to plot_rgl.fm_mesh_2d()
#'
#' @family inlabru RGL tools

glplot.fm_mesh_2d <- function(object, add = TRUE, col = NULL, ...) {
  if (object$manifold == "S2") {
    # mesh$loc = mesh$loc
  } else {
    object <- fm_transform(object, crs = fm_crs("sphere"), passthrough = TRUE)
  }

  if (is.null(col)) {
    fmesher::plot_rgl(object, add = add, ...)
  } else {
    fmesher::plot_rgl(object, add = add, col = col, ...)
  }
}
#' @rdname glplot
#' @export
glplot.inla.mesh <- function(object, add = TRUE, col = NULL, ...) {
  glplot(fm_as_fm(object), add = add, col = col, ...)
}