Plot 3D data in R - r

I have a 3D dataset:
data = data.frame(
x = rep( c(0.1, 0.2, 0.3, 0.4, 0.5), each=5),
y = rep( c(1, 2, 3, 4, 5), 5)
)
data$z = runif(
25,
min = (data$x*data$y - 0.1 * (data$x*data$y)),
max = (data$x*data$y + 0.1 * (data$x*data$y))
)
data
str(data)
And I want to plot it, but the built-in-functions of R alwyas give the error
increasing 'x' and 'y' values expected
# ### 3D Plots ######################################################
# built-in function always give the error
# "increasing 'x' and 'y' values expected"
demo(image)
image(x = data$x, y = data$y, z = data$z)
demo(persp)
persp(data$x,data$y,data$z)
contour(data$x,data$y,data$z)
When I searched on the internet, I found that this message happens when combinations of X and Y values are not unique. But here they are unique.
I tried some other libraries and there it works without problems. But I don't like the default style of the plots (the built-in functions should fulfill my expectations).
# ### 3D Scatterplot ######################################################
# Nice plots without surface maps?
install.packages("scatterplot3d", dependencies = TRUE)
library(scatterplot3d)
scatterplot3d(x = data$x, y = data$y, z = data$z)
# ### 3D Scatterplot ######################################################
# Only to play around?
install.packages("rgl", dependencies = TRUE)
library(rgl)
plot3d(x = data$x, y = data$y, z = data$z)
lines3d(x = data$x, y = data$y, z = data$z)
surface3d(x = data$x, y = data$y, z = data$z)
Why are my datasets not accepted by the built-in functions?

