是否有更有效的方法在R中绘制3D箭头?

发布于 2025-02-09 12:42:36 字数 2171 浏览 2 评论 0原文

我在R中进行了ShinyApp的工作,只要选择相应的复选框,我想在RGLWidgetOutput中绘制数百个箭头。但是,每当我选择复选框时,我的屏幕都会冻结几秒钟,现在我想知道是否有更有效的绘制箭头的方法。

这是一个最小示例(在闪亮之外):

library(rgl)

mat0 = matrix(rep(1:10,3), ncol = 3) # 1:n to adjust number of points
mat1 = cbind(mat0[,1]*cos(seq(0,2*pi,length = 10)) - mat0[,2] * sin(seq(0,2*pi,length = 10)),
             mat0[,1]*sin(seq(0,2*pi,length = 10)) + mat0[,2] * cos(seq(0,2*pi,length = 10)),
             mat0[,3])
mat1 = mat1 + 0.5
open3d()
plot3d(mat0[2:9,], aspect = FALSE, axes = FALSE, xlab = "", ylab ="", zlab = "", col = 1)
plot3d(mat1[2:9,], add = TRUE, col = 2)

for(i in 2:9) arrow3d(mat0[i,], mat1[i,], type = "rotation")

所有点都可以在单个表达式中绘制(例如plot3d(mat0 [2:9,]),但是要绘制箭头,需要一个循环。有没有一种方法可以在单个表达式中同时绘制所有箭头?我还从matlib库中查看了vectors3d功能从我的Shiny应用程序中的服务器功能效率低下

library(shiny)
library(rgl)

# Define UI for application 
ui <- fluidPage(
    
    # Application title
    titlePanel("Test"),
    
    # Sidebar with checkbox
    sidebarLayout(
        sidebarPanel(
                     checkboxInput("cb", "Show Arrows", value = FALSE),
        ),
        
        # Show plot
        mainPanel(
            rglwidgetOutput(outputId = "threeDPlot", width = "1200px", height = "800px")
        )
    )
)

# Define server logic
server <- function(input, output) {
    
    #create 3D Plot
    output$threeDPlot = renderRglwidget({

        rgl.open(useNULL=TRUE)
        rgl.bg(color="white")
        plot3d(mat0[2:9,], aspect = FALSE, axes = FALSE, xlab = "", ylab = "", zlab = "", col = 1)
        plot3d(mat1[2:9,], add = TRUE, col = 2)

        if(input$cb == TRUE){
            for(i in 2:9) arrow3d(mat0[i,], mat1[i,], type = "rotation")
        }
        rglwidget()
    })
}

#global variables - read only once
mat0 = matrix(rep(1:10,3), ncol = 3)
mat1 = cbind(mat0[,1]*cos(seq(0,2*pi,length = 10)) - mat0[,2] * sin(seq(0,2*pi,length = 10)),
             mat0[,1]*sin(seq(0,2*pi,length = 10)) + mat0[,2] * cos(seq(0,2*pi,length = 10)),
             mat0[,3])
mat1 = mat1 + 0.5

# Run the application 
shinyApp(ui = ui, server = server)

I'm working on a ShinyApp in R where I want to draw hundreds of arrows displayed in an rglwidgetOutput whenever the respective checkbox is selected. However, my screen is freezing for a couple of seconds whenever I select the checkbox and now I'm wondering if there is a more efficient way to draw the arrows.

Here is a minimal example (outside of Shiny):

library(rgl)

mat0 = matrix(rep(1:10,3), ncol = 3) # 1:n to adjust number of points
mat1 = cbind(mat0[,1]*cos(seq(0,2*pi,length = 10)) - mat0[,2] * sin(seq(0,2*pi,length = 10)),
             mat0[,1]*sin(seq(0,2*pi,length = 10)) + mat0[,2] * cos(seq(0,2*pi,length = 10)),
             mat0[,3])
mat1 = mat1 + 0.5
open3d()
plot3d(mat0[2:9,], aspect = FALSE, axes = FALSE, xlab = "", ylab ="", zlab = "", col = 1)
plot3d(mat1[2:9,], add = TRUE, col = 2)

for(i in 2:9) arrow3d(mat0[i,], mat1[i,], type = "rotation")

All points can be drawn in a single expression (e.g. plot3d(mat0[2:9,]), however to draw the arrows a loop is required. Is there a way to draw all arrows at the same time within a single expression? The arrows have different lengths, orientation and points of origin. Therefore I believe I cannot use the spriteOrigin argument or do I misunderstand this? I have also looked into the vectors3d function from the matlib library but it seems a single point of origin is required. I'm also not sure if the perfomance issue maybe comes from an inefficient design of the server function within my shiny application. A more elaborate example:

library(shiny)
library(rgl)

# Define UI for application 
ui <- fluidPage(
    
    # Application title
    titlePanel("Test"),
    
    # Sidebar with checkbox
    sidebarLayout(
        sidebarPanel(
                     checkboxInput("cb", "Show Arrows", value = FALSE),
        ),
        
        # Show plot
        mainPanel(
            rglwidgetOutput(outputId = "threeDPlot", width = "1200px", height = "800px")
        )
    )
)

# Define server logic
server <- function(input, output) {
    
    #create 3D Plot
    output$threeDPlot = renderRglwidget({

        rgl.open(useNULL=TRUE)
        rgl.bg(color="white")
        plot3d(mat0[2:9,], aspect = FALSE, axes = FALSE, xlab = "", ylab = "", zlab = "", col = 1)
        plot3d(mat1[2:9,], add = TRUE, col = 2)

        if(input$cb == TRUE){
            for(i in 2:9) arrow3d(mat0[i,], mat1[i,], type = "rotation")
        }
        rglwidget()
    })
}

#global variables - read only once
mat0 = matrix(rep(1:10,3), ncol = 3)
mat1 = cbind(mat0[,1]*cos(seq(0,2*pi,length = 10)) - mat0[,2] * sin(seq(0,2*pi,length = 10)),
             mat0[,1]*sin(seq(0,2*pi,length = 10)) + mat0[,2] * cos(seq(0,2*pi,length = 10)),
             mat0[,3])
mat1 = mat1 + 0.5

# Run the application 
shinyApp(ui = ui, server = server)

Note: in these examples only 8 arrows are drawn. With ~ 500 arrows the app is freezing for a while, though.

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(3

番薯 2025-02-16 12:42:36

这是使用库的替代方法( data.table ):

library(plotly)
library(data.table)

# Example Data

# P0 data: origin of arrows
DT0 <- setnames(data.table(replicate(4, 1:10)), new = c("x", "y", "z", "sep"))
DT1 <- copy(DT0)
DT1[, c("x", "y", "z") := .(x * cos(seq(0, 2 * pi, length = 10)) - y * sin(seq(0, 2 * pi, length = 10)),
                            x * sin(seq(0, 2 * pi, length = 10)) + y * cos(seq(0, 2 * pi, length = 10)),
                            z)]

DT1[,1:3] <- DT1[,1:3] + 0.5

# Artifical Separator
DTsep <- copy(DT0)
DTsep[,1:3] <- NA

# Each set of points from P0 and P1 is separated by a row of NA coordinates
DT <- rbindlist(list(var_1 = DT0, var_2 = DT1, var_3 = DTsep), idcol = "id")
setorder(DT, sep, id)

# Direction of Arrows 
dirDT <- copy(DT1[,1:3])
dirDT <- dirDT - DT0[,1:3] # direction vector
dirDT <- dirDT / sqrt(rowSums(dirDT ^ 2)) # unit vector for evenly sized cones
setnames(dirDT, new = c("u", "v", "w"))
dirDT <- cbind(dirDT, DT1)

# Add P0 and P1
fig <- plot_ly(
  data = DT,
  type = "scatter3d",
  mode = "markers",
  x = ~ x,
  y = ~ y,
  z = ~ z,
  size = 1,
  marker = list(color = "#000000", line = list(color = "#000000")),
  showlegend = FALSE
)

# Add Lines from P0 to P1
fig <- add_trace(
  fig,
  data = DT,
  type = "scatter3d",
  mode = "lines",
  x = ~ x,
  y = ~ y,
  z = ~ z,
  inherit = FALSE,
  showlegend = FALSE,
  line = list(color = "black")
)

# Add Cones
fig <- add_trace(
  fig,
  data = dirDT,
  type = "cone",
  x = ~ x,
  y = ~ y,
  z = ~ z,
  u = ~ u,
  v = ~ v,
  w = ~ w,
  inherit = FALSE,
  showscale = FALSE,
  colorscale = list(list(0, "black"), list(1, "black"))
)

# Remove grid and axes
ax <- list(
  title = "",
  zeroline = FALSE,
  showline = FALSE,
  showticklabels = FALSE,
  showgrid = FALSE
)

# Update Layout
fig <- layout(
  fig,
  showlegend = FALSE,
  scene = list(
    aspectmode = "data",
    #equal aspect ratio
    xaxis = ax,
    yaxis = ax,
    zaxis = ax,
    camera = list(eye = list(
      x = -0.76, y = 1.8, z = 0.92
    ))
  )
)

fig


//i.sstatic.net/nvyhq.png“ rel =“ nofollow noreferrer >一个没有标记的版本:

library(plotly)
library(data.table)

# Example Data

# P0 data: origin of arrows
DT0 <- setnames(data.table(replicate(4, 1:10)), new = c("x", "y", "z", "sep"))
DT1 <- copy(DT0)
DT1[, c("x", "y", "z") := .(x * cos(seq(0, 2 * pi, length = 10)) - y * sin(seq(0, 2 * pi, length = 10)),
                            x * sin(seq(0, 2 * pi, length = 10)) + y * cos(seq(0, 2 * pi, length = 10)),
                            z)]

DT1[,1:3] <- DT1[,1:3] + 0.5

# Artifical Separator
DTsep <- copy(DT0)
DTsep[,1:3] <- NA

# Each set of points from P0 and P1 is separated by a row of NA coordinates
DT <- rbindlist(list(var_1 = DT0, var_2 = DT1, var_3 = DTsep), idcol = "id")
setorder(DT, sep, id)

# Direction of Arrows 
dirDT <- copy(DT1[,1:3])
dirDT <- dirDT - DT0[,1:3] # direction vector
dirDT <- dirDT / sqrt(rowSums(dirDT ^ 2)) # unit vector for evenly sized cones
setnames(dirDT, new = c("u", "v", "w"))
dirDT <- cbind(dirDT, DT1)

# # Add P0 and P1
# fig <- plot_ly(
#   data = DT,
#   type = "scatter3d",
#   mode = "markers",
#   x = ~ x,
#   y = ~ y,
#   z = ~ z,
#   size = 1,
#   marker = list(color = "#000000", line = list(color = "#000000")),
#   showlegend = FALSE
# )

# Add Lines from P0 to P1
fig <- plot_ly(
  # fig,
  data = DT,
  type = "scatter3d",
  mode = "lines",
  x = ~ x,
  y = ~ y,
  z = ~ z,
  # inherit = FALSE,
  showlegend = FALSE,
  line = list(color = "black")
)

# Add Cones
fig <- add_trace(
  fig,
  data = dirDT,
  type = "cone",
  x = ~ x,
  y = ~ y,
  z = ~ z,
  u = ~ u,
  v = ~ v,
  w = ~ w,
  inherit = FALSE,
  showscale = FALSE,
  colorscale = list(list(0, "black"), list(1, "black"))
)

# Remove grid and axes
ax <- list(
  title = "",
  zeroline = FALSE,
  showline = FALSE,
  showticklabels = FALSE,
  showgrid = FALSE
)

# Update Layout
fig <- layout(
  fig,
  showlegend = FALSE,
  scene = list(
    aspectmode = "data",
    #equal aspect ratio
    xaxis = ax,
    yaxis = ax,
    zaxis = ax,
    camera = list(eye = list(
      x = -0.76, y = 1.8, z = 0.92
    ))
  )
)

fig

“

Here is an alternative approach using library(data.table):

library(plotly)
library(data.table)

# Example Data

# P0 data: origin of arrows
DT0 <- setnames(data.table(replicate(4, 1:10)), new = c("x", "y", "z", "sep"))
DT1 <- copy(DT0)
DT1[, c("x", "y", "z") := .(x * cos(seq(0, 2 * pi, length = 10)) - y * sin(seq(0, 2 * pi, length = 10)),
                            x * sin(seq(0, 2 * pi, length = 10)) + y * cos(seq(0, 2 * pi, length = 10)),
                            z)]

DT1[,1:3] <- DT1[,1:3] + 0.5

# Artifical Separator
DTsep <- copy(DT0)
DTsep[,1:3] <- NA

# Each set of points from P0 and P1 is separated by a row of NA coordinates
DT <- rbindlist(list(var_1 = DT0, var_2 = DT1, var_3 = DTsep), idcol = "id")
setorder(DT, sep, id)

# Direction of Arrows 
dirDT <- copy(DT1[,1:3])
dirDT <- dirDT - DT0[,1:3] # direction vector
dirDT <- dirDT / sqrt(rowSums(dirDT ^ 2)) # unit vector for evenly sized cones
setnames(dirDT, new = c("u", "v", "w"))
dirDT <- cbind(dirDT, DT1)

# Add P0 and P1
fig <- plot_ly(
  data = DT,
  type = "scatter3d",
  mode = "markers",
  x = ~ x,
  y = ~ y,
  z = ~ z,
  size = 1,
  marker = list(color = "#000000", line = list(color = "#000000")),
  showlegend = FALSE
)

# Add Lines from P0 to P1
fig <- add_trace(
  fig,
  data = DT,
  type = "scatter3d",
  mode = "lines",
  x = ~ x,
  y = ~ y,
  z = ~ z,
  inherit = FALSE,
  showlegend = FALSE,
  line = list(color = "black")
)

# Add Cones
fig <- add_trace(
  fig,
  data = dirDT,
  type = "cone",
  x = ~ x,
  y = ~ y,
  z = ~ z,
  u = ~ u,
  v = ~ v,
  w = ~ w,
  inherit = FALSE,
  showscale = FALSE,
  colorscale = list(list(0, "black"), list(1, "black"))
)

# Remove grid and axes
ax <- list(
  title = "",
  zeroline = FALSE,
  showline = FALSE,
  showticklabels = FALSE,
  showgrid = FALSE
)

# Update Layout
fig <- layout(
  fig,
  showlegend = FALSE,
  scene = list(
    aspectmode = "data",
    #equal aspect ratio
    xaxis = ax,
    yaxis = ax,
    zaxis = ax,
    camera = list(eye = list(
      x = -0.76, y = 1.8, z = 0.92
    ))
  )
)

fig

result


A version without markers:

library(plotly)
library(data.table)

# Example Data

# P0 data: origin of arrows
DT0 <- setnames(data.table(replicate(4, 1:10)), new = c("x", "y", "z", "sep"))
DT1 <- copy(DT0)
DT1[, c("x", "y", "z") := .(x * cos(seq(0, 2 * pi, length = 10)) - y * sin(seq(0, 2 * pi, length = 10)),
                            x * sin(seq(0, 2 * pi, length = 10)) + y * cos(seq(0, 2 * pi, length = 10)),
                            z)]

DT1[,1:3] <- DT1[,1:3] + 0.5

# Artifical Separator
DTsep <- copy(DT0)
DTsep[,1:3] <- NA

# Each set of points from P0 and P1 is separated by a row of NA coordinates
DT <- rbindlist(list(var_1 = DT0, var_2 = DT1, var_3 = DTsep), idcol = "id")
setorder(DT, sep, id)

# Direction of Arrows 
dirDT <- copy(DT1[,1:3])
dirDT <- dirDT - DT0[,1:3] # direction vector
dirDT <- dirDT / sqrt(rowSums(dirDT ^ 2)) # unit vector for evenly sized cones
setnames(dirDT, new = c("u", "v", "w"))
dirDT <- cbind(dirDT, DT1)

# # Add P0 and P1
# fig <- plot_ly(
#   data = DT,
#   type = "scatter3d",
#   mode = "markers",
#   x = ~ x,
#   y = ~ y,
#   z = ~ z,
#   size = 1,
#   marker = list(color = "#000000", line = list(color = "#000000")),
#   showlegend = FALSE
# )

# Add Lines from P0 to P1
fig <- plot_ly(
  # fig,
  data = DT,
  type = "scatter3d",
  mode = "lines",
  x = ~ x,
  y = ~ y,
  z = ~ z,
  # inherit = FALSE,
  showlegend = FALSE,
  line = list(color = "black")
)

# Add Cones
fig <- add_trace(
  fig,
  data = dirDT,
  type = "cone",
  x = ~ x,
  y = ~ y,
  z = ~ z,
  u = ~ u,
  v = ~ v,
  w = ~ w,
  inherit = FALSE,
  showscale = FALSE,
  colorscale = list(list(0, "black"), list(1, "black"))
)

# Remove grid and axes
ax <- list(
  title = "",
  zeroline = FALSE,
  showline = FALSE,
  showticklabels = FALSE,
  showgrid = FALSE
)

# Update Layout
fig <- layout(
  fig,
  showlegend = FALSE,
  scene = list(
    aspectmode = "data",
    #equal aspect ratio
    xaxis = ax,
    yaxis = ax,
    zaxis = ax,
    camera = list(eye = list(
      x = -0.76, y = 1.8, z = 0.92
    ))
  )
)

fig

result

意犹 2025-02-16 12:42:36

RGL解决方案:
现在,我使用了一些基本的几何形状来计算箭头,仅基于线段:

library(rgl)

#example data
p0 = matrix(rep(1:10,3), ncol = 3)
p1 = cbind(p0[,1]*cos(seq(0,2*pi,length = 10)) - p0[,2] * sin(seq(0,2*pi,length = 10)),
             p0[,1]*sin(seq(0,2*pi,length = 10)) + p0[,2] * cos(seq(0,2*pi,length = 10)),
             p0[,3])
p1 = p1 + 0.5

pu = p1 - p0 #direction vector
pu = pu / sqrt(rowSums(pu^2)) #make it a unit vector
pu = pu / 2 # scaling: division by 2 for shorter arrows

#a vector that is perpendicular to the unit vector
#based on: https://math.stackexchange.com/questions/137362/how-to-find-perpendicular-vector-to-another-vector (Ken Whatmough)
ppu = cbind(pu[,3] * sign(sign(pu[,1]) + 0.5),
            pu[,3] * sign(sign(pu[,2]) + 0.5),
            -((abs(pu[,1])+abs(pu[,2])) * sign(sign(pu[,3]) + 0.5))) 

tp1 = p1 - pu - ppu #triangle points 1
tp2 = p1 - pu + ppu #triangle points 2 (opposite direction)

#draw points
open3d()
plot3d(p0, aspect = FALSE, axes = FALSE, xlab = "", ylab ="", zlab = "", col = 4)
plot3d(p1, add = TRUE, col = 2)

#draw arrows
segments3d(x = c(t(cbind(p0[,1],p1[,1]))), y = c(t(cbind(p0[,2],p1[,2]))), z = c(t(cbind(p0[,3],p1[,3]))), lwd = 2)
segments3d(x = c(t(cbind(p1[,1], tp1[,1]))), y = c(t(cbind(p1[,2], tp1[,2]))), z = c(t(cbind(p1[,3], tp1[,3]))), lwd = 2)
segments3d(x = c(t(cbind(p1[,1], tp2[,1]))), y = c(t(cbind(p1[,2], tp2[,2]))), z = c(t(cbind(p1[,3], tp2[,3]))), lwd = 2)

”在此处输入图像说明“

此代码已经运行得更快,尽管箭头看起来不那么漂亮。也许它仍然对别人有帮助。

我将这个问题打开了一段时间,以防有更多优雅的答案。

Rgl solution:
For now I've used some basic geometry to calculate the arrows based solely on line segments:

library(rgl)

#example data
p0 = matrix(rep(1:10,3), ncol = 3)
p1 = cbind(p0[,1]*cos(seq(0,2*pi,length = 10)) - p0[,2] * sin(seq(0,2*pi,length = 10)),
             p0[,1]*sin(seq(0,2*pi,length = 10)) + p0[,2] * cos(seq(0,2*pi,length = 10)),
             p0[,3])
p1 = p1 + 0.5

pu = p1 - p0 #direction vector
pu = pu / sqrt(rowSums(pu^2)) #make it a unit vector
pu = pu / 2 # scaling: division by 2 for shorter arrows

#a vector that is perpendicular to the unit vector
#based on: https://math.stackexchange.com/questions/137362/how-to-find-perpendicular-vector-to-another-vector (Ken Whatmough)
ppu = cbind(pu[,3] * sign(sign(pu[,1]) + 0.5),
            pu[,3] * sign(sign(pu[,2]) + 0.5),
            -((abs(pu[,1])+abs(pu[,2])) * sign(sign(pu[,3]) + 0.5))) 

tp1 = p1 - pu - ppu #triangle points 1
tp2 = p1 - pu + ppu #triangle points 2 (opposite direction)

#draw points
open3d()
plot3d(p0, aspect = FALSE, axes = FALSE, xlab = "", ylab ="", zlab = "", col = 4)
plot3d(p1, add = TRUE, col = 2)

#draw arrows
segments3d(x = c(t(cbind(p0[,1],p1[,1]))), y = c(t(cbind(p0[,2],p1[,2]))), z = c(t(cbind(p0[,3],p1[,3]))), lwd = 2)
segments3d(x = c(t(cbind(p1[,1], tp1[,1]))), y = c(t(cbind(p1[,2], tp1[,2]))), z = c(t(cbind(p1[,3], tp1[,3]))), lwd = 2)
segments3d(x = c(t(cbind(p1[,1], tp2[,1]))), y = c(t(cbind(p1[,2], tp2[,2]))), z = c(t(cbind(p1[,3], tp2[,3]))), lwd = 2)

enter image description here

This code is already running much faster, although the arrows do not look as beautiful. Maybe it still helps someone else.

I'm leaving this question open for a while in case there will be some more elegant answers.

高跟鞋的旋律 2025-02-16 12:42:36

这是一个情节解决方案:

library(plotly)

# Example data
mat0 = matrix(rep(1:10,3), ncol = 3) # 1:n to adjust number of points
mat1 = cbind(mat0[,1]*cos(seq(0,2*pi,length = 10)) - mat0[,2] * sin(seq(0,2*pi,length = 10)),
             mat0[,1]*sin(seq(0,2*pi,length = 10)) + mat0[,2] * cos(seq(0,2*pi,length = 10)),
             mat0[,3])
mat1 = mat1 + 0.5

dir = mat1 - mat0 #direction vector
dir = dir / sqrt(rowSums(dir^2)) #unit vector

fig = plotly_empty()
#Add P0
fig = fig %>%
  add_markers(type = "scatter3d", mode = "markers", size = 1,
              x = mat0[,1], y = mat0[,2], z = mat0[,3],
              color = rep(1, length(mat0[,1])) ,colors = c("#000000", "#ff0000"))
#Add P1
fig = fig %>%
  add_markers(type = "scatter3d", mode = "markers", size = 1,
              x = mat1[,1], y = mat1[,2], z = mat1[,3],
              color = rep(2, length(mat1[,1])) ,colors = c("#000000", "#ff0000"))
#Add Lines from P0 to P1
fig = fig %>%
  add_trace(type = "scatter3d", mode = "lines", split = rep(1:length(mat0[,1]), each = 2),
            x = c(rbind(mat0[,1],mat1[,1])), y = c(rbind(mat0[,2],mat1[,2])), z = c(rbind(mat0[,3],mat1[,3])),
            color = rep(1, length(mat0[,1])*2), colors = c("#000000", "#ff0000"))
#Add Cones
fig = fig %>%
  add_trace(type = "cone",
            x = mat1[,1], y = mat1[,2], z = mat1[,3],
            u = dir[,1], v = dir[,2], w = dir[,3],
            color = rep(1, length(mat1[,1])), colors = c("#000000"),
            showscale = FALSE)

#ensure that no lines and numbers for axes are shown
ax <- list(
  title = "",
  zeroline = FALSE,
  showline = FALSE,
  showticklabels = FALSE,
  showgrid = FALSE
)
#Update Layout
fig = fig %>%
  layout(
    showlegend = FALSE,
    scene = list(
      aspectmode = "data", #equal aspect ratio
      xaxis = ax,
      yaxis = ax,
      zaxis = ax,
      camera = list(
        eye = list(x= -0.76, y= 1.8, z= 0.92)
      )
    )
  )

#Show plot
fig

出于某种原因,第一个和最后一个锥体的颜色错误(找到解决方案时我会更新)。另外,添加锥体工作非常快。但是,现在添加从P0到P1的线非常慢。

Here is a plotly solution:

library(plotly)

# Example data
mat0 = matrix(rep(1:10,3), ncol = 3) # 1:n to adjust number of points
mat1 = cbind(mat0[,1]*cos(seq(0,2*pi,length = 10)) - mat0[,2] * sin(seq(0,2*pi,length = 10)),
             mat0[,1]*sin(seq(0,2*pi,length = 10)) + mat0[,2] * cos(seq(0,2*pi,length = 10)),
             mat0[,3])
mat1 = mat1 + 0.5

dir = mat1 - mat0 #direction vector
dir = dir / sqrt(rowSums(dir^2)) #unit vector

fig = plotly_empty()
#Add P0
fig = fig %>%
  add_markers(type = "scatter3d", mode = "markers", size = 1,
              x = mat0[,1], y = mat0[,2], z = mat0[,3],
              color = rep(1, length(mat0[,1])) ,colors = c("#000000", "#ff0000"))
#Add P1
fig = fig %>%
  add_markers(type = "scatter3d", mode = "markers", size = 1,
              x = mat1[,1], y = mat1[,2], z = mat1[,3],
              color = rep(2, length(mat1[,1])) ,colors = c("#000000", "#ff0000"))
#Add Lines from P0 to P1
fig = fig %>%
  add_trace(type = "scatter3d", mode = "lines", split = rep(1:length(mat0[,1]), each = 2),
            x = c(rbind(mat0[,1],mat1[,1])), y = c(rbind(mat0[,2],mat1[,2])), z = c(rbind(mat0[,3],mat1[,3])),
            color = rep(1, length(mat0[,1])*2), colors = c("#000000", "#ff0000"))
#Add Cones
fig = fig %>%
  add_trace(type = "cone",
            x = mat1[,1], y = mat1[,2], z = mat1[,3],
            u = dir[,1], v = dir[,2], w = dir[,3],
            color = rep(1, length(mat1[,1])), colors = c("#000000"),
            showscale = FALSE)

#ensure that no lines and numbers for axes are shown
ax <- list(
  title = "",
  zeroline = FALSE,
  showline = FALSE,
  showticklabels = FALSE,
  showgrid = FALSE
)
#Update Layout
fig = fig %>%
  layout(
    showlegend = FALSE,
    scene = list(
      aspectmode = "data", #equal aspect ratio
      xaxis = ax,
      yaxis = ax,
      zaxis = ax,
      camera = list(
        eye = list(x= -0.76, y= 1.8, z= 0.92)
      )
    )
  )

#Show plot
fig

For some reason the first and last cone have the wrong color (I'll update when I find a solution). Also, adding cones works very fast. However, now adding the lines from P0 to P1 is very slow.

enter image description here

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文