Nothing
R/plot-rgl-grid.R
In icosa: Global Triangular and Penta-Hexagonal Grids Based on Tessellated Icosahedra
Defines functions
plot3d.hexagrid
plot3d.trigrid
Documented in
plot3d.hexagrid
plot3d.trigrid
#' 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.")
}
}
)
Try the icosa package in your browser
Any scripts or data that you put into this service are public.
icosa documentation built on March 31, 2023, 8:33 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions plot3d.hexagrid plot3d.trigrid
Documented in plot3d.hexagrid plot3d.trigrid
#' 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.")
}
}
)
Try the icosa package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.