R/plot-rgl-facelayer.R
In adamkocsis/icosa: Global Triangular and Penta-Hexagonal Grids Based on Tessellated Icosahedra
Defines functions
plot3d.facelayer
Documented in
plot3d.facelayer
#' 3d plotting of a facelayer of an icosahedral grid or its subset
#'
#' The function is built on the openGL renderer of the R package \code{rgl}. The default plotting window size is \code{800x800} pixels. In case you want to override this, please
#' use the function with \code{defaultPar3d=FALSE} after running \code{\link[rgl]{par3d}}\code{(windowRect=<>)}.
#'
#' @param defaultPar3d (\code{logical}) Flag indicating whether the default settings for \code{\link[rgl]{par3d}} are to be used \code{(windowRect = c(50, 60, 800, 800), zoom=0.8)}.
#' @param frame (\code{logical}) If set to TRUE the grid line structure will be plotted.
#'
#' @exportS3Method rgl::plot3d facelayer
#' @exportS3Method plot3d facelayer
#' @rdname plot3d
#' @export plot3d.facelayer
plot3d.facelayer <- function(x,type="f",frame=TRUE, guides=TRUE, defaultPar3d=TRUE, ...){
if(!requireNamespace("rgl", quietly = TRUE)) stop("Install the 'rgl' package and reload 'icosa' to use this function.")
# rgl is installed and is working
if(!rgl::rgl.useNULL()){
# default par3d options
if(defaultPar3d){
rgl::par3d(windowRect = c(50, 60, 800, 800), zoom=0.8)
}
actGrid <- get(x@grid)
checkLinkedGrid(actGrid, x)
#do not allow arguments to pass through!
if(frame==TRUE){
plot3d(actGrid, guides=guides, col="gray50")
}else{
plot3d(actGrid, type="n", guides=guides)
#boundaries
if(type=="l"){
lines3d(x,...)
}
}
if(type=="f"){
faces3d(x,specular="black",...)
}
#add additional types of plotting to this method
#no plotting
if(type=="n"){
}
}else{
message("Your rgl installation is not working.")
}
}
#' Methods of 3d face plotting.
#'
#' @param col (\code{character}) Graphical parameter indicating the colours of the faces. A single value is accepted for \code{logical} values. Multiple colors will be passed to \code{\link[grDevices:colorRamp]{colorRampPalette}}, to create palettes for heat maps in case of \code{numeric} values. The default plotting method in this case is the reversed \code{\link[grDevices:palettes]{heat.colors}}. In case of categorical data, random colors will be chosen.
#' @param breaks (\code{numeric}) Vector stating the breakpoints between the plotted levels. The argument is passed to the \code{\link[base]{cut}} function.
#' @param inclusive (\code{logical}): If there are values beyond the limits of breaks, should these be represented in the plot (\code{TRUE}) or left out completely \code{FALSE}?
#' @param legend (\code{logical}) Should the heatmap legend be plotted?
#'
#' @exportMethod faces3d
#' @rdname faces3d
#' @examples
#' h <- hexagrid(8)
#' b <- facelayer(h)
#' values(b)<- rnorm(length(b))
setMethod(
f="faces3d",
signature="facelayer",
definition= function(x,col="heat",breaks=NULL, inclusive=TRUE, legend=TRUE, ...){
if(!requireNamespace("rgl", quietly = TRUE)) stop("Install the 'rgl' package and reload 'icosa' to use this function.")
# rgl is installed and is working
if(!rgl::rgl.useNULL()){
# extract the grid that needs to be plotted:
actGrid <- get(x@grid)
# checkLinkedGrid(actGrid, x)
discrete<- FALSE
#check whether the grid is actually updated
if(sum(x@names%in%rownames(actGrid@faces))!=length(x))
stop("The facenames in thelinked grid does not match the facelayer object.")
#when the valuues are logical
#FALSEs do not plot; NAs do not plot, TRUEs plot
# defend 'breaks'
if(!is.null(breaks)){
if(!is.numeric(breaks)) stop("The 'breaks' argument has to be numeric.")
if(length(breaks)<3) stop("You need to provide at least three values to the 'breaks' argument.")
}
# if the grid is numerical and it has only one value, make it logical
if(class(x@values)%in%c("integer","double", "numeric")){
if(length(unique(x@values[!is.na(x@values)]))==1){
x@values<-as.logical(x@values)
}
}
if(is.logical(x@values)){
#just add NAs where the values are 0
x@values[x@values==FALSE]<-NA
}
#if the number of values does not match the grid face no
boolPresent1<-rep(T,nrow(actGrid@faces))
if(length(x)!=nrow(actGrid@faces)){
boolPresent1<-rownames(actGrid@faces)%in%x@names
actGrid<-subset(actGrid, rownames(actGrid@faces)[boolPresent1])
}
# in case there are NAs, do a subsetting before going on
# rgl does not understand col=NA as omission of plotting
if(sum(is.na(x@values))>0){
# select only the faces that are available
boolPresent<-!is.na(x@values)
#1. the values
x@values<-x@values[boolPresent]
#2. the names too
x@names<- x@names[boolPresent]
#3. number
x@length <- sum(boolPresent)
# #do a pseudo subsetting!
# tempFacesLog<-rep(F, length(actGrid@skeleton$aF))
# #what should not be removed
# tempFacesLog[actGrid@skeleton$offsetF+actGrid@skeleton$uiF[which(names(actGrid@skeleton$uiF)%in%x@names)]] <- TRUE
# #remove everthing but that
# actGrid@skeleton$aF[!tempFacesLog]<- FALSE
actGrid<-subset(actGrid, x@names) # the real subsetting
}
#when the values are logical
if(inherits(x@values,"logical")){
#set default color value
faces3d(actGrid,col=col,...)
}
# when numerical values are added to the facelayer object, do a heatmap!
if(class(x@values)%in%c("integer","double", "numeric")){
# calculate the breaking vector
if(is.null(breaks)){
minimum <- min(x@values)
maximum <- max(x@values)
steps <- length(x)+1
# the vector used to cut the plottted variable
useBreaks <- seq(minimum, maximum,length.out=steps)
}else{
minimum <- min(breaks)
maximum <- max(breaks)
useBreaks <- breaks
}
# still need to include limitations
bMax <- FALSE
bMin <- FALSE
if(inclusive){
# values that are beyond the minimum boundary set by breaks
beyondMax <- which(x@values>maximum)
if(length(beyondMax)>1){
x@values[beyondMax] <- maximum
bMax <- TRUE
}
# values that are beyond the minimum boundary set by breaks
beyondMin <- which(x@values<minimum)
if(length(beyondMin)>1){
x@values[beyondMin] <- minimum
bMin <- TRUE
}
}
#do a heatmap!
#create a ramp, with a given number of colours
#the color vector will control the heatmap
if(length(col)==1){
# predefined
if(col=="heat"){
# col<-c("red","orange","yellow", "white")
cols <- rev(grDevices::heat.colors(length(useBreaks)-1))
cols<-substring(cols, 1,7)
}else{
if(length(col)==1){
stop("You specified only one color.")
}
}
} else{
#do a heatmap!
ramp<-grDevices::colorRampPalette(col, bias=2, space="Lab")
# produce as many colours as there are values
cols <- ramp(length(useBreaks)-1)
}
# do the cutting
alreadyCut <- base::cut(x@values, breaks=useBreaks, include.lowest=TRUE)
# transfer the factor to indices
trans2 <- as.numeric(alreadyCut)
# this is the ui sequence
faceColors<-cols[trans2]
if(inherits(actGrid,"trigrid") & !inherits(actGrid, "hexagrid")){
#in the inner sequence
#create a source vector as if it was complete
faceColors2<-rep(NA, length(actGrid@skeleton$uiF))
names(faceColors2)<-paste("F", 1:length(faceColors2), sep="")
faceColors2[names(x)]<-faceColors
#order them
faceColors3<-rep(NA, length(faceColors2))
faceColors3[actGrid@skeleton$uiF]<-faceColors2
#and get rid of the NAs
faceColors3<-faceColors3[!is.na(faceColors3)]
}
if(inherits(actGrid, "hexagrid")){
tu <- as.numeric(t(actGrid@skeleton$uiF[names(x),]))
empty<-rep(NA, nrow(actGrid@skeleton$f))
fc<-rep(faceColors, each=12)
empty[tu[!is.na(tu)]] <-fc[!is.na(tu)]
noNA<-empty[as.logical(actGrid@skeleton$aSF)]
###
# get the subfaces where there is information
# f<-as.data.frame(actGrid@skeleton$f[as.logical(actGrid@skeleton$aSF),1:3])
#which outer faces do the subfaces belong?
aas<- actGrid@skeleton$aSF[as.logical(actGrid@skeleton$aSF)]
#create a vector fro all the total colors (as if the grid was full)
totCol<-rep(NA,nrow(actGrid@skeleton$uiF))
names(totCol) <- paste("F", 1:length(totCol), sep="")
# insert the information
totCol[names(x)]<-faceColors
#reorder the colors to the subfaces
faceColors3<-totCol[aas]
#
# temp<-cbind(f, newCol, stringsAsFactors=FALSE)
#
# temp2<-temp[order(temp[,1]),]
# temp2<-unique(temp2)
}
faces3d(actGrid,col=rep(faceColors3, each=3),...)
# numeric heatmap!
# increase the resolution when you plot the legend
currentset<-rgl::par3d("windowRect")
currentset2<-currentset
currentset2[3]<-currentset[3]*1.5
currentset2[4]<-currentset[4]*1.5
# what should be passed to the heatmaplegend
if(!discrete){
tickLabs <- useBreaks
}else{
tickLabs <- (useBreaks+useBreaks[2:(length(useBreaks)+1)])/2
tickLabs <- tickLabs[!is.na(tickLabs)]
}
# double the resolution
rgl::par3d(windowRect=currentset2)
# plot the background
rgl::bgplot3d(
# turn off the graphical parameters warning bullshit
suppressWarnings(
if(legend) heatMapLegend(cols,vals=tickLabs,...)
)
)
rgl::par3d(windowRect=currentset)
}
#when all the values are colors
#plot faces as
if(inherits(x@values, "character") & sum(x@values%in%grDevices::colors())==x@length){
faces3d(actGrid, col=x@values, plot="faces",...)
}
# when the values are text | they are not colors
if(inherits(x@values, "character") & !sum(x@values%in%grDevices::colors())==x@length){
# state the labels in 3d on the face (using the centers of the faces)
colorAll <- grDevices::colors()[grep('gr(a|e)y', grDevices::colors(), invert = TRUE)]
active<-factor(x@values)
if(length(levels(active))>length(colorAll)){
cols<-sample(colorAll, length(levels(active)), replace=TRUE)
}else{
cols<-sample(colorAll, length(levels(active)), replace=FALSE)
}
faceColors<-cols[as.numeric(active)]
if(inherits(actGrid, "trigrid") & !inherits(actGrid, "hexagrid")){
#in the inner sequence
#create a source vector as if it was complete
faceColors2<-rep(NA, length(actGrid@skeleton$uiF))
names(faceColors2)<-paste("F", 1:length(faceColors2), sep="")
faceColors2[names(x)]<-faceColors
#order them
faceColors3<-rep(NA, length(faceColors2))
faceColors3[actGrid@skeleton$uiF]<-faceColors2
#and get rid of the NAs
faceColors3<-faceColors3[!is.na(faceColors3)]
}
if(inherits(actGrid, "hexagrid")){
tu <- as.numeric(t(actGrid@skeleton$uiF[names(x),]))
empty<-rep(NA, nrow(actGrid@skeleton$f))
fc<-rep(faceColors, each=12)
empty[tu[!is.na(tu)]] <-fc[!is.na(tu)]
noNA<-empty[as.logical(actGrid@skeleton$aSF)]
###
# get the subfaces where there is information
# f<-as.data.frame(actGrid@skeleton$f[as.logical(actGrid@skeleton$aSF),1:3])
#which outer faces do the subfaces belong?
aas<- actGrid@skeleton$aSF[as.logical(actGrid@skeleton$aSF)]
#create a vector fro all the total colors (as if the grid was full)
totCol<-rep(NA,nrow(actGrid@skeleton$uiF))
names(totCol) <- paste("F", 1:length(totCol), sep="")
# insert the information
totCol[names(x)]<-faceColors
#reorder the colors to the subfaces
faceColors3<-totCol[aas]
#
# temp<-cbind(f, newCol, stringsAsFactors=FALSE)
#
# temp2<-temp[order(temp[,1]),]
# temp2<-unique(temp2)
}
faces3d(actGrid,col=rep(faceColors3, each=3),...)
}
# when the values are factors!
if(inherits(x@values, "factor")){
# depending on the number of levels, more color palettes might be useful
if(length(levels(factor(x@values))) <= 7){
faces3d(actGrid, col=rep(as.numeric(x@values),each=3), ...)
}
}
# legend3d()
}else{
message("Your rgl installation is not working.")
}
}
)
adamkocsis/icosa documentation built on Aug. 20, 2024, 1:35 a.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.facelayer
Documented in plot3d.facelayer
#' 3d plotting of a facelayer of an icosahedral grid or its subset
#'
#' The function is built on the openGL renderer of the R package \code{rgl}. The default plotting window size is \code{800x800} pixels. In case you want to override this, please
#' use the function with \code{defaultPar3d=FALSE} after running \code{\link[rgl]{par3d}}\code{(windowRect=<>)}.
#'
#' @param defaultPar3d (\code{logical}) Flag indicating whether the default settings for \code{\link[rgl]{par3d}} are to be used \code{(windowRect = c(50, 60, 800, 800), zoom=0.8)}.
#' @param frame (\code{logical}) If set to TRUE the grid line structure will be plotted.
#'
#' @exportS3Method rgl::plot3d facelayer
#' @exportS3Method plot3d facelayer
#' @rdname plot3d
#' @export plot3d.facelayer
plot3d.facelayer <- function(x,type="f",frame=TRUE, guides=TRUE, defaultPar3d=TRUE, ...){
if(!requireNamespace("rgl", quietly = TRUE)) stop("Install the 'rgl' package and reload 'icosa' to use this function.")
# rgl is installed and is working
if(!rgl::rgl.useNULL()){
# default par3d options
if(defaultPar3d){
rgl::par3d(windowRect = c(50, 60, 800, 800), zoom=0.8)
}
actGrid <- get(x@grid)
checkLinkedGrid(actGrid, x)
#do not allow arguments to pass through!
if(frame==TRUE){
plot3d(actGrid, guides=guides, col="gray50")
}else{
plot3d(actGrid, type="n", guides=guides)
#boundaries
if(type=="l"){
lines3d(x,...)
}
}
if(type=="f"){
faces3d(x,specular="black",...)
}
#add additional types of plotting to this method
#no plotting
if(type=="n"){
}
}else{
message("Your rgl installation is not working.")
}
}
#' Methods of 3d face plotting.
#'
#' @param col (\code{character}) Graphical parameter indicating the colours of the faces. A single value is accepted for \code{logical} values. Multiple colors will be passed to \code{\link[grDevices:colorRamp]{colorRampPalette}}, to create palettes for heat maps in case of \code{numeric} values. The default plotting method in this case is the reversed \code{\link[grDevices:palettes]{heat.colors}}. In case of categorical data, random colors will be chosen.
#' @param breaks (\code{numeric}) Vector stating the breakpoints between the plotted levels. The argument is passed to the \code{\link[base]{cut}} function.
#' @param inclusive (\code{logical}): If there are values beyond the limits of breaks, should these be represented in the plot (\code{TRUE}) or left out completely \code{FALSE}?
#' @param legend (\code{logical}) Should the heatmap legend be plotted?
#'
#' @exportMethod faces3d
#' @rdname faces3d
#' @examples
#' h <- hexagrid(8)
#' b <- facelayer(h)
#' values(b)<- rnorm(length(b))
setMethod(
f="faces3d",
signature="facelayer",
definition= function(x,col="heat",breaks=NULL, inclusive=TRUE, legend=TRUE, ...){
if(!requireNamespace("rgl", quietly = TRUE)) stop("Install the 'rgl' package and reload 'icosa' to use this function.")
# rgl is installed and is working
if(!rgl::rgl.useNULL()){
# extract the grid that needs to be plotted:
actGrid <- get(x@grid)
# checkLinkedGrid(actGrid, x)
discrete<- FALSE
#check whether the grid is actually updated
if(sum(x@names%in%rownames(actGrid@faces))!=length(x))
stop("The facenames in thelinked grid does not match the facelayer object.")
#when the valuues are logical
#FALSEs do not plot; NAs do not plot, TRUEs plot
# defend 'breaks'
if(!is.null(breaks)){
if(!is.numeric(breaks)) stop("The 'breaks' argument has to be numeric.")
if(length(breaks)<3) stop("You need to provide at least three values to the 'breaks' argument.")
}
# if the grid is numerical and it has only one value, make it logical
if(class(x@values)%in%c("integer","double", "numeric")){
if(length(unique(x@values[!is.na(x@values)]))==1){
x@values<-as.logical(x@values)
}
}
if(is.logical(x@values)){
#just add NAs where the values are 0
x@values[x@values==FALSE]<-NA
}
#if the number of values does not match the grid face no
boolPresent1<-rep(T,nrow(actGrid@faces))
if(length(x)!=nrow(actGrid@faces)){
boolPresent1<-rownames(actGrid@faces)%in%x@names
actGrid<-subset(actGrid, rownames(actGrid@faces)[boolPresent1])
}
# in case there are NAs, do a subsetting before going on
# rgl does not understand col=NA as omission of plotting
if(sum(is.na(x@values))>0){
# select only the faces that are available
boolPresent<-!is.na(x@values)
#1. the values
x@values<-x@values[boolPresent]
#2. the names too
x@names<- x@names[boolPresent]
#3. number
x@length <- sum(boolPresent)
# #do a pseudo subsetting!
# tempFacesLog<-rep(F, length(actGrid@skeleton$aF))
# #what should not be removed
# tempFacesLog[actGrid@skeleton$offsetF+actGrid@skeleton$uiF[which(names(actGrid@skeleton$uiF)%in%x@names)]] <- TRUE
# #remove everthing but that
# actGrid@skeleton$aF[!tempFacesLog]<- FALSE
actGrid<-subset(actGrid, x@names) # the real subsetting
}
#when the values are logical
if(inherits(x@values,"logical")){
#set default color value
faces3d(actGrid,col=col,...)
}
# when numerical values are added to the facelayer object, do a heatmap!
if(class(x@values)%in%c("integer","double", "numeric")){
# calculate the breaking vector
if(is.null(breaks)){
minimum <- min(x@values)
maximum <- max(x@values)
steps <- length(x)+1
# the vector used to cut the plottted variable
useBreaks <- seq(minimum, maximum,length.out=steps)
}else{
minimum <- min(breaks)
maximum <- max(breaks)
useBreaks <- breaks
}
# still need to include limitations
bMax <- FALSE
bMin <- FALSE
if(inclusive){
# values that are beyond the minimum boundary set by breaks
beyondMax <- which(x@values>maximum)
if(length(beyondMax)>1){
x@values[beyondMax] <- maximum
bMax <- TRUE
}
# values that are beyond the minimum boundary set by breaks
beyondMin <- which(x@values<minimum)
if(length(beyondMin)>1){
x@values[beyondMin] <- minimum
bMin <- TRUE
}
}
#do a heatmap!
#create a ramp, with a given number of colours
#the color vector will control the heatmap
if(length(col)==1){
# predefined
if(col=="heat"){
# col<-c("red","orange","yellow", "white")
cols <- rev(grDevices::heat.colors(length(useBreaks)-1))
cols<-substring(cols, 1,7)
}else{
if(length(col)==1){
stop("You specified only one color.")
}
}
} else{
#do a heatmap!
ramp<-grDevices::colorRampPalette(col, bias=2, space="Lab")
# produce as many colours as there are values
cols <- ramp(length(useBreaks)-1)
}
# do the cutting
alreadyCut <- base::cut(x@values, breaks=useBreaks, include.lowest=TRUE)
# transfer the factor to indices
trans2 <- as.numeric(alreadyCut)
# this is the ui sequence
faceColors<-cols[trans2]
if(inherits(actGrid,"trigrid") & !inherits(actGrid, "hexagrid")){
#in the inner sequence
#create a source vector as if it was complete
faceColors2<-rep(NA, length(actGrid@skeleton$uiF))
names(faceColors2)<-paste("F", 1:length(faceColors2), sep="")
faceColors2[names(x)]<-faceColors
#order them
faceColors3<-rep(NA, length(faceColors2))
faceColors3[actGrid@skeleton$uiF]<-faceColors2
#and get rid of the NAs
faceColors3<-faceColors3[!is.na(faceColors3)]
}
if(inherits(actGrid, "hexagrid")){
tu <- as.numeric(t(actGrid@skeleton$uiF[names(x),]))
empty<-rep(NA, nrow(actGrid@skeleton$f))
fc<-rep(faceColors, each=12)
empty[tu[!is.na(tu)]] <-fc[!is.na(tu)]
noNA<-empty[as.logical(actGrid@skeleton$aSF)]
###
# get the subfaces where there is information
# f<-as.data.frame(actGrid@skeleton$f[as.logical(actGrid@skeleton$aSF),1:3])
#which outer faces do the subfaces belong?
aas<- actGrid@skeleton$aSF[as.logical(actGrid@skeleton$aSF)]
#create a vector fro all the total colors (as if the grid was full)
totCol<-rep(NA,nrow(actGrid@skeleton$uiF))
names(totCol) <- paste("F", 1:length(totCol), sep="")
# insert the information
totCol[names(x)]<-faceColors
#reorder the colors to the subfaces
faceColors3<-totCol[aas]
#
# temp<-cbind(f, newCol, stringsAsFactors=FALSE)
#
# temp2<-temp[order(temp[,1]),]
# temp2<-unique(temp2)
}
faces3d(actGrid,col=rep(faceColors3, each=3),...)
# numeric heatmap!
# increase the resolution when you plot the legend
currentset<-rgl::par3d("windowRect")
currentset2<-currentset
currentset2[3]<-currentset[3]*1.5
currentset2[4]<-currentset[4]*1.5
# what should be passed to the heatmaplegend
if(!discrete){
tickLabs <- useBreaks
}else{
tickLabs <- (useBreaks+useBreaks[2:(length(useBreaks)+1)])/2
tickLabs <- tickLabs[!is.na(tickLabs)]
}
# double the resolution
rgl::par3d(windowRect=currentset2)
# plot the background
rgl::bgplot3d(
# turn off the graphical parameters warning bullshit
suppressWarnings(
if(legend) heatMapLegend(cols,vals=tickLabs,...)
)
)
rgl::par3d(windowRect=currentset)
}
#when all the values are colors
#plot faces as
if(inherits(x@values, "character") & sum(x@values%in%grDevices::colors())==x@length){
faces3d(actGrid, col=x@values, plot="faces",...)
}
# when the values are text | they are not colors
if(inherits(x@values, "character") & !sum(x@values%in%grDevices::colors())==x@length){
# state the labels in 3d on the face (using the centers of the faces)
colorAll <- grDevices::colors()[grep('gr(a|e)y', grDevices::colors(), invert = TRUE)]
active<-factor(x@values)
if(length(levels(active))>length(colorAll)){
cols<-sample(colorAll, length(levels(active)), replace=TRUE)
}else{
cols<-sample(colorAll, length(levels(active)), replace=FALSE)
}
faceColors<-cols[as.numeric(active)]
if(inherits(actGrid, "trigrid") & !inherits(actGrid, "hexagrid")){
#in the inner sequence
#create a source vector as if it was complete
faceColors2<-rep(NA, length(actGrid@skeleton$uiF))
names(faceColors2)<-paste("F", 1:length(faceColors2), sep="")
faceColors2[names(x)]<-faceColors
#order them
faceColors3<-rep(NA, length(faceColors2))
faceColors3[actGrid@skeleton$uiF]<-faceColors2
#and get rid of the NAs
faceColors3<-faceColors3[!is.na(faceColors3)]
}
if(inherits(actGrid, "hexagrid")){
tu <- as.numeric(t(actGrid@skeleton$uiF[names(x),]))
empty<-rep(NA, nrow(actGrid@skeleton$f))
fc<-rep(faceColors, each=12)
empty[tu[!is.na(tu)]] <-fc[!is.na(tu)]
noNA<-empty[as.logical(actGrid@skeleton$aSF)]
###
# get the subfaces where there is information
# f<-as.data.frame(actGrid@skeleton$f[as.logical(actGrid@skeleton$aSF),1:3])
#which outer faces do the subfaces belong?
aas<- actGrid@skeleton$aSF[as.logical(actGrid@skeleton$aSF)]
#create a vector fro all the total colors (as if the grid was full)
totCol<-rep(NA,nrow(actGrid@skeleton$uiF))
names(totCol) <- paste("F", 1:length(totCol), sep="")
# insert the information
totCol[names(x)]<-faceColors
#reorder the colors to the subfaces
faceColors3<-totCol[aas]
#
# temp<-cbind(f, newCol, stringsAsFactors=FALSE)
#
# temp2<-temp[order(temp[,1]),]
# temp2<-unique(temp2)
}
faces3d(actGrid,col=rep(faceColors3, each=3),...)
}
# when the values are factors!
if(inherits(x@values, "factor")){
# depending on the number of levels, more color palettes might be useful
if(length(levels(factor(x@values))) <= 7){
faces3d(actGrid, col=rep(as.numeric(x@values),each=3), ...)
}
}
# legend3d()
}else{
message("Your rgl installation is not working.")
}
}
)
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.