Package rgl includes a very useful function ellipse3d, which can return an ellipsoid that cover like 95% percent of the points in 3D. Then this object can be used in rgl::plot3d to plot it out. My question is that is it possible to convert the output of ellipse3d to something that can be plotted through js plotting packages like plotly?
library(rgl)
dt <- cbind(x = rnorm(100), y = rnorm(100), z = rnorm(100))
ellipse <- ellipse3d(cov(dt))
plot3d(dt)
plot3d(ellipse, add = T, color = "red", alpha = 0.5)
Then what can I do to plot the ellipsoid through plotly?
You can extract the coordinates of the ellipse from the ellipse$vb. Then plot these. Something like:
p <- plot_ly() %>%
add_trace(type = 'scatter3d', size = 1,
x = ellipse$vb[1,], y = ellipse$vb[2,], z = ellipse$vb[3,],
opacity=0.01) %>%
add_trace(data=dt, type = 'scatter3d', x=~x, y=~y, z=~z)
Related
In order to plot a surface in plotly with x, y, z, we can use the function interp to create the data (as input for the add_surface function in plotly)
This article give the solution.
I follow the different steps.
With the follow code, we can plotly a surface with markers.
library(akima)
library(plotly)
x=rep(seq(-1,5,0.2),time=31,each=1)
y=rep(seq(-1,5,0.2),time=1,each=31)
df=data.frame(x=x,y=y,
z=2*x+y-1.4)
fig <- plot_ly()%>% add_markers(data=df,x = ~x, y = ~y, z = ~z,
marker = list(color = "blue",
showscale = TRUE))
fig
We can see the following plot
Then I use interp to create the data for the surface, and I plot the surface together with the markers.
s = interp(x = df$x, y = df$y, z = df$z)
fig <- plot_ly()%>%
add_surface(x = s$x, y = s$y, z = s$z)%>%
add_markers(data=df,x = ~x, y = ~y, z = ~z,
marker = list(color = "blue",
showscale = TRUE))
fig
I have the following image.
We can see that the result is different. And I can't see why.
When I try to change the function to generate z, sometimes, the two surfaces are the same. For example, for this data.frame
df=data.frame(x=x,y=y,
z=x+y+1)
We have the following image. And we can see that this time, we get the same surfaces.
It appears the meanings of x and y are swapped in the add_surface versus the meanings in interp. The example that worked had x and y appear symmetrically. So swap them back by transposing the z matrix:
fig <- plot_ly()%>%
add_surface(x = s$x, y = s$y, z = t(s$z))%>%
add_markers(data=df,x = ~x, y = ~y, z = ~z,
marker = list(color = "blue",
showscale = TRUE))
fig
This is just a guess because the documentation in plotly is so weak. akima::interp clearly documents that rows of z correspond to different x values.
Using plotly in R, how do I make a 3d plot that shows the axes, like this:
instead of a plot that shows a bounding box, like this:
?
R code for the second is
t <- seq(0,2*pi,by =1)
r <- seq(0,1,by = .1)
x <- as.vector(outer(t,r,function(t,r).5*r*cos(t)))
y <- as.vector(outer(t,r,function(t,r)r*sin(t)))
z <- 4*x^2+y^2
plot_ly(x = ~x, y = ~y, z = ~z, type = "mesh3d", opacity=.5)
I plotted a 3d scatter plot in R using the scatter3d function.
Now, I want to plot the labels on every dot in the 3d scatter, such as every point has its ID next to it i.e., "1", "2" etc..
Here is what I tried:
library("car")
library("rgl")
scatter3d(geometry[,1],geometry[,2],geometry[,3] , surface=FALSE, labels = rownames(geometry), id.n=nrow(geometry))
This tutorial says that adding arguments labels=rownames(geometry), id.n=nrow(geometry) should display the labels on every dot but that did not work.
EDIT:
I uploaded the coordinate file here, you can read it like this
geometry = read.csv("geometry.txt",sep = " ")
colnames(geometry) = c("x","y","z")
EDIT:
Actually, even the example from the tutorial does not label the points and does not produce the plot displayed. There is probably something wrong with the package.
scatter3d(x = sep.l, y = pet.l, z = sep.w,
surface=FALSE, labels = rownames(iris), id.n=nrow(iris))
I can give you a quick fix if you want to use any other function other than scatter3d. This can be achieved using plot3d and text3d function. I have provided the basic code block of how it can be implemented. You can customize it to your needs.
plot3d(geometry[,1],geometry[,2],geometry[,3])
text3d(geometry[,1],geometry[,2],geometry[,3],rownames(geometry))
points3d(geometry[,1],geometry[,2],geometry[,3], size = 5)
After much messing around I got it (I also have the method for plot_ly if you,re interested)
test2 <- cbind(dataSet[,paste(d)],set.final$Groups,test)
X <- test2[,1]
Y <- test2[,2]
Z <- test2[,3]
# 3D plot with the regression plane
scatter3d(x = X, y = Y, z = Z, groups = test2$`set.final$Groups`,
grid = FALSE, fit = "linear",ellipsoid = FALSE, surface=FALSE,
surface.col = c("green", "blue", "red"),
#showLabels(x = x, y = y, z = z, labels=test2$test, method="identify",n = nrow(test2), cex=1, col=carPalette()[1], location=c("lr"))
#labels = test2$test,
id=list(method = "mahal", n = length(test2$test), labels = test2$test)
#id.n=nrow(test2$test)
)
#identify3d(x = X, y = Y, z = Z, labels = test2$test, n = length(test2$test), plot = TRUE, adj = c(-0.1, 0.5), tolerance = 20, buttons = c("right"))
rglwidget()
Problem: I am trying to reproduce a round filled 2d contour plot in R using plotly (have tried ggplot2 also but plotly seemed to be easier).
Data: Sample data download link -
https://drive.google.com/file/d/10Mr5yWVReQckPI6TKLY_vzPT8zWiijKl/view?usp=sharing
The data to be plotted for contour is in a column format and typically called z variable, there is x and y data also available for all values of z. A simple dataframe would look like this:
Please ignore the repeat common x and y as I have truncated decimals. The data has about 25000 rows.
Approach: I first use akima package to interpolate z variable values for given x and y to map z in 2d. This makes the z column data fit in a xy grid for 2d plotting and show contours.
Expected outcome:
Code used:
dens <- akima::interp(x = dt$`Xvalue(mm)`,
y = dt$`Yvalue(mm)`,
z = dt$Values,
duplicate = "mean",
xo=seq(min(dt$`Xvalue(mm)`), max(dt$`Xvalue(mm)`), length = 10),
yo=seq(min(dt$`Yvalue(mm)`), max(dt$`Yvalue(mm)`), length = 10))
plot_ly(x = dens$x,
y = dens$y,
z = dens$z,
colors = c("blue","grey","red"),
type = "contour")
Actual outcome:
Help Needed:
To refine edges of the actual outcome plot to something of a close match to the expected outcome image.
Many thanks in advance for your comments and help.
I found that I could increase the grid output z matrix from akima::interp() from default 40x40 to custom using nx and ny input in function.
And then in plot_ly() add contours = list(coloring = 'fill', showlines = FALSE) to hide contour lines to get output close to my expected outcome.
So working code is like this:
dens <- akima::interp(x = dt$`Xvalue(mm)`,
y = dt$`Yvalue(mm)`,
z = dt$Values,
nx = 50,
ny = 50,
duplicate = "mean",
xo=seq(min(dt$`Xvalue(mm)`), max(dt$`Xvalue(mm)`), length = 50),
yo=seq(min(dt$`Yvalue(mm)`), max(dt$`Yvalue(mm)`), length = 50))
plot_ly(x = dens$x,
y = dens$y,
z = dens$z,
colors = c("blue","grey","red"),
type = "contour",
contours = list(coloring = 'fill', showlines = FALSE))
Plotly contour plot reference was very helpful in this case:
https://plot.ly/r/reference/#contour
I've found a way to plot 3D bar chart (ggplot2 3D Bar Plot). Thank you #jbaums
However, is there a way to change the bottom facet to a map? So I can clearly visualize, for example, the population density using bar chart on a map to show the differences between different parts? Thank you in advance. plotting 3D bars on top of the map
Here's one way
# Plotting 3D maps using OpenStreetMap and RGL. For info see:
# http://geotheory.co.uk/blog/2013/04/26/plotting-3d-maps-with-rgl/
map3d <- function(map, ...){
if(length(map$tiles)!=1){stop("multiple tiles not implemented") }
nx = map$tiles[[1]]$xres
ny = map$tiles[[1]]$yres
xmin = map$tiles[[1]]$bbox$p1[1]
xmax = map$tiles[[1]]$bbox$p2[1]
ymin = map$tiles[[1]]$bbox$p1[2]
ymax = map$tiles[[1]]$bbox$p2[2]
xc = seq(xmin,xmax,len=ny)
yc = seq(ymin,ymax,len=nx)
colours = matrix(map$tiles[[1]]$colorData,ny,nx)
m = matrix(0,ny,nx)
surface3d(xc,yc,m,col=colours, ...)
return(list(xc=xc, yc=yc, colours=colours))
}
require(rgl)
require(OpenStreetMap)
map <- openproj(openmap(c(52.5227,13.2974),c(52.4329,13.5669), zoom = 10))
set.seed(1)
n <- 30
bbox <- unlist(map$bbox, use.names = F)
x <- do.call(runif, c(list(n), as.list(bbox[c(1,3)])))
y <- do.call(runif, c(list(n), as.list(bbox[c(4,2)])))
z <- runif(n, 0, .1)
m <- rbind(cbind(x,y,z=0), cbind(x,y,z))
m <- m[as.vector(mapply(c, 1:n, (n+1):(2*n))),]
open3d(windowRect=c(100,100,800,600))
coords <- map3d(map, lit=F)
segments3d(m, col="red", add=T)
which gives you something like:
And another way, which you can extend to use box3D to maybe make it more look like your example:
library(plot3D)
with(coords, {
image3D(
z = 0, x = xc, y = yc, colvar = colours, zlim = c(0,max(z)),
scale=F, theta = 0, bty="n")
segments3D(x,y,rep(0,length(x)),x,y,z, col="red", add=T)
})