Draw only positive octant with rgl.sphere in R-CodePudding

I would like to display only the positive octant of a unit sphere. So far, using the rgl package in R, I could show the entire sphere. Is it possible to "truncate" it? I am open to any other package that does the trick.

# Fake data
norm_vec <- function(x) sqrt(sum(x ^ 2)) 
data <- data.frame(T3 = runif(100), T6 = runif(100), P4 = runif(100))
norms <- apply(data, 1, norm_vec)
data <- data  / norms
cluster <- sample(1:6, 100, replace = T)

#' Initialize a rgl device
#' 
#' @param new.device a logical value. If TRUE, creates a new device
#' @param bg the background color of the device
#' @param width the width of the device
rgl_init <- function(new.device = FALSE, bg = "white", width = 640) { 
  if( new.device | rgl.cur() == 0 ) {
    rgl.open()
    par3d(windowRect = 50   c( 0, 0, width, width ) )
    rgl.bg(color = bg )
  }
  rgl.clear(type = c("shapes", "bboxdeco"))
  rgl.viewpoint(theta = 30, phi = 0, zoom = 0.90)
}

#' Get colors for the different levels of a factor variable
#' 
#' @param groups a factor variable containing the groups of observations
#' @param colors a vector containing the names of the default colors to be used
get_colors <- function(groups, group.col = palette()){
  groups <- as.factor(groups)
  ngrps <- length(levels(groups))
  if(ngrps > length(group.col)) 
    group.col <- rep(group.col, ngrps)
  color <- group.col[as.numeric(groups)]
  names(color) <- as.vector(groups)
  return(color)
}

# Setting colors according to the cluster column
my_cols <- get_colors(cluster, c("#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7"))

# Ploting sphere
rgl_init()
par3d(cex = 1.35)
plot3d(x = data[, "T3"], y = data[, "P4"], z = data[, "T6"],
  type = "s", r = .04,
  col = my_cols, 
  xlab = 'T3', ylab = 'P4', zlab = 'T6')
rgl.spheres(0, 0, 0, radius = 0.995, col = 'lightgray', alpha = 0.6, back = 'lines')
arc3d(c(1, 0, 0), c(0, 1, 0), c(0, 0, 0), radius = 1, lwd = 7.5, col = "black")
arc3d(c(1, 0, 0), c(0, 0, 1), c(0, 0, 0), radius = 1, lwd = 7.5, col = "black")
arc3d(c(0, 0, 1), c(0, 1, 0), c(0, 0, 0), radius = 1, lwd = 7.5, col = "black")
bbox3d(col = c("black", "black"), 
       xat = c(0, 0.5, 1), yat = c(0, 0.5, 1), zat = c(0, 0.5, 1),
       polygon_offset = 1)
aspect3d(1, 1, 1)

3D dispersion plot onto a unit sphere using rgl package

CodePudding user response：

You can use cliplanes3d() to do that. You should also avoid using any of the rgl.* functions; use the *3d alternatives instead unless you really know what you're doing. It's almost never a good idea to mix the two types.

For example:

# Fake data
norm_vec <- function(x) sqrt(sum(x ^ 2)) 
data <- data.frame(T3 = runif(100), T6 = runif(100), P4 = runif(100))
norms <- apply(data, 1, norm_vec)
data <- data  / norms
cluster <- sample(1:6, 100, replace = T)

#' Initialize a rgl device
#' 
#' @param new.device a logical value. If TRUE, creates a new device
#' @param bg the background color of the device
#' @param width the width of the device
rgl_init <- function(new.device = FALSE, bg = "white", width = 640) { 
  if( new.device || rgl.cur() == 0 ) {
    open3d(windowRect = 50   c( 0, 0, width, width ) )
    bg3d(color = bg )
  }
  clear3d(type = c("shapes", "bboxdeco"))
  view3d(theta = 30, phi = 0, zoom = 0.90)
}

#' Get colors for the different levels of a factor variable
#' 
#' @param groups a factor variable containing the groups of observations
#' @param colors a vector containing the names of the default colors to be used
get_colors <- function(groups, group.col = palette()){
  groups <- as.factor(groups)
  ngrps <- length(levels(groups))
  if(ngrps > length(group.col)) 
    group.col <- rep(group.col, ngrps)
  color <- group.col[as.numeric(groups)]
  names(color) <- as.vector(groups)
  return(color)
}

# Setting colors according to the cluster column
my_cols <- get_colors(cluster, c("#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7"))

# Ploting sphere
rgl_init()
par3d(cex = 1.35)
plot3d(x = data[, "T3"], y = data[, "P4"], z = data[, "T6"],
       type = "s", r = .04,
       col = my_cols, 
       xlab = 'T3', ylab = 'P4', zlab = 'T6')
spheres3d(0, 0, 0, radius = 0.995, col = 'lightgray', alpha = 0.6, back = 'lines')
arc3d(c(1, 0, 0), c(0, 1, 0), c(0, 0, 0), radius = 1, lwd = 7.5, col = "black")
arc3d(c(1, 0, 0), c(0, 0, 1), c(0, 0, 0), radius = 1, lwd = 7.5, col = "black")
arc3d(c(0, 0, 1), c(0, 1, 0), c(0, 0, 0), radius = 1, lwd = 7.5, col = "black")
bbox3d(col = c("black", "black"), 
       xat = c(0, 0.5, 1), yat = c(0, 0.5, 1), zat = c(0, 0.5, 1),
       polygon_offset = 1)
aspect3d(1, 1, 1)
clipplanes3d(c(1,0,0), c(0,1,0), c(0,0,1), d=0)

This produces