Related
I am working with the R programming language. I made the following 3 Dimensional Plot using the "plotly" library:
library(dplyr)
library(plotly)
my_function <- function(x,y) {
final_value = (1 - x)^2 + 100*((y - x^2)^2)
}
input_1 <- seq(-1.5, 1.5,0.1)
input_2 <- seq(-1.5, 1.5,0.1)
z <- outer(input_1, input_2, my_function)
plot_ly(x = input_1, y = input_2, z = z) %>% add_surface()
I am now trying to add "contour lines" to the above plot as shown below: https://plotly.com/r/3d-surface-plots/
I am trying to adapt the code from the "plotly website" to make these contours, but I am not sure how to do this:
Graph 1:
# This might have worked?
fig <- plot_ly(z = ~z) %>% add_surface(
contours = list(
z = list(
show=TRUE,
usecolormap=TRUE,
highlightcolor="#ff0000",
project=list(z=TRUE)
)
)
)
fig <- fig %>% layout(
scene = list(
camera=list(
eye = list(x=1.87, y=0.88, z=-0.64)
)
)
)
Graph 2:
# I don't think this worked?
fig <- plot_ly(
type = 'surface',
contours = list(
x = list(show = TRUE, start = 1.5, end = 2, size = 0.04, color = 'white'),
z = list(show = TRUE, start = 0.5, end = 0.8, size = 0.05)),
x = ~x,
y = ~y,
z = ~z)
fig <- fig %>% layout(
scene = list(
xaxis = list(nticks = 20),
zaxis = list(nticks = 4),
camera = list(eye = list(x = 0, y = -1, z = 0.5)),
aspectratio = list(x = .9, y = .8, z = 0.2)))
fig
Can someone please show me how to correctly adapt these above codes?
You were almost there.
The contours on z should be defined according to min-max values of z:
plot_ly(x = input_1, y = input_2, z = z,
contours = list(
z = list(show = TRUE, start = round(min(z),-2),
end = round(max(z),-2),
size = 100))) %>%
add_surface()
or automatically set by plotly :
plot_ly(x = input_1, y = input_2, z = z,
colors = 'Oranges',
contours = list(
z = list(show = TRUE))) %>%
add_surface()
The contour lines are on your plots, but may not be super visible due to the parameters in the contours.z list. Here's how you can tweak the contour lines to fit your needs:
fig <- plot_ly(z = ~z) %>% add_surface(
contours = list(
z = list(
show = TRUE,
# project=list(z=TRUE) # (don't) project contour lines to underlying plane
# usecolormap = TRUE, # (don't) use surface color scale for contours
color = "white", # set contour color
width = 1, # set contour thickness
highlightcolor = "#ff0000", # highlight contour on hover
start = 0, # include contours from z = 0...
end = 1400, # to z = 1400...
size = 100 # every 100 units
)
)
)
You can draw lines along the other dimensions by passing lists to x or y. (Per follow-up question from OP) you can change the surface color scale using colorscale, either specifying one of the named colorscale options or building your own. Example:
fig <- plot_ly(z = ~z) %>% add_surface(
colorscale = "Picnic",
contours = list(
x = list(show=TRUE, color="#a090b0", width=2, start=0, end=30, size=7.5),
y = list(show=TRUE, color="#a090b0", width=2, start=0, end=30, size=7.5),
z = list(show=TRUE, color="#a090b0", width=2, start=0, end=1400, size=300)
)
)
Using plotly and R I want to check that an ellipsoid is a good fit to the data points.
library(plotrix)
library(plotly)
library(Rvcg)
Library(rgl)
df_r_n_r = read.csv('temp.csv', header = TRUE)
fig <- plot_ly(df_r_n_r,type = "scatter3d", mode="markers", x = ~x, y = ~y, z = ~z)
fig
D <- rbind(c(459.956, -34.198, -29.844), c(-34.198, 481.647, 1.505), c(-29.844, 1.505, 559.393))
A <- D %*% t(D)
Am <- solve(A)
o <- c(73.658, 420.551, -429.058)
r <- 1
sphr <- vcgSphere()
ell <- scale3d(transform3d(sphr, chol(Am)), r, r, r)
vs <- ell$vb[1:3,] + o
idx <- ell$it - 1
e_plot <- plot_ly(type="mesh3d",
x = vs[1,], y = vs[2,], z = vs[3,],
i = idx[1,], j = idx[2,], k = idx[3,],
opacity = 0.3)
I can plot the points using fig and the ellipsoid using e_plot, but how do I put them on the same plot so I can see how closely they fit.
Using plot_ly, you can combine a number of plots using theadd_trace method. In the first instance, you can add the traces using the same parameters as you used to individually plot each item. In regard to the above question, this would produce:
plot<- plot_ly()%>%
add_trace(df_r_n_r,type = "scatter3d", mode="markers", x = ~x, y = ~y, z = ~z) %>%
add_trace(type="mesh3d",x = vs[1,], y = vs[2,], z = vs[3,], idx[1,], j = idx[2,], k = idx[3,],opacity = 0.3)
plot
Then you might want to vary the parameters in each trace to make the final plot clearer, e.g. change the opacity in the second plot.
I have a need to place a colorbar to a mesh3d plot that consists of several traces. Each mesh3d trace has a single color, but I need the colorbar to span all the trace-colors.
I am trying to combine a scatter3d with visible="legendonly" with the mesh3d, so achieve this. But when the mesh is plotted, the legend is removed.
Using the helicopter-example:
library(plotly)
library(geomorph)
plyFile <- 'http://people.sc.fsu.edu/~jburkardt/data/ply/chopper.ply'
dest <- basename(plyFile)
if (!file.exists(dest)) {
download.file(plyFile, dest)
}
mesh <- read.ply(dest, ShowSpecimen = F)
# see getS3method("shade3d", "mesh3d") for details on how to plot
# plot point cloud
x <- mesh$vb["xpts",]
y <- mesh$vb["ypts",]
z <- mesh$vb["zpts",]
m <- matrix(c(x,y,z), ncol=3, dimnames=list(NULL,c("x","y","z")))
# now figure out the colormap
zmean <- apply(t(mesh$it),MARGIN=1,function(row){mean(m[row,3])})
library(scales)
facecolor = colour_ramp(
brewer_pal(palette="RdBu")(9)
)(rescale(x=zmean))
plot_ly() %>%
# Creates the legend, and also the plotting space
add_trace(
x = x, y = y, z = z,
color = x,
colors = c("#ffffff", "#000000"),
# visible="legendonly",
type = "scatter3d",
mode="markers"
) %>%
# Adds the mesh, but removes the legend
add_trace(
x = x, y = y, z = z,
i = mesh$it[1,]-1, j = mesh$it[2,]-1, k = mesh$it[3,]-1,
facecolor = facecolor,
type = "mesh3d"
)
After a lot of hacking, I finally have a working solution.
In this case, by plotting a mesh3d area, with points that are "inside" the helicopter and will not be visible later, and then plot the actual helicopter later.
It seems that "visible='legendonly'" does not apply to mesh3d, as this option removes both the plot and legend.
library(plotly)
library(geomorph)
plyFile <- 'http://people.sc.fsu.edu/~jburkardt/data/ply/chopper.ply'
dest <- basename(plyFile)
if (!file.exists(dest)) {
download.file(plyFile, dest)
}
mesh <- read.ply(dest, ShowSpecimen = F)
# see getS3method("shade3d", "mesh3d") for details on how to plot
# plot point cloud
x <- mesh$vb["xpts",]
y <- mesh$vb["ypts",]
z <- mesh$vb["zpts",]
m <- matrix(c(x,y,z), ncol=3, dimnames=list(NULL,c("x","y","z")))
# now figure out the colormap
zmean <- apply(t(mesh$it),MARGIN=1,function(row){mean(m[row,3])})
# Get colors you want
cols = brewer_pal(palette="RdBu")(9)
# Ramp to add to facecolor
library(scales)
facecolor = colour_ramp(cols)(rescale(x=zmean))
# Create data.frame of colours and breakpoints.
# Must go from 0 to 1, plotly scales it based on values it self.
colz = data.frame(seq(0,1,length.out = length(cols)),
cols)
# Make stupid pointcloud to fool the colorbar
xx = c(min(x), max(x))
yy = c(min(y), max(y))
zz = c(min(z), max(z))
plot_ly() %>%
# Creates the legend, and also the plotting space
add_trace(
x = xx, y = yy, z = zz,
intensity = x,
colorscale = colz,
# visible="legendonly",
type = "mesh3d"
) %>%
# Adds the mesh
add_trace(
x = x, y = y, z = z,
i = mesh$it[1,]-1, j = mesh$it[2,]-1, k = mesh$it[3,]-1,
facecolor = facecolor,
showscale=FALSE,
type = "mesh3d"
)
Similar to the question here but this didn't give me excatly what I needed and I couldn't figure it out: Plot ellipse3d in R plotly?. I want to recreate rgl's ellipse3d and surface ellipsoid in plotly. I know there there was an anwer which allowed plotting of an ellipse but as individual opaque markers, I need to get it as a surface ellipsoid that's slightly opaque so I can still see the data points in the ellipsoid.
I tried to figure out how dww's comment for "add_surface" instead works but couldn't figure it out.... Can anyone help please?
if (!require("rgl")) install.packages("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)
dww's answer was:
if (!require("plotly")) install.packages("plotly")
if (!require("rgl")) install.packages("rgl")
dt <- cbind(x = rnorm(100), y = rnorm(100), z = rnorm(100))
ellipse <- ellipse3d(cov(dt))
p <- plot_ly(mode = 'markers') %>%
add_trace(type = 'scatter3d', size = 1,
x = ellipse$vb[1,], y = ellipse$vb[2,], z = ellipse$vb[3,],
opacity=0.01) %>%
add_trace(type = 'scatter3d', x = dt[,1], y = dt[,2], z = dt[,3])
p
# shows more obviously what dww's code does to create the visual ellipsoid
w <- plot_ly(mode = 'markers') %>%
add_trace(type = 'scatter3d',
x = ellipse$vb[1,], y = ellipse$vb[2,], z = ellipse$vb[3,],
opacity=0.5) %>%
add_trace(type = 'scatter3d', x = dt[,1], y = dt[,2], z = dt[,3])
w
Their comment on how to use add_surface was
Note that for simplicity, I plotted the ellipse as a cloud using markers. If you want to use add_surface instead, you will have to first convert the ellipse into a different format, with a vector of x locations, a vector of y locations, z as a matrix (dimensions equal to x by y). You'll also need to split the z values into two separate surface layers one for the top half of the ellipsoid and one for the bottom. I don't have time right now to do all this, but if you get stuck I can work this out later
This is my solution if anyone is interested in it. This allows using of the buttons in plotly to toggle the ellipsoid on and off so that you can still hover over and select data points inside the ellipsoid when desired:
if (!require("rgl")) install.packages("rgl", dependencies=TRUE, repos="http://cran.rstudio.com/")
if (!require("plotly")) install.packages("plotly", dependencies=TRUE, repos="http://cran.rstudio.com/")
dt <- cbind(x = rnorm(100), y = rnorm(100), z = rnorm(100))
ellipse <- ellipse3d(cov(dt))
updatemenus <- list(
list(
active = 0,
type= 'buttons',
buttons = list(
list(
label = "Ellipsoid",
method = "update",
args = list(list(visible = c(TRUE, TRUE)))),
list(
label = "No Ellipsoid",
method = "update",
args = list(list(visible = c(TRUE, FALSE)))))
)
)
plot<- plot_ly()%>%
# Plot raw scatter data points
add_trace(data = dt, x = dt[,1], y = dt[,2], z = dt[,3],
type = "scatter3d", mode = 'markers', marker = list(size = 3)) %>%
# Plot ellipsoid
add_trace(x=ellipse$vb [1,], y=ellipse$vb [2,], z=ellipse$vb [3,],
type='mesh3d', alphahull = 0, opacity = 0.4)%>%
# Axes Titles
layout(updatemenus = updatemenus)
plot
Here is a possibility, using the mesh3d type, and with the help of the misc3d package.
pts <- cbind(x = rnorm(10), y = rnorm(10), z = rnorm(10))
C <- chol(cov(pts))
SVD <- svd(t(C))
A <- solve(t(SVD$u)) %*% diag(SVD$d)
cr <- colMeans(pts)
r <- sqrt(qchisq(0.95,3))
fx <- function(u,v){
cr[1] + r*(A[1,1]*cos(u)*cos(v) + A[1,2]*cos(u)*sin(v) + A[1,3]*sin(u))
}
fy <- function(u,v){
cr[2] + r*(A[2,1]*cos(u)*cos(v) + A[2,2]*cos(u)*sin(v) + A[2,3]*sin(u))
}
fz <- function(u,v){
cr[3] + r*(A[3,1]*cos(u)*cos(v) + A[3,2]*cos(u)*sin(v) + A[3,3]*sin(u))
}
library(misc3d)
tris <- parametric3d(fx, fy, fz,
umin=-pi/2, umax=pi/2, vmin=0, vmax=2*pi,
n=100, engine="none")
n <- nrow(tris$v1)
cont <- matrix(NA_real_, ncol=3, nrow=3*n)
cont[3*(1:n)-2,] <- tris$v1
cont[3*(1:n)-1,] <- tris$v2
cont[3*(1:n),] <- tris$v3
idx <- matrix(0:(3*n-1), ncol=3, byrow=TRUE)
library(plotly)
p <- plot_ly() %>%
add_trace(type = "mesh3d",
x = cont[,1], y = cont[,2], z = cont[,3],
i = idx[,1], j = idx[,2], k = idx[,3],
opacity = 0.3) %>%
add_trace(type = "scatter3d", mode = "markers",
data = as.data.frame(pts),
x = ~x, y = ~y, z = ~z,
marker = list(size = 5)) %>%
layout(scene = list(aspectmode = "data"))
To add some colors:
midpoints <- (tris$v1 + tris$v2 + tris$v3)/3
distances <- apply(midpoints, 1, function(x) crossprod(x-cr))
intervals <- cut(distances, 256)
colorsPalette <- viridisLite::viridis(256)
colors <- colorsPalette[as.integer(intervals)]
p <- plot_ly() %>%
add_trace(type = "mesh3d",
x = cont[,1], y = cont[,2], z = cont[,3],
i = idx[,1], j = idx[,2], k = idx[,3],
facecolor = colors,
opacity = 0.3) %>%
add_trace(type = "scatter3d", mode = "markers",
data = as.data.frame(pts),
x = ~x, y = ~y, z = ~z,
marker = list(size = 5)) %>%
layout(scene = list(aspectmode = "data"))
Another solution with the Rvcg package. We use the vcgSphere function which generates a triangulated sphere.
sphr <- Rvcg::vcgSphere() # triangualted sphere
library(rgl) # to use scale3d and transform3d
ell <- scale3d(transform3d(sphr, A), r, r, r)
vs <- ell$vb[1:3,] + cr
idx <- ell$it - 1
p <- plot_ly() %>%
add_trace(type="mesh3d",
x = vs[1,], y = vs[2,], z = vs[3,],
i = idx[1,], j = idx[2,], k = idx[3,],
opacity = 0.3) %>%
add_trace(type = "scatter3d", mode = "markers",
data = as.data.frame(pts),
x = ~x, y = ~y, z = ~z,
marker = list(size = 5)) %>%
layout(scene = list(aspectmode = "data"))
For graphs drawn with R in the R package(Plotly), there is a limit to enlarging the graph. After zooming to a certain size, I can not zoom in anymore, but I want to zoom in. Do you have any code or arguments that circumvent these restrictions?
If you want to go to the bottom of the link, please check the limit of enlargement with the last example 'Map'.
https://plot.ly/r/trisurf/
I need help!
// additional information
The following code shows the graph and I want to zoom in on the helicopter more than the image! Is there a way?
(Zooming is done using the tools of plotly or using the mouse wheel.)
Click graph image (Maximum magnification)
library(plotly)
library(geomorph)
data <- read.csv('https://raw.githubusercontent.com/plotly/datasets/master/_3d-line-plot.csv')
plyFile <- 'http://people.sc.fsu.edu/~jburkardt/data/ply/chopper.ply'
dest <- basename(plyFile)
if (!file.exists(dest)) {
download.file(plyFile, dest)
}
mesh <- read.ply(dest)
# see getS3method("shade3d", "mesh3d") for details on how to plot
# plot point cloud
x <- mesh$vb["xpts",]
y <- mesh$vb["ypts",]
z <- mesh$vb["zpts",]
m <- matrix(c(x,y,z), ncol=3, dimnames=list(NULL,c("x","y","z")))
# now figure out the colormap
zmean <- apply(t(mesh$it),MARGIN=1,function(row){mean(m[row,3])})
library(scales)
facecolor = colour_ramp(
brewer_pal(palette="RdBu")(10)
)(rescale(x=zmean))
p <- plot_ly(data, x = ~x1, y = ~y1, z = ~z1, type = 'scatter3d', mode = 'lines',
line = list(color = '#1f77b4', width = 1)) %>%
add_trace(x = ~x2, y = ~y2, z = ~z2,
line = list(color = 'rgb(44, 160, 44)', width = 1)) %>%
add_trace(x = ~x3, y = ~y3, z = ~z3,
line = list(color = 'bcbd22', width = 1))
add_trace(p, x = x, y = y, z = z,
i = mesh$it[1,]-1, j = mesh$it[2,]-1, k = mesh$it[3,]-1,
facecolor = facecolor,
type = "mesh3d")