R: 4D plot, x, y, z, colours - r

Could you give me an example on how to use rgl to plot 3 variables at the axes x, y and z and a fourth one with different colours?
thanks

You use a combination of persp and colour according to a separate function. Here's some example code:
## Create a simple surface f(x,y) = -x^2 - y^2
## Colour the surface according to x^2 only
nx = 31; ny = 31
x = seq(-1, 1, length = nx)
y = seq(-1, 1, length = ny)
z = outer(x, y, function(x,y) -x^2 -y^2)
## Fourth dim
z_col = outer(x, y, function(x,y) x^2)
## Average the values at the corner of each facet
## and scale to a value in [0, 1]. We will use this
## to select a gray for colouring the facet.
hgt = 0.25 * (z_col[-nx,-ny] + z_col[-1,-ny] + z_col[-nx,-1] + z_col[-1,-1])
hgt = (hgt - min(hgt))/ (max(hgt) - min(hgt))
## Plot the surface with the specified facet colours.
persp(x, y, z, col = gray(1 - hgt))
persp(x, y, z, col=cm.colors(32)[floor(31*hgt+1)], theta=-35, phi=10)
This gives:
RGL
It's fairly straightforward to use the above technique with the rgl library:
library(rgl)
## Generate the data using the above commands
## New window
open3d()
## clear scene:
clear3d("all")
## setup env:
bg3d(color="#887777")
light3d()
surface3d(x, y, z, color=cm.colors(32)[floor(31*hgt+1)], alpha=0.5)

There is an example in ?plot3d if you are talking about plotting points in a 3d space and colouring them:
x <- sort(rnorm(1000))
y <- rnorm(1000)
z <- rnorm(1000) + atan2(x,y)
plot3d(x, y, z, col=rainbow(1000))
But if you mean to colour the points by a 4th variable, say a grouping variable, then we can modify the example above to do this by creating a grouping variable
grp <- gl(5, 200) ## 5 groups 200 members each
## now select the colours we want
cols <- 1:5
## Now plot
plot3d(x, y, z, col=cols[grp])
OK, is this more what you want?
X <- 1:10
Y <- 1:10
## Z is now a 100 row object of X,Y combinations
Z <- expand.grid(X = X, Y = Y)
## Add in Z1, which is the 3rd variable
## X,Y,Z1 define the surface, which we colour according to
## 4th variable Z2
Z <- within(Z, {
Z1 <- 1.2 + (1.4 * X) + (-1.9 * Y)
Z2 <- 1.2 + (1.4 * X) - (1.2 * X^2) + (1.9 * Y) + (-1.3 * Y^2)
Z3 <- 1.2 + (1.4 * X) + (-1.9 * Y) + (-X^2) + (-Y^2)})
## show the data
head(Z)
## Set-up the rgl device
with(Z, plot3d(X, Y, Z1, type = "n"))
## Need a scale for Z2 to display as colours
## Here I choose 10 equally spaced colours from a palette
cols <- heat.colors(10)
## Break Z2 into 10 equal regions
cuts <- with(Z, cut(Z2, breaks = 10))
## Add in the surface, colouring by Z2
with(Z, surface3d(1:10,1:10, matrix(Z1, ncol = 10),
color = cols[cuts], back = "fill"))
with(Z, points3d(X, Y, Z1, size = 5)) ## show grid X,Y,Z1
Here's a modification where the plane surface Z1 is curved (Z3).
## Set-up the rgl device plotting Z3, a curved surface
with(Z, plot3d(X, Y, Z3, type = "n"))
with(Z, surface3d(1:10,1:10, matrix(Z3, ncol = 10),
color = cols[cuts], back = "fill"))
The detail of what I did to get Z2 probably doesn't matter, but I tried to get something like the graph you linked to.
If I've still not got what you want, can you edit your Q with some example data and give us a better idea of what you want?
HTH

Take a look at example(points3d).
The r3d help page shows you how to draw axes.
x <- c(0, 10, 0, 0)
y <- c(0, 0, 100, 0)
z <- c(0, 0, 0, 1)
i <- c(1,2,1,3,1,4)
labels <- c("Origin", "X", "Y", "Z")
text3d(x,y,z,labels)
segments3d(x[i],y[i],z[i])
Now you add some points
dfr <- data.frame(x = 1:10, y = (1:10)^2, z = runif(10), col = rainbow(10))
with(dfr, points3d(x, y, z, col = col))

Related

How to set a logarithmic scale across multiple ggplot2 contour plots?