I use the lattice package for almost everything I plot in R and it has a corresponing plot to persp called wireframe. Let data be the way Sven defined it.
wireframe(z ~ x * y, data=data)
Or how about this (modification of fig 6.3 in Deepanyan Sarkar's book):
p <- wireframe(z ~ x * y, data=data)
npanel <- c(4, 2)
rotx <- c(-50, -80)
rotz <- seq(30, 300, length = npanel[1]+1)
update(p[rep(1, prod(npanel))], layout = npanel,
panel = function(..., screen) {
panel.wireframe(..., screen = list(z = rotz[current.column()],
x = rotx[current.row()]))
})
Update: Plotting surfaces with OpenGL
Since this post continues to draw attention I want to add the OpenGL way to make 3-d plots too (as suggested by #tucson below). First we need to reformat the dataset from xyz-tripplets to axis vectors x and y and a matrix z.
x <- 1:5/10
y <- 1:5
z <- x %o% y
z <- z + .2*z*runif(25) - .1*z
library(rgl)
persp3d(x, y, z, col="skyblue")
This image can be freely rotated and scaled using the mouse, or modified with additional commands, and when you are happy with it you save it using rgl.snapshot.
rgl.snapshot("myplot.png")

Adding to the solutions of others, I'd like to suggest using the plotly package for R, as this has worked well for me.
Below, I'm using the reformatted dataset suggested above, from xyz-tripplets to axis vectors x and y and a matrix z:
x <- 1:5/10
y <- 1:5
z <- x %o% y
z <- z + .2*z*runif(25) - .1*z
library(plotly)
plot_ly(x=x,y=y,z=z, type="surface")
The rendered surface can be rotated and scaled using the mouse. This works fairly well in RStudio.
You can also try it with the built-in volcano dataset from R:
plot_ly(z=volcano, type="surface")

If you're working with "real" data for which the grid intervals and sequence cannot be guaranteed to be increasing or unique (hopefully the (x,y,z) combinations are unique at least, even if these triples are duplicated), I would recommend the akima package for interpolating from an irregular grid to a regular one.
Using your definition of data:
library(akima)
im <- with(data,interp(x,y,z))
with(im,image(x,y,z))
And this should work not only with image but similar functions as well.
Note that the default grid to which your data is mapped to by akima::interp is defined by 40 equal intervals spanning the range of x and y values:
> formals(akima::interp)[c("xo","yo")]
$xo
seq(min(x), max(x), length = 40)
$yo
seq(min(y), max(y), length = 40)
But of course, this can be overridden by passing arguments xo and yo to akima::interp.

I think the following code is close to what you want
x <- c(0.1, 0.2, 0.3, 0.4, 0.5)
y <- c(1, 2, 3, 4, 5)
zfun <- function(a,b) {a*b * ( 0.9 + 0.2*runif(a*b) )}
z <- outer(x, y, FUN="zfun")
It gives data like this (note that x and y are both increasing)
> x
[1] 0.1 0.2 0.3 0.4 0.5
> y
[1] 1 2 3 4 5
> z
[,1] [,2] [,3] [,4] [,5]
[1,] 0.1037159 0.2123455 0.3244514 0.4106079 0.4777380
[2,] 0.2144338 0.4109414 0.5586709 0.7623481 0.9683732
[3,] 0.3138063 0.6015035 0.8308649 1.2713930 1.5498939
[4,] 0.4023375 0.8500672 1.3052275 1.4541517 1.9398106
[5,] 0.5146506 1.0295172 1.5257186 2.1753611 2.5046223
and a graph like
persp(x, y, z)

Not sure why the code above did not work for the library rgl, but the following link has a great example with the same library.
Run the code in R and you will obtain a beautiful 3d plot that you can turn around in all angles.
http://statisticsr.blogspot.de/2008/10/some-r-functions.html
########################################################################
## another example of 3d plot from my personal reserach, use rgl library
########################################################################
# 3D visualization device system
library(rgl);
data(volcano)
dim(volcano)
peak.height <- volcano;
ppm.index <- (1:nrow(volcano));
sample.index <- (1:ncol(volcano));
zlim <- range(peak.height)
zlen <- zlim[2] - zlim[1] + 1
colorlut <- terrain.colors(zlen) # height color lookup table
col <- colorlut[(peak.height-zlim[1]+1)] # assign colors to heights for each point
open3d()
ppm.index1 <- ppm.index*zlim[2]/max(ppm.index);
sample.index1 <- sample.index*zlim[2]/max(sample.index)
title.name <- paste("plot3d ", "volcano", sep = "");
surface3d(ppm.index1, sample.index1, peak.height, color=col, back="lines", main = title.name);
grid3d(c("x", "y+", "z"), n =20)
sample.name <- paste("col.", 1:ncol(volcano), sep="");
sample.label <- as.integer(seq(1, length(sample.name), length = 5));
axis3d('y+',at = sample.index1[sample.label], sample.name[sample.label], cex = 0.3);
axis3d('y',at = sample.index1[sample.label], sample.name[sample.label], cex = 0.3)
axis3d('z',pos=c(0, 0, NA))
ppm.label <- as.integer(seq(1, length(ppm.index), length = 10));
axes3d('x', at=c(ppm.index1[ppm.label], 0, 0), abs(round(ppm.index[ppm.label], 2)), cex = 0.3);
title3d(main = title.name, sub = "test", xlab = "ppm", ylab = "samples", zlab = "peak")
rgl.bringtotop();

Related

How to Draw a three-dimensional graph in R

f(x,y)= (1/25)*(20-x)/x 10<x<20, x/2 <y <x
0 o.t
I have to create this image through this expression.
but
x <- seq(10, 20, length=20)
y <- seq(10, 20, length=20)
f <- function(x,y){(1/25)*(20-x)/5}
z <- outer(x,y,f)
persp(x,y,z,theta=30,phi=30, expand=0.5,col=rainbow(19), border=NA)
what is wrong?
You should mask z based on the constraint. As a suggestion, you can use an amazing interactive rgl package in R.
#source: https://stackoverflow.com/questions/50079316/plot3d-how-to-change-z-axis-surface-color-to-heat-map-color
map2color <- function(x, pal, limits = range(x,na.rm=T)){
pal[findInterval(x, seq(limits[1], limits[2], length.out = length(pal) + 1),
all.inside=TRUE)]
}
x <- seq(10, 20, length=20)
y <- seq(10, 20, length=20)
mask <- sapply(x,function(m) sapply(y,function(n) if((n>m/2)&(n<m)){(1/25)*(20-m)/5}else{ NA }))
z <- outer(x,y,f)
z <- z * mask
#persp(x,y,z, col= map2color(z, rainbow(100)),border = NA)
library(rgl)
persp3d(x,y,z,col = map2color(z, rainbow(100)),theta=30,phi=30)
#SRhm's answer is probably the best choice, but if you want to live on the bleeding edge, you can get rid of the jagged diagonal edge using a development version of rgl (from R-forge), at least version 0.100.8.
This version supports triangulations with boundaries using the tripack package. So you set up a grid of values over the x-y range, then define the boundaries of the region using the equations, and you get smooth edges. For example:
library(tripack)
library(rgl)
g <- expand.grid(x=10:20, y=5:20)
keep <- with(g, 10 < x & x < 20 & x/2 < y & y < x)
g2 <- g[keep,]
tri <- tri.mesh(g2)
# Set up boundary constraints
cx <- c(10:20, 20: 10)
cy <- c(seq(5, 10, len=11), 20:10)
tri2 <- add.constraint(tri, cx, cy, reverse = TRUE)
# This isn't necessary, but shows where the formula will be evaluated
plot(tri2)
It might be better to fill in some of the left and right edges with more points to avoid those big triangles,
but skip that for now.
z <- with(tri2, (1/25)*(20-x)/x)
# Now plot it, using the map2color function #SRhm found:
#source: https://stackoverflow.com/questions/50079316/plot3d-how-to-change-z-axis-surface-color-to-heat-map-color
map2color <- function(x, pal, limits = range(x,na.rm=T)){
pal[findInterval(x, seq(limits[1], limits[2], length.out = length(pal) + 1),
all.inside=TRUE)]
}
persp3d(tri2, z, col = map2color(z, rainbow(100)))
After rotation, you get this view:

topoplot in ggplot2 – 2D visualisation of e.g. EEG data

Can ggplot2 be used to produce a so-called topoplot (often used in neuroscience)?
Sample data:
label x y signal
1 R3 0.64924459 0.91228430 2.0261520
2 R4 0.78789621 0.78234410 1.7880972
3 R5 0.93169511 0.72980685 0.9170998
4 R6 0.48406513 0.82383895 3.1933129
Full sample data.
Rows represent individual electrodes. Columns x and y represent the projection into 2D space and the column signal is essentially the z-axis representing voltage measured at a given electrode.
stat_contour doesn't work, apparently due to unequal grid.
geom_density_2d only provides a density estimation of x and y.
geom_raster is one not fitted for this task or I must be using it incorrectly since it quickly runs out of memory.
Smoothing (like in the image on the right) and head contours (nose, ears) aren't necessary.
I want to avoid Matlab and transforming the data so that it fits this or that toolbox… Many thanks!
Update (26 January 2016)
The closest I've been able to get to my objective is via
library(colorRamps)
ggplot(channels, aes(x, y, z = signal)) + stat_summary_2d() + scale_fill_gradientn(colours=matlab.like(20))
which produces an image like this:
Update 2 (27 January 2016)
I've tried #alexforrence's approach with full data and this is the result:
It's a great start but there is a couple of issues:
The last call (ggplot()) takes about 40 seconds on an Intel i7 4790K while Matlab toolboxes manage to generate these almost instantly; my ‘emergency solution’ above takes about a second.
As you can see, the upper and lower border of the central part appear to be ‘sliced’ – I'm not sure what causes this but it could be the third issue.
I'm getting these warnings:
1: Removed 170235 rows containing non-finite values (stat_contour).
2: Removed 170235 rows containing non-finite values (stat_contour).
Update 3 (27 January 2016)
Comparison between two plots produced with different interp(xo, yo) and stat_contour(binwidth) values:
Ragged edges if one chooses low interp(xo, yo), in this case xo/yo = seq(0, 1, length = 100):
Here's a potential start:
First, we'll attach some packages. I'm using akima to do linear interpolation, though it looks like EEGLAB uses some sort of spherical interpolation here? (the data was a little sparse to try it).
library(ggplot2)
library(akima)
library(reshape2)
Next, reading in the data:
dat <- read.table(text = " label x y signal
1 R3 0.64924459 0.91228430 2.0261520
2 R4 0.78789621 0.78234410 1.7880972
3 R5 0.93169511 0.72980685 0.9170998
4 R6 0.48406513 0.82383895 3.1933129")
We'll interpolate the data, and stick that in a data frame.
datmat <- interp(dat$x, dat$y, dat$signal,
xo = seq(0, 1, length = 1000),
yo = seq(0, 1, length = 1000))
datmat2 <- melt(datmat$z)
names(datmat2) <- c('x', 'y', 'value')
datmat2[,1:2] <- datmat2[,1:2]/1000 # scale it back
I'm going to borrow from some previous answers. The circleFun below is from Draw a circle with ggplot2.
circleFun <- function(center = c(0,0),diameter = 1, npoints = 100){
r = diameter / 2
tt <- seq(0,2*pi,length.out = npoints)
xx <- center[1] + r * cos(tt)
yy <- center[2] + r * sin(tt)
return(data.frame(x = xx, y = yy))
}
circledat <- circleFun(c(.5, .5), 1, npoints = 100) # center on [.5, .5]
# ignore anything outside the circle
datmat2$incircle <- (datmat2$x - .5)^2 + (datmat2$y - .5)^2 < .5^2 # mark
datmat2 <- datmat2[datmat2$incircle,]
And I really liked the look of the contour plot in R plot filled.contour() output in ggpplot2, so we'll borrow that one.
ggplot(datmat2, aes(x, y, z = value)) +
geom_tile(aes(fill = value)) +
stat_contour(aes(fill = ..level..), geom = 'polygon', binwidth = 0.01) +
geom_contour(colour = 'white', alpha = 0.5) +
scale_fill_distiller(palette = "Spectral", na.value = NA) +
geom_path(data = circledat, aes(x, y, z = NULL)) +
# draw the nose (haven't drawn ears yet)
geom_line(data = data.frame(x = c(0.45, 0.5, .55), y = c(1, 1.05, 1)),
aes(x, y, z = NULL)) +
# add points for the electrodes
geom_point(data = dat, aes(x, y, z = NULL, fill = NULL),
shape = 21, colour = 'black', fill = 'white', size = 2) +
theme_bw()
With improvements mentioned in the comments (setting extrap = TRUE and linear = FALSE in the interp call to fill in gaps and do a spline smoothing, respectively, and removing NAs before plotting), we get:
mgcv can do spherical splines. This replaces akima (the chunk containing interp() isn't necessary).
library(mgcv)
spl1 <- gam(signal ~ s(x, y, bs = 'sos'), data = dat)
# fine grid, coarser is faster
datmat2 <- data.frame(expand.grid(x = seq(0, 1, 0.001), y = seq(0, 1, 0.001)))
resp <- predict(spl1, datmat2, type = "response")
datmat2$value <- resp

Drawing a regression surface with an interaction in a 3D figure in R

Using car::scatter3d(), I am trying to create a 3D figure with a regression surface indicating an interaction between a categorical and a continuous variable. Partly following the code here, I obtained a figure below.
The figure is obviously wrong in that the regression surface does not reach one of the values of the categorical variable. The problem perhaps lies in the use of the rgl::persp3d() (the last block of the code below), but I have not been able to identify what exactly I'm doing wrongly. Could someone let me know what I'm missing and how to fix the problem?
library(rgl)
library(car)
n <- 100
set.seed(1)
x <- runif(n, 0, 10)
set.seed(1)
z <- sample(c(0, 1), n, replace = TRUE)
set.seed(1)
y <- 0.5 * x + 0.1 * z + 0.3 * x * z + rnorm(n, sd = 1.5)
d <- data.frame(x, z, y)
scatter3d(y ~ x + z, data = d,
xlab = "continuous", zlab = "categorical", ylab = "outcome",
residuals = FALSE, surface = FALSE
)
d2 <- d
d2$x <- d$x / (max(d$x) - min(d$x))
d2$y <- d$y / (max(d$y) - min(d$y))
mod <- lm(y ~ x * z, data = d2)
grd <- expand.grid(x = unique(d2$x), z = unique(d2$z))
grd$pred <- predict(mod, newdata = grd)
grd <- grd[order(grd$z, grd$x), ]
# The problem is likely to lie somewhere below.
persp3d(x = unique(grd$x), y = unique(grd$z),
z = matrix(grd$pred, length(unique(grd$z)), length(unique(grd$x))),
alpha = 0.5,
col = "blue",
add = TRUE,
xlab = "", ylab = "", zlab = ""
)
I prefer sticking to car::scatter3d() in drawing the original graph because I already made several figures with car::scatter3d() and want to make this figure consistent with them as well.

Using dates on axis in persp

I'm trying to plot the dates on the x-axis of a persp plot, but cannot find a way of doing so. This is where I am at:
x <- seq(-10, 10, length= 30)
x0 <- as.Date("2000-01-01")
x.dates <- seq(x0,x0+length(x)-1,1)
y <- x
f <- function(x,y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r }
z <- outer(x, y, f)
z[is.na(z)] <- 1
op <- par(bg = "white")
persp(x.dates, y, z, theta = 30, phi = 30, expand = 0.5, col = "lightblue",ticktype="detailed")
Here's a way to plot perspective with dates (by Jeff Ryan):
http://www.quantmod.com/examples/chartSeries3d/
The alpha code for the above graph is at the following url. This is a DOWNLOAD of R code, so I purposely omitted the http stuff:
www.quantmod.com/examples/chartSeries3d/chartSeries3d.alpha.R
If you look at the code, you can see how he did it.

R: Plotting a 3D surface from x, y, z

imagine I have a 3 columns matrix
x, y, z
where z is a function of x and y.
I know how to plot a "scatter plot" of these points with
plot3d(x,y,z)
But if I want a surface instead I must use other commands such as surface3d
The problem is that it doesn't accept the same inputs as plot3d
it seems to need a matrix with
(nº elements of z) = (n of elements of x) * (n of elements of x)
How can I get this matrix?
I've tried with the command interp, as I do when I need to use contour plots.
How can I plot a surface directly from x,y,z without calculating this matrix?
If I had too many points this matrix would be too big.
cheers
If your x and y coords are not on a grid then you need to interpolate your x,y,z surface onto one. You can do this with kriging using any of the geostatistics packages (geoR, gstat, others) or simpler techniques such as inverse distance weighting.
I'm guessing the 'interp' function you mention is from the akima package. Note that the output matrix is independent of the size of your input points. You could have 10000 points in your input and interpolate that onto a 10x10 grid if you wanted. By default akima::interp does it onto a 40x40 grid:
require(akima)
require(rgl)
x = runif(1000)
y = runif(1000)
z = rnorm(1000)
s = interp(x,y,z)
> dim(s$z)
[1] 40 40
surface3d(s$x,s$y,s$z)
That'll look spiky and rubbish because its random data. Hopefully your data isnt!
You can use the function outer() to generate it.
Have a look at the demo for the function persp(), which is a base graphics function to draw perspective plots for surfaces.
Here is their first example:
x <- seq(-10, 10, length.out = 50)
y <- x
rotsinc <- function(x,y) {
sinc <- function(x) { y <- sin(x)/x ; y[is.na(y)] <- 1; y }
10 * sinc( sqrt(x^2+y^2) )
}
z <- outer(x, y, rotsinc)
persp(x, y, z)
The same applies to surface3d():
require(rgl)
surface3d(x, y, z)
You could look at using Lattice. In this example I have defined a grid over which I want to plot z~x,y. It looks something like this. Note that most of the code is just building a 3D shape that I plot using the wireframe function.
The variables "b" and "s" could be x or y.
require(lattice)
# begin generating my 3D shape
b <- seq(from=0, to=20,by=0.5)
s <- seq(from=0, to=20,by=0.5)
payoff <- expand.grid(b=b,s=s)
payoff$payoff <- payoff$b - payoff$s
payoff$payoff[payoff$payoff < -1] <- -1
# end generating my 3D shape
wireframe(payoff ~ s * b, payoff, shade = TRUE, aspect = c(1, 1),
light.source = c(10,10,10), main = "Study 1",
scales = list(z.ticks=5,arrows=FALSE, col="black", font=10, tck=0.5),
screen = list(z = 40, x = -75, y = 0))
rgl is great, but takes a bit of experimentation to get the axes right.
If you have a lot of points, why not take a random sample from them, and then plot the resulting surface. You can add several surfaces all based on samples from the same data to see if the process of sampling is horribly affecting your data.
So, here is a pretty horrible function but it does what I think you want it to do (but without the sampling). Given a matrix (x, y, z) where z is the heights it will plot both the points and also a surface. Limitations are that there can only be one z for each (x,y) pair. So planes which loop back over themselves will cause problems.
The plot_points = T will plot the individual points from which the surface is made - this is useful to check that the surface and the points actually meet up. The plot_contour = T will plot a 2d contour plot below the 3d visualization. Set colour to rainbow to give pretty colours, anything else will set it to grey, but then you can alter the function to give a custom palette. This does the trick for me anyway, but I'm sure that it can be tidied up and optimized. The verbose = T prints out a lot of output which I use to debug the function as and when it breaks.
plot_rgl_model_a <- function(fdata, plot_contour = T, plot_points = T,
verbose = F, colour = "rainbow", smoother = F){
## takes a model in long form, in the format
## 1st column x
## 2nd is y,
## 3rd is z (height)
## and draws an rgl model
## includes a contour plot below and plots the points in blue
## if these are set to TRUE
# note that x has to be ascending, followed by y
if (verbose) print(head(fdata))
fdata <- fdata[order(fdata[, 1], fdata[, 2]), ]
if (verbose) print(head(fdata))
##
require(reshape2)
require(rgl)
orig_names <- colnames(fdata)
colnames(fdata) <- c("x", "y", "z")
fdata <- as.data.frame(fdata)
## work out the min and max of x,y,z
xlimits <- c(min(fdata$x, na.rm = T), max(fdata$x, na.rm = T))
ylimits <- c(min(fdata$y, na.rm = T), max(fdata$y, na.rm = T))
zlimits <- c(min(fdata$z, na.rm = T), max(fdata$z, na.rm = T))
l <- list (x = xlimits, y = ylimits, z = zlimits)
xyz <- do.call(expand.grid, l)
if (verbose) print(xyz)
x_boundaries <- xyz$x
if (verbose) print(class(xyz$x))
y_boundaries <- xyz$y
if (verbose) print(class(xyz$y))
z_boundaries <- xyz$z
if (verbose) print(class(xyz$z))
if (verbose) print(paste(x_boundaries, y_boundaries, z_boundaries, sep = ";"))
# now turn fdata into a wide format for use with the rgl.surface
fdata[, 2] <- as.character(fdata[, 2])
fdata[, 3] <- as.character(fdata[, 3])
#if (verbose) print(class(fdata[, 2]))
wide_form <- dcast(fdata, y ~ x, value_var = "z")
if (verbose) print(head(wide_form))
wide_form_values <- as.matrix(wide_form[, 2:ncol(wide_form)])
if (verbose) print(wide_form_values)
x_values <- as.numeric(colnames(wide_form[2:ncol(wide_form)]))
y_values <- as.numeric(wide_form[, 1])
if (verbose) print(x_values)
if (verbose) print(y_values)
wide_form_values <- wide_form_values[order(y_values), order(x_values)]
wide_form_values <- as.numeric(wide_form_values)
x_values <- x_values[order(x_values)]
y_values <- y_values[order(y_values)]
if (verbose) print(x_values)
if (verbose) print(y_values)
if (verbose) print(dim(wide_form_values))
if (verbose) print(length(x_values))
if (verbose) print(length(y_values))
zlim <- range(wide_form_values)
if (verbose) print(zlim)
zlen <- zlim[2] - zlim[1] + 1
if (verbose) print(zlen)
if (colour == "rainbow"){
colourut <- rainbow(zlen, alpha = 0)
if (verbose) print(colourut)
col <- colourut[ wide_form_values - zlim[1] + 1]
# if (verbose) print(col)
} else {
col <- "grey"
if (verbose) print(table(col2))
}
open3d()
plot3d(x_boundaries, y_boundaries, z_boundaries,
box = T, col = "black", xlab = orig_names[1],
ylab = orig_names[2], zlab = orig_names[3])
rgl.surface(z = x_values, ## these are all different because
x = y_values, ## of the confusing way that
y = wide_form_values, ## rgl.surface works! - y is the height!
coords = c(2,3,1),
color = col,
alpha = 1.0,
lit = F,
smooth = smoother)
if (plot_points){
# plot points in red just to be on the safe side!
points3d(fdata, col = "blue")
}
if (plot_contour){
# plot the plane underneath
flat_matrix <- wide_form_values
if (verbose) print(flat_matrix)
y_intercept <- (zlim[2] - zlim[1]) * (-2/3) # put the flat matrix 1/2 the distance below the lower height
flat_matrix[which(flat_matrix != y_intercept)] <- y_intercept
if (verbose) print(flat_matrix)
rgl.surface(z = x_values, ## these are all different because
x = y_values, ## of the confusing way that
y = flat_matrix, ## rgl.surface works! - y is the height!
coords = c(2,3,1),
color = col,
alpha = 1.0,
smooth = smoother)
}
}
The add_rgl_model does the same job without the options, but overlays a surface onto the existing 3dplot.
add_rgl_model <- function(fdata){
## takes a model in long form, in the format
## 1st column x
## 2nd is y,
## 3rd is z (height)
## and draws an rgl model
##
# note that x has to be ascending, followed by y
print(head(fdata))
fdata <- fdata[order(fdata[, 1], fdata[, 2]), ]
print(head(fdata))
##
require(reshape2)
require(rgl)
orig_names <- colnames(fdata)
#print(head(fdata))
colnames(fdata) <- c("x", "y", "z")
fdata <- as.data.frame(fdata)
## work out the min and max of x,y,z
xlimits <- c(min(fdata$x, na.rm = T), max(fdata$x, na.rm = T))
ylimits <- c(min(fdata$y, na.rm = T), max(fdata$y, na.rm = T))
zlimits <- c(min(fdata$z, na.rm = T), max(fdata$z, na.rm = T))
l <- list (x = xlimits, y = ylimits, z = zlimits)
xyz <- do.call(expand.grid, l)
#print(xyz)
x_boundaries <- xyz$x
#print(class(xyz$x))
y_boundaries <- xyz$y
#print(class(xyz$y))
z_boundaries <- xyz$z
#print(class(xyz$z))
# now turn fdata into a wide format for use with the rgl.surface
fdata[, 2] <- as.character(fdata[, 2])
fdata[, 3] <- as.character(fdata[, 3])
#print(class(fdata[, 2]))
wide_form <- dcast(fdata, y ~ x, value_var = "z")
print(head(wide_form))
wide_form_values <- as.matrix(wide_form[, 2:ncol(wide_form)])
x_values <- as.numeric(colnames(wide_form[2:ncol(wide_form)]))
y_values <- as.numeric(wide_form[, 1])
print(x_values)
print(y_values)
wide_form_values <- wide_form_values[order(y_values), order(x_values)]
x_values <- x_values[order(x_values)]
y_values <- y_values[order(y_values)]
print(x_values)
print(y_values)
print(dim(wide_form_values))
print(length(x_values))
print(length(y_values))
rgl.surface(z = x_values, ## these are all different because
x = y_values, ## of the confusing way that
y = wide_form_values, ## rgl.surface works!
coords = c(2,3,1),
alpha = .8)
# plot points in red just to be on the safe side!
points3d(fdata, col = "red")
}
So my approach would be to, try to do it with all your data (I easily plot surfaces generated from ~15k points). If that doesn't work, take several smaller samples and plot them all at once using these functions.
Maybe is late now but following Spacedman, did you try duplicate="strip" or any other option?
x=runif(1000)
y=runif(1000)
z=rnorm(1000)
s=interp(x,y,z,duplicate="strip")
surface3d(s$x,s$y,s$z,color="blue")
points3d(s)

Resources