Nothing
#' 3d plotting of an icosahedral grid, its subset or a data layer
#'
#'
#' @usage plot3d(x,...)
#' @rdname plot3d
#' @export plot3d
"plot3d"
if(requireNamespace("rgl", quietly = TRUE)){
# package installed, and not working...
if(rgl::rgl.useNULL()){
# manually create S3 generic
plot3d <-function(x,...){
UseMethod("plot3d")
}
# rgl is available to be called
}else{
# manually copy S3 generic
plot3d <- rgl::plot3d
}
}else{
# manually create S3 generic
plot3d <-function(x,...){
UseMethod("plot3d")
}
}
#' @param x (\code{\link{trigrid}}, \code{\link{hexagrid}} or \code{\link{facelayer}}) Object to be plotted.
#'
#' @param type (\code{character}) Value specifying the part of the grid to be plotted by the call of the function.
#' \code{"v"} plots the grid vertex points.
#' \code{"e"} draws the grid edges.
#' \code{"f"} draws the grid faces.
#' \code{"c"} draws the face centers of the grid.
#'
#' @param sphere (\code{numeric}) Defaults to \code{NULL}, adding a central white sphere to the plot. Assigning a \code{numeric} value will draw a new sphere with the given radius,
#' \code{FALSE} does not plot the sphere.
#' @param guides (\code{logical}) Value indicating whether the guidelines of the polar coordinate system shall be plotted.
#' @param add (\code{logical}) Value indicating whether a new plot shall be drawn, or the currently plotted information should be added to the active \code{rgl} device.
#'
#' @param ... Further graphical parameters passed to (see \code{\link[rgl]{plot3d}}).
#'
#' @return The function does not return any value.
#'
#'
#' @examples
#' # create a hexagonal grid
#' g <- hexagrid(c(2,2))
#' # plot the grid in 3d space
#' # plot3d(g, col="blue")
#' # make a subset to select faces
#' subG <- subset(g, c("F5", "F2"))
#' # plot the subset defined above
#' # plot3d(subG, type="f", col=c("orange"), add=TRUE, lwd=1)
#' @rdname plot3d
#' @exportS3Method rgl::plot3d trigrid
#' @exportS3Method plot3d trigrid
#' @export plot3d.trigrid
plot3d.trigrid <- function(x, type=c("l"),sphere=NULL, add=FALSE, guides=TRUE, ...){
# package not installed
if(!requireNamespace("rgl", quietly = TRUE)){
stop("Install the 'rgl' package and reload 'icosa' to use this function.")
}
# package installed and it is actually working
if(!rgl::rgl.useNULL()){
#create new plot?
if(add==FALSE)
{
#checking plotting
rgl::plot3d(x@vertices, type="n", box=FALSE, axes=FALSE, xlab="", ylab="", zlab="")
#default sphere plotting
if(is.null(sphere)){
#get the radius
fc<-apply(x@vertices[x@faces[1,],],2,mean)-x@center
rad<-sqrt(fc[1]^2+fc[2]^2+fc[3]^2)-15
blankSphere(x@center[1],x@center[2], x@center[3], radius = rad, color ="white", ng=200, box=FALSE, axes=FALSE)
}else{
if(sphere){
blankSphere(x@center[1],x@center[2], x@center[3], radius = sphere, color ="white", ng=200, box=FALSE, axes=FALSE)
}
}
}
if(type=="p")
{
#single point
if(length(x@vertices)==3)
{
rgl::points3d(x=x@vertices[1],y=x@vertices[2],z=x@vertices[3],...)
}else{
rgl::points3d(x@vertices, ...)
}
}
if(type=="l")
{
lines3d(x, ...)
}
if(type=="f")
{
faces3d(x,...)
}
if(type=="n"){
}
# guides
if(guides){
guides3d(col="green", origin=x@center, radius=x@r, lwd=2)
}
}else{
message("Your rgl installation is not working.")
}
}
#' 3d plotting of an icosahedral grid or its subset
#' @rdname plot3d
#' @param color (\code{character}) Only for the hexagrid plotting: value/values passed to the \code{\link{faces3d}} function instead of \code{col}.
#' @exportS3Method rgl::plot3d hexagrid
#' @exportS3Method plot3d hexagrid
#' @export plot3d.hexagrid
plot3d.hexagrid <- function(x, type=c("l"),sphere=NULL, color="gray70", add=FALSE, guides=TRUE, ...){
if(!requireNamespace("rgl", quietly = TRUE)){
stop("Install the 'rgl' package and reload 'icosa' to use this function.")
}
# prevent access to rgl if it is not working.
if(!rgl::rgl.useNULL()){
#create new plot?
if(add==FALSE)
{
#empty plotting plotting
rgl::plot3d(x@vertices, type="n", box=FALSE, axes=FALSE, xlab="", ylab="", zlab="")
#default sphere plotting
if(is.null(sphere)){
fVect<-x@faces[2,!is.na(x@faces[2,])]
#get the radius
fc<-apply(x@vertices[fVect,],2,mean)-x@center
rad<-sqrt(fc[1]^2+fc[2]^2+fc[3]^2)-10
blankSphere(x@center[1],x@center[2], x@center[3], radius = rad, color ="white", ng=200, box=FALSE, axes=FALSE)
}else{
if(sphere){
blankSphere(x@center[1],x@center[2], x@center[3], radius = sphere, color ="white", ng=200, box=FALSE, axes=FALSE)
}
}
}
if(type=="p")
{
#single point
if(length(x@vertices)==3)
{
rgl::points3d(x=x@vertices[1],y=x@vertices[2],z=x@vertices[3], col=color,...)
}else{
rgl::points3d(x@vertices, col=color, ...)
}
}
if(type=="l")
{
lines3d(x, ...)
}
if(type=="f")
{
faces3d(x,...)
}
if(type=="c")
{
#single point
if(length(x@faceCenters)==3)
{
rgl::points3d(x=x@faceCenters[1],y=x@faceCenters[2],z=x@faceCenters[3], col=color, ...)
}else{
rgl::points3d(x@faceCenters, col=color, ...)
}
}
if(type=="t")
{
rgl::text3d(x@faceCenters, texts=rownames(x@faceCenters),col=color, ...)
}
if(type=="n"){
}
if(guides){
guides3d(col="green", origin=x@center, radius=x@r, lwd=2)
}
}else{
message("Your rgl installation is not working.")
}
}
#' Methods of 3d line plotting
#'
#' This is a generic function used to plot the edge lines of either a \code{trigrid} or a \code{hexagrid} object, a \code{facelayer}, or \code{Spatial} objects in 3d space. The method is also implemented for
#' the object classes defined by the package 'sp'.
#'
#' The function is built on the openGL renderer of the R package \code{rgl}, which needs to be installed for the function to run. Although the function is works without attaching rgl, note that if you want to attach both \code{icosa} and \code{rgl},the \code{rgl} package has to be loaded ifrst otherwise the function will not be usable.
#'
#' @param x (\code{\link{trigrid}}, \code{\link{hexagrid}}, \code{\link{facelayer}} or \code{sp}) Object to be plotted.
#' @param arcs \code{logical} Value setting whether great circle arcs or segments shall be drawn betwenn the points of the grid.
#'
#' @param ... Further graphical parameters passed to (see \code{\link[rgl]{plot3d}}).
#'
#' @return The function does not return any value.
#'
#' @examples
#' # create a hexagonal grid
#' g <- hexagrid(c(2,2))
#' # plot the grid in 3d space
#' # lines3d(g, col="blue")
#' @rdname lines3d
"lines3d"
if(requireNamespace("rgl", quietly = TRUE)){
# package installed, and it is working
if(!rgl::rgl.useNULL()){
setGeneric(
name="lines3d",
def=function(x,y=NULL,z=NULL, ...){
standardGeneric("lines3d")
}
)
# package is working, use its generic
}else{
setGeneric("lines3d", def=rgl::lines3d, package="rgl")
}
}else{
setGeneric(
name="lines3d",
def=function(x,y=NULL,z=NULL, ...){
standardGeneric("lines3d")
}
)
}
#' lines3d method for the trigrid class
#' @rdname lines3d
#' @exportMethod lines3d
setMethod(
"lines3d",
signature="trigrid",
definition=function(x, arcs=FALSE, ...){
# rgl not installed, quit immediately
if(!requireNamespace("rgl", quietly = TRUE)) stop("Install the 'rgl' package and reload 'icosa' to use this function.")
# prevent access to rgl if it is not working.
if(!rgl::rgl.useNULL()){
v<-x@skeleton$v
e<-x@skeleton$e[x@skeleton$aE,]
#create edgeMat with a simple Rccp function
edgeMat<-.Call(Cpp_icosa_edgeMatTri_, v=v, e=e)
# get the list of additional arguments
newArgs<-list(...)
if(prod(x@tessellation)<16 & arcs){
res<-10
edgeMat<-.Call(Cpp_icosa_expandEdges_, edgeMat, x@center, res)
}
edgeMatExp<-edgeMat
rgl::segments3d(x=edgeMatExp[,1],y=edgeMatExp[,2],z=edgeMatExp[,3], ...)
}else{
message("Your rgl installation is not working.")
}
}
)
#' Methods of 3D face plotting.
#'
#' This function is used to plot the faces of either a \code{\link{trigrid}}, \code{\link{hexagrid}} or \code{\link{facelayer}} object in 3D space.
#'
#' The function is built on the openGL renderer of the R package \code{rgl}.
#'
#' @name faces3d
#' @param x The \code{\link{trigrid}}, \code{\link{hexagrid}} or \code{\link{facelayer}} object to be plotted.
#'
#' @param ... Further graphical parameters passed to (see \code{\link[rgl]{plot3d}}) and the \code{\link{heatMapLegend}} function.
#'
#' @return The function does not return any value.
#'
#' @examples
#' # create a hexagonal grid
#' g <- hexagrid(c(2,2))
#' # plot the grid in 3d space
#' # faces3d(g)
#' @exportMethod faces3d
#' @rdname faces3d
setGeneric(
name="faces3d",
package="icosa",
def=function(x,...){
standardGeneric("faces3d")
}
)
#' Methods of 3d face plotting.
#'
#'
#' @rdname faces3d
setMethod(
"faces3d",
signature="trigrid",
definition=function(x, ...){
# not to user if rgl is not installed
if(!requireNamespace("rgl", quietly = TRUE)) stop("Install the 'rgl' package and reload 'icosa' to use this function.")
# rgl is installed but not workign
if(!rgl::rgl.useNULL()){
v<-x@skeleton$v
f<-x@skeleton$f[as.logical(x@skeleton$aF),1:3]
#create edgeMat with a simple Rccp function
triMat<- .Call(Cpp_icosa_triMatTri_, v, f)
rgl::triangles3d(x=triMat[,1],y=triMat[,2],z=triMat[,3],...)
}else {
message("Your rgl installation is not working.")
}
}
)
#' Methods of 3d face plotting.
#'
#' @rdname faces3d
setMethod(
"faces3d",
signature="hexagrid",
definition=function(x,...){
# not to user if rgl is not installed
if(!requireNamespace("rgl", quietly = TRUE)) stop("Install the 'rgl' package and reload 'icosa' to use this function.")
# rgl is installed but not workign
if(!rgl::rgl.useNULL()){
v<-x@skeleton$plotV
f<-x@skeleton$f[as.logical(x@skeleton$aSF),1:3]
# f2<-f[order(f[,1]),]
#
# f2<-unique(f2)
#create edgeMat with a simple Rccp function
triMat<- .Call(Cpp_icosa_triMatTri_, v, f)
rgl::triangles3d(x=triMat[,1],y=triMat[,2],z=triMat[,3],...)
}else {
message("Your rgl installation is not working.")
}
}
)
#' Display the names of the grid elements in 3d plots.
#'
#' This function will display the names of vertices, faces and edges on 3d plots.
#'
#' @name gridlabs3d
#'
#' @param gridObj (\code{\link{trigrid}}, \code{\link{hexagrid}}) An icosahedral grid.
#'
#' @param type (\code{character}) Vector containing either \code{"f"}, \code{"e"} or \code{"v"}, rendering the names
#' of either the faces, edges or vertives respectively.
#'
#' @param ... Additional arguments passed to \code{\link[rgl:texts]{text3d}} function of the \code{rgl} package.
#'
#' @return The function does not return any value.
#'
#' @examples
#' # create a hexagonal grid
#' g <- hexagrid(c(2,2))
#' # plot the grid in 3d space
#' # lines3d(g, guides=FALSE)
#' # labels
#' # gridlabs3d(g)
#' @exportMethod gridlabs3d
#' @rdname gridlabs3d
setGeneric(
name="gridlabs3d",
package="icosagrid",
def=function(gridObj,...){
if(!requireNamespace("rgl", quietly = TRUE)) stop("Install the 'rgl' package and reload 'icosa' to use this function.")
standardGeneric("gridlabs3d")
}
)
#' @rdname gridlabs3d
setMethod(
"gridlabs3d",
signature="trigrid",
definition=function(gridObj,type="f",...){
# rgl is installed but not workign
if(!rgl::rgl.useNULL()){
# vertex names
if("v"%in%type){
rgl::text3d(texts=rownames(gridObj@vertices), gridObj@vertices*1.005,...)
}
if("f"%in%type){
rgl::text3d(texts=rownames(gridObj@faceCenters), gridObj@faceCenters*1.005,...)
}
if("e"%in%type){
#the coordinates
coords<-apply(gridObj@edges,1,function(x){
apply(gridObj@vertices[x,], 2, mean)
})
rgl::text3d(t(coords)*1.005, texts=rownames(gridObj@edges),...)
}
}else {
message("Your rgl installation is not working.")
}
}
)
#' @rdname gridlabs3d
setMethod(
"gridlabs3d",
signature="hexagrid",
definition=function(gridObj,type="f",...){
# rgl is installed and working
if(!rgl::rgl.useNULL()){
# vertex names
if("v"%in%type){
rgl::text3d(texts=rownames(gridObj@vertices), gridObj@vertices*1.005,...)
}
if("f"%in%type){
rgl::text3d(texts=rownames(gridObj@faceCenters), gridObj@faceCenters*1.005,...)
}
if("e"%in%type){
#the coordinates
coords<-apply(gridObj@edges,1,function(x){
apply(gridObj@vertices[x,], 2, mean)
})
rgl::text3d(t(coords)*1.005, texts=rownames(gridObj@edges),...)
}
}else {
message("Your rgl installation is not working.")
}
}
)
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.