R/rgl.R

In inlabru: Bayesian Latent Gaussian Modelling using INLA and Extensions

#' 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 \dots further arguments passed to or from other methods.
#'
#' @examples
#' \donttest{
#' if (interactive() &&
#'   require("rgl", quietly = TRUE) &&
#'   require("sphereplot", quietly = TRUE) &&
#'   bru_safe_sp() &&
#'   require("sp")) {
#'   # Show the globe:
#'   globe()
#'
#'   # Load pantropoical dolphin data
#'   mexdolphin <- inlabru::mexdolphin_sp()
#'
#'   # Add mesh, ship transects and dolphin sightings stored
#'   # as fm_mesh_2d, SpatialLines and SpatialPoints objects, respectively
#'
#'   glplot(mexdolphin$mesh, alpha = 0.2)
#'   glplot(mexdolphin$samplers, lwd = 5)
#'   glplot(mexdolphin$points, size = 10)
#' }
#' }
#'
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.

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

  object <- fmesher::fm_transform(object, crs = fmesher::fm_crs("sphere"))
  cc <- sp::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

glplot.SpatialLines <- function(object, add = TRUE, ...) {
  qq <- sp::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)

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

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

  cs <- sp::coordinates(sp)
  ce <- sp::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 [fmesher::plot_rgl()] 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 \dots Parameters passed on to `plot_rgl.fm_mesh_2d()`

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

  if (is.null(col)) {
    fmesher::plot_rgl(object, add = add, ...)
  } else {
    fmesher::plot_rgl(object, add = add, col = col, ...)
  }
}

#' @describeIn glplot Visualize a globe using RGL
#'
#' 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
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)
}