########## R script: rglSetup ########## # For setting up rgl() graphics so that # three-dimensional surface fits can be # displayed. # Last changed: 19 MAY 2019 rhcs.lines3d <- function (x, y, z, add = FALSE, ...) { n <- length(x) if (n != length(y) || n != length(z)) stop("Lengths of x, y, z do not match") if (!add) rgl.clear() off <- c(1, 1) x <- kronecker(x, off)[-c(1, 2 * n)] y <- kronecker(y, off)[-c(1, 2 * n)] z <- kronecker(z, off)[-c(1, 2 * n)] rgl.lines(x, z, -y, ...) } # Set up `Right-Hand Coordinate System' versions # of required rgl functions. rhcs.spheres <- function(x,y,z,radius,...) return(rgl.spheres(x,z,-y,radius,...)) rhcs.texts <- function(x,y,z,text,...) return(rgl.texts(x,z,-y,text,...)) rhcs.triangles <- function(x,y,z,...) return(rgl.triangles(x,z,-y,...)) rhcs.quads <- function(x,y,z,...) return(rgl.quads(x,z,-y,...)) rhcs.surface <- function(x,y,z,...) return(rgl.surface(x,z,-y,...)) rhcs.clear <- function(type="shapes") { rgl.viewpoint(theta=135) return(rgl.clear(type)) } bg.col <- "lightskyblue1" bs.col <- "blue1" ph.col <- "green3" ax.col <- "DeepPink" tx.col <- "maroon" sp.rad <- 0.03 xtx.pos <- 2.2 ; ytx.pos <- 2.2 ; ztx.pos <- 2.2 xax.low <- -0.2; yax.low <- -0.2; zax.low <- -0.2 xax.upp <- 2.1 ; yax.upp <- 2.1 ; zax.upp <- 2.1 al.val <- 0.7 sz.val <- 15 createAxesandBase <- function(xlab="",ylab="",zlab="") { rhcs.clear() rgl.bg(col=bg.col) rhcs.lines3d(c(xax.low,xax.upp),rep(0,2),rep(0,2), size=3,col=ax.col,add=TRUE) rhcs.lines3d(rep(0,2),c(yax.low,yax.upp),rep(0,2), size=3,col=ax.col,add=TRUE) rhcs.lines3d(rep(0,2),rep(0,2),c(zax.low,zax.upp), size=3,col=ax.col,add=TRUE) rhcs.texts(xtx.pos,0,0,xlab,col=tx.col) rhcs.texts(0,ytx.pos,0,ylab,col=tx.col) rhcs.texts(0,0,ztx.pos,zlab,col=tx.col) rhcs.quads(c(xax.low,xax.low,xax.upp,xax.upp), c(yax.low,yax.upp,yax.upp,yax.low), rep(0,4),col=bs.col,alpha=al.val) } ############ End of rglSetup ############