Nothing
#' 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, ...)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.