Nothing
####### R function: plot3D ###########
# For plotting points in 3D space.
# Last changed: 07 MAR 2016
plot3D <- function(x,y,z,main=NULL,
xlab=deparse(substitute(x)),
ylab=deparse(substitute(y)),
zlab=deparse(substitute(z)),
xlim=NULL,ylim=NULL,zlim=NULL,
cex=1,ptCol="red",axCol="navy",tickCol="navy",
labCol="DarkGreen",bgCol="white",addBase=FALSE,
baseCol="cyan",ptAlpha=0.7,baseAlpha=0.7,type="p")
{
# Create working versions of input data:
wx <- x ; wy <- y ; wz <- z
# Remove data outside of specified ranges:
omitInds <- NULL
if (!is.null(xlim))
omitInds <- union(omitInds,(1:length(x))[(wx<xlim[1])|(wx>xlim[2])])
if (!is.null(ylim))
omitInds <- union(omitInds,(1:length(y))[(wy<ylim[1])|(wy>ylim[2])])
if (!is.null(zlim))
omitInds <- union(omitInds,(1:length(z))[(wz<zlim[1])|(wz>zlim[2])])
if (!is.null(omitInds))
{
wx <- wx[-omitInds] ; wy <- wy[-omitInds] ; wz <- wz[-omitInds]
}
# Insert safeguards against too much data being omitted:
if (length(wx)==0) wx <- quantile(x,c(0.05,0.5,0.95))
if (length(wy)==0) wy <- quantile(y,c(0.05,0.5,0.95))
if (length(wz)==0) wz <- quantile(z,c(0.05,0.5,0.95))
pwx <- wx ; pwy <- wy ; pwz <- wz
if (!is.null(xlim)) pwx <- c(pwx,xlim)
if (!is.null(ylim)) pwy <- c(pwy,ylim)
if (!is.null(zlim)) pwz <- c(pwz,zlim)
xtcks <- pretty(pwx) ; ytcks <- pretty(pwy) ; ztcks <- pretty(pwz)
xtcks <- xtcks[(xtcks>min(wx))&(xtcks<max(wx))]
ytcks <- ytcks[(ytcks>min(wy))&(ytcks<max(wy))]
ztcks <- ztcks[(ztcks>min(wz))&(ztcks<max(wz))]
# Insert safeguards against too much data being omitted:
if (length(xtcks)==0)
{
if (is.null(xlim))
xtcks <- quantile(x,c(0.25,0.75))
if (!is.null(xlim))
xtcks <- xlim
}
if (length(ytcks)==0)
{
if (is.null(ylim))
ytcks <- quantile(y,c(0.25,0.75))
if (!is.null(ylim))
ytcks <- ylim
}
if (length(ztcks)==0)
{
if (is.null(zlim))
ztcks <- quantile(z,c(0.25,0.75))
if (!is.null(zlim))
ztcks <- zlim
}
# Set axis limits:
a.x <- min(wx) ; b.x <- max(wx)
a.y <- min(wy) ; b.y <- max(wy)
a.z <- min(wz) ; b.z <- max(wz)
# Transform data to unit cube:
tx <- tranUnitInt(wx,a.x,b.x)
ty <- tranUnitInt(wy,a.y,b.y)
tz <- tranUnitInt(wz,a.z,b.z)
# Set up axes for unit cube:
rgl.clear()
rgl.bg(color=bgCol)
rgl.lines3d(c(0,1.1),rep(0,2),rep(0,2),
size=3,col=axCol,add=TRUE)
rgl.lines3d(rep(0,2),c(0,1.1),rep(0,2),
size=3,col=axCol,add=TRUE)
rgl.lines3d(rep(0,2),rep(0,2),c(0,1.1),
size=3,col=axCol,add=TRUE)
rgl.texts(1.1,0,0,"x",col=axCol)
rgl.texts(0,1.1,0,"y",col=axCol)
rgl.texts(0,0,1.1,"z",col=axCol)
rgl.texts(1.15,0,0,xlab,col=labCol)
rgl.texts(0,1.15,0,ylab,col=labCol)
rgl.texts(0,0,1.15,zlab,col=labCol)
if (addBase)
rgl.quads(c(-0.1,-0.1,1.1,1.1),
c(-0.1,1.1,1.1,-0.1),
rep(0,4),col=baseCol,alpha=baseAlpha)
# Add `main' string:
if (!is.null(main))
rgl.texts(0.5,1.15,0,main,col=axCol)
# Add tick marks:
txtcks <- tranUnitInt(xtcks,a.x,b.x)
for (ix in 1:length(txtcks))
{
rgl.lines3d(rep(txtcks[ix],2),rep(0,2),c(0,0.015),col=axCol,add=TRUE)
rgl.lines3d(rep(txtcks[ix],2),c(0,0.015),rep(0,2),col=axCol,add=TRUE)
rgl.texts(txtcks[ix],-0.05,-0.05,as.character(xtcks[ix]),col=tickCol)
}
tytcks <- tranUnitInt(ytcks,a.y,b.y)
for (iy in 1:length(tytcks))
{
rgl.lines3d(rep(0,2),rep(tytcks[iy],2),c(0,0.015),col=axCol,add=TRUE)
rgl.lines3d(c(0,0.015),rep(tytcks[iy],2),rep(0,2),col=axCol,add=TRUE)
rgl.texts(-0.05,tytcks[iy],-0.05,as.character(ytcks[iy]),col=tickCol)
}
tztcks <- tranUnitInt(ztcks,a.z,b.z)
for (iz in 1:length(tztcks))
{
rgl.lines3d(rep(0,2),c(0,0.015),rep(tztcks[iz],2),col=axCol,add=TRUE)
rgl.lines3d(c(0,0.015),rep(0,2),rep(tztcks[iz],2),col=axCol,add=TRUE)
rgl.texts(-0.05,-0.05,tztcks[iz],as.character(ztcks[iz]),col=tickCol)
}
# Add points:
if (type=="p")
rgl.spheres(tx,ty,tz,col=ptCol,radius=cex*0.015)
################
# CHANGE FOR 12 AUG 2010 TALK
# rgl.spheres(tx,ty,tz,col=ptCol,alpha=ptAlpha,radius=cex*0.015)
###########################
# Add limit information as attributes:
obj <- 0
attr(obj,"a.x") <- a.x ; attr(obj,"b.x") <- b.x
attr(obj,"a.y") <- a.y ; attr(obj,"b.y") <- b.y
attr(obj,"a.z") <- a.z ; attr(obj,"b.z") <- b.z
invisible(obj)
}
############# End of plot3D ##############
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.