在不使用强度的情况下将颜色条添加到 mesh3d(使用 facecolor)
plotly adding colorbar to mesh3d without using intensity (using facecolor)
我需要将颜色条放置到由多条迹线组成的 mesh3d 图上。每个 mesh3d 轨迹都有一种颜色,但我需要颜色条来跨越所有轨迹颜色。
我正在尝试将带有 visible="legendonly"
的 scatter3d 与 mesh3d 相结合,所以实现这个。但是当绘制网格时,图例被删除。
使用直升机示例:
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"
)
经过大量的黑客攻击,我终于有了一个可行的解决方案。
在这种情况下,通过绘制一个 mesh3d 区域,其中的点是 "inside" 直升机,稍后将不可见,然后绘制实际的直升机。
似乎 "visible='legendonly'" 不适用于 mesh3d,因为此选项同时删除了绘图和图例。
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"
)
我需要将颜色条放置到由多条迹线组成的 mesh3d 图上。每个 mesh3d 轨迹都有一种颜色,但我需要颜色条来跨越所有轨迹颜色。
我正在尝试将带有 visible="legendonly"
的 scatter3d 与 mesh3d 相结合,所以实现这个。但是当绘制网格时,图例被删除。
使用直升机示例:
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"
)
经过大量的黑客攻击,我终于有了一个可行的解决方案。 在这种情况下,通过绘制一个 mesh3d 区域,其中的点是 "inside" 直升机,稍后将不可见,然后绘制实际的直升机。
似乎 "visible='legendonly'" 不适用于 mesh3d,因为此选项同时删除了绘图和图例。
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"
)