I have a following data:
library(rgl)
x <- c(rep(1,6),
rep(3,6),
rep(6,6),
rep(9,6),
rep(12,6))
y <- c(1.35,1.39,1.48,1.29,1.35,1.32,
NA,1.5,1.44,1.6,1.5,1.41,
NA,NA,1.72,1.56,1.6,1.55,
NA,NA,NA,1.95,1.9,1.75,
NA,NA,NA,NA,2.05,1.95)
z <- rep(1:6,5)
open3d()
plot3d(x,y,z, type = 'n')
lines3d(x,y,z)
Which is plotting lines in 3d as I expect.
But I cannot get it to plot a surface3d.
As I already read some threads I might need to interpolate my data. RGL docs has not cover this subject well. I tried akima but it doesn't accept NA's.
I would like to link lines to create a surface in linear way. I aware of the NA, so I expect that surface will be decreasing in the area for bigger x (more NA's).
Do I need to perform interpolation? If yes, how to do that on my sample data?
If no, how to achieve the surface3d on my sample data?
Thanks
the solution comes to me from this thread:
Making a wireframe plot from an x,y,z data.frame
below code will work for the sample data provided above (just switch x->y,y->z,z->x)
zmat <- matrix(data = z, nrow = 6, ncol = 5, byrow = FALSE)
surface3d(x = 1:6, y = c(1,3,6,9,12), z = zmat, alpha = 0.4, colour = 'blue')
Related
So I have this code that produces the exact surface
f = function(x, y){
z = ((x^2)+(3*y^2))*exp(-(x^2)-(y^2))
}
plot3d(f, col = colorRampPalette(c("blue", "white")),
xlab = "X", ylab = "Y", zlab = "Z",
xlim = c(-3, 3), ylim = c(-3, 3),
aspect = c(1, 1, 0.5))
Giving the following plot:
Now I have some code that does a random walk metropolis algorithm to reproduce the above image. I think it works as if I do another plot of these calculated values I get the next image with 500 points. Here is the code
open3d()
plot3d(x0, y0, f(x0, y0), type = "p")
Which gives the following plot:
I know it's hard looking at this still image but being able to rotate the sampling is working.
Now here is my question: How can I use plot3d() so that I can have a surface that connects all these points and gives a more jagged representation of the exact plot? Or how can I have each point in the z axis as a bar from the xy plane? I just want something more 3 dimensional than points and I can't find how to do this.
Thanks for your help
You can do this by triangulating the surface. You don't give us your actual data, but I can create some similar data using
f = function(x, y){
z = ((x^2)+(3*y^2))*exp(-(x^2)-(y^2))
}
x <- runif(500, -3, 3)
y <- runif(500, -3, 3)
z <- f(x, y)
Then the plotting is done using the method in ?persp3d.deldir:
library(deldir)
library(rgl)
col <- colorRampPalette(c("blue", "white"))(20)[1 + round(19*(z - min(z))/diff(range(z)))]
dxyz <- deldir::deldir(x, y, z = z, suppressMsge = TRUE)
persp3d(dxyz, col = col, front = "lines", back = "lines")
This might need some cosmetic fixes, e.g.
aspect3d(2, 2, 1)
After some rotation, this gives me the following plot:
I'm not sure to understand what you want. If my understanding is correct, here is a solution. Define a parametric representation of your surface:
fx <- function(u,v) u
fy <- function(u,v) v
fz <- function(u,v){
((u^2)+(3*v^2))*exp(-(u^2)-(v^2))
}
Let's say you have these points:
x0 <- seq(-3, 3, length.out = 20)
y0 <- seq(-3, 3, length.out = 20)
Then you can use the function parametric3d of the misc3d package, with the option fill=FALSE to get a wireframe:
library(misc3d)
parametric3d(fx, fy, fz, u=x0, v=y0,
color="blue", fill = FALSE)
Is it what you want?
To get some vertical bars, use the function segments3d of rgl:
i <- 8
bar <- rbind(c(x0[i],y0[i],0),c(x0[i],y0[i],f(x0[i],y0[i])))
segments3d(bar, color="red")
Here is a plot with only 50 points using my original code.
When I then apply what was said by Stéphane Laurent I then get this plot which feels too accurate when given the actual points I have
Perhaps you need to explain to me what is actually happening in the function parametric3d
How can I highlight the ten minimum value grid points of a 385*373 levelplot as black points?
I have the indexes as well as the coordinates of the ten minimum grid points. Preferably I would use the idexes...
I have the following levelplot displaying Europe's air temperature (Z), with X and Y being longitude and latitude respectively.
levelplot(Z ~ X*Y, data=data , xlab="X" , col.regions = heat.colors(100))
One further question: how can I add the country contours with the same projection type as the base data? I tried that before within another function
image(x,y,data,...)
data(wrdl_simpl)
plot(wrld_simpl, add = TRUE)
where the country contours plot seemed to have a totally different projection. However, I want to do this for levelplot() now.
I am very thankful for any help!
lattice plots differ to base plots. Therefore using points does not work. But there are replacement functions. Here is a way to do it:
x <- seq(-10, 10, length.out = 100)
y <- seq(-10, 10, length.out = 100)
z <- as.vector(sqrt(outer(x^2, y^2, "+")))
grid <- cbind(expand.grid(x=x, y=y), z)
minimum <- grid[which.min(grid$z),]
levelplot(z ~ x * y, grid, panel = function(...) {
panel.levelplot(...)
panel.points(x = minimum$x, y = minimum$y, pch = "x", cex =2)
})
We are basically building up the plot inside the panel argument.
I would like to use Plotly in R to create 3D modells of trenches of archaeological excavations. I'm quite successful to plot point and surface data (Example: Vignette of the R package I'm working on), but I would also like to add raster information of the georeferenced profile pictures of the trenches.
I didn't find any way to plot raster data in Plotlys 3D environment. The only solution I came up with so far (thanks to this post) was to create a 3D modell of the profile with SFM using Photoscan, export the coloured mesh as .ply file, fix the header of this file and import it into R to do the plotting with the following example code:
library(geomorph)
library(plotly)
#load data
mesh <- read.ply("plotly/expply8_corr.ply", ShowSpecimen = FALSE)
# extract vertex coordinates
x <- mesh$vb["xpts",]
y <- mesh$vb["ypts",]
z <- mesh$vb["zpts",]
# plot
plot_ly(
x = x, y = y, z = z,
i = mesh$it[1,]-1, j = mesh$it[2,]-1, k = mesh$it[3,]-1,
facecolor = c(mesh$material$color[1, ]),
type = "mesh3d"
)
You'll find the example data here.
Unfortunately this scales really badly. If you increase the mesh resolution everything becomes to slow. I would really like to just add a simple georeferenced raster to keep the performance high and avoid the necessity to create 3D modells of the profiles. Is there a workflow to achieve this with Plotly or an other plotting library?
I found a nice solution with the package rgl. Example:
library(rgl)
library(jpeg)
# download and load picture
download.file(
url = 'https://upload.wikimedia.org/wikipedia/en/6/6d/Chewbacca-2-.jpg',
destfile = "chewbacca.jpg",
mode = 'wb'
)
chewie <- readJPEG("chewbacca.jpg", native = TRUE)
# create some sample data
x <- sort(rnorm(1000))
y <- rnorm(1000)
z <- rnorm(1000) + atan2(x, y)
# plot sample data
plot3d(x, y, z, col = rainbow(1000), size = 5)
# add picture
show2d(
# plot raster
{
par(mar = rep(0, 4))
plot(
0:1, 0:1, type="n",
ann = FALSE, axes = FALSE,
xaxs = "i", yaxs = "i"
)
rasterImage(chewie, 0, 0, 1, 1)
},
# image position and extent
# coordinate order: lower left, lower right, upper right and upper left
x = c(-2, 1, 1, -2),
y = c(-1, -1, 1, 1),
z = c(-3, -3, 2, 2)
)
The pictures have to be georeferenced with other software (photogrammetry in GIS/CAD). If you have the georeferenced raster you just need the coordinates of its corner points to plot it.
I would like to generate a 3d scatterplot that includes volumes around groups of points. Something like this, but in R.
These could be rough spheroids or something more complex like in the image linked above, honestly I'm just trying to illustrate hypervolume overlap for a presentation. It seems like I could build a kernel density estimation for each set of points and plot that, but I can't figure out how to do so.
The scatterplot that I am using as a base is very similar to that generated by this code:
# Code from http://www.sthda.com/english/wiki/impressive-package-for-3d-and-4d-graph-r-software-and-data-visualization#change-the-color-by-groups
library(plot3D)
# Set up data
data(iris)
x <- sep.l <- iris$Sepal.Length
y <- pet.l <- iris$Petal.Length
z <- sep.w <- iris$Sepal.Width
# Make 3d scatterplot with colors by category
scatter3D(x, y, z, bty = "g", pch = 18,
col.var = as.integer(iris$Species),
col = c("#1B9E77", "#D95F02", "#7570B3"),
pch = 18, ticktype = "detailed",
colkey = list(at = c(2, 3, 4), side = 1,
addlines = TRUE, length = 0.5, width = 0.5,
labels = c("setosa", "versicolor", "virginica")) )
Bonus: If you can tell me how to edit the hypervolume() package so that plotting a hypervolume object works properly you would have my undying gratitude. See here for better description of the problems.
I want to plot a matrix of z values with x rows and y columns as a surface similar to this graph from MATLAB.
Surface plot:
Code to generate matrix:
# Parameters
shape<-1.849241
scale<-38.87986
x<-seq(from = -241.440, to = 241.440, by = 0.240)# 2013 length
y<-seq(from = -241.440, to = 241.440, by = 0.240)
matrix_fun<-matrix(data = 0, nrow = length(x), ncol = length(y))
# Generate two dimensional travel distance probability density function
for (i in 1:length(x)) {
for (j in 1:length(y)){
dxy<-sqrt(x[i]^2+y[j]^2)
prob<-1/(scale^(shape)*gamma(shape))*dxy^(shape-1)*exp(-(dxy/scale))
matrix_fun[i,j]<-prob
}}
# Rescale 2-d pdf to sum to 1
a<-sum(matrix_fun)
matrix_scale<-matrix_fun/a
I am able to generate surface plots using a couple methods (persp(), persp3d(), surface3d()) but the colors aren't displaying the z values (the probabilities held within the matrix). The z values only seem to display as heights not as differentiated colors as in the MATLAB figure.
Example of graph code and graphs:
library(rgl)
persp3d(x=x, y=y, z=matrix_scale, color=rainbow(25, start=min(matrix_scale), end=max(matrix_scale)))
surface3d(x=x, y=y, z=matrix_scale, color=rainbow(25, start=min(matrix_scale), end=max(matrix_scale)))
persp(x=x, y=y, z=matrix_scale, theta=30, phi=30, col=rainbow(25, start=min(matrix_scale), end=max(matrix_scale)), border=NA)
Image of the last graph
Any other tips to recreate the image in R would be most appreciated (i.e. legend bar, axis tick marks, etc.)
So here's a ggplot solution which seems to come a little bit closer to the MATLAB plot
# Parameters
shape<-1.849241
scale<-38.87986
x<-seq(from = -241.440, to = 241.440, by = 2.40)
y<-seq(from = -241.440, to = 241.440, by = 2.40)
df <- expand.grid(x=x,y=y)
df$dxy <- with(df,sqrt(x^2+y^2))
df$prob <- dgamma(df$dxy,shape=shape,scale=scale)
df$prob <- df$prob/sum(df$prob)
library(ggplot2)
library(colorRamps) # for matlab.like(...)
library(scales) # for labels=scientific
ggplot(df, aes(x,y))+
geom_tile(aes(fill=prob))+
scale_fill_gradientn(colours=matlab.like(10), labels=scientific)
BTW: You can generate your data frame of probabilities much more efficiently using the built-in dgamma(...) function, rather than calculating it yourself.
In line with alexis_laz's comment, here is an example using filled.contour. You might want to increase your by to 2.40 since the finer granularity increases the time it takes to generate the plot by a lot but doesn't improve quality.
filled.contour(x = x, y = y, z = matrix_scale, color = terrain.colors)
# terrain.colors is in the base grDevices package
If you want something closer to your color scheme above, you can fiddle with the rainbow function:
filled.contour(x = x, y = y, z = matrix_scale,
color = (function(n, ...) rep(rev(rainbow(n/2, ...)[1:9]), each = 3)))
Finer granularity:
filled.contour(x = x, y = y, z = matrix_scale, nlevels = 150,
color = (function(n, ...)
rev(rep(rainbow(50, start = 0, end = 0.75, ...), each = 3))[5:150]))