#Librerías necesarias
install.packages("rgl")
library("rgl")
#Datos
data(iris)
head(iris)
#Codigo
x <- sep.l <- iris$Sepal.Length
y <- pet.l <- iris$Petal.Length
z <- sep.w <- iris$Sepal.Width
lim <- function(x){c(-max(abs(x)), max(abs(x))) * 1.1}
rgl_add_axes <- function(x, y, z, axis.col = "red",
xlab = "", ylab="", zlab="", show.plane = TRUE,
show.bbox = TRUE, bbox.col = c("#335377","black"))
{
lim <- function(x){c(-max(abs(x)), max(abs(x))) * 1.1}
# Añadir ejes
xlim <- lim(x); ylim <- lim(y); zlim <- lim(z)
rgl.lines(xlim, c(0, 0), c(0, 0), color = axis.col)
rgl.lines(c(0, 0), ylim, c(0, 0), color = axis.col)
rgl.lines(c(0, 0), c(0, 0), zlim, color = axis.col)
axes <- rbind(c(xlim[2], 0, 0), c(0, ylim[2], 0), c(0, 0, zlim[2]))
rgl.points(axes, color = axis.col, size = 3)
# Añadir Titulos
rgl.texts(axes, text = c(xlab, ylab, zlab), color = axis.col,
adj = c(0.5, -0.8), size = 2)
# Añadir plano
if(show.plane)
xlim <- xlim/1.1; zlim <- zlim /1.1
rgl.quads( x = rep(xlim, each = 2), y = c(0, 0, 0, 0),
z = c(zlim[1], zlim[2], zlim[2], zlim[1]))
# Añadir Caja Exterior
if(show.bbox){
rgl.bbox(color=c(bbox.col[1],bbox.col[2]), alpha = 0.5,
emission=bbox.col[1], specular=bbox.col[1], shininess=5,
xlen = 3, ylen = 3, zlen = 3)
}
}
# Funcion de colores
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)
}
cols <- get_colors(iris$Species, c("#999999", "#E69F00", "#56B4E9"))
#rgl_init()
rgl.spheres(x, y, z, r = 0.2, color = cols)
rgl_add_axes(x, y, z, show.bbox = TRUE)
aspect3d(1,1,1)
ā
# Especificar Color de Fondo
rgl.bg(color = "white")
#Codigo
#Giro Automatico
play3d( spin3d( axis = c(0, 1, 0), rpm = 4), duration = 100 )
###################################################
install.packages("rgl")
library("rgl")
data(iris)
head(iris)
x <- sep.l <- iris$Sepal.Length
y <- pet.l <- iris$Petal.Length
z <- sep.w <- iris$Sepal.Width
lim <- function(x){c(-max(abs(x)), max(abs(x))) * 1.1}
rgl_add_axes <- function(x, y, z, axis.col = "red",
xlab = "", ylab="", zlab="", show.plane = TRUE,
show.bbox = TRUE, bbox.col = c("#335377","black"))
{
lim <- function(x){c(-max(abs(x)), max(abs(x))) * 1.1}
xlim <- lim(x); ylim <- lim(y); zlim <- lim(z)
rgl.lines(xlim, c(0, 0), c(0, 0), color = axis.col)
rgl.lines(c(0, 0), ylim, c(0, 0), color = axis.col)
rgl.lines(c(0, 0), c(0, 0), zlim, color = axis.col)
axes <- rbind(c(xlim[2], 0, 0), c(0, ylim[2], 0),
c(0, 0, zlim[2]))
rgl.points(axes, color = axis.col, size = 3)
rgl.texts(axes, text = c(xlab, ylab, zlab), color = axis.col,
adj = c(0.5, -0.8), size = 2)
if(show.plane)
xlim <- xlim/1.1; zlim <- zlim /1.1
rgl.quads( x = rep(xlim, each = 2), y = c(0, 0, 0, 0),
z = c(zlim[1], zlim[2], zlim[2], zlim[1]))
if(show.bbox){
rgl.bbox(color=c(bbox.col[1],bbox.col[2]), alpha = 0.5,
emission=bbox.col[1], specular=bbox.col[1], shininess=5,
xlen = 3, ylen = 3, zlen = 3)
}
}
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)
}
cols <- get_colors(iris$Species, c("#999999", "#E69F00", "#56B4E9"))
#rgl_init()
rgl.spheres(x, y, z, r = 0.2, color = cols)
rgl_add_axes(x, y, z, show.bbox = TRUE)
aspect3d(1,1,1)
rgl.bg(color = "white")
play3d( spin3d( axis = c(0, 1, 0), rpm = 4), duration = 100 )
###################################################