COLOR OF Mesh3d objects with plotly - r

I am trying to draw ellipsoids using Mesh3d plotly. Only problem, I can't change the color. There is a lot of parameters for the colour (colorscale, colorface, colorbar, ...), is there any way to control the color of each ellipsoid ?
My code:
Color1<-c("#A6CEE3","#1F78B4","#8DA0CB","#33A02C","#FB9A99","#E31A1C","#FDBF6F","#FF7F00",
"#CAB2D6","#6A3D9A","#FFFF99","#B15928","#66C2A5","#FC8D62","B2DF8A","#E78AC3")
fig <- plot_ly(x = BD_PCA[,1], y = BD_PCA[,2], z = BD_PCA[,3])
fig <- fig %>% layout(scene = list(xaxis = list(title = 'PCA1'),
yaxis = list(title = 'PCA2'),
zaxis = list(title = 'PCA3')))
for(i in levels(data_CSV$groups)){
ellipse <- ellipse3d(cov(cbind(x = BD_PCA[data_CSV$groups==i,1],
y = BD_PCA[data_CSV$groups==i,2],
z = BD_PCA[data_CSV$groups==i,3])),
centre=c(mean(BD_PCA[data_CSV$groups==i,1]),
mean(BD_PCA[data_CSV$groups==i,2]),
mean(BD_PCA[data_CSV$groups==i,3])), level = 0.4)
fig <- fig %>% add_trace(x=ellipse$vb [1,], y=ellipse$vb [2,], z=ellipse$vb [3,],
type='mesh3d', alphahull = 0, opacity = 0.3,name=i,showlegend = T,
autocolorscale=FALSE,color=Color1[strtoi(i)]),cauto=FALSE)
}
fig <- fig %>%
add_trace(
x = BD_PCA[nrow(BD_PCA),1],y = BD_PCA[nrow(BD_PCA),2],z = BD_PCA[nrow(BD_PCA),3],
marker = list(color = 'black',symbol='square-dot',size = 5),name="Tested results",showlegend = F)
fig <- fig %>% layout(legend = list(x = 1, y = 1))
plot(fig)
Ellipses with autocolor:

The doc says that the argument color sets the color of the whole mesh, but I tried and it didn't work. You can use facecolor, but then you must provide one color for each face:
library(plotly)
library(rgl)
Sigma <- matrix(c(10, 3, 0, 3, 2, 0, 0, 0, 1), 3, 3)
Mean <- 1:3
ellipsoid <-
ellipse3d(Sigma, centre = Mean, subdivide = 5) # this is a mesh of quads
ellipsoid <- Morpho::quad2trimesh(ellipsoid) # we triangulate it
plot_ly(
x = ellipsoid$vb[1,], y = ellipsoid$vb[2,], z = ellipsoid$vb[3,],
i = ellipsoid$it[1,]-1, j = ellipsoid$it[2,]-1, k = ellipsoid$it[3,]-1,
type = "mesh3d",
facecolor = rep("#ff0000", ncol(ellipsoid$it))
) %>% layout(scene = list(aspectmode = "data"))

Work perfect with facecolor, I repeated 1000 times.
Thanks Stéphane.

Related

Adding Contour Lines to 3D Plots

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)
)
)

Change Legend Titles in R Plotly

I am using the following code to generate a 3D scatter plot with vectors in Plotly - R studio. Currently, the legend labels are displayed as "trace 1, trace 2, etc", but I'd like to change that with my own text. Any idea how to achieve this?
#Define the data from df to be plotted, basically three columns of a data frame
x = df[,1]
y = df[,2]
z = df[,3]
#Scatter and Axis Labels
p <- plot_ly() %>%
add_trace(x=x, y=y, z=z,
type="scatter3d", mode="markers",
marker = list(color=y,
colorscale = 'Viridis',
opacity = 0.02,showscale = F)) %>%
layout(title = "TITLE",
scene = list(
xaxis = list(title = "LABEL 1"),
yaxis = list(title = "LABEL 2"),
zaxis = list(title = "LABEL 3")))
#Add Vectors to the Plot
for (k in 1:nrow(df_vector)) {
x <- c(0, df_vector[k,1])
y <- c(0, df_vector[k,2])
z <- c(0, df_vector[k,3])
p <- p %>% add_trace(x=x, y=y, z=z,
type="scatter3d", mode="lines",
line = list(width=8),
opacity = 1)
}
Use the name argument to add_trace. I've mocked up some data below, but in future bear in mind that it's helpful to include easily-readable example data using (eg) dput.
library(plotly)
## Reproducible by setting RND seed
set.seed(42)
## Define the data from df to be plotted, basically three columns of a data frame
df <- data.frame(x = rnorm(100), y = rnorm(100), z = rnorm(100))
## Scatter and Axis Labels
p <- plot_ly(df) %>%
add_trace(x=~x, y=~y, z=~z,
type="scatter3d", mode="markers",
name = "markers"
# ,
# marker = list(
# colorscale = 'Viridis',
# opacity = 0.02,showscale = F)
) %>%
layout(title = "TITLE",
scene = list(
xaxis = list(title = "LABEL 1"),
yaxis = list(title = "LABEL 2"),
zaxis = list(title = "LABEL 3")))
#Add Vectors to the Plot
for (k in 1:nrow(df[1:3, ])) {
x <- c(0, df[k, 1])
y <- c(0, df[k, 2])
z <- c(0, df[k, 3])
p <- p %>% add_trace(x=x, y=y, z=z,
name = paste("my trace name", k),
type="scatter3d", mode="lines",
line = list(width=8),
opacity = 1)
}