I am attempting to create three contour plots, each illustrating the following function applied to two input vectors and a fixed alpha:
alphas <- c(1, 5, 25)
x_vals <- seq(0, 25, length.out = 100)
y_vals <- seq(0, 50, length.out = 100)
my_function <- function(x, y, alpha) {
z <- (1 / (x + alpha)) * (1 / (y + alpha))
}
for each alpha in the vector alphas, I am creating a contour plot of z values—relative to the minimal z value—over x and y axes.
I do so with the following code (probably not best practices; I'm still learning the basics with R):
plots <- list()
for(i in seq_along(alphas)) {
z_table <- sapply(x_vals, my_function, y = y_vals, alpha = alphas[i])
x <- rep(x_vals, each = 100)
y <- rep(y_vals, 100)
z <- unlist(flatten(list(z_table)))
z_rel <- z / min(z)
d <- data.frame(cbind(x, y, z_rel))
plots[[i]] <- ggplot(data = d, aes(x = x, y = y, z = z_rel)) +
geom_contour_filled()
}
When alpha = 1:
When alpha = 25:
I want to display these plots in one grouping using ggarrange(), with one logarithmic color scale (as relative z varies so much from plot to plot). Is there a way to do this?
You can build a data frame with all the data for all alphas combined, with a column indicating the alpha, so you can facet your graph:
I basically removed the plot[[i]] part, and stacked up the d's created in the former loop:
d = numeric()
for(i in seq_along(alphas)) {
z_table <- sapply(x_vals, my_function, y = y_vals, alpha = alphas[i])
x <- rep(x_vals, each = 100)
y <- rep(y_vals, 100)
z <- unlist(flatten(list(z_table)))
z_rel <- z / min(z)
d <- rbind(d, cbind(x, y, z_rel))}
d = as.data.frame(d)
Then we create the alphas column:
d$alpha = factor(paste("alpha =", alphas[rep(1:3, each=nrow(d)/length(alphas))]),
levels = paste("alpha =", alphas[1:3]))
Then build the log scale inside the contour:
ggplot(data = d, aes(x = x, y = y, z = z_rel)) +
geom_contour_filled(breaks=round(exp(seq(log(1), log(1400), length = 14)),1)) +
facet_wrap(~alpha)
Output:

Creating a 3D surface plot from two vectors and a matrix

I have got two vectors and a 2D-matrix, from which I want to create a 3D surface plot. I already have split my data into X and Y (vectors (time "t" and wavelength "w") and Z (matrix; absorbance "NIR" at time and wavelength) with the same number of rows/columns respectively:
t = matrix(1:456, ncol= 1)
w = matrix(1350:1650, nrow = 1)
NIR = as.matrix(read.table("NIR_alle_pur.txt", header = TRUE, dec =","))
colnames(NIR) = c(paste0("NIR.", 1350:1650))
dim(NIR)
# [1] 456 301
dput(NIR_example)
structure(c(60771.93, 57230.56, 56235.96, 41617.47, 41709.93,
57466.6, 59916.97, 63376.4, 41966.73, 41254.34, 65535, 61468.76,
65535, 41238.03, 42530.97, 56936.03, 65009.4, 65535, 40375.5,
41021.6, 62757, 65455.44, 63795.6, 41349.6, 41178.2), .Dim = c(5L,
5L), .Dimnames = list(NULL, c("NIR.Spectrum_1350.0000000", "NIR.Spectrum_1351.0000000",
"NIR.Spectrum_1352.0000000", "NIR.Spectrum_1353.0000000", "NIR.Spectrum_1354.0000000"
)))
I tried to insert those into the rgl.surface function, but I get the following error message:
Error in rgl.surface(x, y, z, coords = 1:3) : Bad dimension for rows
I've also tried to plot them with plotly, but my success was equally low.
Can someone give me an input how I can get my spectral data to look like the last ones (multiple surfaces) on this site, individually? I'll try the overlay of the surfaces with plotlylater on!
I am happy for every extra input and information on my level!
Thank you!
After looking at the source code, I'd guess the problem is that you stored your x and y vectors as matrices. If they are matrices, they need to be identical in shape to z.
As I mentioned in a comment, you should avoid using rgl.surface (and the other rgl.* functions in most cases), and use surface3d instead, or persp3d if you want axes.
The *3d functions are higher level functions that act more like other R functions, and they will lead to fewer problems in the long run.
You haven't posted any data, so I'll post a completely artificial example. Let's suppose z = x^2 + y^2 + a, where a is a different constant for each surface. Then you can plot it like this:
x <- seq(-2, 2, length = 7)
y <- seq(-3, 3, length = 5) # I've chosen different ranges
# and lengths just to illustrate.
z <- outer(x, y, function(x, y) x^2 + y^2)
colours <- heat.colors(100)
minval <- min(z)
maxval <- max(z) + 10
col <- colours[(z - minval)/(maxval - minval)*99 + 1]
persp3d(x, y, z, col = col) # get axes the first time
z <- outer(x, y, function(x, y) x^2 + y^2 + 5)
col <- colours[(z - minval)/(maxval - minval)*99 + 1]
surface3d(x, y, z, col = col)
z <- outer(x, y, function(x, y) x^2 + y^2 + 10)
col <- colours[(z - minval)/(maxval - minval)*99 + 1]
surface3d(x, y, z, col = col)
aspect3d(1, 1, 1) # Make axes all equal
That produces this plot:

Making a 4D plot in R with different x, y, z colors and lengths

I have a 30 x 16 x 9 matrix that I would like to visualize via a 4-D plot in R.
I have tried scatter3D() in packages plot3d and scatterplot3d.
x <- seq(10, 300, 10)
y <- seq(5.0, 20.0, 1.0)
z <- c(seq(0.5, 4, 0.5), 10)
scatter3D(x, y, z, colvar = data)
It always gives error saying that y should have same length as x.
How do I deal with this? Why do x, y, z have to be equal length? This is so inconvenient.
This happens because each point must have three values for this plot. You have 30 values for x, 16 values for y and 9 values for z. With this data, only the first 9 points will have the x-y-z value. In the comments of your question, eipi10 gives a very good explanation about this. An alternative, for example, is to interpolate the data to create the missing values. More about data interpolation.
library("plot3D")
number_of_points <- 50
xx <- seq(10, 300, 10)
yy <- seq(5.0, 20.0, 1.0)
zz <- c(seq(0.5, 4, 0.5), 10)
xx <- approx(x = xx, method="linear", n=number_of_points, ties = mean)$y
yy <- approx(x = yy, method="linear", n=number_of_points, ties = mean)$y
zz <- approx(x = zz, method="linear", n=number_of_points, ties = mean)$y
scatter3D(xx, yy, zz)
Hope it helps!
You say you have a matrix, but what you have is three vectors. You first need to create the "matrix" (here we will make a data.frame named df using expand.grid):
x <- seq(10, 300, 10)
y <- seq(5.0, 20.0, 1.0)
z <- c(seq(0.5, 4, 0.5), 10)
df <- expand.grid(x = x, y = y, z = z)
Then we can plot using the scatter3d function from the car package using either method:
car::scatter3d(x ~ y + z, data = df)
car::scatter3d(df$x, df$y, df$z)

R: Add points to surface plot with persp having the appropriate size

I would like to achieve that the points I add to the plot have their size adjusted to obtain a better 3D impression. I know that I somehow have to use the transformation matrix that is returned to compute the length of the vector orthogonal to the 2d plane to the respective point in 3d, but I don't know how to do that.
Here is an example:
x1 <- rnorm(100)
x2 <- 4 + rpois(100, 4)
y <- 0.1*x1 + 0.2*x2 + rnorm(100)
dat <- data.frame(x1, x2, y)
m1 <- lm(y ~ x1 + x2, data=dat)
x1r <- range(dat$x1)
x1seq <- seq(x1r[1], x1r[2], length=30)
x2r <- range(dat$x2)
x2seq <- seq(x2r[1], x2r[2], length=30)
z <- outer(x1seq, x2seq, function(a,b){
predict(m1, newdata=data.frame(x1=a, x2=b))
})
res <- persp(x1seq, x2seq, z)
mypoints <- trans3d(dat$x1, dat$x2, dat$y, pmat=res)
points(mypoints, pch=1, col="red")
You can use the function presented here to determine distance to the observer, then scale the pointsize (cex) to that distance:
# volcano data
z <- 2 * volcano # Exaggerate the relief
x <- 10 * (1:nrow(z)) # 10 meter spacing (S to N)
y <- 10 * (1:ncol(z)) # 10 meter spacing (E to W)
# draw volcano and store transformation matrix
pmat <- persp(x, y, z, theta = 35, phi = 40, col = 'green4', scale = FALSE,
ltheta = -120, shade = 0.75, border = NA, box = TRUE)
# take some xyz values from the matrix
s = sample(1:prod(dim(z)), size=500)
xx = x[row(z)[s] ]
yy = y[col(z)[s]]
zz = z[s] + 10
# depth calculation function (adapted from Duncan Murdoch at https://stat.ethz.ch/pipermail/r-help/2005-September/079241.html)
depth3d <- function(x,y,z, pmat, minsize=0.2, maxsize=2) {
# determine depth of each point from xyz and transformation matrix pmat
tr <- as.matrix(cbind(x, y, z, 1)) %*% pmat
tr <- tr[,3]/tr[,4]
# scale depth to point sizes between minsize and maxsize
psize <- ((tr-min(tr) ) * (maxsize-minsize)) / (max(tr)-min(tr)) + minsize
return(psize)
}
# determine distance to eye
psize = depth3d(xx,yy,zz,pmat,minsize=0.1, maxsize = 1)
# from 3D to 2D coordinates
mypoints <- trans3d(xx, yy, zz, pmat=pmat)
# plot in 2D space with pointsize related to distance
points(mypoints, pch=8, cex=psize, col=4)

surface plots of large 3D datasets using R [duplicate]

Could you give me an example on how to use rgl to plot 3 variables at the axes x, y and z and a fourth one with different colours?
thanks
You use a combination of persp and colour according to a separate function. Here's some example code:
## Create a simple surface f(x,y) = -x^2 - y^2
## Colour the surface according to x^2 only
nx = 31; ny = 31
x = seq(-1, 1, length = nx)
y = seq(-1, 1, length = ny)
z = outer(x, y, function(x,y) -x^2 -y^2)
## Fourth dim
z_col = outer(x, y, function(x,y) x^2)
## Average the values at the corner of each facet
## and scale to a value in [0, 1]. We will use this
## to select a gray for colouring the facet.
hgt = 0.25 * (z_col[-nx,-ny] + z_col[-1,-ny] + z_col[-nx,-1] + z_col[-1,-1])
hgt = (hgt - min(hgt))/ (max(hgt) - min(hgt))
## Plot the surface with the specified facet colours.
persp(x, y, z, col = gray(1 - hgt))
persp(x, y, z, col=cm.colors(32)[floor(31*hgt+1)], theta=-35, phi=10)
This gives:
RGL
It's fairly straightforward to use the above technique with the rgl library:
library(rgl)
## Generate the data using the above commands
## New window
open3d()
## clear scene:
clear3d("all")
## setup env:
bg3d(color="#887777")
light3d()
surface3d(x, y, z, color=cm.colors(32)[floor(31*hgt+1)], alpha=0.5)
There is an example in ?plot3d if you are talking about plotting points in a 3d space and colouring them:
x <- sort(rnorm(1000))
y <- rnorm(1000)
z <- rnorm(1000) + atan2(x,y)
plot3d(x, y, z, col=rainbow(1000))
But if you mean to colour the points by a 4th variable, say a grouping variable, then we can modify the example above to do this by creating a grouping variable
grp <- gl(5, 200) ## 5 groups 200 members each
## now select the colours we want
cols <- 1:5
## Now plot
plot3d(x, y, z, col=cols[grp])
OK, is this more what you want?
X <- 1:10
Y <- 1:10
## Z is now a 100 row object of X,Y combinations
Z <- expand.grid(X = X, Y = Y)
## Add in Z1, which is the 3rd variable
## X,Y,Z1 define the surface, which we colour according to
## 4th variable Z2
Z <- within(Z, {
Z1 <- 1.2 + (1.4 * X) + (-1.9 * Y)
Z2 <- 1.2 + (1.4 * X) - (1.2 * X^2) + (1.9 * Y) + (-1.3 * Y^2)
Z3 <- 1.2 + (1.4 * X) + (-1.9 * Y) + (-X^2) + (-Y^2)})
## show the data
head(Z)
## Set-up the rgl device
with(Z, plot3d(X, Y, Z1, type = "n"))
## Need a scale for Z2 to display as colours
## Here I choose 10 equally spaced colours from a palette
cols <- heat.colors(10)
## Break Z2 into 10 equal regions
cuts <- with(Z, cut(Z2, breaks = 10))
## Add in the surface, colouring by Z2
with(Z, surface3d(1:10,1:10, matrix(Z1, ncol = 10),
color = cols[cuts], back = "fill"))
with(Z, points3d(X, Y, Z1, size = 5)) ## show grid X,Y,Z1
Here's a modification where the plane surface Z1 is curved (Z3).
## Set-up the rgl device plotting Z3, a curved surface
with(Z, plot3d(X, Y, Z3, type = "n"))
with(Z, surface3d(1:10,1:10, matrix(Z3, ncol = 10),
color = cols[cuts], back = "fill"))
The detail of what I did to get Z2 probably doesn't matter, but I tried to get something like the graph you linked to.
If I've still not got what you want, can you edit your Q with some example data and give us a better idea of what you want?
HTH
Take a look at example(points3d).
The r3d help page shows you how to draw axes.
x <- c(0, 10, 0, 0)
y <- c(0, 0, 100, 0)
z <- c(0, 0, 0, 1)
i <- c(1,2,1,3,1,4)
labels <- c("Origin", "X", "Y", "Z")
text3d(x,y,z,labels)
segments3d(x[i],y[i],z[i])
Now you add some points
dfr <- data.frame(x = 1:10, y = (1:10)^2, z = runif(10), col = rainbow(10))
with(dfr, points3d(x, y, z, col = col))

Resources