Plotting Ellipse3d in R Plotly with surface ellipse

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"))

plotly show 3d outer box axis

I use the following code to create a a 3d scatterplot in plotly:
library(plotly)
A <- c(50,20,0)
B <- c(50,0,30)
C <- c(50,0,0)
D <- c(50,20,30)
E <- c(0,0,30)
F <- c(0,20,0)
G <- c(0,0,0)
H <- c(0,20,30)
classes <- c("A","B","C","D",
"E","F","G","H")
conceptual <- rbind(data.frame(),A,B,C,D,
E,F,G,H)
colnames(conceptual) <- c("X","Y","Z")
conceptual$labels <- classes
scene = list(camera = list(eye = list(x = 2.5, y = -1.5, z = 1.25)))
p <- plot_ly(conceptual, x = ~X, y = ~Y, z = ~Z, text = ~labels) %>%
add_markers() %>%
add_text() %>%
layout(scene=scene,showlegend = FALSE)
p
And get this plot:
plot
My question is, how can I add a line that will show the outer side of the box on the axis? something like that:
required plot
library(plotly)
A <- c(50,20,0); B <- c(50,0,30); C <- c(50,0,0); D <- c(50,20,30)
E <- c(0,0,30); F <- c(0,20,0); G <- c(0,0,0); H <- c(0,20,30)
classes <- c("A","B","C","D","E","F","G","H")
conceptual <- rbind(data.frame(),A,B,C,D,E,F,G,H)
colnames(conceptual) <- c("X","Y","Z")
conceptual$labels <- classes
l1 <- subset(conceptual, labels %in% c("E","B"))
l2 <- subset(conceptual, labels %in% c("D","B"))
l3 <- subset(conceptual, labels %in% c("C","B"))
scene = list(camera = list(eye = list(x = 2.5, y = -1.5, z = 1.25)))
p <- plot_ly(conceptual, x = ~X, y = ~Y, z = ~Z, text = ~labels) %>%
add_markers() %>%
add_text() %>%
add_trace(x=~X, y=~Y, z=~Z, data=l1,
type='scatter3d', mode='lines',
line = list(color = "black", width = 4, dash='dash')) %>%
add_trace(x=~X, y=~Y, z=~Z, data=l2,
type='scatter3d', mode='lines',
line = list(color = "black", width = 4, dash='dash')) %>%
add_trace(x=~X, y=~Y, z=~Z, data=l3,
type='scatter3d', mode='lines',
line = list(color = "black", width = 4, dash='dash')) %>%
layout(scene=scene,showlegend = FALSE)
p

Overlay vertical line on top of histogram in R using Plotly

I have an histogram like the one below and I want to plot a vertical line of a specific value on top of the histogram.
My code for the histogram is:
library(plotly)
p <- plot_ly(x = ~rnorm(50,mean = 50,sd = 10), type = "histogram")
p
I want to overlay a line on top of the histogram, for example say,
x <- 42
Can anyone help getting this?
library(plotly)
set.seed(1)
p <- plot_ly(x = ~rnorm(50,mean = 50,sd = 10), type = "histogram") %>%
add_segments(x=42, y=0, xend=42, yend=14, line=list(color="red", width = 4))
p
A different solution (see here for details):
vline <- function(x = 0, color = "red") {
list(
type = "line",
y0 = 0,
y1 = 1,
yref = "paper",
x0 = x,
x1 = x,
line = list(color = color)
)
}
p <- plot_ly(x = ~rnorm(50, mean = 50,sd = 10), type = "histogram") %>%
layout(shapes = list(vline(42)))
p

Resources